Merge pull request #28 from leanprover/modifiers

Remaining modifiers for declarations
main
Henrik Böving 2022-02-13 03:35:21 +01:00 committed by GitHub
commit 96c8a048e3
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
19 changed files with 438 additions and 209 deletions

View File

@ -9,3 +9,4 @@ import DocGen4.Load
import DocGen4.ToHtmlFormat import DocGen4.ToHtmlFormat
import DocGen4.IncludeStr import DocGen4.IncludeStr
import DocGen4.Output import DocGen4.Output
import DocGen4.Attributes

110
DocGen4/Attributes.lean Normal file
View File

@ -0,0 +1,110 @@
import Lean
namespace DocGen4
open Lean Meta
-- The following is probably completely overengineered but I love it
class ValueAttr (attrKind : Type → Type) where
getValue {α : Type} [Inhabited α] [ToString α] : attrKind α → Environment → Name → Option String
structure ValueAttrWrapper (attrKind : Type → Type) [ValueAttr attrKind] where
{α : Type}
attr : attrKind α
[str : ToString α]
[inhab : Inhabited α]
def enumGetValue {α : Type} [Inhabited α] [ToString α] (attr : EnumAttributes α) (env : Environment) (decl : Name) : Option String := OptionM.run do
let val ← EnumAttributes.getValue attr env decl
some (toString val)
instance : ValueAttr EnumAttributes where
getValue := enumGetValue
def parametricGetValue {α : Type} [Inhabited α] [ToString α] (attr : ParametricAttribute α) (env : Environment) (decl : Name) : Option String := OptionM.run 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
def tagAttributes : Array TagAttribute := #[IR.UnboxResult.unboxAttr, neverExtractAttr, Elab.Term.elabWithoutExpectedTypeAttr, SynthInstance.inferTCGoalsRLAttr, 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
| InlineAttributeKind.inline => "inline"
| InlineAttributeKind.noinline => "noinline"
| InlineAttributeKind.macroInline => "macroInline"
| InlineAttributeKind.inlineIfReduce => "inlineIfReduce"
open Compiler in
instance : ToString SpecializeAttributeKind where
toString kind :=
match kind with
| SpecializeAttributeKind.specialize => "specialize"
| SpecializeAttributeKind.nospecialize => "nospecialize"
def enumAttributes : Array EnumAttrWrapper := #[⟨Compiler.inlineAttrs⟩, ⟨Compiler.specializeAttrs⟩]
instance : ToString ExternEntry where
toString entry :=
match entry with
| ExternEntry.adhoc `all => ""
| ExternEntry.adhoc backend => s!"{backend} adhoc"
| ExternEntry.standard `all fn => fn
| ExternEntry.standard backend fn => s!"{backend} {fn}"
| ExternEntry.inline backend pattern => s!"{backend} inline {String.quote pattern}"
-- TODO: The docs in the module dont specific how to render this
| ExternEntry.foreign backend fn => s!"{backend} foreign {fn}"
instance : ToString ExternAttrData where
toString data := (data.arity?.map toString |>.getD "") ++ String.intercalate " " (data.entries.map toString)
def parametricAttributes : Array ParametricAttrWrapper := #[⟨externAttr⟩, ⟨Compiler.implementedByAttr⟩]
def getTags (decl : Name) : MetaM (Array String) := do
let env ← getEnv
pure $ tagAttributes.filter (TagAttribute.hasTag · env decl) |>.map (λ t => t.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
pure $ va.getValue attr env decl
def getValues {attrKind : Type → Type} [ValueAttr attrKind] (decl : Name) (attrs : Array (ValueAttrWrapper attrKind)) : MetaM (Array String) := do
let env ← getEnv
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
pure res
def getEnumValues (decl : Name) : MetaM (Array String) := getValues decl enumAttributes
def getParametricValues (decl : Name) : MetaM (Array String) := getValues decl parametricAttributes
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}"
pure none
def hasSimp (decl : Name) : MetaM (Bool) := do
let thms ← simpExtension.getTheorems
pure $ thms.isLemma decl
def getAllAttributes (decl : Name) : MetaM (Array String) := do
let tags ← getTags decl
let enums ← getEnumValues decl
let parametric ← getParametricValues decl
let simp := if ←hasSimp decl then #["simp"] else #[]
pure $ simp ++ tags ++ enums ++ parametric
end DocGen4

View File

@ -19,7 +19,7 @@ syntax (name := includeStr) "include_str" str : term
throwError s!"{str} is a directory" throwError s!"{str} is a directory"
else else
let content ← FS.readFile path let content ← FS.readFile path
return mkStrLit content pure $ mkStrLit content
else else
throwError s!"\"{str}\" does not exist as a file" throwError s!"\"{str}\" does not exist as a file"

View File

@ -14,10 +14,10 @@ open Lean System Std IO
def getLakePath : IO FilePath := do def getLakePath : IO FilePath := do
match (← IO.getEnv "LAKE") with match (← IO.getEnv "LAKE") with
| some path => System.FilePath.mk path | some path => pure $ System.FilePath.mk path
| none => | none =>
let lakePath := (←findSysroot?) / "bin" / "lake" let lakePath := (←findSysroot?) / "bin" / "lake"
lakePath.withExtension System.FilePath.exeExtension pure $ lakePath.withExtension System.FilePath.exeExtension
-- Modified from the LSP Server -- Modified from the LSP Server
def lakeSetupSearchPath (lakePath : System.FilePath) (imports : Array String) : IO Lean.SearchPath := do def lakeSetupSearchPath (lakePath : System.FilePath) (imports : Array String) : IO Lean.SearchPath := do

View File

@ -32,22 +32,22 @@ def getGithubBaseUrl : IO String := do
if url.startsWith "git@" then if url.startsWith "git@" then
url := url.drop 15 url := url.drop 15
url := url.dropRight 4 url := url.dropRight 4
s!"https://github.com/{url}" pure s!"https://github.com/{url}"
else if url.endsWith ".git" then else if url.endsWith ".git" then
url.dropRight 4 pure $ url.dropRight 4
else else
url pure url
def getCommit : IO String := do def getCommit : IO String := do
let out ← IO.Process.output {cmd := "git", args := #["rev-parse", "HEAD"]} let out ← IO.Process.output {cmd := "git", args := #["rev-parse", "HEAD"]}
if out.exitCode != 0 then if out.exitCode != 0 then
throw <| IO.userError <| "git exited with code " ++ toString out.exitCode throw <| IO.userError <| "git exited with code " ++ toString out.exitCode
out.stdout.trimRight pure out.stdout.trimRight
def sourceLinker : IO (Name → Option DeclarationRange → String) := do def sourceLinker : IO (Name → Option DeclarationRange → String) := do
let baseUrl ← getGithubBaseUrl let baseUrl ← getGithubBaseUrl
let commit ← getCommit let commit ← getCommit
return λ name range => pure λ name range =>
let parts := name.components.map Name.toString let parts := name.components.map Name.toString
let path := (parts.intersperse "/").foldl (· ++ ·) "" let path := (parts.intersperse "/").foldl (· ++ ·) ""
let r := name.getRoot let r := name.getRoot

View File

@ -25,17 +25,17 @@ def setCurrentName (name : Name) (ctx : SiteContext) := {ctx with currentName :=
abbrev HtmlT := ReaderT SiteContext abbrev HtmlT := ReaderT SiteContext
abbrev HtmlM := HtmlT Id abbrev HtmlM := HtmlT Id
def getRoot : HtmlM String := do (←read).root def getRoot : HtmlM String := do pure (←read).root
def getResult : HtmlM AnalyzerResult := do (←read).result def getResult : HtmlM AnalyzerResult := do pure (←read).result
def getCurrentName : HtmlM (Option Name) := do (←read).currentName def getCurrentName : HtmlM (Option Name) := do pure (←read).currentName
def getSourceUrl (module : Name) (range : Option DeclarationRange): HtmlM String := do (←read).sourceLinker module range def getSourceUrl (module : Name) (range : Option DeclarationRange): HtmlM String := do pure $ (←read).sourceLinker module range
def templateExtends {α β : Type} (base : α → HtmlM β) (new : HtmlM α) : HtmlM β := def templateExtends {α β : Type} (base : α → HtmlM β) (new : HtmlM α) : HtmlM β :=
new >>= base new >>= base
def moduleNameToLink (n : Name) : HtmlM String := do def moduleNameToLink (n : Name) : HtmlM String := do
let parts := n.components.map Name.toString let parts := n.components.map Name.toString
(←getRoot) ++ (parts.intersperse "/").foldl (· ++ ·) "" ++ ".html" pure $ (←getRoot) ++ (parts.intersperse "/").foldl (· ++ ·) "" ++ ".html"
def moduleNameToFile (basePath : FilePath) (n : Name) : FilePath := def moduleNameToFile (basePath : FilePath) (n : Name) : FilePath :=
let parts := n.components.map Name.toString let parts := n.components.map Name.toString
@ -53,7 +53,7 @@ end Static
def declNameToLink (name : Name) : HtmlM String := do def declNameToLink (name : Name) : HtmlM String := do
let res ← getResult let res ← getResult
let module := res.moduleNames[res.name2ModIdx.find! name] let module := res.moduleNames[res.name2ModIdx.find! name]
(←moduleNameToLink module) ++ "#" ++ name.toString pure $ (←moduleNameToLink module) ++ "#" ++ name.toString
def splitWhitespaces (s : String) : (String × String × String) := Id.run do def splitWhitespaces (s : String) : (String × String × String) := Id.run do
let front := "".pushn ' ' (s.find (!Char.isWhitespace ·)) let front := "".pushn ' ' (s.find (!Char.isWhitespace ·))
@ -64,8 +64,8 @@ def splitWhitespaces (s : String) : (String × String × String) := Id.run do
partial def infoFormatToHtml (i : CodeWithInfos) : HtmlM (Array Html) := do partial def infoFormatToHtml (i : CodeWithInfos) : HtmlM (Array Html) := do
match i with match i with
| TaggedText.text t => return #[t] | TaggedText.text t => pure #[t]
| TaggedText.append tt => tt.foldlM (λ acc t => do acc ++ (←infoFormatToHtml t)) #[] | TaggedText.append tt => tt.foldlM (λ acc t => do pure $ acc ++ (←infoFormatToHtml t)) #[]
| TaggedText.tag a t => | TaggedText.tag a t =>
match a.info.val.info with match a.info.val.info with
| Info.ofTermInfo i => | Info.ofTermInfo i =>
@ -75,13 +75,13 @@ partial def infoFormatToHtml (i : CodeWithInfos) : HtmlM (Array Html) := do
| TaggedText.text t => | TaggedText.text t =>
let (front, t, back) := splitWhitespaces t let (front, t, back) := splitWhitespaces t
let elem := Html.element "a" true #[("href", ←declNameToLink name)] #[t] let elem := Html.element "a" true #[("href", ←declNameToLink name)] #[t]
#[Html.text front, elem, Html.text back] pure #[Html.text front, elem, Html.text back]
| _ => | _ =>
-- TODO: Is this ever reachable? -- TODO: Is this ever reachable?
#[Html.element "a" true #[("href", ←declNameToLink name)] (←infoFormatToHtml t)] pure #[Html.element "a" true #[("href", ←declNameToLink name)] (←infoFormatToHtml t)]
| _ => | _ =>
#[Html.element "span" true #[("class", "fn")] (←infoFormatToHtml t)] pure #[Html.element "span" true #[("class", "fn")] (←infoFormatToHtml t)]
| _ => #[Html.element "span" true #[("class", "fn")] (←infoFormatToHtml t)] | _ => pure #[Html.element "span" true #[("class", "fn")] (←infoFormatToHtml t)]
end Output end Output
end DocGen4 end DocGen4

View File

@ -8,11 +8,12 @@ open scoped DocGen4.Jsx
open Lean open Lean
def classInstanceToHtml (name : Name) : HtmlM Html := do def classInstanceToHtml (name : Name) : HtmlM Html := do
<li><a href={←declNameToLink name}>{name.toString}</a></li> pure <li><a href={←declNameToLink name}>{name.toString}</a></li>
def classInstancesToHtml (i : ClassInfo) : HtmlM Html := do def classInstancesToHtml (instances : Array Name) : HtmlM Html := do
let instancesHtml ← i.instances.mapM classInstanceToHtml let instancesHtml ← instances.mapM classInstanceToHtml
return <details «class»="instances"> pure
<details «class»="instances">
<summary>Instances</summary> <summary>Instances</summary>
<ul> <ul>
[instancesHtml] [instancesHtml]
@ -20,7 +21,7 @@ def classInstancesToHtml (i : ClassInfo) : HtmlM Html := do
</details> </details>
def classToHtml (i : ClassInfo) : HtmlM (Array Html) := do def classToHtml (i : ClassInfo) : HtmlM (Array Html) := do
(←structureToHtml i.toStructureInfo).push (←classInstancesToHtml i) pure $ (←structureToHtml i.toStructureInfo).push (←classInstancesToHtml i.instances)
end Output end Output
end DocGen4 end DocGen4

View File

@ -0,0 +1,13 @@
import DocGen4.Output.Template
import DocGen4.Output.Class
import DocGen4.Output.Inductive
namespace DocGen4
namespace Output
def classInductiveToHtml (i : ClassInductiveInfo) : HtmlM (Array Html) := do
pure $ (←inductiveToHtml i.toInductiveInfo).push (←classInstancesToHtml i.instances)
end Output
end DocGen4

View File

@ -7,26 +7,27 @@ open scoped DocGen4.Jsx
open Lean Widget open Lean Widget
def equationToHtml (c : CodeWithInfos) : HtmlM Html := do def equationToHtml (c : CodeWithInfos) : HtmlM Html := do
<li «class»="equation">[←infoFormatToHtml c]</li> pure <li «class»="equation">[←infoFormatToHtml c]</li>
def equationsToHtml (i : DefinitionInfo) : HtmlM (Option Html) := do def equationsToHtml (i : DefinitionInfo) : HtmlM (Option Html) := do
if let some eqs i.equations then if let some eqs := i.equations then
let equationsHtml ← eqs.mapM equationToHtml let equationsHtml ← eqs.mapM equationToHtml
return <details> pure
<summary>Equations</summary> <details>
<ul «class»="equations"> <summary>Equations</summary>
[equationsHtml] <ul «class»="equations">
</ul> [equationsHtml]
</details> </ul>
</details>
else else
return none pure none
def definitionToHtml (i : DefinitionInfo) : HtmlM (Array Html) := do def definitionToHtml (i : DefinitionInfo) : HtmlM (Array Html) := do
let equationsHtml ← equationsToHtml i let equationsHtml ← equationsToHtml i
if let some equationsHtml equationsHtml then if let some equationsHtml := equationsHtml then
#[equationsHtml] pure #[equationsHtml]
else else
#[] pure #[]
end Output end Output
end DocGen4 end DocGen4

View File

@ -11,7 +11,7 @@ namespace Output
open scoped DocGen4.Jsx open scoped DocGen4.Jsx
def index : HtmlM Html := do templateExtends (baseHtml "Index") $ def index : HtmlM Html := do templateExtends (baseHtml "Index") $ pure $
<main> <main>
<a id="top"></a> <a id="top"></a>
<h1> Welcome to the documentation page </h1> <h1> Welcome to the documentation page </h1>

View File

@ -8,10 +8,10 @@ open scoped DocGen4.Jsx
def ctorToHtml (i : NameInfo) : HtmlM Html := do def ctorToHtml (i : NameInfo) : HtmlM Html := do
let shortName := i.name.components'.head!.toString let shortName := i.name.components'.head!.toString
let name := i.name.toString let name := i.name.toString
return <li «class»="constructor" id={name}>{shortName} : [←infoFormatToHtml i.type]</li> pure <li «class»="constructor" id={name}>{shortName} : [←infoFormatToHtml i.type]</li>
def inductiveToHtml (i : InductiveInfo) : HtmlM (Array Html) := def inductiveToHtml (i : InductiveInfo) : HtmlM (Array Html) := do
return #[<ul "class"="constructors">[← i.ctors.toArray.mapM ctorToHtml]</ul>] pure #[<ul "class"="constructors">[← i.ctors.toArray.mapM ctorToHtml]</ul>]
end Output end Output
end DocGen4 end DocGen4

View File

@ -9,6 +9,7 @@ import DocGen4.Output.Structure
import DocGen4.Output.Class import DocGen4.Output.Class
import DocGen4.Output.Definition import DocGen4.Output.Definition
import DocGen4.Output.Instance import DocGen4.Output.Instance
import DocGen4.Output.ClassInductive
namespace DocGen4 namespace DocGen4
namespace Output namespace Output
@ -30,9 +31,9 @@ def argToHtml (arg : Arg) : HtmlM Html := do
let inner := Html.element "span" true #[("class", "fn")] nodes let inner := Html.element "span" true #[("class", "fn")] nodes
let html := Html.element "span" false #[("class", "decl_args")] #[inner] let html := Html.element "span" false #[("class", "decl_args")] #[inner]
if implicit then if implicit then
<span «class»="impl_arg">{html}</span> pure <span «class»="impl_arg">{html}</span>
else else
html pure html
def structureInfoHeader (s : StructureInfo) : HtmlM (Array Html) := do def structureInfoHeader (s : StructureInfo) : HtmlM (Array Html) := do
let mut nodes := #[] let mut nodes := #[]
@ -45,13 +46,11 @@ def structureInfoHeader (s : StructureInfo) : HtmlM (Array Html) := do
let html:= Html.element "span" false #[("class", "decl_parent")] #[inner] let html:= Html.element "span" false #[("class", "decl_parent")] #[inner]
parents := parents.push html parents := parents.push html
nodes := nodes.append (parents.toList.intersperse (Html.text ", ")).toArray nodes := nodes.append (parents.toList.intersperse (Html.text ", ")).toArray
nodes pure nodes
def docInfoHeader (doc : DocInfo) : HtmlM Html := do def docInfoHeader (doc : DocInfo) : HtmlM Html := do
let mut nodes := #[] let mut nodes := #[]
-- TODO: noncomputable, partial nodes := nodes.push <span «class»="decl_kind">{doc.getKindDescription}</span>
-- TODO: Support all the kinds in CSS
nodes := nodes.push <span «class»="decl_kind">{doc.getKind}</span>
nodes := nodes.push nodes := nodes.push
<span «class»="decl_name"> <span «class»="decl_name">
<a «class»="break_within" href={←declNameToLink doc.getName}> <a «class»="break_within" href={←declNameToLink doc.getName}>
@ -70,28 +69,37 @@ def docInfoHeader (doc : DocInfo) : HtmlM Html := do
nodes := nodes.push <span «class»="decl_args">:</span> nodes := nodes.push <span «class»="decl_args">:</span>
nodes := nodes.push $ Html.element "div" true #[("class", "decl_type")] (←infoFormatToHtml doc.getType) nodes := nodes.push $ Html.element "div" true #[("class", "decl_type")] (←infoFormatToHtml doc.getType)
return <div «class»="decl_header"> [nodes] </div> pure <div «class»="decl_header"> [nodes] </div>
def docInfoToHtml (module : Name) (doc : DocInfo) : HtmlM Html := do def docInfoToHtml (module : Name) (doc : DocInfo) : HtmlM Html := do
let doc_html ← match doc with let docHtml ← match doc with
| DocInfo.inductiveInfo i => inductiveToHtml i | DocInfo.inductiveInfo i => inductiveToHtml i
| DocInfo.structureInfo i => structureToHtml i | DocInfo.structureInfo i => structureToHtml i
| DocInfo.classInfo i => classToHtml i | DocInfo.classInfo i => classToHtml i
| DocInfo.definitionInfo i => definitionToHtml i | DocInfo.definitionInfo i => definitionToHtml i
| DocInfo.instanceInfo i => instanceToHtml i | DocInfo.instanceInfo i => instanceToHtml i
| _ => #[] | DocInfo.classInductiveInfo i => classInductiveToHtml i
| _ => pure #[]
return <div «class»="decl" id={doc.getName.toString}> let attrs := doc.getAttrs
<div «class»={doc.getKind}> let attrsHtml :=
<div «class»="gh_link"> if attrs.size > 0 then
-- TODO: Put the proper source link let attrStr := "@[" ++ String.intercalate ", " doc.getAttrs.toList ++ "]"
<a href={←getSourceUrl module doc.getDeclarationRange}>source</a> #[Html.element "div" false #[("class", "attributes")] #[attrStr]]
else
#[]
pure
<div «class»="decl" id={doc.getName.toString}>
<div «class»={doc.getKind}>
<div «class»="gh_link">
<a href={←getSourceUrl module doc.getDeclarationRange}>source</a>
</div>
[attrsHtml]
{←docInfoHeader doc}
[docHtml]
</div> </div>
-- TODO: Attributes
{←docInfoHeader doc}
[←doc_html]
</div> </div>
</div>
def declarationToNavLink (module : Name) : Html := def declarationToNavLink (module : Name) : Html :=
<div «class»="nav_link"> <div «class»="nav_link">
@ -100,62 +108,62 @@ def declarationToNavLink (module : Name) : Html :=
-- TODO: Similar functions are used all over the place, we should dedup them -- TODO: Similar functions are used all over the place, we should dedup them
def moduleToNavLink (module : Name) : HtmlM Html := do def moduleToNavLink (module : Name) : HtmlM Html := do
<a href={←moduleNameToLink module}>{module.toString}</a> pure <a href={←moduleNameToLink module}>{module.toString}</a>
def getImports (module : Name) : HtmlM (Array Name) := do def getImports (module : Name) : HtmlM (Array Name) := do
let res ← getResult let res ← getResult
let some idx res.moduleNames.findIdx? (. == module) | unreachable! let some idx := res.moduleNames.findIdx? (. == module) | unreachable!
let adj := res.importAdj.get! idx let adj := res.importAdj.get! idx
let mut imports := #[] let mut imports := #[]
for i in [:adj.size] do for i in [:adj.size] do
if adj.get! i then if adj.get! i then
imports := imports.push (res.moduleNames.get! i) imports := imports.push (res.moduleNames.get! i)
imports pure imports
def getImportedBy (module : Name) : HtmlM (Array Name) := do def getImportedBy (module : Name) : HtmlM (Array Name) := do
let res ← getResult let res ← getResult
let some idx res.moduleNames.findIdx? (. == module) | unreachable! let some idx := res.moduleNames.findIdx? (. == module) | unreachable!
let adj := res.importAdj let adj := res.importAdj
let mut impBy := #[] let mut impBy := #[]
for i in [:adj.size] do for i in [:adj.size] do
if adj.get! i |>.get! idx then if adj.get! i |>.get! idx then
impBy := impBy.push (res.moduleNames.get! i) impBy := impBy.push (res.moduleNames.get! i)
impBy pure impBy
def importedByHtml (moduleName : Name) : HtmlM (Array Html) := do def importedByHtml (moduleName : Name) : HtmlM (Array Html) := do
let imports := (←getImportedBy moduleName) |>.qsort Name.lt let imports := (←getImportedBy moduleName) |>.qsort Name.lt
imports.mapM (λ i => do <li>{←moduleToNavLink i}</li>) imports.mapM (λ i => do pure <li>{←moduleToNavLink i}</li>)
def importsHtml (moduleName : Name) : HtmlM (Array Html) := do def importsHtml (moduleName : Name) : HtmlM (Array Html) := do
let imports := (←getImports moduleName) |>.qsort Name.lt let imports := (←getImports moduleName) |>.qsort Name.lt
imports.mapM (λ i => do <li>{←moduleToNavLink i}</li>) imports.mapM (λ i => do pure <li>{←moduleToNavLink i}</li>)
def internalNav (members : Array Name) (moduleName : Name) : HtmlM Html := do def internalNav (members : Array Name) (moduleName : Name) : HtmlM Html := do
<nav «class»="internal_nav"> pure
<h3><a «class»="break_within" href="#top">{moduleName.toString}</a></h3> <nav «class»="internal_nav">
-- TODO: Proper source links <h3><a «class»="break_within" href="#top">{moduleName.toString}</a></h3>
<p «class»="gh_nav_link"><a href={←getSourceUrl moduleName none}>source</a></p> <p «class»="gh_nav_link"><a href={←getSourceUrl moduleName none}>source</a></p>
<div «class»="imports"> <div «class»="imports">
<details> <details>
<summary>Imports</summary> <summary>Imports</summary>
<ul> <ul>
[←importsHtml moduleName] [←importsHtml moduleName]
</ul> </ul>
</details> </details>
<details> <details>
<summary>Imported by</summary> <summary>Imported by</summary>
<ul> <ul>
[←importedByHtml moduleName] [←importedByHtml moduleName]
</ul> </ul>
</details> </details>
</div> </div>
[members.map declarationToNavLink] [members.map declarationToNavLink]
</nav> </nav>
def moduleToHtml (module : Module) : HtmlM Html := withReader (setCurrentName module.name) do def moduleToHtml (module : Module) : HtmlM Html := withReader (setCurrentName module.name) do
let docInfos ← module.members.mapM (λ i => docInfoToHtml module.name i) let docInfos ← module.members.mapM (λ i => docInfoToHtml module.name i)
templateExtends (baseHtmlArray module.name.toString) $ #[ templateExtends (baseHtmlArray module.name.toString) $ pure #[
←internalNav (module.members.map DocInfo.getName) module.name, ←internalNav (module.members.map DocInfo.getName) module.name,
Html.element "main" false #[] docInfos Html.element "main" false #[] docInfos
] ]

View File

@ -13,8 +13,8 @@ namespace Output
open Lean open Lean
open scoped DocGen4.Jsx open scoped DocGen4.Jsx
def moduleListFile (file : Name) : HtmlM Html := def moduleListFile (file : Name) : HtmlM Html := do
return <div "class"="nav_link" [if (← getCurrentName) == file then #[("visible", "")] else #[]]> pure <div "class"="nav_link" [if (← getCurrentName) == file then #[("visible", "")] else #[]]>
<a href={← moduleNameToLink file}>{file.toString}</a> <a href={← moduleNameToLink file}>{file.toString}</a>
</div> </div>
@ -25,36 +25,38 @@ partial def moduleListDir (h : Hierarchy) : HtmlM Html := do
let dirNodes ← (dirs.mapM moduleListDir) let dirNodes ← (dirs.mapM moduleListDir)
let fileNodes ← (files.mapM moduleListFile) let fileNodes ← (files.mapM moduleListFile)
let moduleLink ← moduleNameToLink h.getName let moduleLink ← moduleNameToLink h.getName
return <details "class"="nav_sect" "data-path"={moduleLink} pure
[if (← getCurrentName).any (h.getName.isPrefixOf ·) then #[("open", "")] else #[]]> <details "class"="nav_sect" "data-path"={moduleLink}
<summary>{h.getName.toString}</summary> [if (←getCurrentName).any (h.getName.isPrefixOf ·) then #[("open", "")] else #[]]>
[dirNodes] <summary>{h.getName.toString}</summary>
[fileNodes] [dirNodes]
</details> [fileNodes]
</details>
def moduleList : HtmlM Html := do def moduleList : HtmlM Html := do
let hierarchy := (←getResult).hierarchy let hierarchy := (←getResult).hierarchy
let mut list := Array.empty let mut list := Array.empty
for (n, cs) in hierarchy.getChildren do for (n, cs) in hierarchy.getChildren do
list := list.push $ ←moduleListDir cs list := list.push $ ←moduleListDir cs
return <div "class"="module_list">[list]</div> pure <div "class"="module_list">[list]</div>
def navbar : HtmlM Html := do def navbar : HtmlM Html := do
<nav «class»="nav"> pure
<h3>General documentation</h3> <nav «class»="nav">
<div «class»="nav_link"><a href={s!"{←getRoot}"}>index</a></div> <h3>General documentation</h3>
/- <div «class»="nav_link"><a href={s!"{←getRoot}"}>index</a></div>
TODO: Add these in later /-
<div «class»="nav_link"><a href={s!"{←getRoot}tactics.html"}>tactics</a></div> TODO: Add these in later
<div «class»="nav_link"><a href={s!"{←getRoot}commands.html"}>commands</a></div> <div «class»="nav_link"><a href={s!"{←getRoot}tactics.html"}>tactics</a></div>
<div «class»="nav_link"><a href={s!"{←getRoot}hole_commands.html"}>hole commands</a></div> <div «class»="nav_link"><a href={s!"{←getRoot}commands.html"}>commands</a></div>
<div «class»="nav_link"><a href={s!"{←getRoot}attributes.html"}>attributes</a></div> <div «class»="nav_link"><a href={s!"{←getRoot}hole_commands.html"}>hole commands</a></div>
<div «class»="nav_link"><a href={s!"{←getRoot}notes.html"}>notes</a></div> <div «class»="nav_link"><a href={s!"{←getRoot}attributes.html"}>attributes</a></div>
<div «class»="nav_link"><a href={s!"{←getRoot}references.html"}>references</a></div> <div «class»="nav_link"><a href={s!"{←getRoot}notes.html"}>notes</a></div>
-/ <div «class»="nav_link"><a href={s!"{←getRoot}references.html"}>references</a></div>
<h3>Library</h3> -/
{← moduleList} <h3>Library</h3>
</nav> {← moduleList}
</nav>
end Output end Output
end DocGen4 end DocGen4

View File

@ -11,7 +11,7 @@ namespace Output
open scoped DocGen4.Jsx open scoped DocGen4.Jsx
def notFound : HtmlM Html := do templateExtends (baseHtml "404") $ def notFound : HtmlM Html := do templateExtends (baseHtml "404") $ pure $
<main> <main>
<h1>404 Not Found</h1> <h1>404 Not Found</h1>
<p> Unfortunately, the page you were looking for is no longer here. </p> <p> Unfortunately, the page you were looking for is no longer here. </p>

View File

@ -9,16 +9,18 @@ open Lean
def fieldToHtml (f : NameInfo) : HtmlM Html := do def fieldToHtml (f : NameInfo) : HtmlM Html := do
let shortName := f.name.components'.head!.toString let shortName := f.name.components'.head!.toString
let name := f.name.toString let name := f.name.toString
return <li «class»="structure_field" id={name}>{s!"{shortName} "} : [←infoFormatToHtml f.type]</li> pure <li «class»="structure_field" id={name}>{s!"{shortName} "} : [←infoFormatToHtml f.type]</li>
def structureToHtml (i : StructureInfo) : HtmlM (Array Html) := do def structureToHtml (i : StructureInfo) : HtmlM (Array Html) := do
if Name.isSuffixOf `mk i.ctor.name then if Name.isSuffixOf `mk i.ctor.name then
#[<ul «class»="structure_fields" id={i.ctor.name.toString}> pure #[
[←i.fieldInfo.mapM fieldToHtml] <ul «class»="structure_fields" id={i.ctor.name.toString}>
</ul>] [←i.fieldInfo.mapM fieldToHtml]
</ul>]
else else
let ctorShortName := i.ctor.name.components'.head!.toString let ctorShortName := i.ctor.name.components'.head!.toString
#[<ul «class»="structure_ext"> pure #[
<ul «class»="structure_ext">
<li id={i.ctor.name.toString} «class»="structure_ext_ctor">{s!"{ctorShortName} "} :: (</li> <li id={i.ctor.name.toString} «class»="structure_ext_ctor">{s!"{ctorShortName} "} :: (</li>
<ul «class»="structure_ext_fields"> <ul «class»="structure_ext_fields">
[←i.fieldInfo.mapM fieldToHtml] [←i.fieldInfo.mapM fieldToHtml]

View File

@ -12,44 +12,45 @@ namespace Output
open scoped DocGen4.Jsx open scoped DocGen4.Jsx
def baseHtmlArray (title : String) (site : Array Html) : HtmlM Html := do def baseHtmlArray (title : String) (site : Array Html) : HtmlM Html := do
<html lang="en"> pure
<head> <html lang="en">
<link rel="stylesheet" href={s!"{←getRoot}style.css"}/> <head>
<link rel="stylesheet" href={s!"{←getRoot}pygments.css"}/> <link rel="stylesheet" href={s!"{←getRoot}style.css"}/>
<link rel="shortcut icon" href={s!"{←getRoot}favicon.ico"}/> <link rel="stylesheet" href={s!"{←getRoot}pygments.css"}/>
<title>{title}</title> <link rel="shortcut icon" href={s!"{←getRoot}favicon.ico"}/>
<meta charset="UTF-8"/> <title>{title}</title>
<meta name="viewport" content="width=device-width, initial-scale=1"/> <meta charset="UTF-8"/>
</head> <meta name="viewport" content="width=device-width, initial-scale=1"/>
</head>
<body> <body>
<input id="nav_toggle" type="checkbox"/> <input id="nav_toggle" type="checkbox"/>
<header> <header>
<h1><label «for»="nav_toggle"></label>Documentation</h1> <h1><label «for»="nav_toggle"></label>Documentation</h1>
<p «class»="header_filename break_within">{title}</p> <p «class»="header_filename break_within">{title}</p>
-- TODO: Replace this form with our own search -- TODO: Replace this form with our own search
<form action="https://google.com/search" method="get" id="search_form"> <form action="https://google.com/search" method="get" id="search_form">
<input type="hidden" name="sitesearch" value="https://leanprover-community.github.io/mathlib_docs"/> <input type="hidden" name="sitesearch" value="https://leanprover-community.github.io/mathlib_docs"/>
<input type="text" name="q" autocomplete="off"/> <input type="text" name="q" autocomplete="off"/>
<button>Google site search</button> <button>Google site search</button>
</form> </form>
</header> </header>
[site] [site]
{←navbar} {←navbar}
-- Lean in JS in HTML in Lean...very meta -- Lean in JS in HTML in Lean...very meta
<script> <script>
siteRoot = "{←getRoot}"; siteRoot = "{←getRoot}";
</script> </script>
-- TODO Add more js stuff -- TODO Add more js stuff
<script src={s!"{←getRoot}nav.js"}></script> <script src={s!"{←getRoot}nav.js"}></script>
</body> </body>
</html> </html>
def baseHtml (title : String) (site : Html) : HtmlM Html := baseHtmlArray title #[site] def baseHtml (title : String) (site : Html) : HtmlM Html := baseHtmlArray title #[site]

View File

@ -10,6 +10,7 @@ import Std.Data.HashMap
import Lean.Meta.SynthInstance import Lean.Meta.SynthInstance
import DocGen4.Hierarchy import DocGen4.Hierarchy
import DocGen4.Attributes
namespace DocGen4 namespace DocGen4
@ -29,6 +30,7 @@ structure Info extends NameInfo where
args : Array Arg args : Array Arg
doc : Option String doc : Option String
declarationRange : DeclarationRange declarationRange : DeclarationRange
attrs : Array String
deriving Inhabited deriving Inhabited
structure AxiomInfo extends Info where structure AxiomInfo extends Info where
@ -40,14 +42,17 @@ structure TheoremInfo extends Info
structure OpaqueInfo extends Info where structure OpaqueInfo extends Info where
value : CodeWithInfos value : CodeWithInfos
isUnsafe : Bool -- A value of partial is interpreted as this constant being part of a partial def
-- since the actual definition for a partial def is hidden behind an inaccessible value
unsafeInformation : DefinitionSafety
deriving Inhabited deriving Inhabited
structure DefinitionInfo extends Info where structure DefinitionInfo extends Info where
--value : CodeWithInfos -- partial defs are handled by OpaqueInfo
unsafeInformation : DefinitionSafety isUnsafe : Bool
hints : ReducibilityHints hints : ReducibilityHints
equations : Option (Array CodeWithInfos) equations : Option (Array CodeWithInfos)
isComputable : Bool
deriving Inhabited deriving Inhabited
abbrev InstanceInfo := DefinitionInfo abbrev InstanceInfo := DefinitionInfo
@ -67,6 +72,10 @@ structure ClassInfo extends StructureInfo where
instances : Array Name instances : Array Name
deriving Inhabited deriving Inhabited
structure ClassInductiveInfo extends InductiveInfo where
instances : Array Name
deriving Inhabited
inductive DocInfo where inductive DocInfo where
| axiomInfo (info : AxiomInfo) : DocInfo | axiomInfo (info : AxiomInfo) : DocInfo
| theoremInfo (info : TheoremInfo) : DocInfo | theoremInfo (info : TheoremInfo) : DocInfo
@ -76,6 +85,7 @@ inductive DocInfo where
| inductiveInfo (info : InductiveInfo) : DocInfo | inductiveInfo (info : InductiveInfo) : DocInfo
| structureInfo (info : StructureInfo) : DocInfo | structureInfo (info : StructureInfo) : DocInfo
| classInfo (info : ClassInfo) : DocInfo | classInfo (info : ClassInfo) : DocInfo
| classInductiveInfo (info : ClassInductiveInfo) : DocInfo
deriving Inhabited deriving Inhabited
namespace DocInfo namespace DocInfo
@ -89,6 +99,7 @@ def getDeclarationRange : DocInfo → DeclarationRange
| inductiveInfo i => i.declarationRange | inductiveInfo i => i.declarationRange
| structureInfo i => i.declarationRange | structureInfo i => i.declarationRange
| classInfo i => i.declarationRange | classInfo i => i.declarationRange
| classInductiveInfo i => i.declarationRange
def lineOrder (l r : DocInfo) : Bool := def lineOrder (l r : DocInfo) : Bool :=
l.getDeclarationRange.pos.line < r.getDeclarationRange.pos.line l.getDeclarationRange.pos.line < r.getDeclarationRange.pos.line
@ -132,35 +143,40 @@ def prettyPrintTerm (expr : Expr) : MetaM CodeWithInfos := do
openDecls := ← getOpenDecls openDecls := ← getOpenDecls
fileMap := default fileMap := default
} }
tagExprInfos ctx infos tt pure $ tagExprInfos ctx infos tt
def Info.ofConstantVal (v : ConstantVal) : MetaM Info := do def Info.ofConstantVal (v : ConstantVal) : MetaM Info := do
let env ← getEnv let env ← getEnv
let (args, type) := typeToArgsType v.type let (args, type) := typeToArgsType v.type
let type ← prettyPrintTerm type let type ← prettyPrintTerm type
let args ← args.mapM (λ (n, e, b) => do Arg.mk n (←prettyPrintTerm e) b) let args ← args.mapM (λ (n, e, b) => do pure $ Arg.mk n (←prettyPrintTerm e) b)
let doc ← findDocString? env v.name let doc ← findDocString? env v.name
match ←findDeclarationRanges? v.name with match ←findDeclarationRanges? v.name with
-- TODO: Maybe selection range is more relevant? Figure this out in the future -- TODO: Maybe selection range is more relevant? Figure this out in the future
| some range => return Info.mk ⟨v.name, type⟩ args doc range.range | some range => pure $ Info.mk ⟨v.name, type⟩ args doc range.range (←getAllAttributes v.name)
| none => panic! s!"{v.name} is a declaration without position" | none => panic! s!"{v.name} is a declaration without position"
def AxiomInfo.ofAxiomVal (v : AxiomVal) : MetaM AxiomInfo := do def AxiomInfo.ofAxiomVal (v : AxiomVal) : MetaM AxiomInfo := do
let info ← Info.ofConstantVal v.toConstantVal let info ← Info.ofConstantVal v.toConstantVal
return AxiomInfo.mk info v.isUnsafe pure $ AxiomInfo.mk info v.isUnsafe
def TheoremInfo.ofTheoremVal (v : TheoremVal) : MetaM TheoremInfo := do def TheoremInfo.ofTheoremVal (v : TheoremVal) : MetaM TheoremInfo := do
let info ← Info.ofConstantVal v.toConstantVal let info ← Info.ofConstantVal v.toConstantVal
return TheoremInfo.mk info pure $ TheoremInfo.mk info
def OpaqueInfo.ofOpaqueVal (v : OpaqueVal) : MetaM OpaqueInfo := do def OpaqueInfo.ofOpaqueVal (v : OpaqueVal) : MetaM OpaqueInfo := do
let info ← Info.ofConstantVal v.toConstantVal let info ← Info.ofConstantVal v.toConstantVal
let t ← prettyPrintTerm v.value let t ← prettyPrintTerm v.value
return OpaqueInfo.mk info t v.isUnsafe let env ← getEnv
let isPartial := env.find? (Compiler.mkUnsafeRecName v.name) |>.isSome
if isPartial then
pure $ OpaqueInfo.mk info t DefinitionSafety.partial
else
let safety := if v.isUnsafe then DefinitionSafety.unsafe else DefinitionSafety.safe
pure $ OpaqueInfo.mk info t safety
def isInstance (declName : Name) : MetaM Bool := do def isInstance (declName : Name) : MetaM Bool := do
(instanceExtension.getState (←getEnv)).instanceNames.contains declName pure $ (instanceExtension.getState (←getEnv)).instanceNames.contains declName
partial def stripArgs (e : Expr) : Expr := partial def stripArgs (e : Expr) : Expr :=
match e.consumeMData with match e.consumeMData with
@ -184,34 +200,50 @@ def valueToEq (v : DefinitionVal) : MetaM Expr := withLCtx {} {} do
let us := v.levelParams.map mkLevelParam let us := v.levelParams.map mkLevelParam
let type ← mkEq (mkAppN (Lean.mkConst v.name us) xs) body let type ← mkEq (mkAppN (Lean.mkConst v.name us) xs) body
let type ← mkForallFVars xs type let type ← mkForallFVars xs type
type pure type
-- The following code is translated from ll_infer_type.cpp
def computable? (defn : Name) : MetaM Bool := do
let cstage2Name := defn.append `_cstage2
let env ← getEnv
pure $ env.find? cstage2Name |>.isSome
def DefinitionInfo.ofDefinitionVal (v : DefinitionVal) : MetaM DefinitionInfo := do def DefinitionInfo.ofDefinitionVal (v : DefinitionVal) : MetaM DefinitionInfo := do
let info ← Info.ofConstantVal v.toConstantVal let info ← Info.ofConstantVal v.toConstantVal
let isUnsafe := v.safety == DefinitionSafety.unsafe
let isComputable ← computable? v.name
try try
let eqs? ← getEqnsFor? v.name let eqs? ← getEqnsFor? v.name
match eqs? with match eqs? with
| some eqs => | some eqs =>
let prettyEqs ← eqs.mapM processEq let prettyEqs ← eqs.mapM processEq
DefinitionInfo.mk info v.safety v.hints prettyEqs pure $ DefinitionInfo.mk info isUnsafe v.hints prettyEqs isComputable
| none => | none =>
let eq ← prettyPrintTerm $ stripArgs (←valueToEq v) let eq ← prettyPrintTerm $ stripArgs (←valueToEq v)
DefinitionInfo.mk info v.safety v.hints (some #[eq]) pure $ DefinitionInfo.mk info isUnsafe v.hints (some #[eq]) isComputable
catch err => catch err =>
IO.println s!"WARNING: Failed to calculate equational lemmata for {v.name}: {←err.toMessageData.toString}" IO.println s!"WARNING: Failed to calculate equational lemmata for {v.name}: {←err.toMessageData.toString}"
return DefinitionInfo.mk info v.safety v.hints none pure $ DefinitionInfo.mk info isUnsafe v.hints none isComputable
def InstanceInfo.ofDefinitionVal (v : DefinitionVal) : MetaM InstanceInfo := do
let info ← DefinitionInfo.ofDefinitionVal v
let some className := getClassName (←getEnv) v.type | unreachable!
if let some instAttr ← getDefaultInstance v.name className then
pure { info with attrs := info.attrs.push instAttr }
else
pure info
def getConstructorType (ctor : Name) : MetaM CodeWithInfos := do def getConstructorType (ctor : Name) : MetaM CodeWithInfos := do
let env ← getEnv let env ← getEnv
match env.find? ctor with match env.find? ctor with
| some (ConstantInfo.ctorInfo i) => ←prettyPrintTerm i.type | some (ConstantInfo.ctorInfo i) => prettyPrintTerm i.type
| _ => panic! s!"Constructor {ctor} was requested but does not exist" | _ => panic! s!"Constructor {ctor} was requested but does not exist"
def InductiveInfo.ofInductiveVal (v : InductiveVal) : MetaM InductiveInfo := do def InductiveInfo.ofInductiveVal (v : InductiveVal) : MetaM InductiveInfo := do
let info ← Info.ofConstantVal v.toConstantVal let info ← Info.ofConstantVal v.toConstantVal
let env ← getEnv let env ← getEnv
let ctors ← v.ctors.mapM (λ name => do NameInfo.mk name (←getConstructorType name)) let ctors ← v.ctors.mapM (λ name => do pure $ NameInfo.mk name (←getConstructorType name))
return InductiveInfo.mk info ctors v.isUnsafe pure $ InductiveInfo.mk info ctors v.isUnsafe
def dropArgs (type : Expr) (n : Nat) : (Expr × List (Name × Expr)) := def dropArgs (type : Expr) (n : Nat) : (Expr × List (Name × Expr)) :=
match type, n with match type, n with
@ -229,7 +261,7 @@ def getFieldTypes (struct : Name) (ctor : ConstructorVal) (parents : Nat) : Meta
let mut field_infos := #[] let mut field_infos := #[]
for (name, type) in fields do for (name, type) in fields do
field_infos := field_infos.push { name := struct.append name, type := ←prettyPrintTerm type} field_infos := field_infos.push { name := struct.append name, type := ←prettyPrintTerm type}
field_infos pure $ field_infos
def StructureInfo.ofInductiveVal (v : InductiveVal) : MetaM StructureInfo := do def StructureInfo.ofInductiveVal (v : InductiveVal) : MetaM StructureInfo := do
let info ← Info.ofConstantVal v.toConstantVal let info ← Info.ofConstantVal v.toConstantVal
@ -240,17 +272,24 @@ def StructureInfo.ofInductiveVal (v : InductiveVal) : MetaM StructureInfo := do
match getStructureInfo? env v.name with match getStructureInfo? env v.name with
| some i => | some i =>
if i.fieldNames.size - parents.size > 0 then if i.fieldNames.size - parents.size > 0 then
return StructureInfo.mk info (←getFieldTypes v.name ctor parents.size) parents ⟨ctor.name, ctorType⟩ pure $ StructureInfo.mk info (←getFieldTypes v.name ctor parents.size) parents ⟨ctor.name, ctorType⟩
else else
return StructureInfo.mk info #[] parents ⟨ctor.name, ctorType⟩ pure $ StructureInfo.mk info #[] parents ⟨ctor.name, ctorType⟩
| none => panic! s!"{v.name} is not a structure" | none => panic! s!"{v.name} is not a structure"
def getInstances (className : Name) : MetaM (Array Name) := do
let fn ← mkConstWithFreshMVarLevels className
let (xs, _, _) ← forallMetaTelescopeReducing (← inferType fn)
let insts ← SynthInstance.getInstances (mkAppN fn xs)
pure $ insts.map Expr.constName!
def ClassInfo.ofInductiveVal (v : InductiveVal) : MetaM ClassInfo := do def ClassInfo.ofInductiveVal (v : InductiveVal) : MetaM ClassInfo := do
let sinfo ← StructureInfo.ofInductiveVal v let sinfo ← StructureInfo.ofInductiveVal v
let fn ← mkConstWithFreshMVarLevels v.name pure $ ClassInfo.mk sinfo (←getInstances v.name)
let (xs, _, _) ← forallMetaTelescopeReducing (← inferType fn)
let insts ← SynthInstance.getInstances (mkAppN fn xs) def ClassInductiveInfo.ofInductiveVal (v : InductiveVal) : MetaM ClassInductiveInfo := do
return ClassInfo.mk sinfo (insts.map Expr.constName!) let info ← InductiveInfo.ofInductiveVal v
pure $ ClassInductiveInfo.mk info (←getInstances v.name)
namespace DocInfo namespace DocInfo
@ -258,13 +297,13 @@ def isBlackListed (declName : Name) : MetaM Bool := do
match ←findDeclarationRanges? declName with match ←findDeclarationRanges? declName with
| some _ => | some _ =>
let env ← getEnv let env ← getEnv
declName.isInternal pure (declName.isInternal)
<||> isAuxRecursor env declName <||> (pure $ isAuxRecursor env declName)
<||> isNoConfusion env declName <||> (pure $ isNoConfusion env declName)
<||> isRec declName <||> isRec declName
<||> isMatcher declName <||> isMatcher declName
-- TODO: Evaluate whether filtering out declarations without range is sensible -- TODO: Evaluate whether filtering out declarations without range is sensible
| none => true | none => pure true
-- TODO: Is this actually the best way? -- TODO: Is this actually the best way?
def isProjFn (declName : Name) : MetaM Bool := do def isProjFn (declName : Name) : MetaM Bool := do
@ -275,42 +314,46 @@ def isProjFn (declName : Name) : MetaM Bool := do
match getStructureInfo? env parent with match getStructureInfo? env parent with
| some i => | some i =>
match i.fieldNames.find? (· == name) with match i.fieldNames.find? (· == name) with
| some _ => true | some _ => pure true
| none => false | none => pure false
| none => panic! s!"{parent} is not a structure" | none => panic! s!"{parent} is not a structure"
else else
false pure false
| _ => false | _ => pure false
def ofConstant : (Name × ConstantInfo) → MetaM (Option DocInfo) := λ (name, info) => do def ofConstant : (Name × ConstantInfo) → MetaM (Option DocInfo) := λ (name, info) => do
if (←isBlackListed name) then if (←isBlackListed name) then
return none return none
match info with match info with
| ConstantInfo.axiomInfo i => some $ axiomInfo (←AxiomInfo.ofAxiomVal i) | ConstantInfo.axiomInfo i => pure <| some <| axiomInfo (←AxiomInfo.ofAxiomVal i)
| ConstantInfo.thmInfo i => some $ theoremInfo (←TheoremInfo.ofTheoremVal i) | ConstantInfo.thmInfo i => pure <| some <| theoremInfo (←TheoremInfo.ofTheoremVal i)
| ConstantInfo.opaqueInfo i => some $ opaqueInfo (←OpaqueInfo.ofOpaqueVal i) | ConstantInfo.opaqueInfo i => pure <| some <| opaqueInfo (←OpaqueInfo.ofOpaqueVal i)
| ConstantInfo.defnInfo i => | ConstantInfo.defnInfo i =>
if ← (isProjFn i.name) then if ← (isProjFn i.name) then
none pure none
else else
let info ← DefinitionInfo.ofDefinitionVal i
if (←isInstance i.name) then if (←isInstance i.name) then
some $ instanceInfo info let info ← InstanceInfo.ofDefinitionVal i
pure <| some <| instanceInfo info
else else
some $ definitionInfo info let info ← DefinitionInfo.ofDefinitionVal i
pure <| some <| definitionInfo info
| ConstantInfo.inductInfo i => | ConstantInfo.inductInfo i =>
let env ← getEnv let env ← getEnv
if isStructure env i.name then if isStructure env i.name then
if isClass env i.name then if isClass env i.name then
some $ classInfo (←ClassInfo.ofInductiveVal i) pure <| some <| classInfo (←ClassInfo.ofInductiveVal i)
else else
some $ structureInfo (←StructureInfo.ofInductiveVal i) pure <| some <| structureInfo (←StructureInfo.ofInductiveVal i)
else else
some $ inductiveInfo (←InductiveInfo.ofInductiveVal i) if isClass env i.name then
pure <| some <| classInductiveInfo (←ClassInductiveInfo.ofInductiveVal i)
else
pure <| some <| inductiveInfo (←InductiveInfo.ofInductiveVal i)
-- we ignore these for now -- we ignore these for now
| ConstantInfo.ctorInfo i => none | ConstantInfo.ctorInfo i => pure none
| ConstantInfo.recInfo i => none | ConstantInfo.recInfo i => pure none
| ConstantInfo.quotInfo i => none | ConstantInfo.quotInfo i => pure none
def getName : DocInfo → Name def getName : DocInfo → Name
| axiomInfo i => i.name | axiomInfo i => i.name
@ -321,16 +364,52 @@ def getName : DocInfo → Name
| inductiveInfo i => i.name | inductiveInfo i => i.name
| structureInfo i => i.name | structureInfo i => i.name
| classInfo i => i.name | classInfo i => i.name
| classInductiveInfo i => i.name
def getKind : DocInfo → String def getKind : DocInfo → String
| axiomInfo _ => "axiom" | axiomInfo _ => "axiom"
| theoremInfo _ => "theorem" | theoremInfo _ => "theorem"
| opaqueInfo _ => "constant" | opaqueInfo _ => "constant"
| definitionInfo _ => "def" | definitionInfo _ => "def"
| instanceInfo _ => "instance" -- TODO: This doesnt exist in CSS yet | instanceInfo _ => "instance"
| inductiveInfo _ => "inductive" | inductiveInfo _ => "inductive"
| structureInfo _ => "structure" | structureInfo _ => "structure"
| classInfo _ => "class" -- TODO: This is handled as structure right now | classInfo _ => "class"
| classInductiveInfo _ => "class"
def getKindDescription : DocInfo → String
| axiomInfo i => if i.isUnsafe then "unsafe axiom" else "axiom"
| theoremInfo _ => "theorem"
| opaqueInfo i =>
match i.unsafeInformation with
| DefinitionSafety.safe => "constant"
| DefinitionSafety.unsafe => "unsafe constant"
| DefinitionSafety.partial => "partial def"
| definitionInfo i => Id.run do
if i.hints.isAbbrev then
pure "abbrev"
else
let mut modifiers := #[]
if i.isUnsafe then
modifiers := modifiers.push "unsafe"
if ¬i.isComputable then
modifiers := modifiers.push "noncomputable"
modifiers := modifiers.push "def"
pure $ String.intercalate " " modifiers.toList
| instanceInfo i => Id.run do
let mut modifiers := #[]
if i.isUnsafe then
modifiers := modifiers.push "unsafe"
if ¬i.isComputable then
modifiers := modifiers.push "noncomputable"
modifiers := modifiers.push "instance"
pure $ String.intercalate " " modifiers.toList
| inductiveInfo i => if i.isUnsafe then "unsafe inductive" else "inductive"
| structureInfo _ => "structure"
| classInfo _ => "class"
| classInductiveInfo _ => "class inductive"
def getType : DocInfo → CodeWithInfos def getType : DocInfo → CodeWithInfos
| axiomInfo i => i.type | axiomInfo i => i.type
@ -341,6 +420,7 @@ def getType : DocInfo → CodeWithInfos
| inductiveInfo i => i.type | inductiveInfo i => i.type
| structureInfo i => i.type | structureInfo i => i.type
| classInfo i => i.type | classInfo i => i.type
| classInductiveInfo i => i.type
def getArgs : DocInfo → Array Arg def getArgs : DocInfo → Array Arg
| axiomInfo i => i.args | axiomInfo i => i.args
@ -351,6 +431,18 @@ def getArgs : DocInfo → Array Arg
| inductiveInfo i => i.args | inductiveInfo i => i.args
| structureInfo i => i.args | structureInfo i => i.args
| classInfo i => i.args | classInfo i => i.args
| classInductiveInfo i => i.args
def getAttrs : DocInfo → Array String
| axiomInfo i => i.attrs
| theoremInfo i => i.attrs
| opaqueInfo i => i.attrs
| definitionInfo i => i.attrs
| instanceInfo i => i.attrs
| inductiveInfo i => i.attrs
| structureInfo i => i.attrs
| classInfo i => i.attrs
| classInductiveInfo i => i.attrs
end DocInfo end DocInfo
@ -379,7 +471,7 @@ def process : MetaM AnalyzerResult := do
try try
let analysis := Prod.fst <$> Meta.MetaM.toIO (DocInfo.ofConstant cinfo) { maxHeartbeats := 5000000, options := ⟨[(`pp.tagAppFns, true)]⟩ } { env := env} {} {} let analysis := Prod.fst <$> Meta.MetaM.toIO (DocInfo.ofConstant cinfo) { maxHeartbeats := 5000000, options := ⟨[(`pp.tagAppFns, true)]⟩ } { env := env} {} {}
if let some dinfo ← analysis then if let some dinfo ← analysis then
let some modidx env.getModuleIdxFor? dinfo.getName | unreachable! let some modidx := env.getModuleIdxFor? dinfo.getName | unreachable!
let moduleName := env.allImportedModuleNames.get! modidx let moduleName := env.allImportedModuleNames.get! modidx
let module := res.find! moduleName let module := res.find! moduleName
res := res.insert moduleName {module with members := module.members.push dinfo} res := res.insert moduleName {module with members := module.members.push dinfo}
@ -391,13 +483,13 @@ def process : MetaM AnalyzerResult := do
-- TODO: This could probably be faster if we did an insertion sort above instead -- TODO: This could probably be faster if we did an insertion sort above instead
for (moduleName, module) in res.toArray do for (moduleName, module) in res.toArray do
res := res.insert moduleName {module with members := module.members.qsort DocInfo.lineOrder} res := res.insert moduleName {module with members := module.members.qsort DocInfo.lineOrder}
let some modIdx env.getModuleIdx? moduleName | unreachable! let some modIdx := env.getModuleIdx? moduleName | unreachable!
let moduleData := env.header.moduleData.get! modIdx let moduleData := env.header.moduleData.get! modIdx
for imp in moduleData.imports do for imp in moduleData.imports do
let some importIdx env.getModuleIdx? imp.module | unreachable! let some importIdx := env.getModuleIdx? imp.module | unreachable!
adj := adj.set! modIdx (adj.get! modIdx |>.set! importIdx true) adj := adj.set! modIdx (adj.get! modIdx |>.set! importIdx true)
return { pure {
name2ModIdx := env.const2ModIdx, name2ModIdx := env.const2ModIdx,
moduleNames := env.header.moduleNames, moduleNames := env.header.moduleNames,
moduleInfo := res, moduleInfo := res,
@ -405,6 +497,4 @@ def process : MetaM AnalyzerResult := do
importAdj := adj importAdj := adj
} }
end DocGen4 end DocGen4

View File

@ -86,12 +86,12 @@ def translateAttrs (attrs : Array Syntax) : MacroM Syntax := do
as ← match attr with as ← match attr with
| `(jsxAttr| $n:jsxAttrName=$v:jsxAttrVal) => | `(jsxAttr| $n:jsxAttrName=$v:jsxAttrVal) =>
let n ← match n with let n ← match n with
| `(jsxAttrName| $n:strLit) => n | `(jsxAttrName| $n:strLit) => pure n
| `(jsxAttrName| $n:ident) => quote (toString n.getId) | `(jsxAttrName| $n:ident) => pure $ quote (toString n.getId)
| _ => Macro.throwUnsupported | _ => Macro.throwUnsupported
let v ← match v with let v ← match v with
| `(jsxAttrVal| {$v}) => v | `(jsxAttrVal| {$v}) => pure v
| `(jsxAttrVal| $v:strLit) => v | `(jsxAttrVal| $v:strLit) => pure v
| _ => Macro.throwUnsupported | _ => Macro.throwUnsupported
`(($as).push ($n, ($v : String))) `(($as).push ($n, ($v : String)))
| `(jsxAttr| [$t]) => `($as ++ ($t : Array (String × String))) | `(jsxAttr| [$t]) => `($as ++ ($t : Array (String × String)))

View File

@ -1 +1 @@
leanprover/lean4:nightly-2022-02-04 leanprover/lean4:nightly-2022-02-11