bookshelf-doc/DocGen4/Process/StructureInfo.lean

59 lines
1.8 KiB
Plaintext
Raw Normal View History

/-
Copyright (c) 2022 Henrik Böving. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henrik Böving
-/
import Lean
import DocGen4.Process.Base
import DocGen4.Process.NameInfo
namespace DocGen4.Process
open Lean Meta
-- TODO: replace with Leos variant from Zulip
def dropArgs (type : Expr) (n : Nat) : (Expr × List (Name × Expr)) :=
match type, n with
| e, 0 => (e, [])
| Expr.forallE name type body _, x + 1 =>
2022-07-23 11:01:25 +00:00
let body := body.instantiate1 <| mkFVar ⟨name⟩
let next := dropArgs body x
{ next with snd := (name, type) :: next.snd}
2022-07-23 11:04:36 +00:00
| _e, _x + 1 => panic! s!"No forallE left"
def getFieldTypes (struct : Name) (ctor : ConstructorVal) (parents : Nat) : MetaM (Array NameInfo) := do
let type := ctor.type
2022-07-23 11:04:36 +00:00
let (fieldFunction, _) := dropArgs type (ctor.numParams + parents)
let (_, fields) := dropArgs fieldFunction (ctor.numFields - parents)
let mut fieldInfos := #[]
for (name, type) in fields do
2022-07-23 11:01:25 +00:00
fieldInfos := fieldInfos.push <| ←NameInfo.ofTypedName (struct.append name) type
pure <| fieldInfos
def StructureInfo.ofInductiveVal (v : InductiveVal) : MetaM StructureInfo := do
let info ← Info.ofConstantVal v.toConstantVal
let env ← getEnv
let parents := getParentStructures env v.name
2022-07-23 11:37:17 +00:00
let ctorVal := getStructureCtor env v.name
let ctor ← NameInfo.ofTypedName ctorVal.name ctorVal.type
match getStructureInfo? env v.name with
| some i =>
if i.fieldNames.size - parents.size > 0 then
2022-07-23 11:37:17 +00:00
pure {
toInfo := info,
fieldInfo := (←getFieldTypes v.name ctorVal parents.size),
parents,
ctor
}
else
2022-07-23 11:37:17 +00:00
pure {
toInfo := info,
fieldInfo := #[],
parents,
ctor
}
| none => panic! s!"{v.name} is not a structure"
end DocGen4.Process