Merge pull request #27 from leanprover/equations

Equations

DocGen4/Output/Class.lean

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

DocGen4/Output/Definition.lean

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

DocGen4/Output/Instance.lean

@@ -0,0 +1,10 @@
+import DocGen4.Output.Template
+import DocGen4.Output.Definition
+
+namespace DocGen4
+namespace Output
+
+def instanceToHtml (i : InstanceInfo) : HtmlM (Array Html) := definitionToHtml i
+
+end Output
+end DocGen4

DocGen4/Output/Module.lean

@@ -7,6 +7,8 @@ import DocGen4.Output.Template
 import DocGen4.Output.Inductive
 import DocGen4.Output.Structure
 import DocGen4.Output.Class
+import DocGen4.Output.Definition
+import DocGen4.Output.Instance
 
 namespace DocGen4
 namespace Output
@@ -75,6 +77,8 @@ def docInfoToHtml (module : Name) (doc : DocInfo) : HtmlM Html := do
   | DocInfo.inductiveInfo i => inductiveToHtml i
   | DocInfo.structureInfo i => structureToHtml i
   | DocInfo.classInfo i => classToHtml i
+  | DocInfo.definitionInfo i => definitionToHtml i
+  | DocInfo.instanceInfo i => instanceToHtml i
   | _ => #[]
 
   return <div «class»="decl" id={doc.getName.toString}>

DocGen4/Process.lean

@@ -47,6 +47,7 @@ structure DefinitionInfo extends Info where
   --value : CodeWithInfos
   unsafeInformation : DefinitionSafety
   hints : ReducibilityHints
+  equations : Option (Array CodeWithInfos)
   deriving Inhabited
 
 abbrev InstanceInfo := DefinitionInfo
@@ -160,11 +161,45 @@ def OpaqueInfo.ofOpaqueVal (v : OpaqueVal) : MetaM OpaqueInfo := do
 def isInstance (declName : Name) : MetaM Bool := do
   (instanceExtension.getState (←getEnv)).instanceNames.contains declName
 
+
+partial def stripArgs (e : Expr) : Expr :=
+  match e.consumeMData with
+  | Expr.lam name type body data =>
+    let name := name.eraseMacroScopes
+    stripArgs (Expr.instantiate1 body (mkFVar ⟨name⟩))
+  | Expr.forallE name type body data =>
+    let name := name.eraseMacroScopes
+    stripArgs (Expr.instantiate1 body (mkFVar ⟨name⟩))
+  | _ => e
+
+def processEq (eq : Name) : MetaM CodeWithInfos := do
+  let type ← (mkConstWithFreshMVarLevels eq >>= inferType)
+  let final := stripArgs type
+  prettyPrintTerm final
+
+def valueToEq (v : DefinitionVal) : MetaM Expr := withLCtx {} {} do
+  let env ← getEnv
+  withOptions (tactic.hygienic.set . false) do
+    lambdaTelescope v.value fun xs body => do
+      let us := v.levelParams.map mkLevelParam
+      let type ← mkEq (mkAppN (Lean.mkConst v.name us) xs) body
+      let type ← mkForallFVars xs type
+      type
+
 def DefinitionInfo.ofDefinitionVal (v : DefinitionVal) : MetaM DefinitionInfo := do
   let info ← Info.ofConstantVal v.toConstantVal
-  -- Elaborating the value yields weird exceptions
-  --let value ← prettyPrintTerm v.value
-  return DefinitionInfo.mk info v.safety v.hints
+  try
+    let eqs? ← getEqnsFor? v.name
+    match eqs? with
+    | some eqs =>
+      let prettyEqs ← eqs.mapM processEq
+      DefinitionInfo.mk info v.safety v.hints prettyEqs
+    | none =>
+      let eq ← prettyPrintTerm $ stripArgs (←valueToEq v)
+      DefinitionInfo.mk info v.safety v.hints (some #[eq])
+  catch err =>
+    IO.println s!"WARNING: Failed to calculate equational lemmata for {v.name}: {←err.toMessageData.toString}"
+    return DefinitionInfo.mk info v.safety v.hints none
 
 def getConstructorType (ctor : Name) : MetaM CodeWithInfos := do
   let env ← getEnv
@@ -254,7 +289,6 @@ def ofConstant : (Name × ConstantInfo) → MetaM (Option DocInfo) := λ (name,
   | ConstantInfo.axiomInfo i => some $ axiomInfo (←AxiomInfo.ofAxiomVal i)
   | ConstantInfo.thmInfo i => some $ theoremInfo (←TheoremInfo.ofTheoremVal i)
   | ConstantInfo.opaqueInfo i => some $ opaqueInfo (←OpaqueInfo.ofOpaqueVal i)
-  -- TODO: Find a way to extract equations nicely
   | ConstantInfo.defnInfo i =>
     if ← (isProjFn i.name) then
       none
@@ -342,14 +376,15 @@ def process : MetaM AnalyzerResult := do
     res := res.insert module (Module.mk module moduleDoc #[])
 
   for cinfo in env.constants.toList do
-    let d := ←DocInfo.ofConstant cinfo
-    match d with
-    | some dinfo =>
-      let some modidx ← env.getModuleIdxFor? cinfo.fst | unreachable!
-      let moduleName := env.allImportedModuleNames.get! modidx
-      let module := res.find! moduleName
-      res := res.insert moduleName {module with members := module.members.push dinfo}
-    | none => ()
+    try
+      let analysis := Prod.fst <$> Meta.MetaM.toIO (DocInfo.ofConstant cinfo) { maxHeartbeats := 5000000, options := ⟨[(`pp.tagAppFns, true)]⟩ } { env := env} {} {}
+      if let some dinfo ← analysis then
+        let some modidx ← env.getModuleIdxFor? dinfo.getName | unreachable!
+        let moduleName := env.allImportedModuleNames.get! modidx
+        let module := res.find! moduleName
+        res := res.insert moduleName {module with members := module.members.push dinfo}
+    catch e =>
+      IO.println s!"WARNING: Failed to obtain information for: {cinfo.fst}: {←e.toMessageData.toString}"
 
   -- TODO: This is definitely not the most efficient way to store this data
   let mut adj := Array.mkArray res.size (Array.mkArray res.size false)
@@ -370,4 +405,6 @@ def process : MetaM AnalyzerResult := do
     importAdj := adj
   }
 
+
+
 end DocGen4

lean-toolchain

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