feat: change structure command to elaborate fields as if structures are flat (#7302)

This PR changes how fields are elaborated in the `structure`/`class`
commands and also makes default values respect the structure resolution
order when there is diamond inheritance. Before, the details of
subobjects were exposed during elaboration, and in the local context any
fields that came from a subobject were defined to be projections of the
subobject field. Now, every field is represented as a local variable.
All parents (not just subobject parents) are now represented in the
local context, and they are now local variables defined to be parent
constructors applied to field variables (inverting the previous
relationship). Other notes:
- The entire collection of parents is processed, and all parent
projection names are checked for consistency. Every parent appears in
the local context now.
- For classes, every parent now contributes an instance, not just the
parents represented as subobjects.
- Default values are now processed according to the parent resolution
order. Default value definition/override auxiliary definitions are
stored at `StructName.fieldName._default`, and inherited values are
stored at `StructName.fieldName._inherited_default`. Metaprograms no
longer need to look at parents when doing calculations on default
values.
- Default value omission for structure instance notation pretty printing
has been updated in consideration of this.
- Now the elaborator generates a `_flat_ctor` constructor that will be
used for structure instance elaboration. All types in this constructor
are put in "field normal form" (projections of parent constructors are
reduced, and parent constructors are eta reduced), and all fields with
autoParams are annotated as such. This is not meant for users, but it
may be useful for metaprogramming.
- While elaborating fields, any metavariables whose type is one of the
parents is assigned to that parent. The hypothesis is that, for the
purpose of elaborating structure fields, parents are fixed: there is
only *one* instance of any given parent under consideration. See the
`Magma` test for an example of this being necessary. The hypothesis may
not be true when there are recursive structures, since different values
of the structure might not agree on parent fields.

Other notes:
- The elaborator has been refactored, and it now uses a monad to keep
track of the elaboration state.
- This PR was motivation for #7100, since we need to be able to make all
parents have consistent projection names when there is diamond
inheritance.

Still to do:
- Handle autoParams like we do default values. Inheritance for these is
not correct when there is diamond inheritance.
- Avoid splitting apart parents if the overlap is only on proof fields.
- Non-subobject parent projections do not have parameter binder kinds
that are consistent with other projections (i.e., all implicit by
default, no inst implicits). This needs to wait on adjustments to the
synthOrder algorithm.
- We could elide parents with no fields, letting their projections be
constant functions. This causes some trouble for defeq checking however
(maybe #2258 would address this).

src/Lean/Elab/StructInst.lean

@@ -845,7 +845,9 @@ private partial def elabStructInstView (s : StructInstView) (expectedType? : Opt
             let val ← ensureHasType d val
             cont val { field with val := FieldVal.nested sNew } (instMVars ++ instMVarsNew)
         | .default  =>
-          match d.getAutoParamTactic? with
+          let some fieldInfo := getFieldInfo? env s.structName fieldName
+            | withRef field.ref <| throwFailedToElabField fieldName s.structName m!"no such field '{fieldName}'"
+          match fieldInfo.autoParam? with
           | some (.const tacticDecl ..) =>
             match evalSyntaxConstant env (← getOptions) tacticDecl with
             | .error err       => throwError err
@@ -855,7 +857,7 @@ private partial def elabStructInstView (s : StructInstView) (expectedType? : Opt
               -- We add info to get reliable positions for messages from evaluating the tactic script.
               let info := field.ref.getHeadInfo.nonCanonicalSynthetic
               let stx := stx.raw.rewriteBottomUp (·.setInfo info)
-              let type := (d.getArg! 0).consumeTypeAnnotations
+              let type := d.consumeTypeAnnotations
               let mvar ← mkTacticMVar type stx (.fieldAutoParam fieldName s.structName)
               -- Note(kmill): We are adding terminfo to simulate a previous implementation that elaborated `tacticBlock`.
               -- (See the aforementioned `processExplicitArg` for a comment about this.)
@@ -970,13 +972,23 @@ abbrev M := ReaderT Context (StateRefT State TermElabM)
 def isRoundDone : M Bool := do
   return (← get).progress && (← read).maxDistance > 0
 
-/-- Returns the `expr?` for the given field. -/
-def getFieldValue? (struct : StructInstView) (fieldName : Name) : Option Expr :=
-  struct.fields.findSome? fun field =>
-    if getFieldName field == fieldName then
-      field.expr?
-    else
-      none
+/-- Returns the `expr?` for the given field. The value may be inside a subobject. -/
+partial def getFieldValue? (struct : StructInstView) (fieldName : Name) : MetaM (Option Expr) := do
+  for field in struct.fields do
+    let fieldName' := getFieldName field
+    if fieldName' == fieldName then
+      return field.expr?
+    if let .nested s' := field.val then
+      if let some val ← getFieldValue? s' fieldName then
+        return val
+    if let some info := getFieldInfo? (← getEnv) struct.structName fieldName' then
+      if info.subobject?.isSome then
+        if let some e := field.expr? then
+          try
+            return ← mkProjection e fieldName
+          catch _ =>
+            pure ()
+  return none
 
 /-- Instantiates a default value from the given default value declaration, if applicable. -/
 partial def mkDefaultValue? (struct : StructInstView) (cinfo : ConstantInfo) : TermElabM (Option Expr) :=
@@ -988,7 +1000,7 @@ where
   | .lam n d b c => withRef struct.ref do
     if c.isExplicit then
       let fieldName := n
-      match getFieldValue? struct fieldName with
+      match ← getFieldValue? struct fieldName with
       | none     => return none
       | some val =>
         let valType ← inferType val
@@ -1078,8 +1090,9 @@ def tryToSynthesizeDefault (structs : Array StructInstView) (allStructNames : Ar
       return false
     else if h : i < structs.size then
       let struct := structs[i]
-      match getDefaultFnForField? (← getEnv) struct.structName fieldName with
+      match getEffectiveDefaultFnForField? (← getEnv) struct.structName fieldName with
       | some defFn =>
+        trace[Elab.struct] "default fn for '{fieldName}' is '{.ofConstName defFn}'"
         let cinfo ← getConstInfo defFn
         let mctx ← getMCtx
         match (← mkDefaultValue? struct cinfo) with
@@ -1141,7 +1154,7 @@ partial def propagateLoop (hierarchyDepth : Nat) (d : Nat) (struct : StructInstV
         let env := (← getEnv)
         let structs := (← read).allStructNames
         missingFields.filter fun fieldName => structs.all fun struct =>
-          (getDefaultFnForField? env struct fieldName).isNone
+          (getEffectiveDefaultFnForField? env struct fieldName).isNone
       let fieldsToReport :=
         if missingFieldsWithoutDefault.isEmpty then missingFields else missingFieldsWithoutDefault
       throwErrorAt field.ref "fields missing: {fieldsToReport.toList.map (s!"'{·}'") |> ", ".intercalate}"

src/Lean/PrettyPrinter/Delaborator/Builtins.lean

@@ -556,18 +556,13 @@ def delabDelayedAssignedMVar : Delab := whenNotPPOption getPPMVarsDelayed do
     delabMVarAux decl.mvarIdPending
 
 private partial def collectStructFields
+    (structName : Name)
+    (paramMap : NameMap Expr)
     (fields : Array (TSyntax ``Parser.Term.structInstField))
     (fieldValues : NameMap Expr)
     (s : ConstructorVal) :
     DelabM (NameMap Expr × Array (TSyntax ``Parser.Term.structInstField)) := do
   let env ← getEnv
-  -- For default value handling, we need to create a map of type parameter names to expressions.
-  let args := (← getExpr).getAppArgs
-  let paramMap : NameMap Expr ← forallTelescope s.type fun xs _ => do
-    let mut paramMap := {}
-    for i in [:s.numParams] do
-      paramMap := paramMap.insert (← xs[i]!.fvarId!.getUserName) args[i]!
-    return paramMap
   let fieldNames := getStructureFields env s.induct
   let (_, fieldValues, fields) ← withBoundedAppFnArgs s.numFields
     (do return (0, fieldValues, fields))
@@ -580,11 +575,11 @@ private partial def collectStructFields
         if ← getPPOption getPPStructureInstancesFlatten then
           if let some s' ← isConstructorApp? (← getExpr) then
             if s'.induct == parentName then
-              let (fieldValues, fields) ← collectStructFields fields fieldValues s'
+              let (fieldValues, fields) ← collectStructFields structName paramMap fields fieldValues s'
               return (i + 1, fieldValues, fields)
       /- Does it have the default value, and should it be omitted? -/
       unless ← getPPOption getPPStructureInstancesDefaults do
-        if let some defFn := getDefaultFnForField? (← getEnv) s.induct fieldName then
+        if let some defFn := getEffectiveDefaultFnForField? (← getEnv) structName fieldName then
           let cinfo ← getConstInfo defFn
           let defValue := cinfo.instantiateValueLevelParams! (← mkFreshLevelMVarsFor cinfo)
           if let some defValue ← withNewMCtxDepth <| processDefaultValue paramMap fieldValues defValue then
@@ -668,7 +663,14 @@ def delabStructureInstance : Delab := do
     If `pp.structureInstances.flatten` is true (and `pp.explicit` is false or the subobject has no parameters)
     then subobjects are flattened.
     -/
-    let (_, fields) ← collectStructFields #[] {} s
+    -- For default value handling, we need to create a map of type parameter names to expressions.
+    let args := (← getExpr).getAppArgs
+    let paramMap : NameMap Expr ← forallTelescope s.type fun xs _ => do
+      let mut paramMap := {}
+      for param in args[:s.numParams], x in xs do
+        paramMap := paramMap.insert (← x.fvarId!.getUserName) param
+      return paramMap
+    let (_, fields) ← collectStructFields s.induct paramMap #[] {} s
     if ← withType <| getPPOption getPPStructureInstanceType then
       let tyStx ← withType delab
       `({ $fields,* : $tyStx })

src/Lean/Structure.lean

@@ -193,6 +193,20 @@ partial def findField? (env : Environment) (structName : Name) (fieldName : Name
   else
     getStructureSubobjects env structName |>.findSome? fun parentStructName => findField? env parentStructName fieldName
 
+/--
+Gets the name for a structure constructor where the fields have been fully flattened.
+This constructor simulates a flat representation for structures,
+and it is used by structure instance notation when elaborating structure fields
+and for organizing the fields into subobjects.
+
+The body of the flat constructor has the following properties (recursively):
+- the fields come in order
+- for subobject fields, the value is the unfolded flat constructor for that field
+- for standard fields, the value is one of the flat constructor parameters
+-/
+def mkFlatCtorOfStructName (structName : Name) : Name :=
+  structName ++ `_flat_ctor
+
 private partial def getStructureFieldsFlattenedAux (env : Environment) (structName : Name) (fullNames : Array Name) (includeSubobjectFields : Bool) : Array Name :=
   (getStructureFields env structName).foldl (init := fullNames) fun fullNames fieldName =>
     match isSubobjectField? env structName fieldName with
@@ -239,19 +253,41 @@ def getProjFnInfoForField? (env : Environment) (structName : Name) (fieldName :
   else
     none
 
-/-- Get the name of the auxiliary definition that would have the default value for the structure field. -/
+/--
+Gets the name of the auxiliary definition that would have the default value for the structure field if it exists.
+-/
 def mkDefaultFnOfProjFn (projFn : Name) : Name :=
   projFn ++ `_default
 
-def getDefaultFnForField? (env : Environment) (structName : Name) (fieldName : Name) : Option Name :=
+/--
+Gets the name of the auxiliary definition that would have the inherited default value for the structure field if it exists.
+-/
+def mkInheritedDefaultFnOfProjFn (projFn : Name) : Name :=
+  projFn ++ `_inherited_default
+
+private def getFnForFieldUsing? (mkName : Name → Name) (env : Environment) (structName : Name) (fieldName : Name) : Option Name :=
   if let some projName := getProjFnForField? env structName fieldName then
-    let defFn := mkDefaultFnOfProjFn projName
+    let defFn := mkName projName
     if env.contains defFn then defFn else none
   else
     -- Check if we have a default function for a default values overridden by substructure.
-    let defFn := mkDefaultFnOfProjFn (structName ++ fieldName)
+    let defFn := mkName (structName ++ fieldName)
     if env.contains defFn then defFn else none
 
+/--
+Returns the name of the auxiliary definition that defines a default value for the field, if any such definition exists.
+This is *not* an inherited default. We need to store provided defaults so that it is possible to resolve defaults according to the resolution order.
+-/
+def getDefaultFnForField? (env : Environment) (structName : Name) (fieldName : Name) : Option Name :=
+  getFnForFieldUsing? mkDefaultFnOfProjFn env structName fieldName
+
+/--
+Returns the name of the auxiliary definition for a default value for the field, even if inherited, if any such definition exists.
+-/
+def getEffectiveDefaultFnForField? (env : Environment) (structName : Name) (fieldName : Name) : Option Name :=
+  getDefaultFnForField? env structName fieldName
+  <|> getFnForFieldUsing? mkInheritedDefaultFnOfProjFn env structName fieldName
+
 partial def getPathToBaseStructureAux (env : Environment) (baseStructName : Name) (structName : Name) (path : List Name) : Option (List Name) :=
   if baseStructName == structName then
     some path.reverse
@@ -367,6 +403,8 @@ structure StructureResolutionOrderResult where
   conflicts : Array StructureResolutionOrderConflict := #[]
   deriving Inhabited
 
+mutual
+
 /--
 Computes and caches the C3 linearization. Assumes parents have already been set with `setStructureParents`.
 If `relaxed` is false, then if the linearization cannot be computed, conflicts are recorded in the return value.
@@ -377,6 +415,12 @@ partial def computeStructureResolutionOrder [Monad m] [MonadEnv m]
   if let some resOrder := getStructureResolutionOrder? env structName then
     return { resolutionOrder := resOrder }
   let parentNames := getStructureParentInfo env structName |>.map (·.structName)
+  let result ← mergeStructureResolutionOrders structName parentNames relaxed
+  setStructureResolutionOrder structName result.resolutionOrder
+  return result
+
+partial def mergeStructureResolutionOrders [Monad m] [MonadEnv m]
+    (structName : Name) (parentNames : Array Name) (relaxed : Bool) : m StructureResolutionOrderResult := do
   -- Don't be strict about parents: if they were supposed to be checked, they were already checked.
   let parentResOrders ← parentNames.mapM fun parentName => return (← computeStructureResolutionOrder parentName true).resolutionOrder
 
@@ -405,7 +449,6 @@ partial def computeStructureResolutionOrder [Monad m] [MonadEnv m]
       |>.map (fun resOrder => resOrder.filter (· != name))
       |>.filter (!·.isEmpty)
 
-  setStructureResolutionOrder structName resOrder
   return { resolutionOrder := resOrder, conflicts := defects }
 where
   selectParent (resOrders : Array (Array Name)) : m (Bool × Name) := do
@@ -421,6 +464,8 @@ where
     -- unreachable, but correct default:
     return (false, resOrders[0]![0]!)
 
+end
+
 /--
 Gets the resolution order for a structure.
 -/

tests/lean/diamond1.lean.expected.out

@@ -1,4 +1,4 @@
-diamond1.lean:11:40-11:45: error: parent field type mismatch, field 'a' from parent 'Baz' has type
+diamond1.lean:11:40-11:45: error: field type mismatch, field 'a' from parent 'Baz' has type
   α → α : Type
 but is expected to have type
   α : Type

tests/lean/mvarAtDefaultValue.lean.expected.out

@@ -1,6 +1,6 @@
 mvarAtDefaultValue.lean:5:7-5:8: error: failed to infer default value for field 'x'
 mvarAtDefaultValue.lean:8:7-8:8: error: don't know how to synthesize placeholder
 context:
-toA : A
-x : Nat := toA.x
+x : Nat
+toA : A := { x := x }
 ⊢ Nat

tests/lean/run/delabStructInst.lean

@@ -158,3 +158,58 @@ structure H where
 
 /-- info: { x := 1 } : H -/
 #guard_msgs in #check { x := 1 : H }
+
+/-!
+Diamond inheritance
+-/
+structure D1 where
+  x := 1
+structure D2 extends D1 where
+structure D3 extends D1 where
+  x := 3
+structure D4 extends D2, D3
+
+/-- info: { } : D1 -/
+#guard_msgs in #check { : D1 }
+set_option pp.structureInstances.defaults true in
+/-- info: { x := 1 } : D1 -/
+#guard_msgs in #check { : D1 }
+
+/-- info: { } : D2 -/
+#guard_msgs in #check { : D2 }
+set_option pp.structureInstances.defaults true in
+/-- info: { x := 1 } : D2 -/
+#guard_msgs in #check { : D2 }
+
+/-- info: { } : D3 -/
+#guard_msgs in #check { : D3 }
+set_option pp.structureInstances.defaults true in
+/-- info: { x := 3 } : D3 -/
+#guard_msgs in #check { : D3 }
+
+/-- info: { } : D4 -/
+#guard_msgs in #check { : D4 }
+set_option pp.structureInstances.defaults true in
+/-- info: { x := 3 } : D4 -/
+#guard_msgs in #check { : D4 }
+
+/-!
+Inheritance with parameters
+-/
+namespace Test1
+
+structure A (α : Type) [Inhabited α] where
+  x : α := default
+structure B (β : Type) [Inhabited β] extends A β where
+
+/-- info: { } : B Nat -/
+#guard_msgs in #check { : B Nat }
+set_option pp.structureInstances.defaults true in
+/-- info: { x := default } : B Nat -/
+#guard_msgs in #check { : B Nat }
+
+-- Only reducible defeq, so the `x` fields is still included:
+/-- info: { x := 0 } : B Nat -/
+#guard_msgs in #check { x := 0 : B Nat }
+
+end Test1

tests/lean/run/inductive_univ.lean

@@ -93,8 +93,8 @@ Errors for `structure` talk about parent projection fields too.
 structure A' where
   α : Type
 /--
-error: invalid universe level for field 'toA'', has type
-  A'
+error: invalid universe level for field 'α', has type
+  Type
 at universe level
   2
 which is not less than or equal to the structure's resulting universe level

tests/lean/run/structNamedParentProj.lean

@@ -18,13 +18,21 @@ Non-atomic parent projections are not allowed.
 /-!
 Shadowing other fields is not allowed.
 -/
-/-- error: field 'x' has already been declared -/
-#guard_msgs in structure S' extends x : S
+/--
+error: field 'x' has already been declared
+
+The 'toParent : P' syntax can be used to adjust the name for the parent projection
+-/
+#guard_msgs in  structure S' extends x : S
 
 /-!
 Duplicate parent projections
 -/
-/-- error: field 'toP' has already been declared -/
+/--
+error: field 'toP' has already been declared
+
+The 'toParent : P' syntax can be used to adjust the name for the parent projection
+-/
 #guard_msgs in structure S' extends toP : S, toP : T
 
 /-!
@@ -33,16 +41,26 @@ Duplicate parent projections because from different namespaces
 structure NS1.S
 structure NS2.S
 /--
-error: field 'toS' has already been declared, use 'toParent : P' syntax to give a unique name for the parent projection
+error: field 'toS' has already been declared
+
+The 'toParent : P' syntax can be used to adjust the name for the parent projection
 -/
 #guard_msgs in structure S' extends NS1.S, NS2.S
 
 /-!
 Duplicate parent projections, when there are overlapping fields
 -/
-/-- error: field 'toS' has already been declared -/
+/--
+error: field 'toS' has already been declared
+
+The 'toParent : P' syntax can be used to adjust the name for the parent projection
+-/
 #guard_msgs in structure S' extends S, toS : U
-/-- error: field 'toP' has already been declared -/
+/--
+error: field 'toP' has already been declared
+
+The 'toParent : P' syntax can be used to adjust the name for the parent projection
+-/
 #guard_msgs in structure S' extends toP : S, toP : T
 
 /-!
@@ -51,7 +69,9 @@ Duplicate parent projections because from different namespaces, when there are d
 structure NS1.S' where x : Nat
 structure NS2.S' where x : Nat
 /--
-error: field 'toS'' has already been declared, use 'toParent : P' syntax to give a unique name for the parent projection
+error: field 'toS'' has already been declared
+
+The 'toParent : P' syntax can be used to adjust the name for the parent projection
 -/
 #guard_msgs in structure S' extends NS1.S', NS2.S'
 

tests/lean/run/structureElab.lean

@@ -0,0 +1,340 @@
+/-!
+# Tests of the structure elaborator
+-/
+
+-- We want to see the exact constructors in tests.
+set_option pp.structureInstances false
+set_option pp.proofs true
+
+
+/-!
+Diamond, look at the constructors and flat constructors
+-/
+namespace Test1
+
+structure S1 (α : Type) where
+  x : α
+  y : Nat
+
+structure S2 (α : Type) extends S1 α where
+  z : Nat
+
+structure S3 (α : Type) extends S1 α where
+  w : Nat
+
+structure S4 (α : Type) extends S2 α, S3 α where
+  x' : α
+
+/-- info: Test1.S1.mk {α : Type} (x : α) (y : Nat) : S1 α -/
+#guard_msgs in #check S1.mk
+/-- info: Test1.S2.mk {α : Type} (toS1 : S1 α) (z : Nat) : S2 α -/
+#guard_msgs in #check S2.mk
+/-- info: Test1.S3.mk {α : Type} (toS1 : S1 α) (w : Nat) : S3 α -/
+#guard_msgs in #check S3.mk
+/-- info: Test1.S4.mk {α : Type} (toS2 : S2 α) (w : Nat) (x' : α) : S4 α -/
+#guard_msgs in #check S4.mk
+/--
+info: def Test1.S1._flat_ctor : {α : Type} → α → Nat → S1 α :=
+fun α x y => S1.mk x y
+-/
+#guard_msgs in #print S1._flat_ctor
+/--
+info: def Test1.S2._flat_ctor : {α : Type} → α → Nat → Nat → S2 α :=
+fun α x y z => S2.mk (S1.mk x y) z
+-/
+#guard_msgs in #print S2._flat_ctor
+/--
+info: def Test1.S3._flat_ctor : {α : Type} → α → Nat → Nat → S3 α :=
+fun α x y w => S3.mk (S1.mk x y) w
+-/
+#guard_msgs in #print S3._flat_ctor
+/--
+info: def Test1.S4._flat_ctor : {α : Type} → α → Nat → Nat → Nat → α → S4 α :=
+fun α x y z w x' => S4.mk (S2.mk (S1.mk x y) z) w x'
+-/
+#guard_msgs in #print S4._flat_ctor
+/-- info: Test1.S4._flat_ctor {α : Type} (x : α) (y z w : Nat) (x' : α) : S4 α -/
+#guard_msgs in #check S4._flat_ctor
+
+end Test1
+
+/-!
+Verify existence of default value definitions
+-/
+namespace TestD1
+
+structure D1 where
+  x := 1
+structure D2 extends D1 where
+structure D3 extends D1 where
+  x := 3
+structure D4 extends D2, D3
+
+/--
+info: @[reducible] def TestD1.D1.x._default : Nat :=
+id 1
+-/
+#guard_msgs in #print D1.x._default
+/-- error: unknown constant 'D2.x._default' -/
+#guard_msgs in #print D2.x._default
+/--
+info: @[reducible] def TestD1.D2.x._inherited_default : Nat :=
+id 1
+-/
+#guard_msgs in #print D2.x._inherited_default
+/--
+info: @[reducible] def TestD1.D3.x._default : Nat :=
+id 3
+-/
+#guard_msgs in #print D3.x._default
+/-- error: unknown constant 'D4.x._default' -/
+#guard_msgs in #print D4.x._default
+/--
+info: @[reducible] def TestD1.D4.x._inherited_default : Nat :=
+id 3
+-/
+#guard_msgs in #print D4.x._inherited_default
+
+end TestD1
+
+/-!
+Verify default value definitions can support parameters
+-/
+namespace TestD2
+
+structure D1 (α : Type) [Inhabited α] where
+  x : α := default
+structure D2 (α : Type) [Inhabited α] extends D1 α where
+structure D3 extends D1 Nat where
+
+/--
+info: @[reducible] def TestD2.D1.x._default : {α : Type} → {inst : Inhabited α} → α :=
+fun {α} {inst} => id default
+-/
+#guard_msgs in #print D1.x._default
+/-- error: unknown constant 'D2.x._default' -/
+#guard_msgs in #print D2.x._default
+/--
+info: @[reducible] def TestD2.D2.x._inherited_default : {α : Type} → {inst : Inhabited α} → α :=
+fun {α} {inst} => id default
+-/
+#guard_msgs in #print D2.x._inherited_default
+/-- error: unknown constant 'D3.x._default' -/
+#guard_msgs in #print D3.x._default
+/--
+info: @[reducible] def TestD2.D3.x._inherited_default : Nat :=
+id default
+-/
+#guard_msgs in #print D3.x._inherited_default
+
+end TestD2
+
+/-!
+Make sure class parents can be used in successive parents
+-/
+namespace Test2_1
+
+local infixl:70 (priority := high) " * " => Mul.mul
+
+class AssociativeMul (α : Type _) [Mul α] : Prop where
+  mul_assoc (x y z : α) : x * y * z = x * (y * z)
+
+class Semigroup (α : Type _) extends Mul α, AssociativeMul α where
+
+/--
+info: Test2_1.Semigroup.mk.{u_1} {α : Type u_1} [toMul : Mul α] [toAssociativeMul : AssociativeMul α] : Semigroup α
+-/
+#guard_msgs in #check Semigroup.mk
+/--
+info: def Test2_1.Semigroup._flat_ctor.{u_1} : {α : Type u_1} →
+  (mul : α → α → α) → (∀ (x y z : α), @Eq α (mul (mul x y) z) (mul x (mul y z))) → Semigroup α :=
+fun α mul mul_assoc => @Semigroup.mk α (@Mul.mk α mul) (@AssociativeMul.mk α (@Mul.mk α mul) mul_assoc)
+-/
+#guard_msgs in set_option pp.explicit true in #print Semigroup._flat_ctor
+/--
+info: Test2_1.Semigroup._flat_ctor.{u_1} {α : Type u_1} (mul : α → α → α)
+  (mul_assoc : ∀ (x y z : α), @Eq α (mul (mul x y) z) (mul x (mul y z))) : Semigroup α
+-/
+#guard_msgs in set_option pp.explicit true in #check Semigroup._flat_ctor
+
+end Test2_1
+
+/-!
+Make sure instances can come from parents with overlapping fields
+-/
+namespace Test2_2
+
+structure Add2 (α : Type _) where
+  add : α → α → α
+
+class Add3 (α : Type _) extends Add2 α, Add α where
+  h (x : α) : x + x = x
+
+/--
+info: Test2_2.Add3._flat_ctor.{u_1} {α : Type u_1} (add : α → α → α)
+  (h : ∀ (x : α), @Eq α (@HAdd.hAdd α α α (@instHAdd α (@Add.mk α add)) x x) x) : Add3 α
+-/
+#guard_msgs in set_option pp.explicit true in #check Add3._flat_ctor
+
+end Test2_2
+
+/-!
+Example that used to be in a comment at `getFieldDefaultValue?`.
+The issue was that the default value function was in terms of subobject fields,
+so there could be a cyclic dependency.
+With a field-centric view in #7302, this is no longer an issue to consider.
+-/
+namespace Test3
+
+structure A where
+  a : Nat
+
+structure B where
+  a : Nat
+  b : Nat
+  c : Nat
+
+structure C extends B where
+  d : Nat
+  c := b + d
+
+structure D extends A, C
+
+/--
+info: @[reducible] def Test3.D.c._inherited_default : Nat → Nat → Nat :=
+fun b d => @id Nat (@HAdd.hAdd Nat Nat Nat (@instHAdd Nat instAddNat) b d)
+-/
+#guard_msgs in set_option pp.explicit true in #print D.c._inherited_default
+
+end Test3
+
+/-!
+Make sure we can fill in `toMagma` at the use of `mul`.
+It used to be (before #7302) that `mul` would see that the type of `a`, `b`, and `c` were `toMagma.α`,
+which would cause unification to fill in the `M` argument.
+However, now the types of these variables are just `α`, with no connection to `toMagma`.
+We use the heuristic that parent structures should effectively be singleton types while elaborating fields,
+and so the `?M : Magma` metavariable should be assigned with `toMagma`.
+-/
+
+namespace Test4
+
+structure Magma where
+  α   : Type u
+  mul : α → α → α
+
+instance : CoeSort Magma (Type u) where
+  coe s := s.α
+
+abbrev mul {M : Magma} (a b : M) : M :=
+  M.mul a b
+
+local infixl:70 (priority := high) " * " => mul
+
+structure Semigroup extends Magma where
+  mul_assoc (a b c : α) : a * b * c = a * (b * c)
+
+/--
+info: Test4.Semigroup.mk.{u_1} (toMagma : Magma)
+  (mul_assoc :
+    ∀ (a b c : toMagma.α), @Eq toMagma.α (@mul toMagma (@mul toMagma a b) c) (@mul toMagma a (@mul toMagma b c))) :
+  Semigroup
+-/
+#guard_msgs in set_option pp.explicit true in #check Semigroup.mk
+
+/--
+info: def Test4.Semigroup._flat_ctor.{u_1} : (α : Type u_1) →
+  (mul : α → α → α) →
+    (∀ (a b c : α),
+        @Eq α (@Test4.mul (Magma.mk α mul) (@Test4.mul (Magma.mk α mul) a b) c)
+          (@Test4.mul (Magma.mk α mul) a (@Test4.mul (Magma.mk α mul) b c))) →
+      Semigroup :=
+fun α mul mul_assoc => Semigroup.mk (Magma.mk α mul) mul_assoc
+-/
+#guard_msgs in set_option pp.explicit true in #print Semigroup._flat_ctor
+
+end Test4
+
+/-!
+Default value involving parent instance
+-/
+namespace Test5
+
+structure C (α : Type) extends Mul α where
+  (x y : α)
+  z := x * y
+
+/--
+info: @[reducible] def Test5.C.z._default : {α : Type} → (α → α → α) → α → α → α :=
+fun {α} mul x y => @id α (@HMul.hMul α α α (@instHMul α (@Mul.mk α mul)) x y)
+-/
+#guard_msgs in set_option pp.explicit true in #print C.z._default
+
+end Test5
+
+/-!
+Test from a docstring in Elab/StructInst, to check computed defaults.
+-/
+namespace Test6
+
+structure A where
+  x : Nat := 1
+
+structure B extends A where
+  y : Nat := x + 1
+  x := y + 1
+
+structure C extends B where
+  z : Nat := 2*y
+  x := z + 3
+
+/--
+info: @[reducible] def Test6.A.x._default : Nat :=
+id 1
+-/
+#guard_msgs in #print A.x._default
+/--
+info: @[reducible] def Test6.B.y._default : Nat → Nat :=
+fun x => id (x + 1)
+-/
+#guard_msgs in #print B.y._default
+/--
+info: @[reducible] def Test6.B.x._default : Nat → Nat :=
+fun y => id (y + 1)
+-/
+#guard_msgs in #print B.x._default
+/--
+info: @[reducible] def Test6.C.x._default : Nat → Nat :=
+fun z => id (z + 3)
+-/
+#guard_msgs in #print C.x._default
+/--
+info: @[reducible] def Test6.C.y._inherited_default : Nat → Nat :=
+fun x => id (x + 1)
+-/
+#guard_msgs in #print C.y._inherited_default
+/--
+info: @[reducible] def Test6.C.z._default : Nat → Nat :=
+fun y => id (2 * y)
+-/
+#guard_msgs in #print C.z._default
+
+end Test6
+
+/-!
+Dependent types to an inherited field
+-/
+namespace Test7
+
+structure A1 where
+  n : Nat
+structure A2 extends A1 where
+  h : n > 0
+
+/--
+info: def Test7.A2._flat_ctor : (n : Nat) → n > 0 → A2 :=
+fun n h => A2.mk (A1.mk n) h
+-/
+#guard_msgs in #print A2._flat_ctor
+
+end Test7

tests/lean/struct1.lean.expected.out

@@ -7,7 +7,7 @@ The purpose of the change is to accommodate 'structure S extends toP : P' syntax
 struct1.lean:15:28-15:33: warning: field 'x' from 'B' has already been declared
 struct1.lean:16:1-16:2: error: field 'x' has been declared in parent structure
 struct1.lean:17:30-17:35: warning: duplicate parent structure 'A', skipping
-struct1.lean:19:27-19:33: error: parent field type mismatch, field 'x' from parent 'B' has type
+struct1.lean:19:27-19:33: error: field type mismatch, field 'x' from parent 'B' has type
   Bool : Type
 but is expected to have type
   Nat : Type