Compare commits

..

No commits in common. "2d068ecd5072386fd4043931b96e64fd47760aab" and "ea813e5bc5d0116d09d9e8f43c3213fa33b2ae4d" have entirely different histories.

3 changed files with 7 additions and 3 deletions

View File

@ -110,7 +110,7 @@ private def collectSorrysInTree (t : Elab.InfoTree) : IO (List InfoWithContext)
return true return true
ctx.runMetaM lctx do ctx.runMetaM lctx do
let type ← Meta.inferType expr let type ← Meta.inferType expr
Bool.not <$> Meta.isExprDefEqGuarded type expectedType Bool.not <$> Meta.isDefEq type expectedType
| .ofTacticInfo { stx, goalsBefore, .. } => | .ofTacticInfo { stx, goalsBefore, .. } =>
-- The `sorry` term is distinct from the `sorry` tactic -- The `sorry` term is distinct from the `sorry` tactic
let isSorry := stx.isOfKind `Lean.Parser.Tactic.tacticSorry let isSorry := stx.isOfKind `Lean.Parser.Tactic.tacticSorry
@ -123,6 +123,8 @@ private def collectSorrysInTree (t : Elab.InfoTree) : IO (List InfoWithContext)
def collectSorrys (step: CompilationStep) : IO (List InfoWithContext) := do def collectSorrys (step: CompilationStep) : IO (List InfoWithContext) := do
return (← step.trees.mapM collectSorrysInTree).join return (← step.trees.mapM collectSorrysInTree).join
/-- /--
Since we cannot directly merge `MetavarContext`s, we have to get creative. This Since we cannot directly merge `MetavarContext`s, we have to get creative. This
function duplicates frozen mvars in term and tactic info nodes, and add them to function duplicates frozen mvars in term and tactic info nodes, and add them to

View File

@ -103,7 +103,7 @@ partial def InfoTree.findAllInfo
| .context inner t => findAllInfo t (inner.mergeIntoOuter? context?) haltOnMatch pred | .context inner t => findAllInfo t (inner.mergeIntoOuter? context?) haltOnMatch pred
| .node i children => | .node i children =>
let head := if pred i then [(i, context?, children)] else [] let head := if pred i then [(i, context?, children)] else []
let tail := if haltOnMatch ∧ !head.isEmpty then [] else children.toList.bind (fun t => findAllInfo t context? haltOnMatch pred) let tail := if haltOnMatch then [] else children.toList.bind (fun t => findAllInfo t context? haltOnMatch pred)
head ++ tail head ++ tail
| _ => [] | _ => []
@ -118,7 +118,7 @@ partial def InfoTree.findAllInfoM [Monad m]
| .context inner t => t.findAllInfoM (inner.mergeIntoOuter? context?) haltOnMatch pred | .context inner t => t.findAllInfoM (inner.mergeIntoOuter? context?) haltOnMatch pred
| .node i children => | .node i children =>
let head := if ← pred i context? then [(i, context?, children)] else [] let head := if ← pred i context? then [(i, context?, children)] else []
let tail := if haltOnMatch ∧ !head.isEmpty then pure [] else children.toList.mapM (fun t => t.findAllInfoM context? haltOnMatch pred) let tail := if haltOnMatch then pure [] else children.toList.mapM (fun t => t.findAllInfoM context? haltOnMatch pred)
return head ++ (← tail).join return head ++ (← tail).join
| _ => return [] | _ => return []

View File

@ -10,6 +10,8 @@ def collectSorrysFromSource (source: String) : MetaM (List GoalState) := do
let filename := "<anonymous>" let filename := "<anonymous>"
let (context, state) ← do Frontend.createContextStateFromFile source filename (← getEnv) {} let (context, state) ← do Frontend.createContextStateFromFile source filename (← getEnv) {}
let m := Frontend.mapCompilationSteps λ step => do let m := Frontend.mapCompilationSteps λ step => do
for tree in step.trees do
IO.println s!"{← tree.toString}"
return (step.before, ← Frontend.collectSorrys step) return (step.before, ← Frontend.collectSorrys step)
let li ← m.run context |>.run' state let li ← m.run context |>.run' state
let goalStates ← li.filterMapM λ (env, sorrys) => withEnv env do let goalStates ← li.filterMapM λ (env, sorrys) => withEnv env do