2023-05-11 13:27:25 +00:00
|
|
|
|
/-
|
|
|
|
|
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
|
|
|
|
|
|
2023-11-08 01:36:00 +00:00
|
|
|
|
open Lean Meta
|
2023-05-11 13:27:25 +00:00
|
|
|
|
|
2023-11-08 01:36:00 +00:00
|
|
|
|
/--
|
|
|
|
|
Execute `k` with an array containing pairs `(fieldName, fieldType)`.
|
|
|
|
|
`k` is executed in an updated local context which contains local declarations for the `structName` parameters.
|
|
|
|
|
-/
|
|
|
|
|
def withFields (info : InductiveVal) (k : Array (Name × Expr) → MetaM α) (includeSubobjectFields : Bool := false) : MetaM α := do
|
|
|
|
|
let structName := info.name
|
|
|
|
|
let us := info.levelParams.map mkLevelParam
|
|
|
|
|
forallTelescopeReducing info.type fun params _ =>
|
|
|
|
|
withLocalDeclD `s (mkAppN (mkConst structName us) params) fun s => do
|
|
|
|
|
let mut info := #[]
|
|
|
|
|
for fieldName in getStructureFieldsFlattened (← getEnv) structName includeSubobjectFields do
|
|
|
|
|
let proj ← mkProjection s fieldName
|
|
|
|
|
info := info.push (fieldName, (← inferType proj))
|
|
|
|
|
k info
|
2023-05-11 13:27:25 +00:00
|
|
|
|
|
2023-11-08 01:36:00 +00:00
|
|
|
|
def getFieldTypes (v : InductiveVal) : MetaM (Array NameInfo) := do
|
|
|
|
|
withFields v fun fields =>
|
|
|
|
|
fields.foldlM (init := #[]) (fun acc (name, type) => do return acc.push (← NameInfo.ofTypedName (v.name.append name) type))
|
2023-05-11 13:27:25 +00:00
|
|
|
|
|
|
|
|
|
def StructureInfo.ofInductiveVal (v : InductiveVal) : MetaM StructureInfo := do
|
|
|
|
|
let info ← Info.ofConstantVal v.toConstantVal
|
|
|
|
|
let env ← getEnv
|
|
|
|
|
let parents := getParentStructures env v.name
|
|
|
|
|
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
|
|
|
|
|
return {
|
|
|
|
|
toInfo := info,
|
2023-11-08 01:36:00 +00:00
|
|
|
|
fieldInfo := ← getFieldTypes v,
|
2023-05-11 13:27:25 +00:00
|
|
|
|
parents,
|
|
|
|
|
ctor
|
|
|
|
|
}
|
|
|
|
|
else
|
|
|
|
|
return {
|
|
|
|
|
toInfo := info,
|
|
|
|
|
fieldInfo := #[],
|
|
|
|
|
parents,
|
|
|
|
|
ctor
|
|
|
|
|
}
|
|
|
|
|
| none => panic! s!"{v.name} is not a structure"
|
|
|
|
|
|
|
|
|
|
end DocGen4.Process
|