Skip to content

Commit

Permalink
feat: show parents' parameters for structures (#234)
Browse files Browse the repository at this point in the history
Pretty prints parents in the `extends` clause to include parameters.

Fixes a whitespace bug for the `extends` list. Now it's `extends A, B, C` instead of `extends A , B , C`. Also fixes a bug introduced in #232 where the links to inherited fields were incorrect.
  • Loading branch information
kmill authored Nov 14, 2024
1 parent 845244d commit b41ee51
Show file tree
Hide file tree
Showing 4 changed files with 46 additions and 22 deletions.
13 changes: 6 additions & 7 deletions DocGen4/Output/Module.lean
Original file line number Diff line number Diff line change
Expand Up @@ -41,13 +41,12 @@ def structureInfoHeader (s : Process.StructureInfo) : HtmlM (Array Html) := do
let mut nodes := #[]
if s.parents.size > 0 then
nodes := nodes.push <span class="decl_extends">extends</span>
let mut parents := #[]
for parent in s.parents do
let link ← declNameToHtmlBreakWithinLink parent
let inner := <span class="fn">{link}</span>
let html:= Html.element "span" false #[("class", "decl_parent")] #[inner]
parents := parents.push html
nodes := nodes.append (parents.toList.intersperse (Html.text ", ")).toArray
let mut parents := #[Html.text " "]
for parent in s.parents, i in [0:s.parents.size] do
if i > 0 then
parents := parents.push (Html.text ", ")
parents := parents ++ (← infoFormatToHtml parent.type)
nodes := nodes ++ parents
return nodes

/--
Expand Down
2 changes: 1 addition & 1 deletion DocGen4/Output/Structure.lean
Original file line number Diff line number Diff line change
Expand Up @@ -29,7 +29,7 @@ def fieldToHtml (f : Process.FieldInfo) : HtmlM Html := do
else
pure
<li class="structure_field inherited_field">
<div class="structure_field_info"><a href={s!"#{name}"}>{s!"{shortName}"}</a>{" "}: [← infoFormatToHtml f.type]</div>
<div class="structure_field_info"><a href={← declNameToLink f.name}>{s!"{shortName}"}</a>{" "}: [← infoFormatToHtml f.type]</div>
</li>

/--
Expand Down
19 changes: 17 additions & 2 deletions DocGen4/Process/Base.lean
Original file line number Diff line number Diff line change
Expand Up @@ -16,7 +16,7 @@ structure NameInfo where
/--
The name that has this info attached.
-/
name : Name
name : Name
/--
The pretty printed type of this name.
-/
Expand All @@ -27,7 +27,13 @@ structure NameInfo where
doc : Option String
deriving Inhabited

/--
Stores information about a structure field.
-/
structure FieldInfo extends NameInfo where
/--
Whether or not this field is new to this structure, or instead whether it was inherited from a parent.
-/
isDirect : Bool

/--
Expand Down Expand Up @@ -122,6 +128,15 @@ structure InductiveInfo extends Info where
isUnsafe : Bool
deriving Inhabited

/--
Information about a `structure` parent.
-/
structure StructureParentInfo where
/-- Name of the projection function. -/
projFn : Name
/-- Pretty printed type. -/
type : CodeWithInfos

/--
Information about a `structure` declaration.
-/
Expand All @@ -133,7 +148,7 @@ structure StructureInfo extends Info where
/--
All the structures this one inherited from.
-/
parents : Array Name
parents : Array StructureParentInfo
/--
The constructor of the structure.
-/
Expand Down
34 changes: 22 additions & 12 deletions DocGen4/Process/StructureInfo.lean
Original file line number Diff line number Diff line change
Expand Up @@ -13,39 +13,49 @@ namespace DocGen4.Process
open Lean Meta

/--
Execute `k` with an array containing pairs `(fieldName, fieldType)`.
Execute `k` with an array containing pairs `(parentName, projFn, parentType)`
and 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 α) : MetaM α := do
def withFields (info : InductiveVal) (k : Array (Name × Name × Expr) → Array (Name × Expr) → MetaM α) : MetaM α := do
let structName := info.name
let us := info.levelParams.map mkLevelParam
forallTelescopeReducing info.type fun params _ =>
withLocalDeclD `self (mkAppN (mkConst structName us) params) fun s => do
let mut info := #[]
let mut parents := #[]
for parent in getStructureParentInfo (← getEnv) structName do
let proj := mkApp (mkAppN (mkConst parent.projFn us) params) s
parents := parents.push (parent.structName, parent.projFn, ← inferType proj)
let mut fields := #[]
for fieldName in getStructureFieldsFlattened (← getEnv) structName (includeSubobjectFields := false) do
let proj ← mkProjection s fieldName
info := info.push (fieldName, (← inferType proj))
k info
fields := fields.push (fieldName, (← inferType proj))
k parents fields

def getFieldTypes (parents : Array Name) (v : InductiveVal) : MetaM (Array FieldInfo) := do
def getFieldTypes (v : InductiveVal) : MetaM (Array StructureParentInfo × Array FieldInfo) := do
let env ← getEnv
withFields v fun fields =>
fields.foldlM (init := #[]) (fun acc (name, type) => do
withFields v fun parents fields => do
let mut parentInfo : Array StructureParentInfo := #[]
let mut fieldInfo : Array FieldInfo := #[]
for (_, projFn, type) in parents do
parentInfo := parentInfo.push { projFn, type := ← prettyPrintTerm type }
for (name, type) in fields do
let some structForField := findField? env v.name name | unreachable!
-- We can't simply do `structForField == v.name` since the field might be from a parent that overlapped with another.
let isDirect := structForField == v.name && !parents.any fun parent => (getFieldInfo? env parent name).isSome
let isDirect := structForField == v.name && !parents.any fun (parent, _) => (getFieldInfo? env parent name).isSome
let some fi := getFieldInfo? env structForField name | unreachable!
return acc.push { ← NameInfo.ofTypedName fi.projFn type with isDirect })
fieldInfo := fieldInfo.push { ← NameInfo.ofTypedName fi.projFn type with isDirect }
return (parentInfo, fieldInfo)

def StructureInfo.ofInductiveVal (v : InductiveVal) : MetaM StructureInfo := do
let info ← Info.ofConstantVal v.toConstantVal
let env ← getEnv
let parents := (getStructureParentInfo env v.name).map fun parent => parent.structName
let ctorVal := getStructureCtor env v.name
let ctor ← NameInfo.ofTypedName ctorVal.name ctorVal.type
let (parents, fieldInfo) ← getFieldTypes v
return {
toInfo := info,
fieldInfo := ← getFieldTypes parents v,
fieldInfo,
parents,
ctor
}
Expand Down

0 comments on commit b41ee51

Please sign in to comment.