Compare commits
No commits in common. "e0ba65a7cdac889836c8f9602117668d15dc26c9" and "1cd41b4993c785c769ab3a13b1f67ecbc897a625" have entirely different histories.
e0ba65a7cd
...
1cd41b4993
|
@ -168,10 +168,9 @@ private def collectSorrysInTree (t : Elab.InfoTree) : List InfoWithContext :=
|
||||||
let infos := findAllInfo t none fun i => match i with
|
let infos := findAllInfo t none fun i => match i with
|
||||||
| .ofTermInfo { expectedType?, expr, stx, .. } =>
|
| .ofTermInfo { expectedType?, expr, stx, .. } =>
|
||||||
expr.isSorry ∧ expectedType?.isSome ∧ stx.isOfKind `Lean.Parser.Term.sorry
|
expr.isSorry ∧ expectedType?.isSome ∧ stx.isOfKind `Lean.Parser.Term.sorry
|
||||||
| .ofTacticInfo { stx, goalsBefore, .. } =>
|
| .ofTacticInfo { stx, .. } =>
|
||||||
-- 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
|
stx.isOfKind `Lean.Parser.Tactic.tacticSorry
|
||||||
isSorry ∧ !goalsBefore.isEmpty
|
|
||||||
| _ => false
|
| _ => false
|
||||||
infos.map fun (info, context?, _) => { info, context? }
|
infos.map fun (info, context?, _) => { info, context? }
|
||||||
|
|
||||||
|
@ -198,9 +197,9 @@ def sorrysToGoalState (sorrys : List InfoWithContext) : MetaM GoalState := do
|
||||||
| .ofTacticInfo tacticInfo => do
|
| .ofTacticInfo tacticInfo => do
|
||||||
MetaTranslate.translateMVarFromTacticInfoBefore tacticInfo i.context?
|
MetaTranslate.translateMVarFromTacticInfoBefore tacticInfo i.context?
|
||||||
| _ => panic! "Invalid info"
|
| _ => panic! "Invalid info"
|
||||||
let goals := List.join (← goalsM.run {} |>.run' {})
|
let goals := (← goalsM.run {} |>.run' {}).bind id
|
||||||
let root := match goals with
|
let root := match goals with
|
||||||
| [] => panic! "No MVars generated"
|
| [] => panic! "This function cannot be called on an empty list"
|
||||||
| [g] => g
|
| [g] => g
|
||||||
| _ => { name := .anonymous }
|
| _ => { name := .anonymous }
|
||||||
GoalState.createFromMVars goals root
|
GoalState.createFromMVars goals root
|
||||||
|
|
|
@ -39,28 +39,8 @@ def resetFVarMap : MetaTranslateM Unit := do
|
||||||
modifyGet λ state => ((), { state with fvarMap := {} })
|
modifyGet λ state => ((), { state with fvarMap := {} })
|
||||||
|
|
||||||
mutual
|
mutual
|
||||||
private partial def translateLevel (srcLevel: Level) : MetaTranslateM Level := do
|
|
||||||
let sourceMCtx ← getSourceMCtx
|
|
||||||
let (_, level) := instantiateLevelMVarsImp sourceMCtx srcLevel
|
|
||||||
match level with
|
|
||||||
| .zero => return .zero
|
|
||||||
| .succ inner => do
|
|
||||||
let inner' ← translateLevel inner
|
|
||||||
return .succ inner'
|
|
||||||
| .max l1 l2 => do
|
|
||||||
let l1' ← translateLevel l1
|
|
||||||
let l2' ← translateLevel l2
|
|
||||||
return .max l1' l2'
|
|
||||||
| .imax l1 l2 => do
|
|
||||||
let l1' ← translateLevel l1
|
|
||||||
let l2' ← translateLevel l2
|
|
||||||
return .imax l1' l2'
|
|
||||||
| .param p => return .param p
|
|
||||||
| .mvar _ =>
|
|
||||||
Meta.mkFreshLevelMVar
|
|
||||||
private partial def translateExpr (srcExpr: Expr) : MetaTranslateM Expr := do
|
private partial def translateExpr (srcExpr: Expr) : MetaTranslateM Expr := do
|
||||||
let sourceMCtx ← getSourceMCtx
|
let sourceMCtx ← getSourceMCtx
|
||||||
-- We want to create as few mvars as possible
|
|
||||||
let (srcExpr, _) := instantiateMVarsCore (mctx := sourceMCtx) srcExpr
|
let (srcExpr, _) := instantiateMVarsCore (mctx := sourceMCtx) srcExpr
|
||||||
--IO.println s!"Transform src: {srcExpr}"
|
--IO.println s!"Transform src: {srcExpr}"
|
||||||
let result ← Core.transform srcExpr λ e => do
|
let result ← Core.transform srcExpr λ e => do
|
||||||
|
@ -71,7 +51,7 @@ private partial def translateExpr (srcExpr: Expr) : MetaTranslateM Expr := do
|
||||||
assert! (← getLCtx).contains fvarId'
|
assert! (← getLCtx).contains fvarId'
|
||||||
return .done $ .fvar fvarId'
|
return .done $ .fvar fvarId'
|
||||||
| .mvar mvarId => do
|
| .mvar mvarId => do
|
||||||
-- Must not be assigned
|
assert! !(sourceMCtx.dAssignment.contains mvarId)
|
||||||
assert! !(sourceMCtx.eAssignment.contains mvarId)
|
assert! !(sourceMCtx.eAssignment.contains mvarId)
|
||||||
match state.mvarMap[mvarId]? with
|
match state.mvarMap[mvarId]? with
|
||||||
| .some mvarId' => do
|
| .some mvarId' => do
|
||||||
|
@ -82,9 +62,6 @@ private partial def translateExpr (srcExpr: Expr) : MetaTranslateM Expr := do
|
||||||
let mvarId' ← translateMVarId mvarId
|
let mvarId' ← translateMVarId mvarId
|
||||||
restoreFVarMap fvarMap
|
restoreFVarMap fvarMap
|
||||||
return .done $ .mvar mvarId'
|
return .done $ .mvar mvarId'
|
||||||
| .sort level => do
|
|
||||||
let level' ← translateLevel level
|
|
||||||
return .done $ .sort level'
|
|
||||||
| _ => return .continue
|
| _ => return .continue
|
||||||
Meta.check result
|
Meta.check result
|
||||||
return result
|
return result
|
||||||
|
@ -118,23 +95,16 @@ partial def translateLCtx : MetaTranslateM LocalContext := do
|
||||||
partial def translateMVarId (srcMVarId: MVarId) : MetaTranslateM MVarId := do
|
partial def translateMVarId (srcMVarId: MVarId) : MetaTranslateM MVarId := do
|
||||||
if let .some mvarId' := (← get).mvarMap[srcMVarId]? then
|
if let .some mvarId' := (← get).mvarMap[srcMVarId]? then
|
||||||
return mvarId'
|
return mvarId'
|
||||||
let mvarId' ← Meta.withLCtx .empty #[] do
|
let mvar ← Meta.withLCtx .empty #[] do
|
||||||
let srcDecl := (← getSourceMCtx).findDecl? srcMVarId |>.get!
|
let srcDecl := (← getSourceMCtx).findDecl? srcMVarId |>.get!
|
||||||
withTheReader Context (λ ctx => { ctx with sourceLCtx := srcDecl.lctx }) do
|
withTheReader Context (λ ctx => { ctx with sourceLCtx := srcDecl.lctx }) do
|
||||||
let lctx' ← translateLCtx
|
let lctx' ← translateLCtx
|
||||||
let localInstances' ← srcDecl.localInstances.mapM translateLocalInstance
|
let localInstances' ← srcDecl.localInstances.mapM translateLocalInstance
|
||||||
Meta.withLCtx lctx' localInstances' do
|
Meta.withLCtx lctx' localInstances' do
|
||||||
let target' ← translateExpr srcDecl.type
|
let target' ← translateExpr srcDecl.type
|
||||||
let mvar' ← Meta.mkFreshExprMVar target' srcDecl.kind srcDecl.userName
|
Meta.mkFreshExprMVar target' srcDecl.kind srcDecl.userName
|
||||||
let mvarId' := mvar'.mvarId!
|
addTranslatedMVar srcMVarId mvar.mvarId!
|
||||||
if let .some { fvars, mvarIdPending }:= (← getSourceMCtx).getDelayedMVarAssignmentExp srcMVarId then
|
return mvar.mvarId!
|
||||||
-- Map the fvars in the pending context.
|
|
||||||
let mvarIdPending' ← translateMVarId mvarIdPending
|
|
||||||
let fvars' ← mvarIdPending'.withContext $ fvars.mapM translateExpr
|
|
||||||
assignDelayedMVar mvarId' fvars' mvarIdPending'
|
|
||||||
pure mvarId'
|
|
||||||
addTranslatedMVar srcMVarId mvarId'
|
|
||||||
return mvarId'
|
|
||||||
end
|
end
|
||||||
|
|
||||||
def translateMVarFromTermInfo (termInfo : Elab.TermInfo) (context? : Option Elab.ContextInfo)
|
def translateMVarFromTermInfo (termInfo : Elab.TermInfo) (context? : Option Elab.ContextInfo)
|
||||||
|
|
Loading…
Reference in New Issue