bookshelf/DocGen4/Process/Attributes.lean

183 lines
6.3 KiB
Plaintext
Raw Blame History

This file contains ambiguous Unicode characters!

This file contains ambiguous Unicode characters that may be confused with others in your current locale. If your use case is intentional and legitimate, you can safely ignore this warning. Use the Escape button to highlight these characters.

import Lean
namespace DocGen4
open Lean Meta
-- The following is probably completely overengineered but I love it
/--
Captures the notion of a value based attributes, `attrKind` is things like
`EnumAttributes`.
-/
class ValueAttr (attrKind : Type → Type) where
/--
Given a certain value based attribute, an `Environment` and the `Name` of
a declaration returns the value of the attribute on this declaration if present.
-/
getValue {α : Type} [Inhabited α] [ToString α] : attrKind α → Environment → Name → Option String
/--
Contains a specific attribute declaration of a certain attribute kind (enum based, parametric etc.).
-/
structure ValueAttrWrapper (attrKind : Type → Type) [ValueAttr attrKind] where
{α : Type}
attr : attrKind α
[str : ToString α]
[inhab : Inhabited α]
/--
Obtain the value of an enum attribute for a certain name.
-/
def enumGetValue {α : Type} [Inhabited α] [ToString α] (attr : EnumAttributes α) (env : Environment) (decl : Name) : Option String := do
let val ← EnumAttributes.getValue attr env decl
some (toString val)
instance : ValueAttr EnumAttributes where
getValue := enumGetValue
/--
Obtain the value of a parametric attribute for a certain name.
-/
def parametricGetValue {α : Type} [Inhabited α] [ToString α] (attr : ParametricAttribute α) (env : Environment) (decl : Name) : Option String := do
let val ← ParametricAttribute.getParam? attr env decl
some (attr.attr.name.toString ++ " " ++ toString val)
instance : ValueAttr ParametricAttribute where
getValue := parametricGetValue
abbrev EnumAttrWrapper := ValueAttrWrapper EnumAttributes
abbrev ParametricAttrWrapper := ValueAttrWrapper ParametricAttribute
/--
The list of all tag based attributes doc-gen knows about and can recover.
-/
def tagAttributes : Array TagAttribute :=
#[IR.UnboxResult.unboxAttr, neverExtractAttr,
Elab.Term.elabWithoutExpectedTypeAttr, matchPatternAttr]
deriving instance Repr for Compiler.InlineAttributeKind
deriving instance Repr for Compiler.SpecializeAttributeKind
open Compiler in
instance : ToString InlineAttributeKind where
toString kind :=
match kind with
| .inline => "inline"
| .noinline => "noinline"
| .macroInline => "macro_inline"
| .inlineIfReduce => "inline_if_reduce"
| .alwaysInline => "always_inline"
open Compiler in
instance : ToString SpecializeAttributeKind where
toString kind :=
match kind with
| .specialize => "specialize"
| .nospecialize => "nospecialize"
instance : ToString ReducibilityStatus where
toString kind :=
match kind with
| .reducible => "reducible"
| .semireducible => "semireducible"
| .irreducible => "irreducible"
/--
The list of all enum based attributes doc-gen knows about and can recover.
-/
@[reducible]
def enumAttributes : Array EnumAttrWrapper := #[⟨Compiler.inlineAttrs⟩, ⟨reducibilityAttrs⟩]
instance : ToString ExternEntry where
toString entry :=
match entry with
| .adhoc `all => ""
| .adhoc backend => s!"{backend} adhoc"
| .standard `all fn => fn
| .standard backend fn => s!"{backend} {fn}"
| .inline backend pattern => s!"{backend} inline {String.quote pattern}"
-- TODO: The docs in the module dont specific how to render this
| .foreign backend fn => s!"{backend} foreign {fn}"
instance : ToString ExternAttrData where
toString data := (data.arity?.map toString |>.getD "") ++ " " ++ String.intercalate " " (data.entries.map toString)
/--
The list of all parametric attributes (that is, attributes with any kind of information attached)
doc-gen knows about and can recover.
-/
def parametricAttributes : Array ParametricAttrWrapper := #[⟨externAttr⟩, ⟨Compiler.implementedByAttr⟩, ⟨exportAttr⟩, ⟨Compiler.specializeAttr⟩]
def getTags (decl : Name) : MetaM (Array String) := do
let env ← getEnv
return tagAttributes.filter (TagAttribute.hasTag · env decl) |>.map (·.attr.name.toString)
def getValuesAux {α : Type} {attrKind : Type → Type} [va : ValueAttr attrKind] [Inhabited α] [ToString α] (decl : Name) (attr : attrKind α) : MetaM (Option String) := do
let env ← getEnv
return va.getValue attr env decl
def getValues {attrKind : Type → Type} [ValueAttr attrKind] (decl : Name) (attrs : Array (ValueAttrWrapper attrKind)) : MetaM (Array String) := do
let mut res := #[]
for attr in attrs do
if let some val ← @getValuesAux attr.α attrKind _ attr.inhab attr.str decl attr.attr then
res := res.push val
return res
def getEnumValues (decl : Name) : MetaM (Array String) := getValues decl enumAttributes
def getParametricValues (decl : Name) : MetaM (Array String) := do
let mut uniform ← getValues decl parametricAttributes
-- This attribute contains an `Option Name` but we would like to pretty print it better
if let some depTag := Linter.deprecatedAttr.getParam? (← getEnv) decl then
let str := match depTag with
| some alt => s!"deprecated {alt.toString}"
| none => "deprecated"
uniform := uniform.push str
return uniform
def getDefaultInstance (decl : Name) (className : Name) : MetaM (Option String) := do
let insts ← getDefaultInstances className
for (inst, prio) in insts do
if inst == decl then
return some s!"defaultInstance {prio}"
return none
def hasSimp (decl : Name) : MetaM (Option String) := do
let thms ← simpExtension.getTheorems
if thms.isLemma (.decl decl) then
return "simp"
else
return none
def hasCsimp (decl : Name) : MetaM (Option String) := do
let env ← getEnv
if Compiler.hasCSimpAttribute env decl then
return some "csimp"
else
return none
/--
The list of custom attributes, that don't fit in the parametric or enum
attribute kinds, doc-gen konws about and can recover.
-/
def customAttrs := #[hasSimp, hasCsimp]
def getCustomAttrs (decl : Name) : MetaM (Array String) := do
let mut values := #[]
for attr in customAttrs do
if let some value ← attr decl then
values := values.push value
return values
/--
The main entry point for recovering all attribute values for a given
declaration.
-/
def getAllAttributes (decl : Name) : MetaM (Array String) := do
let tags ← getTags decl
let enums ← getEnumValues decl
let parametric ← getParametricValues decl
let customs ← getCustomAttrs decl
return customs ++ tags ++ enums ++ parametric
end DocGen4