Pantograph/Serial.lean

@@ -101,6 +101,26 @@ partial def serializeSortLevel (level: Level) (sanitize: Bool): String :=
   | _, .zero => s!"{k}"
   | _, _ => s!"(+ {u_str} {k})"
 
+structure DelayedMVarInvocation where
+  mvarIdPending: MVarId
+  args: Array (FVarId × Expr)
+  tail: Array Expr
+
+def toDelayedMVarInvocation (e: Expr): MetaM (Option DelayedMVarInvocation) := do
+  let .mvar mvarId := e.getAppFn | return .none
+  let .some decl ← getDelayedMVarAssignment? mvarId | return .none
+  let mvarIdPending := decl.mvarIdPending
+  -- Print the function application e. See Lean's `withOverApp`
+  let args := e.getAppArgs
+
+  assert! args.size >= decl.fvars.size
+
+  return .some {
+    mvarIdPending,
+    args := decl.fvars.map (·.fvarId!) |>.zip args,
+    tail := args.toList.drop decl.fvars.size |>.toArray,
+  }
+
 
 /--
  Completely serializes an expression tree. Json not used due to compactness
@@ -111,30 +131,19 @@ partial def serializeExpressionSexp (expr: Expr) (sanitize: Bool := true): MetaM
   self expr
   where
   delayedMVarToSexp (e: Expr): MetaM (Option String) := do
-    let .mvar mvarId := e.getAppFn | return .none
-    let .some decl ← getDelayedMVarAssignment? mvarId | return .none
-    let mvarIdPending := decl.mvarIdPending
-    -- Print the function application e. See Lean's `withOverApp`
-    let args := e.getAppArgs
-
-    -- Not enough arguments to instantiate this
-    if args.size < decl.fvars.size then
-      return .none
-
-    let callee ← self $ ← instantiateMVars $ .mvar mvarIdPending
-    let sites ←
-      decl.fvars.zip args |>.mapM (λ (fvar, arg) => do
-        let fvarName := Expr.fvarId! fvar |>.name
-        return s!"({toString fvarName} {← self arg})"
+    let .some invocation ← toDelayedMVarInvocation e | return .none
+    let callee ← self $ ← instantiateMVars $ .mvar invocation.mvarIdPending
+    let sites ← invocation.args.mapM (λ (fvar, arg) => do
+        pure s!"({toString fvar.name} {← self arg})"
       )
-    let tailArgs ← args.toList.drop decl.fvars.size |>.mapM self
+    let tailArgs ← invocation.tail.mapM self
 
 
     let sites := " ".intercalate sites.toList
     let result := if tailArgs.isEmpty then
         s!"(:subst {callee} {sites})"
       else
-        let tailArgs := " ".intercalate tailArgs
+        let tailArgs := " ".intercalate tailArgs.toList
         s!"((:subst {callee} {sites}) {tailArgs})"
     return .some result
 

Test/Proofs.lean

@@ -748,10 +748,11 @@ def test_nat_zero_add_alt: TestM Unit := do
     | other => do
       addTest $ assertUnreachable $ other.toString
       return ()
+  let major := "_uniq.68"
   addTest $ LSpec.check s!"mapply {recursor}" ((← state2.serializeGoals (options := ← read)).map (·.devolatilizeVars) =
     #[
       buildNamedGoal "_uniq.67" [("n", "Nat")] "Nat → Prop" (.some "motive"),
-      buildNamedGoal "_uniq.68" [("n", "Nat")] "Nat",
+      buildNamedGoal major [("n", "Nat")] "Nat",
       buildNamedGoal "_uniq.69" [("n", "Nat")] "∀ (t : Nat), Nat.below t → ?motive t",
       buildNamedGoal "_uniq.70" [("n", "Nat")] "?motive ?m.68 = (n + 0 = n)" (.some "conduit")
     ])
@@ -770,7 +771,8 @@ def test_nat_zero_add_alt: TestM Unit := do
     | other => do
       addTest $ assertUnreachable $ other.toString
       return ()
-  addTest $ LSpec.check tactic $ state3m2.goals.map (·.name.toString) = ["_uniq.85", "_uniq.86", "_uniq.84"]
+  let (eqL, eqR, eqT) := ("_uniq.85", "_uniq.86", "_uniq.84")
+  addTest $ LSpec.check tactic $ state3m2.goals.map (·.name.toString) = [eqL, eqR, eqT]
   let [_motive, _major, _step, conduit] := state2.goals | panic! "Goals conflict"
   let state2b ← match state3m2.resume [conduit] with
     | .ok state => pure state
@@ -788,7 +790,7 @@ def test_nat_zero_add_alt: TestM Unit := do
         userName? := .some "conduit",
         target := {
           pp? := .some "?m.79 ?m.68 = (n + 0 = n)",
-          sexp? := .some s!"((:c Eq) (:sort 0) (:subst ((:c Eq) (:mv _uniq.84) (:mv _uniq.85) (:mv _uniq.86)) (_uniq.77 (:mv _uniq.68))) ((:c Eq) (:c Nat) ({cNatAdd} (:fv {fvN}) {cNat0}) (:fv {fvN})))",
+          sexp? := .some s!"((:c Eq) (:sort 0) (:subst ((:c Eq) (:mv {eqT}) (:mv {eqL}) (:mv {eqR})) (_uniq.77 (:mv {major}))) ((:c Eq) (:c Nat) ({cNatAdd} (:fv {fvN}) {cNat0}) (:fv {fvN})))",
         },
         vars := #[{
           name := fvN,