Compare commits

..

2 Commits

Author SHA1 Message Date
Leni Aniva 2d068ecd50
fix: Use guarded `isDefEq` 2024-12-09 00:06:20 -08:00
Leni Aniva 17ab2eafd8
fix: Halt on match guard 2024-12-09 00:03:53 -08:00
3 changed files with 3 additions and 7 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.isDefEq type expectedType Bool.not <$> Meta.isExprDefEqGuarded 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,8 +123,6 @@ 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 then [] else children.toList.bind (fun t => findAllInfo t context? haltOnMatch pred) let tail := if haltOnMatch ∧ !head.isEmpty 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 then pure [] else children.toList.mapM (fun t => t.findAllInfoM context? haltOnMatch pred) let tail := if haltOnMatch ∧ !head.isEmpty 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,8 +10,6 @@ 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