Compare commits

..

No commits in common. "fef7f1e2f3b4f816d3d61794a2dfba8f1ab333b2" and "bfdc7dd39ee008506dafb010725fc192ccbe5287" have entirely different histories.

37 changed files with 418 additions and 1081 deletions

6
.gitignore vendored
View File

@ -1,4 +1,6 @@
.* .*
!.gitignore !.gitignore
*.[io]lean
/result *.olean
/build
/lake-packages

View File

@ -264,24 +264,25 @@ def serializeName (name: Name) (sanitize: Bool := true): String :=
if n.contains Lean.idBeginEscape then s!"{quote}{n}{quote}" else n if n.contains Lean.idBeginEscape then s!"{quote}{n}{quote}" else n
/-- serialize a sort level. Expression is optimized to be compact e.g. `(+ u 2)` -/ /-- serialize a sort level. Expression is optimized to be compact e.g. `(+ u 2)` -/
partial def serializeSortLevel (level: Level) : String := partial def serializeSortLevel (level: Level) (sanitize: Bool): String :=
let k := level.getOffset let k := level.getOffset
let u := level.getLevelOffset let u := level.getLevelOffset
let u_str := match u with let u_str := match u with
| .zero => "0" | .zero => "0"
| .succ _ => panic! "getLevelOffset should not return .succ" | .succ _ => panic! "getLevelOffset should not return .succ"
| .max v w => | .max v w =>
let v := serializeSortLevel v let v := serializeSortLevel v sanitize
let w := serializeSortLevel w let w := serializeSortLevel w sanitize
s!"(:max {v} {w})" s!"(:max {v} {w})"
| .imax v w => | .imax v w =>
let v := serializeSortLevel v let v := serializeSortLevel v sanitize
let w := serializeSortLevel w let w := serializeSortLevel w sanitize
s!"(:imax {v} {w})" s!"(:imax {v} {w})"
| .param name => | .param name =>
let name := serializeName name sanitize
s!"{name}" s!"{name}"
| .mvar id => | .mvar id =>
let name := id.name let name := serializeName id.name sanitize
s!"(:mv {name})" s!"(:mv {name})"
match k, u with match k, u with
| 0, _ => u_str | 0, _ => u_str
@ -294,7 +295,7 @@ partial def serializeSortLevel (level: Level) : String :=
A `_` symbol in the AST indicates automatic deductions not present in the original expression. A `_` symbol in the AST indicates automatic deductions not present in the original expression.
-/ -/
partial def serializeExpressionSexp (expr: Expr) : MetaM String := do partial def serializeExpressionSexp (expr: Expr) (sanitize: Bool := true): MetaM String := do
self expr self expr
where where
delayedMVarToSexp (e: Expr): MetaM (Option String) := do delayedMVarToSexp (e: Expr): MetaM (Option String) := do
@ -326,17 +327,16 @@ partial def serializeExpressionSexp (expr: Expr) : MetaM String := do
-- Lean these are handled using a `#` prefix. -- Lean these are handled using a `#` prefix.
pure s!"{deBruijnIndex}" pure s!"{deBruijnIndex}"
| .fvar fvarId => | .fvar fvarId =>
let name := fvarId.name let name := ofName fvarId.name
pure s!"(:fv {name})" pure s!"(:fv {name})"
| .mvar mvarId => do | .mvar mvarId => do
let pref := if ← mvarId.isDelayedAssigned then "mvd" else "mv" let pref := if ← mvarId.isDelayedAssigned then "mvd" else "mv"
let name := mvarId.name let name := ofName mvarId.name
pure s!"(:{pref} {name})" pure s!"(:{pref} {name})"
| .sort level => | .sort level =>
let level := serializeSortLevel level let level := serializeSortLevel level sanitize
pure s!"(:sort {level})" pure s!"(:sort {level})"
| .const declName _ => | .const declName _ =>
let declName := serializeName declName (sanitize := false)
-- The universe level of the const expression is elided since it should be -- The universe level of the const expression is elided since it should be
-- inferrable from surrounding expression -- inferrable from surrounding expression
pure s!"(:c {declName})" pure s!"(:c {declName})"
@ -346,20 +346,20 @@ partial def serializeExpressionSexp (expr: Expr) : MetaM String := do
let args := " ".intercalate args let args := " ".intercalate args
pure s!"({fn'} {args})" pure s!"({fn'} {args})"
| .lam binderName binderType body binderInfo => do | .lam binderName binderType body binderInfo => do
let binderName' := binderName.eraseMacroScopes let binderName' := ofName binderName
let binderType' ← self binderType let binderType' ← self binderType
let body' ← self body let body' ← self body
let binderInfo' := binderInfoSexp binderInfo let binderInfo' := binderInfoSexp binderInfo
pure s!"(:lambda {binderName'} {binderType'} {body'}{binderInfo'})" pure s!"(:lambda {binderName'} {binderType'} {body'}{binderInfo'})"
| .forallE binderName binderType body binderInfo => do | .forallE binderName binderType body binderInfo => do
let binderName' := binderName.eraseMacroScopes let binderName' := ofName binderName
let binderType' ← self binderType let binderType' ← self binderType
let body' ← self body let body' ← self body
let binderInfo' := binderInfoSexp binderInfo let binderInfo' := binderInfoSexp binderInfo
pure s!"(:forall {binderName'} {binderType'} {body'}{binderInfo'})" pure s!"(:forall {binderName'} {binderType'} {body'}{binderInfo'})"
| .letE name type value body _ => do | .letE name type value body _ => do
-- Dependent boolean flag diacarded -- Dependent boolean flag diacarded
let name' := name.eraseMacroScopes let name' := serializeName name
let type' ← self type let type' ← self type
let value' ← self value let value' ← self value
let body' ← self body let body' ← self body
@ -369,7 +369,7 @@ partial def serializeExpressionSexp (expr: Expr) : MetaM String := do
-- is wrapped in a :lit sexp. -- is wrapped in a :lit sexp.
let v' := match v with let v' := match v with
| .natVal val => toString val | .natVal val => toString val
| .strVal val => IR.EmitC.quoteString val | .strVal val => s!"\"{val}\""
pure s!"(:lit {v'})" pure s!"(:lit {v'})"
| .mdata _ inner => | .mdata _ inner =>
-- NOTE: Equivalent to expr itself, but mdata influences the prettyprinter -- NOTE: Equivalent to expr itself, but mdata influences the prettyprinter
@ -384,9 +384,10 @@ partial def serializeExpressionSexp (expr: Expr) : MetaM String := do
-- Elides all unhygenic names -- Elides all unhygenic names
binderInfoSexp : Lean.BinderInfo → String binderInfoSexp : Lean.BinderInfo → String
| .default => "" | .default => ""
| .implicit => " :i" | .implicit => " :implicit"
| .strictImplicit => " :si" | .strictImplicit => " :strictImplicit"
| .instImplicit => " :ii" | .instImplicit => " :instImplicit"
ofName (name: Name) := serializeName name sanitize
def serializeExpression (options: @&Protocol.Options) (e: Expr): MetaM Protocol.Expression := do def serializeExpression (options: @&Protocol.Options) (e: Expr): MetaM Protocol.Expression := do
let pp?: Option String ← match options.printExprPretty with let pp?: Option String ← match options.printExprPretty with
@ -419,13 +420,13 @@ def serializeGoal (options: @&Protocol.Options) (goal: MVarId) (mvarDecl: Metava
match localDecl with match localDecl with
| .cdecl _ fvarId userName _ _ _ => | .cdecl _ fvarId userName _ _ _ =>
return { return {
name := fvarId.name.toString, name := ofName fvarId.name,
userName:= ofName userName.simpMacroScopes, userName:= ofName userName.simpMacroScopes,
isInaccessible := userName.isInaccessibleUserName isInaccessible := userName.isInaccessibleUserName
} }
| .ldecl _ fvarId userName _ _ _ _ => do | .ldecl _ fvarId userName _ _ _ _ => do
return { return {
name := fvarId.name.toString, name := ofName fvarId.name,
userName := toString userName.simpMacroScopes, userName := toString userName.simpMacroScopes,
isInaccessible := userName.isInaccessibleUserName isInaccessible := userName.isInaccessibleUserName
} }
@ -435,7 +436,7 @@ def serializeGoal (options: @&Protocol.Options) (goal: MVarId) (mvarDecl: Metava
let userName := userName.simpMacroScopes let userName := userName.simpMacroScopes
let type ← instantiate type let type ← instantiate type
return { return {
name := fvarId.name.toString, name := ofName fvarId.name,
userName:= ofName userName, userName:= ofName userName,
isInaccessible := userName.isInaccessibleUserName isInaccessible := userName.isInaccessibleUserName
type? := .some (← serializeExpression options type) type? := .some (← serializeExpression options type)
@ -449,7 +450,7 @@ def serializeGoal (options: @&Protocol.Options) (goal: MVarId) (mvarDecl: Metava
else else
pure $ .none pure $ .none
return { return {
name := fvarId.name.toString, name := ofName fvarId.name,
userName:= ofName userName, userName:= ofName userName,
isInaccessible := userName.isInaccessibleUserName isInaccessible := userName.isInaccessibleUserName
type? := .some (← serializeExpression options type) type? := .some (← serializeExpression options type)
@ -468,7 +469,7 @@ def serializeGoal (options: @&Protocol.Options) (goal: MVarId) (mvarDecl: Metava
| false => ppVar localDecl | false => ppVar localDecl
return var::acc return var::acc
return { return {
name := goal.name.toString, name := ofName goal.name,
userName? := if mvarDecl.userName == .anonymous then .none else .some (ofName mvarDecl.userName), userName? := if mvarDecl.userName == .anonymous then .none else .some (ofName mvarDecl.userName),
isConversion := isLHSGoal? mvarDecl.type |>.isSome, isConversion := isLHSGoal? mvarDecl.type |>.isSome,
target := (← serializeExpression options (← instantiate mvarDecl.type)), target := (← serializeExpression options (← instantiate mvarDecl.type)),
@ -532,7 +533,7 @@ protected def GoalState.diag (goalState: GoalState) (parent?: Option GoalState :
then instantiateAll decl.type then instantiateAll decl.type
else pure $ decl.type else pure $ decl.type
let type_sexp ← if options.printSexp then let type_sexp ← if options.printSexp then
let sexp ← serializeExpressionSexp type let sexp ← serializeExpressionSexp type (sanitize := false)
pure <| " " ++ sexp pure <| " " ++ sexp
else else
pure "" pure ""

View File

@ -58,7 +58,7 @@ def inspect (args: Protocol.EnvInspect) (options: @&Protocol.Options): CoreM (Pr
| none => return .error $ Protocol.errorIndex s!"Symbol not found {args.name}" | none => return .error $ Protocol.errorIndex s!"Symbol not found {args.name}"
| some info => pure info | some info => pure info
let module? := env.getModuleIdxFor? name >>= let module? := env.getModuleIdxFor? name >>=
(λ idx => env.allImportedModuleNames.get? idx.toNat) (λ idx => env.allImportedModuleNames.get? idx.toNat) |>.map toString
let value? := match args.value?, info with let value? := match args.value?, info with
| .some true, _ => info.value? | .some true, _ => info.value?
| .some false, _ => .none | .some false, _ => .none
@ -80,7 +80,7 @@ def inspect (args: Protocol.EnvInspect) (options: @&Protocol.Options): CoreM (Pr
then value?.map (λ e => then value?.map (λ e =>
e.getUsedConstants.filter (!isNameInternal ·) |>.map (λ n => serializeName n) ) e.getUsedConstants.filter (!isNameInternal ·) |>.map (λ n => serializeName n) )
else .none, else .none,
module? := module?.map (·.toString) module? := module?
} }
let result ← match info with let result ← match info with
| .inductInfo induct => pure { core with inductInfo? := .some { | .inductInfo induct => pure { core with inductInfo? := .some {
@ -113,20 +113,6 @@ def inspect (args: Protocol.EnvInspect) (options: @&Protocol.Options): CoreM (Pr
k := r.k, k := r.k,
} } } }
| _ => pure core | _ => pure core
let result ← if args.source?.getD false then
let srcSearchPath ← initSrcSearchPath
let sourceUri? ← module?.bindM (Server.documentUriFromModule srcSearchPath ·)
let declRange? ← findDeclarationRanges? name
let sourceStart? := declRange?.map (·.range.pos)
let sourceEnd? := declRange?.map (·.range.endPos)
.pure {
result with
sourceUri?,
sourceStart?,
sourceEnd?,
}
else
.pure result
return .ok result return .ok result
def addDecl (args: Protocol.EnvAdd): CoreM (Protocol.CR Protocol.EnvAddResult) := do def addDecl (args: Protocol.EnvAdd): CoreM (Protocol.CR Protocol.EnvAddResult) := do
let env ← Lean.MonadEnv.getEnv let env ← Lean.MonadEnv.getEnv

View File

@ -1,4 +1,4 @@
/- Adapted from lean-training-data by semorrison -/
import Pantograph.Frontend.Basic import Pantograph.Frontend.Basic
import Pantograph.Frontend.Elab import Pantograph.Frontend.Elab
import Pantograph.Frontend.InfoTree
import Pantograph.Frontend.MetaTranslate import Pantograph.Frontend.MetaTranslate

View File

@ -30,13 +30,6 @@ end Lean.PersistentArray
namespace Pantograph.Frontend namespace Pantograph.Frontend
@[export pantograph_frontend_stx_byte_range]
def stxByteRange (stx : Syntax) : String.Pos × String.Pos :=
let pos := stx.getPos?.getD 0
let endPos := stx.getTailPos?.getD 0
(pos, endPos)
abbrev FrontendM := Elab.Frontend.FrontendM abbrev FrontendM := Elab.Frontend.FrontendM
structure CompilationStep where structure CompilationStep where
@ -67,7 +60,7 @@ def processOneCommand: FrontendM (CompilationStep × Bool) := do
let s := (← get).commandState let s := (← get).commandState
let before := s.env let before := s.env
let done ← Elab.Frontend.processCommand let done ← Elab.Frontend.processCommand
let stx := (← get).commands.back! let stx := (← get).commands.back
let src := (← read).inputCtx.input.toSubstring.extract (← get).cmdPos (← get).parserState.pos let src := (← read).inputCtx.input.toSubstring.extract (← get).cmdPos (← get).parserState.pos
let s' := (← get).commandState let s' := (← get).commandState
let after := s'.env let after := s'.env

View File

@ -1,21 +1,87 @@
/- Adapted from https://github.com/semorrison/lean-training-data -/
import Lean.Elab.Import import Lean.Elab.Import
import Lean.Elab.Command import Lean.Elab.Command
import Lean.Elab.InfoTree import Lean.Elab.InfoTree
import Lean.DeclarationRange
import Pantograph.Frontend.Basic import Pantograph.Frontend.Basic
import Pantograph.Frontend.MetaTranslate import Pantograph.Frontend.MetaTranslate
import Pantograph.Goal import Pantograph.Goal
import Pantograph.Protocol import Pantograph.Protocol
import Pantograph.Frontend.InfoTree
open Lean open Lean
namespace Lean.Elab.Info
/-- The `Syntax` for a `Lean.Elab.Info`, if there is one. -/
protected def stx? : Info → Option Syntax
| .ofTacticInfo info => info.stx
| .ofTermInfo info => info.stx
| .ofCommandInfo info => info.stx
| .ofMacroExpansionInfo info => info.stx
| .ofOptionInfo info => info.stx
| .ofFieldInfo info => info.stx
| .ofCompletionInfo info => info.stx
| .ofUserWidgetInfo info => info.stx
| .ofCustomInfo info => info.stx
| .ofFVarAliasInfo _ => none
| .ofFieldRedeclInfo info => info.stx
| .ofOmissionInfo info => info.stx
/-- Is the `Syntax` for this `Lean.Elab.Info` original, or synthetic? -/
protected def isOriginal (i : Info) : Bool :=
match i.stx? with
| none => true -- Somewhat unclear what to do with `FVarAliasInfo`, so be conservative.
| some stx => match stx.getHeadInfo with
| .original .. => true
| _ => false
end Lean.Elab.Info
namespace Lean.Elab.TacticInfo
/-- Find the name for the outermost `Syntax` in this `TacticInfo`. -/
def name? (t : TacticInfo) : Option Name :=
match t.stx with
| Syntax.node _ n _ => some n
| _ => none
/-- Decide whether a tactic is "substantive",
or is merely a tactic combinator (e.g. `by`, `;`, multiline tactics, parenthesized tactics). -/
def isSubstantive (t : TacticInfo) : Bool :=
match t.name? with
| none => false
| some `null => false
| some ``cdot => false
| some ``cdotTk => false
| some ``Lean.Parser.Term.byTactic => false
| some ``Lean.Parser.Tactic.tacticSeq => false
| some ``Lean.Parser.Tactic.tacticSeq1Indented => false
| some ``Lean.Parser.Tactic.«tactic_<;>_» => false
| some ``Lean.Parser.Tactic.paren => false
| _ => true
end Lean.Elab.TacticInfo
namespace Lean.Elab.InfoTree
/--
Keep `.node` nodes and `.hole` nodes satisfying predicates.
Returns a `List InfoTree`, although in most situations this will be a singleton.
-/
partial def filter (p : Info → Bool) (m : MVarId → Bool := fun _ => false) :
InfoTree → List InfoTree
| .context ctx tree => tree.filter p m |>.map (.context ctx)
| .node info children =>
if p info then
[.node info (children.toList.map (filter p m)).join.toPArray']
else
(children.toList.map (filter p m)).join
| .hole mvar => if m mvar then [.hole mvar] else []
end Lean.Elab.InfoTree
namespace Pantograph.Frontend namespace Pantograph.Frontend
-- Info tree filtering functions -- Info tree filtering functions
/- Adapted from lean-training-data -/
structure TacticInvocation where structure TacticInvocation where
info : Elab.TacticInfo info : Elab.TacticInfo
ctx : Elab.ContextInfo ctx : Elab.ContextInfo
@ -65,10 +131,19 @@ protected def usedConstants (t: TacticInvocation) : NameSet :=
end TacticInvocation end TacticInvocation
/-- Analogue of `Lean.Elab.InfoTree.findInfo?`, but that returns a list of all results. -/
partial def findAllInfo (t : Elab.InfoTree) (context?: Option Elab.ContextInfo) (pred : Elab.Info → Bool) :
List (Elab.Info × Option Elab.ContextInfo × PersistentArray Elab.InfoTree) :=
match t with
| .context inner t => findAllInfo t (inner.mergeIntoOuter? context?) pred
| .node i children =>
(if pred i then [(i, context?, children)] else []) ++ children.toList.bind (fun t => findAllInfo t context? pred)
| _ => []
/-- Return all `TacticInfo` nodes in an `InfoTree` corresponding to tactics, /-- Return all `TacticInfo` nodes in an `InfoTree` corresponding to tactics,
each equipped with its relevant `ContextInfo`, and any children info trees. -/ each equipped with its relevant `ContextInfo`, and any children info trees. -/
private def collectTacticNodes (t : Elab.InfoTree) : List TacticInvocation := private def collectTacticNodes (t : Elab.InfoTree) : List TacticInvocation :=
let infos := t.findAllInfo none false fun i => match i with let infos := findAllInfo t none fun i => match i with
| .ofTacticInfo _ => true | .ofTacticInfo _ => true
| _ => false | _ => false
infos.filterMap fun p => match p with infos.filterMap fun p => match p with
@ -80,18 +155,16 @@ def collectTactics (t : Elab.InfoTree) : List TacticInvocation :=
@[export pantograph_frontend_collect_tactics_from_compilation_step_m] @[export pantograph_frontend_collect_tactics_from_compilation_step_m]
def collectTacticsFromCompilationStep (step : CompilationStep) : IO (List Protocol.InvokedTactic) := do def collectTacticsFromCompilationStep (step : CompilationStep) : IO (List Protocol.InvokedTactic) := do
let tacticInfoTrees := step.trees.flatMap λ tree => tree.filter λ let tacticInfoTrees := step.trees.bind λ tree => tree.filter λ
| info@(.ofTacticInfo _) => info.isOriginal | info@(.ofTacticInfo _) => info.isOriginal
| _ => false | _ => false
let tactics := tacticInfoTrees.flatMap collectTactics let tactics := tacticInfoTrees.bind collectTactics
tactics.mapM λ invocation => do tactics.mapM λ invocation => do
let goalBefore := (Format.joinSep (← invocation.goalState) "\n").pretty let goalBefore := (Format.joinSep (← invocation.goalState) "\n").pretty
let goalAfter := (Format.joinSep (← invocation.goalStateAfter) "\n").pretty let goalAfter := (Format.joinSep (← invocation.goalStateAfter) "\n").pretty
let tactic ← invocation.ctx.runMetaM {} <| Meta.withMCtx invocation.info.mctxBefore do let tactic ← invocation.ctx.runMetaM {} do
return (← invocation.ctx.ppSyntax {} invocation.info.stx).pretty let t ← PrettyPrinter.ppTactic ⟨invocation.info.stx⟩
-- FIXME: Why does this not work? There are problems with `term.pseudo.antiquot` return t.pretty
--PrettyPrinter.ppTactic ⟨invocation.info.stx⟩
--return t.pretty
let usedConstants := invocation.usedConstants.toArray.map λ n => n.toString let usedConstants := invocation.usedConstants.toArray.map λ n => n.toString
return { return {
goalBefore, goalBefore,
@ -104,91 +177,47 @@ structure InfoWithContext where
info: Elab.Info info: Elab.Info
context?: Option Elab.ContextInfo := .none context?: Option Elab.ContextInfo := .none
structure GoalCollectionOptions where private def collectSorrysInTree (t : Elab.InfoTree) : List InfoWithContext :=
collectTypeErrors : Bool := false let infos := findAllInfo t none fun i => match i with
| .ofTermInfo { expectedType?, expr, stx, .. } =>
private def collectSorrysInTree (t : Elab.InfoTree) (options : GoalCollectionOptions := {}) expr.isSorry ∧ expectedType?.isSome ∧ stx.isOfKind `Lean.Parser.Term.sorry
: IO (List InfoWithContext) := do
let infos ← t.findAllInfoM none fun i ctx? => match i with
| .ofTermInfo { expectedType?, expr, stx, lctx, isBinder := false, .. } => do
let .some ctx := ctx? | return (false, true)
if expr.isSorry ∧ stx.isOfKind `Lean.Parser.Term.sorry then
if expectedType?.isNone then
throw $ .userError "Sorry of indeterminant type is not allowed"
return (true, false)
unless options.collectTypeErrors do
return (false, true)
let .some expectedType := expectedType? | return (false, true)
let typeMatch ← ctx.runMetaM lctx do
let type ← Meta.inferType expr
Meta.isExprDefEqGuarded type expectedType
return match typeMatch, expr.hasSorry with
| false, true => (true, false) -- Types mismatch but has sorry -> collect, halt
| false, false => (true, false) -- Types mistmatch but no sorry -> collect, halt
| true, true => (false, true) -- Types match but has sorry -> continue
| true, false => (false, false) -- Types match but no sorries -> halt
| .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
return (isSorry ∧ !goalsBefore.isEmpty, ¬ isSorry) isSorry ∧ !goalsBefore.isEmpty
| _ => return (false, true) | _ => false
return infos.map fun (info, context?, _) => { info, context? } infos.map fun (info, context?, _) => { info, context? }
-- NOTE: Plural deliberately not spelled "sorries" -- NOTE: Plural deliberately not spelled "sorries"
@[export pantograph_frontend_collect_sorrys_m] @[export pantograph_frontend_collect_sorrys_m]
def collectSorrys (step: CompilationStep) (options : GoalCollectionOptions := {}) def collectSorrys (step: CompilationStep) : List InfoWithContext :=
: IO (List InfoWithContext) := do step.trees.bind collectSorrysInTree
return (← step.trees.mapM $ λ tree => collectSorrysInTree tree options).flatten
structure AnnotatedGoalState where
state : GoalState
srcBoundaries : List (String.Pos × String.Pos)
/-- /--
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
the current `MetavarContext`. the current `MetavarContext`.
-/ -/
@[export pantograph_frontend_sorrys_to_goal_state_m] @[export pantograph_frontend_sorrys_to_goal_state]
def sorrysToGoalState (sorrys : List InfoWithContext) : MetaM AnnotatedGoalState := do def sorrysToGoalState (sorrys : List InfoWithContext) : MetaM GoalState := do
assert! !sorrys.isEmpty assert! !sorrys.isEmpty
let goalsM := sorrys.mapM λ i => do let goalsM := sorrys.mapM λ i => do
match i.info with match i.info with
| .ofTermInfo termInfo => do | .ofTermInfo termInfo => do
let mvarId ← MetaTranslate.translateMVarFromTermInfo termInfo i.context? let mvarId ← MetaTranslate.translateMVarFromTermInfo termInfo i.context?
if (← mvarId.getType).hasSorry then return [mvarId]
throwError s!"Coupling is not allowed in drafting"
return [(mvarId, stxByteRange termInfo.stx)]
| .ofTacticInfo tacticInfo => do | .ofTacticInfo tacticInfo => do
let mvarIds ← MetaTranslate.translateMVarFromTacticInfoBefore tacticInfo i.context? MetaTranslate.translateMVarFromTacticInfoBefore tacticInfo i.context?
for mvarId in mvarIds do
if (← mvarId.getType).hasSorry then
throwError s!"Coupling is not allowed in drafting"
let range := stxByteRange tacticInfo.stx
return mvarIds.map (·, range)
| _ => panic! "Invalid info" | _ => panic! "Invalid info"
let annotatedGoals := List.flatten (← goalsM.run {} |>.run' {}) let goals := List.join (← goalsM.run {} |>.run' {})
let goals := annotatedGoals.map Prod.fst
let srcBoundaries := annotatedGoals.map Prod.snd
let root := match goals with let root := match goals with
| [] => panic! "No MVars generated" | [] => panic! "No MVars generated"
| [g] => g | [g] => g
| _ => { name := .anonymous } | _ => { name := .anonymous }
let state ← GoalState.createFromMVars goals root GoalState.createFromMVars goals root
return { state, srcBoundaries }
@[export pantograph_frontend_collect_new_defined_constants_m]
def collectNewDefinedConstants (step : CompilationStep) : IO (List Name) := do
step.after.constants.map₂.foldlM (λ acc name _ => do
if step.before.contains name then
return acc
let coreM : CoreM Bool := Option.isSome <$> findDeclarationRanges? name
let hasRange ← coreM.run' { fileName := step.fileName, fileMap := step.fileMap } { env := step.after } |>.toBaseIO
match hasRange with
| .ok true => return name :: acc
| .ok false => return acc
| .error e => throw $ IO.userError (← e.toMessageData.toString)
) []
end Pantograph.Frontend end Pantograph.Frontend

View File

@ -1,157 +0,0 @@
/- Adapted from lean-training-data -/
import Lean.Elab.InfoTree
import Lean.Parser.Term
import Lean.PrettyPrinter
open Lean
namespace Lean.Elab
private def elaboratorToString : Name → String
| .anonymous => ""
| n => s!"⟨{n}⟩ "
private def indent (s : String) : String := "\n".intercalate $ s.splitOn "\n" |>.map ("\t" ++ .)
/-- The `Syntax` for a `Lean.Elab.Info`, if there is one. -/
protected def Info.stx? : Info → Option Syntax
| .ofTacticInfo info => info.stx
| .ofTermInfo info => info.stx
| .ofCommandInfo info => info.stx
| .ofMacroExpansionInfo info => info.stx
| .ofOptionInfo info => info.stx
| .ofFieldInfo info => info.stx
| .ofCompletionInfo info => info.stx
| .ofUserWidgetInfo info => info.stx
| .ofCustomInfo info => info.stx
| .ofFVarAliasInfo _ => none
| .ofFieldRedeclInfo info => info.stx
| .ofOmissionInfo info => info.stx
| .ofChoiceInfo info => info.stx
| .ofPartialTermInfo info => info.stx
/-- Is the `Syntax` for this `Lean.Elab.Info` original, or synthetic? -/
protected def Info.isOriginal (i : Info) : Bool :=
match i.stx? with
| none => true -- Somewhat unclear what to do with `FVarAliasInfo`, so be conservative.
| some stx => match stx.getHeadInfo with
| .original .. => true
| _ => false
def ContextInfo.ppExpr (ctx : ContextInfo) (lctx : LocalContext) (e : Expr) : IO Format :=
ctx.runMetaM lctx (do Meta.ppExpr (← instantiateMVars e))
def CommandInfo.toString (info : CommandInfo) (ctx : ContextInfo) : IO String := do
let stx := (← ctx.ppSyntax {} info.stx).pretty
return s!"{elaboratorToString info.elaborator}\n{stx}"
def TermInfo.toString (info : TermInfo) (ctx : ContextInfo) : IO String := do
let stx := (← ctx.ppSyntax info.lctx info.stx).pretty
let expectedType := (← info.expectedType?.mapM fun ty => do
pure s!": {(← ctx.ppExpr info.lctx ty).pretty}").getD ""
let expr := (← ctx.ppExpr info.lctx info.expr).pretty
return s!"{elaboratorToString info.elaborator}{expr}{expectedType}\n{stx}"
/-- Find the name for the outermost `Syntax` in this `TacticInfo`. -/
def TacticInfo.name? (t : TacticInfo) : Option Name :=
match t.stx with
| Syntax.node _ n _ => some n
| _ => none
/-- Decide whether a tactic is "substantive",
or is merely a tactic combinator (e.g. `by`, `;`, multiline tactics, parenthesized tactics). -/
def TacticInfo.isSubstantive (t : TacticInfo) : Bool :=
match t.name? with
| none => false
| some `null => false
| some ``cdot => false
| some ``cdotTk => false
| some ``Lean.Parser.Term.byTactic => false
| some ``Lean.Parser.Tactic.tacticSeq => false
| some ``Lean.Parser.Tactic.tacticSeq1Indented => false
| some ``Lean.Parser.Tactic.«tactic_<;>_» => false
| some ``Lean.Parser.Tactic.paren => false
| _ => true
def TacticInfo.pp (info : TacticInfo) (ctx : ContextInfo) : IO Format :=
ctx.runMetaM {} try
Lean.PrettyPrinter.ppTactic ⟨info.stx⟩
catch _ =>
pure "<failed to pretty print>"
def TacticInfo.toString (i : TacticInfo) (ctx : ContextInfo) : IO String := do
let name := i.name?
let stx := Format.pretty (← i.pp ctx)
return s!"{name}\n{stx}"
/--
Keep `.node` nodes and `.hole` nodes satisfying predicates.
Returns a `List InfoTree`, although in most situations this will be a singleton.
-/
partial def InfoTree.filter (p : Info → Bool) (m : MVarId → Bool := fun _ => false) :
InfoTree → List InfoTree
| .context ctx tree => tree.filter p m |>.map (.context ctx)
| .node info children =>
if p info then
[.node info (children.toList.map (filter p m)).flatten.toPArray']
else
(children.toList.map (filter p m)).flatten
| .hole mvar => if m mvar then [.hole mvar] else []
/-- Analogue of `Lean.Elab.InfoTree.findInfo?`, but that returns a list of all results. -/
partial def InfoTree.findAllInfo
(t : InfoTree)
(context?: Option Elab.ContextInfo)
(haltOnMatch : Bool := false)
(pred : Elab.Info → Bool)
: List (Elab.Info × Option Elab.ContextInfo × PersistentArray Elab.InfoTree) :=
match t with
| .context inner t => findAllInfo t (inner.mergeIntoOuter? context?) haltOnMatch pred
| .node i children =>
let head := if pred i then [(i, context?, children)] else []
let tail := if haltOnMatch ∧ !head.isEmpty then [] else children.toList.flatMap (fun t => findAllInfo t context? haltOnMatch pred)
head ++ tail
| _ => []
/-- Monadic analogue of `findAllInfo`, but predicate controls whether to recurse. -/
partial def InfoTree.findAllInfoM [Monad m]
(t : InfoTree)
(context?: Option Elab.ContextInfo)
(pred : Elab.Info → Option Elab.ContextInfo → m (Bool × Bool))
: m (List (Elab.Info × Option Elab.ContextInfo × PersistentArray Elab.InfoTree)) := do
match t with
| .context inner t => t.findAllInfoM (inner.mergeIntoOuter? context?) pred
| .node i children =>
let (flagCollect, flagRecurse) ← pred i context?
let head := if flagCollect then [(i, context?, children)] else []
let tail := if ¬ flagRecurse then pure [] else children.toList.mapM (fun t => t.findAllInfoM context? pred)
return head ++ (← tail).flatten
| _ => return []
@[export pantograph_infotree_to_string_m]
partial def InfoTree.toString (t : InfoTree) (ctx?: Option Elab.ContextInfo := .none) : IO String := do
match t with
| .context ctx t => t.toString (ctx.mergeIntoOuter? ctx?)
| .node info children =>
if let some ctx := ctx? then
let node : String ← match info with
| .ofTermInfo info => pure s!"[term] {(← info.toString ctx)}"
| .ofCommandInfo info => pure s!"[command] {(← info.toString ctx)}"
| .ofTacticInfo info => pure s!"[tactic] {(← info.toString ctx)}"
| .ofMacroExpansionInfo _ => pure "[macro_exp]"
| .ofOptionInfo _ => pure "[option]"
| .ofFieldInfo _ => pure "[field]"
| .ofCompletionInfo _ => pure "[completion]"
| .ofUserWidgetInfo _ => pure "[user_widget]"
| .ofCustomInfo _ => pure "[custom]"
| .ofFVarAliasInfo _ => pure "[fvar]"
| .ofFieldRedeclInfo _ => pure "[field_redecl]"
| .ofOmissionInfo _ => pure "[omission]"
| .ofChoiceInfo _ => pure "[choice]"
| .ofPartialTermInfo _ => pure "[partial_term]"
let children := "\n".intercalate (← children.toList.mapM λ t' => do pure $ indent $ ← t'.toString ctx)
return s!"{node}\n{children}"
else throw <| IO.userError "No `ContextInfo` available."
| .hole mvarId =>
if let some ctx := ctx? then
let payload := (← ctx.runMetaM {} (do Meta.ppGoal mvarId)).pretty
return s!"[hole] {payload}"
else throw <| IO.userError "No `ContextInfo` available."
end Lean.Elab

View File

@ -10,6 +10,8 @@ import Lean
namespace Pantograph namespace Pantograph
open Lean open Lean
def filename: String := "<pantograph>"
/-- /--
Represents an interconnected set of metavariables, or a state in proof search Represents an interconnected set of metavariables, or a state in proof search
-/ -/
@ -71,8 +73,6 @@ protected def GoalState.metaContextOfGoal (state: GoalState) (mvarId: MVarId): O
return { lctx := mvarDecl.lctx, localInstances := mvarDecl.localInstances } return { lctx := mvarDecl.lctx, localInstances := mvarDecl.localInstances }
protected def GoalState.metaState (state: GoalState): Meta.State := protected def GoalState.metaState (state: GoalState): Meta.State :=
state.savedState.term.meta.meta state.savedState.term.meta.meta
protected def GoalState.coreState (state: GoalState): Core.SavedState :=
state.savedState.term.meta.core
protected def GoalState.withContext (state: GoalState) (mvarId: MVarId) (m: MetaM α): MetaM α := do protected def GoalState.withContext (state: GoalState) (mvarId: MVarId) (m: MetaM α): MetaM α := do
mvarId.withContext m |>.run' (← read) state.metaState mvarId.withContext m |>.run' (← read) state.metaState
@ -177,52 +177,16 @@ protected def GoalState.getMVarEAssignment (goalState: GoalState) (mvarId: MVarI
--- Tactic execution functions --- --- Tactic execution functions ---
-- Mimics `Elab.Term.logUnassignedUsingErrorInfos` protected def GoalState.step (state: GoalState) (goal: MVarId) (tacticM: Elab.Tactic.TacticM Unit)
private def collectAllErroredMVars (src : MVarId) : Elab.TermElabM (List MVarId) := do
-- These descendants serve as "seed" mvars. If a MVarError's mvar is related
-- to one of these seed mvars, it means an error has occurred when a tactic
-- was executing on `src`. `evalTactic`, will not capture these mvars, so we
-- need to manually find them and save them into the goal list.
let descendants ← Meta.getMVars (.mvar src)
--let _ ← Elab.Term.logUnassignedUsingErrorInfos descendants
let mut alreadyVisited : MVarIdSet := {}
let mut result : MVarIdSet := {}
for { mvarId, .. } in (← get).mvarErrorInfos do
unless alreadyVisited.contains mvarId do
alreadyVisited := alreadyVisited.insert mvarId
/- The metavariable `mvarErrorInfo.mvarId` may have been assigned or
delayed assigned to another metavariable that is unassigned. -/
let mvarDeps ← Meta.getMVars (.mvar mvarId)
if mvarDeps.any descendants.contains then do
result := mvarDeps.foldl (·.insert ·) result
return result.toList
private def mergeMVarLists (li1 li2 : List MVarId) : List MVarId :=
let li2' := li2.filter (¬ li1.contains ·)
li1 ++ li2'
/--
Set `guardMVarErrors` to true to capture mvar errors. Lean will not
automatically collect mvars from text tactics (vide
`test_tactic_failure_synthesize_placeholder`)
-/
protected def GoalState.step (state: GoalState) (goal: MVarId) (tacticM: Elab.Tactic.TacticM Unit) (guardMVarErrors : Bool := false)
: Elab.TermElabM GoalState := do : Elab.TermElabM GoalState := do
unless (← getMCtx).decls.contains goal do unless (← getMCtx).decls.contains goal do
throwError s!"Goal is not in context: {goal.name}" throwError s!"Goal is not in context: {goal.name}"
goal.checkNotAssigned `GoalState.step goal.checkNotAssigned `GoalState.step
let (_, { goals }) ← tacticM { elaborator := .anonymous } |>.run { goals := [goal] } let (_, newGoals) ← tacticM { elaborator := .anonymous } |>.run { goals := [goal] }
let nextElabState ← MonadBacktrack.saveState let nextElabState ← MonadBacktrack.saveState
Elab.Term.synthesizeSyntheticMVarsNoPostponing
let goals ← if guardMVarErrors then
pure $ mergeMVarLists goals (← collectAllErroredMVars goal)
else
pure goals
return { return {
state with state with
savedState := { term := nextElabState, tactic := { goals }, }, savedState := { term := nextElabState, tactic := newGoals },
parentMVar? := .some goal, parentMVar? := .some goal,
calcPrevRhs? := .none, calcPrevRhs? := .none,
} }
@ -238,37 +202,16 @@ inductive TacticResult where
-- The given action cannot be executed in the state -- The given action cannot be executed in the state
| invalidAction (message: String) | invalidAction (message: String)
private def dumpMessageLog (prevMessageLength : Nat) : CoreM (Array String) := do /-- Executes a `TacticM` monads on this `GoalState`, collecting the errors as necessary -/
let newMessages ← (← Core.getMessageLog).toList.drop prevMessageLength protected def GoalState.tryTacticM (state: GoalState) (goal: MVarId) (tacticM: Elab.Tactic.TacticM Unit):
|>.filterMapM λ m => do Elab.TermElabM TacticResult := do
if m.severity == .error then
return .some $ ← m.toString
else
return .none
Core.resetMessageLog
return newMessages.toArray
/-- Executes a `TacticM` monad on this `GoalState`, collecting the errors as necessary -/
protected def GoalState.tryTacticM
(state: GoalState) (goal: MVarId) (tacticM: Elab.Tactic.TacticM Unit)
(guardMVarErrors : Bool := false)
: Elab.TermElabM TacticResult := do
let prevMessageLength := state.coreState.messages.toList.length
try try
let nextState ← state.step goal tacticM guardMVarErrors let nextState ← state.step goal tacticM
-- Check if error messages have been generated in the core.
let newMessages ← dumpMessageLog prevMessageLength
if ¬ newMessages.isEmpty then
return .failure newMessages
return .success nextState return .success nextState
catch exception => catch exception =>
match exception with return .failure #[← exception.toMessageData.toString]
| .internal _ => return .failure $ ← dumpMessageLog prevMessageLength
| _ => return .failure #[← exception.toMessageData.toString]
/-- Execute a string tactic on given state. Restores TermElabM -/ /-- Execute a string tactic on given state. Restores TermElabM -/
@[export pantograph_goal_state_try_tactic_m]
protected def GoalState.tryTactic (state: GoalState) (goal: MVarId) (tactic: String): protected def GoalState.tryTactic (state: GoalState) (goal: MVarId) (tactic: String):
Elab.TermElabM TacticResult := do Elab.TermElabM TacticResult := do
state.restoreElabM state.restoreElabM
@ -276,10 +219,10 @@ protected def GoalState.tryTactic (state: GoalState) (goal: MVarId) (tactic: Str
(env := ← MonadEnv.getEnv) (env := ← MonadEnv.getEnv)
(catName := if state.isConv then `conv else `tactic) (catName := if state.isConv then `conv else `tactic)
(input := tactic) (input := tactic)
(fileName := ← getFileName) with (fileName := filename) with
| .ok stx => pure $ stx | .ok stx => pure $ stx
| .error error => return .parseError error | .error error => return .parseError error
state.tryTacticM goal (Elab.Tactic.evalTactic tactic) true state.tryTacticM goal $ Elab.Tactic.evalTactic tactic
protected def GoalState.tryAssign (state: GoalState) (goal: MVarId) (expr: String): protected def GoalState.tryAssign (state: GoalState) (goal: MVarId) (expr: String):
Elab.TermElabM TacticResult := do Elab.TermElabM TacticResult := do
@ -288,7 +231,7 @@ protected def GoalState.tryAssign (state: GoalState) (goal: MVarId) (expr: Strin
(env := ← MonadEnv.getEnv) (env := ← MonadEnv.getEnv)
(catName := `term) (catName := `term)
(input := expr) (input := expr)
(fileName := ← getFileName) with (fileName := filename) with
| .ok syn => pure syn | .ok syn => pure syn
| .error error => return .parseError error | .error error => return .parseError error
state.tryTacticM goal $ Tactic.evalAssign expr state.tryTacticM goal $ Tactic.evalAssign expr
@ -302,7 +245,7 @@ protected def GoalState.tryLet (state: GoalState) (goal: MVarId) (binderName: St
(env := ← MonadEnv.getEnv) (env := ← MonadEnv.getEnv)
(catName := `term) (catName := `term)
(input := type) (input := type)
(fileName := ← getFileName) with (fileName := filename) with
| .ok syn => pure syn | .ok syn => pure syn
| .error error => return .parseError error | .error error => return .parseError error
state.tryTacticM goal $ Tactic.evalLet binderName.toName type state.tryTacticM goal $ Tactic.evalLet binderName.toName type
@ -389,7 +332,7 @@ protected def GoalState.tryCalc (state: GoalState) (goal: MVarId) (pred: String)
(env := state.env) (env := state.env)
(catName := `term) (catName := `term)
(input := pred) (input := pred)
(fileName := ← getFileName) with (fileName := filename) with
| .ok syn => pure syn | .ok syn => pure syn
| .error error => return .parseError error | .error error => return .parseError error
goal.checkNotAssigned `GoalState.tryCalc goal.checkNotAssigned `GoalState.tryCalc
@ -410,7 +353,7 @@ protected def GoalState.tryCalc (state: GoalState) (goal: MVarId) (pred: String)
throwErrorAt pred "invalid 'calc' step, relation expected{indentExpr step}" throwErrorAt pred "invalid 'calc' step, relation expected{indentExpr step}"
if let some prevRhs := calcPrevRhs? then if let some prevRhs := calcPrevRhs? then
unless ← Meta.isDefEqGuarded lhs prevRhs do unless ← Meta.isDefEqGuarded lhs prevRhs do
throwErrorAt pred "invalid 'calc' step, left-hand-side is{indentD m!"{lhs} : {← Meta.inferType lhs}"}\nprevious right-hand-side is{indentD m!"{prevRhs} : {← Meta.inferType prevRhs}"}" throwErrorAt pred "invalid 'calc' step, left-hand-side is{indentD m!"{lhs} : {← Meta.inferType lhs}"}\nprevious right-hand-side is{indentD m!"{prevRhs} : {← Meta.inferType prevRhs}"}" -- "
-- Creates a mvar to represent the proof that the calc tactic solves the -- Creates a mvar to represent the proof that the calc tactic solves the
-- current branch -- current branch

View File

@ -138,35 +138,16 @@ def goalSerialize (state: GoalState) (options: @&Protocol.Options): CoreM (Array
runMetaM <| state.serializeGoals (parent := .none) options runMetaM <| state.serializeGoals (parent := .none) options
@[export pantograph_goal_print_m] @[export pantograph_goal_print_m]
def goalPrint (state: GoalState) (rootExpr: Bool) (parentExpr: Bool) (goals: Bool) (extraMVars : Array String) (options: @&Protocol.Options) def goalPrint (state: GoalState) (options: @&Protocol.Options): CoreM Protocol.GoalPrintResult :=
: CoreM Protocol.GoalPrintResult := runMetaM do runMetaM do
state.restoreMetaM state.restoreMetaM
let root? ← if rootExpr then
state.rootExpr?.mapM λ expr => state.withRootContext do
serializeExpression options (← instantiateAll expr)
else
pure .none
let parent? ← if parentExpr then
state.parentExpr?.mapM λ expr => state.withParentContext do
serializeExpression options (← instantiateAll expr)
else
pure .none
let goals ← if goals then
goalSerialize state options
else
pure #[]
let extraMVars ← extraMVars.mapM λ mvarId => do
let mvarId: MVarId := { name := mvarId.toName }
let .some _ ← mvarId.findDecl? | return {}
state.withContext mvarId do
let .some expr ← getExprMVarAssignment? mvarId | return {}
serializeExpression options (← instantiateAll expr)
return { return {
root?, root? := ← state.rootExpr?.mapM (λ expr =>
parent?, state.withRootContext do
goals, serializeExpression options (← instantiateAll expr)),
extraMVars, parent? := ← state.parentExpr?.mapM (λ expr =>
state.withParentContext do
serializeExpression options (← instantiateAll expr)),
} }
@[export pantograph_goal_tactic_m] @[export pantograph_goal_tactic_m]

View File

@ -5,7 +5,6 @@ Note that no command other than `InteractionError` may have `error` as one of
its field names to avoid confusion with error messages generated by the REPL. its field names to avoid confusion with error messages generated by the REPL.
-/ -/
import Lean.Data.Json import Lean.Data.Json
import Lean.Data.Position
namespace Pantograph.Protocol namespace Pantograph.Protocol
@ -122,13 +121,11 @@ structure EnvCatalogResult where
-- Print the type of a symbol -- Print the type of a symbol
structure EnvInspect where structure EnvInspect where
name: String name: String
-- Show the value expressions; By default definitions values are shown and -- If true/false, show/hide the value expressions; By default definitions
-- theorem values are hidden. -- values are shown and theorem values are hidden.
value?: Option Bool := .some false value?: Option Bool := .some false
-- Show the type and value dependencies -- If true, show the type and value dependencies
dependency?: Option Bool := .some false dependency?: Option Bool := .some false
-- Show source location
source?: Option Bool := .some false
deriving Lean.FromJson deriving Lean.FromJson
-- See `InductiveVal` -- See `InductiveVal`
structure InductInfo where structure InductInfo where
@ -175,11 +172,6 @@ structure EnvInspectResult where
inductInfo?: Option InductInfo := .none inductInfo?: Option InductInfo := .none
constructorInfo?: Option ConstructorInfo := .none constructorInfo?: Option ConstructorInfo := .none
recursorInfo?: Option RecursorInfo := .none recursorInfo?: Option RecursorInfo := .none
-- Location in source
sourceUri?: Option String := .none
sourceStart?: Option Lean.Position := .none
sourceEnd?: Option Lean.Position := .none
deriving Lean.ToJson deriving Lean.ToJson
structure EnvAdd where structure EnvAdd where
@ -279,23 +271,12 @@ structure GoalDeleteResult where
structure GoalPrint where structure GoalPrint where
stateId: Nat stateId: Nat
-- Print root?
rootExpr?: Option Bool := .some False
-- Print the parent expr?
parentExpr?: Option Bool := .some False
-- Print goals?
goals?: Option Bool := .some False
-- Print values of extra mvars?
extraMVars?: Option (Array String) := .none
deriving Lean.FromJson deriving Lean.FromJson
structure GoalPrintResult where structure GoalPrintResult where
-- The root expression -- The root expression
root?: Option Expression := .none root?: Option Expression := .none
-- The filling expression of the parent goal -- The filling expression of the parent goal
parent?: Option Expression := .none parent?: Option Expression
goals: Array Goal := #[]
extraMVars: Array Expression := #[]
deriving Lean.ToJson deriving Lean.ToJson
-- Diagnostic Options, not available in REPL -- Diagnostic Options, not available in REPL
@ -327,14 +308,10 @@ structure FrontendProcess where
-- One of these two must be supplied: Either supply the file name or the content. -- One of these two must be supplied: Either supply the file name or the content.
fileName?: Option String := .none fileName?: Option String := .none
file?: Option String := .none file?: Option String := .none
-- collect tactic invocations -- If set to true, collect tactic invocations
invocations: Bool := false invocations: Bool := false
-- collect `sorry`s -- If set to true, collect `sorry`s
sorrys: Bool := false sorrys: Bool := false
-- collect type errors
typeErrorsAsGoals: Bool := false
-- list new constants from each compilation step
newConstants: Bool := false
deriving Lean.FromJson deriving Lean.FromJson
structure InvokedTactic where structure InvokedTactic where
goalBefore: String goalBefore: String
@ -348,16 +325,11 @@ structure InvokedTactic where
structure CompilationUnit where structure CompilationUnit where
-- String boundaries of compilation units -- String boundaries of compilation units
boundary: (Nat × Nat) boundary: (Nat × Nat)
messages: Array String := #[]
-- Tactic invocations -- Tactic invocations
invocations?: Option (List InvokedTactic) := .none invocations?: Option (List InvokedTactic) := .none
goalStateId?: Option Nat := .none goalStateId?: Option Nat := .none
goals?: Option (Array Goal) := .none goals: Array Goal := #[]
-- Code segments which generated the goals messages: Array String := #[]
goalSrcBoundaries?: Option (Array (Nat × Nat)) := .none
-- New constants defined in compilation unit
newConstants?: Option (Array String) := .none
deriving Lean.ToJson deriving Lean.ToJson
structure FrontendProcessResult where structure FrontendProcessResult where
units: List CompilationUnit units: List CompilationUnit

View File

@ -59,12 +59,6 @@ and then add the new constants.
def environmentPickle (env : Environment) (path : System.FilePath) : IO Unit := def environmentPickle (env : Environment) (path : System.FilePath) : IO Unit :=
Pantograph.pickle path (env.header.imports, env.constants.map₂) Pantograph.pickle path (env.header.imports, env.constants.map₂)
def resurrectEnvironment
(imports : Array Import)
(map₂ : PHashMap Name ConstantInfo)
: IO Environment := do
let env ← importModules imports {} 0
env.replay (Std.HashMap.ofList map₂.toList)
/-- /--
Unpickle an `Environment` from disk. Unpickle an `Environment` from disk.
@ -74,7 +68,8 @@ and then replace the new constants.
@[export pantograph_env_unpickle_m] @[export pantograph_env_unpickle_m]
def environmentUnpickle (path : System.FilePath) : IO (Environment × CompactedRegion) := unsafe do def environmentUnpickle (path : System.FilePath) : IO (Environment × CompactedRegion) := unsafe do
let ((imports, map₂), region) ← Pantograph.unpickle (Array Import × PHashMap Name ConstantInfo) path let ((imports, map₂), region) ← Pantograph.unpickle (Array Import × PHashMap Name ConstantInfo) path
return (← resurrectEnvironment imports map₂, region) let env ← importModules imports {} 0
return (← env.replay (Std.HashMap.ofList map₂.toList), region)
open Lean.Core in open Lean.Core in
@ -93,9 +88,7 @@ def goalStatePickle (goalState : GoalState) (path : System.FilePath) : IO Unit :
savedState := { savedState := {
term := { term := {
meta := { meta := {
core := { core,
env, nextMacroScope, ngen, ..
},
meta, meta,
} }
«elab», «elab»,
@ -107,10 +100,9 @@ def goalStatePickle (goalState : GoalState) (path : System.FilePath) : IO Unit :
convMVar?, convMVar?,
calcPrevRhs?, calcPrevRhs?,
} := goalState } := goalState
--let env := core.env
Pantograph.pickle path ( Pantograph.pickle path (
env.constants.map₂, ({ core with } : CompactCoreState),
({ nextMacroScope, ngen } : CompactCoreState),
meta, meta,
«elab», «elab»,
tactic, tactic,
@ -125,8 +117,6 @@ def goalStatePickle (goalState : GoalState) (path : System.FilePath) : IO Unit :
def goalStateUnpickle (path : System.FilePath) (env : Environment) def goalStateUnpickle (path : System.FilePath) (env : Environment)
: IO (GoalState × CompactedRegion) := unsafe do : IO (GoalState × CompactedRegion) := unsafe do
let (( let ((
map₂,
compactCore, compactCore,
meta, meta,
«elab», «elab»,
@ -137,8 +127,6 @@ def goalStateUnpickle (path : System.FilePath) (env : Environment)
convMVar?, convMVar?,
calcPrevRhs?, calcPrevRhs?,
), region) ← Pantograph.unpickle ( ), region) ← Pantograph.unpickle (
PHashMap Name ConstantInfo ×
CompactCoreState × CompactCoreState ×
Meta.State × Meta.State ×
Elab.Term.State × Elab.Term.State ×
@ -149,7 +137,6 @@ def goalStateUnpickle (path : System.FilePath) (env : Environment)
Option (MVarId × MVarId × List MVarId) × Option (MVarId × MVarId × List MVarId) ×
Option (MVarId × Expr) Option (MVarId × Expr)
) path ) path
let env ← env.replay (Std.HashMap.ofList map₂.toList)
let goalState := { let goalState := {
savedState := { savedState := {
term := { term := {

View File

@ -27,38 +27,5 @@ def evalAssign : Elab.Tactic.Tactic := fun stx => Elab.Tactic.withMainContext do
goal.assign expr goal.assign expr
Elab.Tactic.replaceMainGoal nextGoals Elab.Tactic.replaceMainGoal nextGoals
def sorryToHole (src : Expr) : StateRefT (List MVarId) MetaM Expr := do
Meta.transform src λ
| .app (.app (.const ``sorryAx ..) type) .. => do
let type ← instantiateMVars type
if type.hasSorry then
throwError s!"Coupling is not allowed in draft tactic: {← Meta.ppExpr type}"
let mvar ← Meta.mkFreshExprSyntheticOpaqueMVar type
modify (mvar.mvarId! :: .)
pure $ .done mvar
| _ => pure .continue
-- Given a complete (no holes) expression, extract the sorry's from it and convert them into goals.
def draft (goal : MVarId) (expr : Expr) : MetaM (List MVarId) := do
goal.checkNotAssigned `Pantograph.Tactic.draft
let exprType ← Meta.inferType expr
let goalType ← goal.getType
unless ← Meta.isDefEq goalType exprType do
throwError s!"{← Meta.ppExpr expr} : {← Meta.ppExpr exprType} ≠ {← Meta.ppExpr goalType}"
let (expr', holes) ← sorryToHole expr |>.run []
goal.assign expr'
return holes.reverse
def evalDraft : Elab.Tactic.Tactic := fun stx ↦ Elab.Tactic.withMainContext do
let target ← Elab.Tactic.getMainTarget
let goal ← Elab.Tactic.getMainGoal
let (expr, holeGoals) ← Elab.Tactic.elabTermWithHoles stx
(expectedType? := .some target)
(tagSuffix := .anonymous)
(allowNaturalHoles := true)
let draftGoals ← draft goal expr
Elab.Tactic.replaceMainGoal $ holeGoals ++ draftGoals
end Pantograph.Tactic end Pantograph.Tactic

View File

@ -40,7 +40,7 @@ def «have» (mvarId: MVarId) (binderName: Name) (type: Expr): MetaM BranchResul
let fvarId ← mkFreshFVarId let fvarId ← mkFreshFVarId
let lctxUpstream := lctx.mkLocalDecl fvarId binderName type let lctxUpstream := lctx.mkLocalDecl fvarId binderName type
let mvarUpstream ← let mvarUpstream ←
Meta.withLCtx lctxUpstream #[] do withTheReader Meta.Context (fun ctx => { ctx with lctx := lctxUpstream }) do
Meta.withNewLocalInstances #[.fvar fvarId] 0 do Meta.withNewLocalInstances #[.fvar fvarId] 0 do
let mvarUpstream ← mkUpstreamMVar mvarId let mvarUpstream ← mkUpstreamMVar mvarId
--let expr: Expr := .app (.lam binderName type mvarBranch .default) mvarUpstream --let expr: Expr := .app (.lam binderName type mvarBranch .default) mvarUpstream

View File

@ -1,6 +1,6 @@
namespace Pantograph namespace Pantograph
@[export pantograph_version] @[export pantograph_version]
def version := "0.2.25" def version := "0.2.19"
end Pantograph end Pantograph

View File

@ -7,8 +7,6 @@ A Machine-to-Machine interaction system for Lean 4.
Pantograph provides interfaces to execute proofs, construct expressions, and Pantograph provides interfaces to execute proofs, construct expressions, and
examine the symbol list of a Lean project for machine learning. examine the symbol list of a Lean project for machine learning.
See [documentations](doc/rationale.md) for design rationale and references.
## Installation ## Installation
For Nix users, run For Nix users, run
@ -17,9 +15,7 @@ nix build .#{sharedLib,executable}
``` ```
to build either the shared library or executable. to build either the shared library or executable.
Install `lake` and `lean` fixed to the version of the `lean-toolchain` file, and Install `elan` and `lake`, and run
run
``` sh ``` sh
lake build lake build
``` ```
@ -28,12 +24,9 @@ This builds the executable in `.lake/build/bin/pantograph-repl`.
## Executable Usage ## Executable Usage
``` sh ``` sh
pantograph-repl MODULES|LEAN_OPTIONS pantograph MODULES|LEAN_OPTIONS
``` ```
The `pantograph-repl` executable must be run with a list of modules to import.
It can also accept lean options of the form `--key=value` e.g. `--pp.raw=true`.
The REPL loop accepts commands as single-line JSON inputs and outputs either an The REPL loop accepts commands as single-line JSON inputs and outputs either an
`Error:` (indicating malformed command) or a JSON return value indicating the `Error:` (indicating malformed command) or a JSON return value indicating the
result of a command execution. The command can be passed in one of two formats result of a command execution. The command can be passed in one of two formats
@ -44,6 +37,8 @@ command { ... }
The list of available commands can be found in `Pantograph/Protocol.lean` and below. An The list of available commands can be found in `Pantograph/Protocol.lean` and below. An
empty command aborts the REPL. empty command aborts the REPL.
The `pantograph` executable must be run with a list of modules to import. It can
also accept lean options of the form `--key=value` e.g. `--pp.raw=true`.
Example: (~5k symbols) Example: (~5k symbols)
``` ```
@ -80,7 +75,7 @@ the environment might be setup like this:
``` sh ``` sh
LIB="../lib" LIB="../lib"
LIB_MATHLIB="$LIB/mathlib4/.lake" LIB_MATHLIB="$LIB/mathlib4/lake-packages"
export LEAN_PATH="$LIB/mathlib4/build/lib:$LIB_MATHLIB/aesop/build/lib:$LIB_MATHLIB/Qq/build/lib:$LIB_MATHLIB/std/build/lib" export LEAN_PATH="$LIB/mathlib4/build/lib:$LIB_MATHLIB/aesop/build/lib:$LIB_MATHLIB/Qq/build/lib:$LIB_MATHLIB/std/build/lib"
LEAN_PATH=$LEAN_PATH build/bin/pantograph $@ LEAN_PATH=$LEAN_PATH build/bin/pantograph $@

View File

@ -79,7 +79,6 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
let state ← get let state ← get
let nGoals := state.goalStates.size let nGoals := state.goalStates.size
set { state with nextId := 0, goalStates := .empty } set { state with nextId := 0, goalStates := .empty }
Lean.Core.resetMessageLog
return .ok { nGoals } return .ok { nGoals }
stat (_: Protocol.Stat): MainM (CR Protocol.StatResult) := do stat (_: Protocol.Stat): MainM (CR Protocol.StatResult) := do
let state ← get let state ← get
@ -223,13 +222,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
let state ← get let state ← get
let .some goalState := state.goalStates[args.stateId]? | let .some goalState := state.goalStates[args.stateId]? |
return .error $ errorIndex s!"Invalid state index {args.stateId}" return .error $ errorIndex s!"Invalid state index {args.stateId}"
let result ← runMetaInMainM <| goalPrint let result ← runMetaInMainM <| goalPrint goalState state.options
goalState
(rootExpr := args.rootExpr?.getD False)
(parentExpr := args.parentExpr?.getD False)
(goals := args.goals?.getD False)
(extraMVars := args.extraMVars?.getD #[])
(options := state.options)
return .ok result return .ok result
goal_save (args: Protocol.GoalSave): MainM (CR Protocol.GoalSaveResult) := do goal_save (args: Protocol.GoalSave): MainM (CR Protocol.GoalSaveResult) := do
let state ← get let state ← get
@ -264,38 +257,27 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
pure $ .some invocations pure $ .some invocations
else else
pure .none pure .none
let sorrys if args.sorrys then let sorrys := if args.sorrys then
Frontend.collectSorrys step (options := { collectTypeErrors := args.typeErrorsAsGoals }) Frontend.collectSorrys step
else else
pure [] []
let messages ← step.messageStrings let messages ← step.messageStrings
let newConstants ← if args.newConstants then return (step.before, boundary, invocations?, sorrys, messages)
Frontend.collectNewDefinedConstants step
else
pure []
return (step.before, boundary, invocations?, sorrys, messages, newConstants)
let li ← frontendM.run context |>.run' state let li ← frontendM.run context |>.run' state
let units ← li.mapM λ (env, boundary, invocations?, sorrys, messages, newConstants) => Lean.withEnv env do let units ← li.mapM λ (env, boundary, invocations?, sorrys, messages) => Lean.withEnv env do
let newConstants? := if args.newConstants then let (goalStateId?, goals) ← if sorrys.isEmpty then do
.some $ newConstants.toArray.map λ name => name.toString pure (.none, #[])
else
.none
let (goalStateId?, goals?, goalSrcBoundaries?) ← if sorrys.isEmpty then do
pure (.none, .none, .none)
else do else do
let { state, srcBoundaries } ← runMetaInMainM $ Frontend.sorrysToGoalState sorrys let goalState ← runMetaInMainM $ Frontend.sorrysToGoalState sorrys
let stateId ← newGoalState state let stateId ← newGoalState goalState
let goals ← goalSerialize state options let goals ← goalSerialize goalState options
let srcBoundaries := srcBoundaries.toArray.map (λ (b, e) => (b.byteIdx, e.byteIdx)) pure (.some stateId, goals)
pure (.some stateId, .some goals, .some srcBoundaries)
return { return {
boundary, boundary,
messages,
invocations?, invocations?,
goalStateId?, goalStateId?,
goals?, goals,
goalSrcBoundaries?, messages,
newConstants?,
} }
return .ok { units } return .ok { units }
catch e => catch e =>

View File

@ -48,12 +48,6 @@ namespace Condensed
deriving instance BEq, Repr for LocalDecl deriving instance BEq, Repr for LocalDecl
deriving instance BEq, Repr for Goal deriving instance BEq, Repr for Goal
-- Enable string interpolation
instance : ToString FVarId where
toString id := id.name.toString
instance : ToString MVarId where
toString id := id.name.toString
protected def LocalDecl.devolatilize (decl: LocalDecl): LocalDecl := protected def LocalDecl.devolatilize (decl: LocalDecl): LocalDecl :=
{ {
decl with fvarId := { name := .anonymous } decl with fvarId := { name := .anonymous }
@ -101,19 +95,19 @@ def runTermElabMSeq (env: Environment) (termElabM: Elab.TermElabM LSpec.TestSeq)
def exprToStr (e: Expr): Lean.MetaM String := toString <$> Meta.ppExpr e def exprToStr (e: Expr): Lean.MetaM String := toString <$> Meta.ppExpr e
def strToTermSyntax (s: String): CoreM Syntax := do def strToTermSyntax [Monad m] [MonadEnv m] (s: String): m Syntax := do
let .ok stx := Parser.runParserCategory let .ok stx := Parser.runParserCategory
(env := ← MonadEnv.getEnv) (env := ← MonadEnv.getEnv)
(catName := `term) (catName := `term)
(input := s) (input := s)
(fileName := ← getFileName) | panic! s!"Failed to parse {s}" (fileName := filename) | panic! s!"Failed to parse {s}"
return stx return stx
def parseSentence (s: String): Elab.TermElabM Expr := do def parseSentence (s: String): Elab.TermElabM Expr := do
let stx ← match Parser.runParserCategory let stx ← match Parser.runParserCategory
(env := ← MonadEnv.getEnv) (env := ← MonadEnv.getEnv)
(catName := `term) (catName := `term)
(input := s) (input := s)
(fileName := ← getFileName) with (fileName := filename) with
| .ok syn => pure syn | .ok syn => pure syn
| .error error => throwError "Failed to parse: {error}" | .error error => throwError "Failed to parse: {error}"
Elab.Term.elabTerm (stx := stx) .none Elab.Term.elabTerm (stx := stx) .none
@ -129,30 +123,22 @@ def mvarUserNameAndType (mvarId: MVarId): MetaM (Name × String) := do
-- Monadic testing -- Monadic testing
abbrev TestT := StateRefT' IO.RealWorld LSpec.TestSeq abbrev TestT := StateT LSpec.TestSeq
section Monadic def addTest [Monad m] (test: LSpec.TestSeq) : TestT m Unit := do
variable [Monad m] [MonadLiftT (ST IO.RealWorld) m]
def addTest (test: LSpec.TestSeq) : TestT m Unit := do
set $ (← get) ++ test set $ (← get) ++ test
def checkEq [DecidableEq α] [Repr α] (desc : String) (lhs rhs : α) : TestT m Unit := do def checkEq [Monad m] [DecidableEq α] (desc : String) (lhs rhs : α) : TestT m Unit := do
addTest $ LSpec.check desc (lhs = rhs) addTest $ LSpec.check desc (lhs == rhs)
def checkTrue (desc : String) (flag : Bool) : TestT m Unit := do def checkTrue [Monad m] (desc : String) (flag : Bool) : TestT m Unit := do
addTest $ LSpec.check desc flag addTest $ LSpec.check desc flag
def fail (desc : String) : TestT m Unit := do def fail [Monad m] (desc : String) : TestT m Unit := do
addTest $ LSpec.check desc false addTest $ LSpec.check desc false
def runTest (t: TestT m Unit): m LSpec.TestSeq := def runTest [Monad m] (t: TestT m Unit): m LSpec.TestSeq :=
Prod.snd <$> t.run LSpec.TestSeq.done Prod.snd <$> t.run LSpec.TestSeq.done
def runTestWithResult { α } (t: TestT m α): m (α × LSpec.TestSeq) := def runTestWithResult { α } [Monad m] (t: TestT m α): m (α × LSpec.TestSeq) :=
t.run LSpec.TestSeq.done t.run LSpec.TestSeq.done
def runTestCoreM (env: Environment) (coreM: TestT CoreM Unit) (options: Array String := #[]): IO LSpec.TestSeq := do
runCoreMSeq env (runTest coreM) options
end Monadic
def runTestTermElabM (env: Environment) (t: TestT Elab.TermElabM Unit): def runTestTermElabM (env: Environment) (t: TestT Elab.TermElabM Unit):
IO LSpec.TestSeq := IO LSpec.TestSeq :=

View File

@ -32,10 +32,10 @@ def test_expr_to_binder (env: Environment): IO LSpec.TestSeq := do
def test_sexp_of_symbol (env: Environment): IO LSpec.TestSeq := do def test_sexp_of_symbol (env: Environment): IO LSpec.TestSeq := do
let entries: List (String × String) := [ let entries: List (String × String) := [
-- This one contains unhygienic variable names which must be suppressed -- This one contains unhygienic variable names which must be suppressed
("Nat.add", "(:forall a (:c Nat) (:forall a (:c Nat) (:c Nat)))"), ("Nat.add", "(:forall _ (:c Nat) (:forall _ (:c Nat) (:c Nat)))"),
-- These ones are normal and easy -- These ones are normal and easy
("Nat.add_one", "(:forall n (:c Nat) ((:c Eq) (:c Nat) ((:c HAdd.hAdd) (:c Nat) (:c Nat) (:c Nat) ((:c instHAdd) (:c Nat) (:c instAddNat)) 0 ((:c OfNat.ofNat) (:c Nat) (:lit 1) ((:c instOfNatNat) (:lit 1)))) ((:c Nat.succ) 0)))"), ("Nat.add_one", "(:forall n (:c Nat) ((:c Eq) (:c Nat) ((:c HAdd.hAdd) (:c Nat) (:c Nat) (:c Nat) ((:c instHAdd) (:c Nat) (:c instAddNat)) 0 ((:c OfNat.ofNat) (:c Nat) (:lit 1) ((:c instOfNatNat) (:lit 1)))) ((:c Nat.succ) 0)))"),
("Nat.le_of_succ_le", "(:forall n (:c Nat) (:forall m (:c Nat) (:forall h ((:c LE.le) (:c Nat) (:c instLENat) ((:c Nat.succ) 1) 0) ((:c LE.le) (:c Nat) (:c instLENat) 2 1)) :i) :i)"), ("Nat.le_of_succ_le", "(:forall n (:c Nat) (:forall m (:c Nat) (:forall h ((:c LE.le) (:c Nat) (:c instLENat) ((:c Nat.succ) 1) 0) ((:c LE.le) (:c Nat) (:c instLENat) 2 1)) :implicit) :implicit)"),
-- Handling of higher order types -- Handling of higher order types
("Or", "(:forall a (:sort 0) (:forall b (:sort 0) (:sort 0)))"), ("Or", "(:forall a (:sort 0) (:forall b (:sort 0) (:sort 0)))"),
("List", "(:forall α (:sort (+ u 1)) (:sort (+ u 1)))") ("List", "(:forall α (:sort (+ u 1)) (:sort (+ u 1)))")
@ -50,8 +50,8 @@ def test_sexp_of_elab (env: Environment): IO LSpec.TestSeq := do
let entries: List (String × (List Name) × String) := [ let entries: List (String × (List Name) × String) := [
("λ x: Nat × Bool => x.1", [], "(:lambda x ((:c Prod) (:c Nat) (:c Bool)) ((:c Prod.fst) (:c Nat) (:c Bool) 0))"), ("λ x: Nat × Bool => x.1", [], "(:lambda x ((:c Prod) (:c Nat) (:c Bool)) ((:c Prod.fst) (:c Nat) (:c Bool) 0))"),
("λ x: Array Nat => x.data", [], "(:lambda x ((:c Array) (:c Nat)) ((:c Array.data) (:c Nat) 0))"), ("λ x: Array Nat => x.data", [], "(:lambda x ((:c Array) (:c Nat)) ((:c Array.data) (:c Nat) 0))"),
("λ {α: Sort (u + 1)} => List α", [`u], "(:lambda α (:sort (+ u 1)) ((:c List) 0) :i)"), ("λ {α: Sort (u + 1)} => List α", [`u], "(:lambda α (:sort (+ u 1)) ((:c List) 0) :implicit)"),
("λ {α} => List α", [], "(:lambda α (:sort (+ (:mv _uniq.4) 1)) ((:c List) 0) :i)"), ("λ {α} => List α", [], "(:lambda α (:sort (+ (:mv _uniq.4) 1)) ((:c List) 0) :implicit)"),
("(2: Nat) <= (5: Nat)", [], "((:c LE.le) (:mv _uniq.18) (:mv _uniq.19) ((:c OfNat.ofNat) (:mv _uniq.4) (:lit 2) (:mv _uniq.5)) ((:c OfNat.ofNat) (:mv _uniq.14) (:lit 5) (:mv _uniq.15)))"), ("(2: Nat) <= (5: Nat)", [], "((:c LE.le) (:mv _uniq.18) (:mv _uniq.19) ((:c OfNat.ofNat) (:mv _uniq.4) (:lit 2) (:mv _uniq.5)) ((:c OfNat.ofNat) (:mv _uniq.14) (:lit 5) (:mv _uniq.15)))"),
] ]
entries.foldlM (λ suites (source, levels, target) => entries.foldlM (λ suites (source, levels, target) =>
@ -77,7 +77,7 @@ def test_sexp_of_expr (env: Environment): IO LSpec.TestSeq := do
.default) .default)
.implicit) .implicit)
.implicit, .implicit,
"(:lambda p (:sort 0) (:lambda q (:sort 0) (:lambda k ((:c And) 1 0) ((:c And.right) _ _ 0)) :i) :i)" "(:lambda p (:sort 0) (:lambda q (:sort 0) (:lambda k ((:c And) 1 0) ((:c And.right) _ _ 0)) :implicit) :implicit)"
), ),
] ]
let termElabM: Elab.TermElabM LSpec.TestSeq := entries.foldlM (λ suites (expr, target) => do let termElabM: Elab.TermElabM LSpec.TestSeq := entries.foldlM (λ suites (expr, target) => do

View File

@ -97,26 +97,11 @@ def test_inspect: IO LSpec.TestSeq := do
) LSpec.TestSeq.done ) LSpec.TestSeq.done
runCoreMSeq env inner runCoreMSeq env inner
def test_symbol_location : TestT IO Unit := do
let env: Environment ← importModules
(imports := #[`Init])
(opts := {})
(trustLevel := 1)
addTest $ ← runTestCoreM env do
let .ok result ← Environment.inspect { name := "Nat.le_of_succ_le", source? := .some true } (options := {}) | fail "Inspect failed"
checkEq "module" result.module? <| .some "Init.Data.Nat.Basic"
-- Extraction of source doesn't work for symbols in `Init` for some reason
checkTrue "file" result.sourceUri?.isNone
checkEq "pos" (result.sourceStart?.map (·.column)) <| .some 0
checkEq "pos" (result.sourceEnd?.map (·.column)) <| .some 88
def suite: List (String × IO LSpec.TestSeq) := def suite: List (String × IO LSpec.TestSeq) :=
[ [
("Catalog", test_catalog), ("Catalog", test_catalog),
("Symbol Visibility", test_symbol_visibility), ("Symbol Visibility", test_symbol_visibility),
("Inspect", test_inspect), ("Inspect", test_inspect),
("Symbol Location", runTest test_symbol_location),
] ]
end Pantograph.Test.Environment end Pantograph.Test.Environment

View File

@ -6,18 +6,17 @@ import Test.Common
open Lean Pantograph open Lean Pantograph
namespace Pantograph.Test.Frontend namespace Pantograph.Test.Frontend
def collectSorrysFromSource (source: String) (options : Frontend.GoalCollectionOptions := {}) def collectSorrysFromSource (source: String) : MetaM (List GoalState) := do
: 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
return (step.before, Frontend.collectSorrys step options) 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
if sorrys.isEmpty then if sorrys.isEmpty then
return .none return .none
let { state, .. } ← Frontend.sorrysToGoalState sorrys let goalState ← Frontend.sorrysToGoalState sorrys
return .some state return .some goalState
return goalStates return goalStates
def test_multiple_sorrys_in_proof : TestT MetaM Unit := do def test_multiple_sorrys_in_proof : TestT MetaM Unit := do
@ -178,58 +177,6 @@ example (n: Nat) : mystery n + 1 = n + 2 := sorry
} }
]) ])
def test_capture_type_mismatch : TestT MetaM Unit := do
let input := "
def mystery (k: Nat) : Nat := true
"
let options := { collectTypeErrors := true }
let goalStates ← (collectSorrysFromSource input options).run' {}
let [goalState] := goalStates | panic! s!"Incorrect number of states: {goalStates.length}"
checkEq "goals" ((← goalState.serializeGoals).map (·.devolatilize)) #[
{
target := { pp? := "Nat" },
vars := #[{
userName := "k",
type? := .some { pp? := "Nat" },
}],
}
]
def test_capture_type_mismatch_in_binder : TestT MetaM Unit := do
let input := "
example (p: Prop) (h: (∀ (x: Prop), Nat) → p): p := h (λ (y: Nat) => 5)
"
let options := { collectTypeErrors := true }
let goalStates ← (collectSorrysFromSource input options).run' {}
let [goalState] := goalStates | panic! s!"Incorrect number of states: {goalStates.length}"
checkEq "goals" ((← goalState.serializeGoals (options := {})).map (·.devolatilize)) #[
]
def collectNewConstants (source: String) : MetaM (List (List Name)) := do
let filename := "<anonymous>"
let (context, state) ← do Frontend.createContextStateFromFile source filename (← getEnv) {}
let m := Frontend.mapCompilationSteps λ step => do
Frontend.collectNewDefinedConstants step
m.run context |>.run' state
def test_collect_one_constant : TestT MetaM Unit := do
let input := "
def mystery : Nat := 123
"
let names ← collectNewConstants input
checkEq "constants" names [[`mystery]]
def test_collect_one_theorem : TestT MetaM Unit := do
let input := "
theorem mystery [SizeOf α] (as : List α) (i : Fin as.length) : sizeOf (as.get i) < sizeOf as := by
match as, i with
| a::as, ⟨0, _⟩ => simp_arith [get]
| a::as, ⟨i+1, h⟩ =>
have ih := sizeOf_get as ⟨i, Nat.le_of_succ_le_succ h⟩
apply Nat.lt_trans ih
simp_arith
"
let names ← collectNewConstants input
checkEq "constants" names [[`mystery]]
def suite (env : Environment): List (String × IO LSpec.TestSeq) := def suite (env : Environment): List (String × IO LSpec.TestSeq) :=
let tests := [ let tests := [
@ -238,10 +185,6 @@ def suite (env : Environment): List (String × IO LSpec.TestSeq) :=
("sorry_in_induction", test_sorry_in_induction), ("sorry_in_induction", test_sorry_in_induction),
("sorry_in_coupled", test_sorry_in_coupled), ("sorry_in_coupled", test_sorry_in_coupled),
("environment_capture", test_environment_capture), ("environment_capture", test_environment_capture),
("capture_type_mismatch", test_capture_type_mismatch),
--("capture_type_mismatch_in_binder", test_capture_type_mismatch_in_binder),
("collect_one_constant", test_collect_one_constant),
("collect_one_theorem", test_collect_one_theorem),
] ]
tests.map (fun (name, test) => (name, runMetaMSeq env $ runTest test)) tests.map (fun (name, test) => (name, runMetaMSeq env $ runTest test))

View File

@ -72,8 +72,8 @@ def test_tactic : Test :=
({ stateId := 0, root := "_uniq.9" }: Protocol.GoalStartResult), ({ stateId := 0, root := "_uniq.9" }: Protocol.GoalStartResult),
step "goal.tactic" [("stateId", .num 0), ("goalId", .num 0), ("tactic", .str "intro x")] step "goal.tactic" [("stateId", .num 0), ("goalId", .num 0), ("tactic", .str "intro x")]
({ nextStateId? := .some 1, goals? := #[goal1], }: Protocol.GoalTacticResult), ({ nextStateId? := .some 1, goals? := #[goal1], }: Protocol.GoalTacticResult),
step "goal.print" [("stateId", .num 1), ("parentExpr", .bool true), ("rootExpr", .bool true)] step "goal.print" [("stateId", .num 1)]
({ parent? := .some { pp? := .some "fun x => ?m.11" }, }: Protocol.GoalPrintResult), ({ parent? := .some { pp? := .some "fun x => ?m.12 x" }, }: Protocol.GoalPrintResult),
step "goal.tactic" [("stateId", .num 1), ("goalId", .num 0), ("tactic", .str "intro y")] step "goal.tactic" [("stateId", .num 1), ("goalId", .num 0), ("tactic", .str "intro y")]
({ nextStateId? := .some 2, goals? := #[goal2], }: Protocol.GoalTacticResult), ({ nextStateId? := .some 2, goals? := #[goal2], }: Protocol.GoalTacticResult),
] ]
@ -90,27 +90,27 @@ def test_automatic_mode (automatic: Bool): Test :=
], ],
} }
let goal2l: Protocol.Goal := { let goal2l: Protocol.Goal := {
name := "_uniq.61", name := "_uniq.59",
userName? := .some "inl", userName? := .some "inl",
target := { pp? := .some "q p" }, target := { pp? := .some "q p" },
vars := varsPQ ++ #[ vars := varsPQ ++ #[
{ name := "_uniq.49", userName := "h✝", type? := .some { pp? := .some "p" }, isInaccessible := true} { name := "_uniq.47", userName := "h✝", type? := .some { pp? := .some "p" }, isInaccessible := true}
], ],
} }
let goal2r: Protocol.Goal := { let goal2r: Protocol.Goal := {
name := "_uniq.74", name := "_uniq.72",
userName? := .some "inr", userName? := .some "inr",
target := { pp? := .some "q p" }, target := { pp? := .some "q p" },
vars := varsPQ ++ #[ vars := varsPQ ++ #[
{ name := "_uniq.62", userName := "h✝", type? := .some { pp? := .some "q" }, isInaccessible := true} { name := "_uniq.60", userName := "h✝", type? := .some { pp? := .some "q" }, isInaccessible := true}
], ],
} }
let goal3l: Protocol.Goal := { let goal3l: Protocol.Goal := {
name := "_uniq.80", name := "_uniq.78",
userName? := .some "inl.h", userName? := .some "inl.h",
target := { pp? := .some "p" }, target := { pp? := .some "p" },
vars := varsPQ ++ #[ vars := varsPQ ++ #[
{ name := "_uniq.49", userName := "h✝", type? := .some { pp? := .some "p" }, isInaccessible := true} { name := "_uniq.47", userName := "h✝", type? := .some { pp? := .some "p" }, isInaccessible := true}
], ],
} }
[ [
@ -174,8 +174,6 @@ def test_frontend_process : Test :=
("file", .str file), ("file", .str file),
("invocations", .bool true), ("invocations", .bool true),
("sorrys", .bool false), ("sorrys", .bool false),
("typeErrorsAsGoals", .bool false),
("newConstants", .bool false),
] ]
({ ({
units := [{ units := [{
@ -216,8 +214,6 @@ def test_frontend_process_sorry : Test :=
("file", .str file), ("file", .str file),
("invocations", .bool false), ("invocations", .bool false),
("sorrys", .bool true), ("sorrys", .bool true),
("typeErrorsAsGoals", .bool false),
("newConstants", .bool false),
] ]
({ ({
units := [{ units := [{
@ -225,8 +221,7 @@ def test_frontend_process_sorry : Test :=
}, { }, {
boundary := (solved.utf8ByteSize, solved.utf8ByteSize + withSorry.utf8ByteSize), boundary := (solved.utf8ByteSize, solved.utf8ByteSize + withSorry.utf8ByteSize),
goalStateId? := .some 0, goalStateId? := .some 0,
goals? := .some #[goal1], goals := #[goal1],
goalSrcBoundaries? := .some #[(57, 62)],
messages := #["<anonymous>:2:0: warning: declaration uses 'sorry'\n"], messages := #["<anonymous>:2:0: warning: declaration uses 'sorry'\n"],
}], }],
}: Protocol.FrontendProcessResult), }: Protocol.FrontendProcessResult),

View File

@ -24,7 +24,7 @@ def test_expr_echo (env: Environment): IO LSpec.TestSeq := do
}, },
expr := { expr := {
pp? := "⟨∀ (x : Prop), x → x, fun x h => h⟩", pp? := "⟨∀ (x : Prop), x → x, fun x h => h⟩",
sexp? := "((:c PSigma.mk) (:sort 0) (:lambda p (:sort 0) 0) (:forall x (:sort 0) (:forall a 0 1)) (:lambda x (:sort 0) (:lambda h 0 0)))", sexp? := "((:c PSigma.mk) (:sort 0) (:lambda p (:sort 0) 0) (:forall x (:sort 0) (:forall _ 0 1)) (:lambda x (:sort 0) (:lambda h 0 0)))",
} }
})) }))
return tests return tests

View File

@ -53,7 +53,6 @@ def main (args: List String) := do
("Proofs", Proofs.suite env_default), ("Proofs", Proofs.suite env_default),
("Delate", Delate.suite env_default), ("Delate", Delate.suite env_default),
("Serial", Serial.suite env_default), ("Serial", Serial.suite env_default),
("Tactic/Assign", Tactic.Assign.suite env_default),
("Tactic/Congruence", Tactic.Congruence.suite env_default), ("Tactic/Congruence", Tactic.Congruence.suite env_default),
("Tactic/Motivated Apply", Tactic.MotivatedApply.suite env_default), ("Tactic/Motivated Apply", Tactic.MotivatedApply.suite env_default),
("Tactic/No Confuse", Tactic.NoConfuse.suite env_default), ("Tactic/No Confuse", Tactic.NoConfuse.suite env_default),

View File

@ -8,7 +8,10 @@ namespace Pantograph.Test.Metavar
open Pantograph open Pantograph
open Lean open Lean
abbrev TestM := TestT $ ReaderT Protocol.Options Elab.TermElabM abbrev TestM := StateRefT LSpec.TestSeq (ReaderT Protocol.Options Elab.TermElabM)
def addTest (test: LSpec.TestSeq): TestM Unit := do
set $ (← get) ++ test
-- Tests that all delay assigned mvars are instantiated -- Tests that all delay assigned mvars are instantiated
def test_instantiate_mvar: TestM Unit := do def test_instantiate_mvar: TestM Unit := do
@ -29,6 +32,8 @@ def test_instantiate_mvar: TestM Unit := do
"((:c LE.le) (:c Nat) (:c instLENat) ((:c OfNat.ofNat) (:mv _uniq.2) (:lit 2) (:mv _uniq.3)) ((:c OfNat.ofNat) (:mv _uniq.14) (:lit 5) (:mv _uniq.15)))") "((:c LE.le) (:c Nat) (:c instLENat) ((:c OfNat.ofNat) (:mv _uniq.2) (:lit 2) (:mv _uniq.3)) ((:c OfNat.ofNat) (:mv _uniq.14) (:lit 5) (:mv _uniq.15)))")
return () return ()
def startProof (expr: String): TestM (Option GoalState) := do def startProof (expr: String): TestM (Option GoalState) := do
let env ← Lean.MonadEnv.getEnv let env ← Lean.MonadEnv.getEnv
let syn? := parseTerm env expr let syn? := parseTerm env expr
@ -239,7 +244,7 @@ def test_partial_continuation: TestM Unit := do
return () return ()
| .ok state => pure state | .ok state => pure state
addTest $ LSpec.check "(continue)" ((← state1b.serializeGoals (options := ← read)).map (·.target.pp?) = addTest $ LSpec.check "(continue)" ((← state1b.serializeGoals (options := ← read)).map (·.target.pp?) =
#[.some "2 ≤ Nat.succ ?m", .some "Nat.succ ?m ≤ 5", .some "Nat"]) #[.some "2 ≤ ?m.succ", .some "?m.succ ≤ 5", .some "Nat"])
addTest $ LSpec.test "(2 root)" state1b.rootExpr?.isNone addTest $ LSpec.test "(2 root)" state1b.rootExpr?.isNone
-- Roundtrip -- Roundtrip
@ -253,7 +258,7 @@ def test_partial_continuation: TestM Unit := do
return () return ()
| .ok state => pure state | .ok state => pure state
addTest $ LSpec.check "(continue)" ((← state1b.serializeGoals (options := ← read)).map (·.target.pp?) = addTest $ LSpec.check "(continue)" ((← state1b.serializeGoals (options := ← read)).map (·.target.pp?) =
#[.some "2 ≤ Nat.succ ?m", .some "Nat.succ ?m ≤ 5", .some "Nat"]) #[.some "2 ≤ ?m.succ", .some "?m.succ ≤ 5", .some "Nat"])
addTest $ LSpec.test "(2 root)" state1b.rootExpr?.isNone addTest $ LSpec.test "(2 root)" state1b.rootExpr?.isNone
-- Continuation should fail if the state does not exist: -- Continuation should fail if the state does not exist:

View File

@ -14,7 +14,10 @@ inductive Start where
| copy (name: String) -- Start from some name in the environment | copy (name: String) -- Start from some name in the environment
| expr (expr: String) -- Start from some expression | expr (expr: String) -- Start from some expression
abbrev TestM := TestT $ ReaderT Protocol.Options $ Elab.TermElabM abbrev TestM := StateRefT LSpec.TestSeq (ReaderT Protocol.Options Elab.TermElabM)
def addTest (test: LSpec.TestSeq): TestM Unit := do
set $ (← get) ++ test
def startProof (start: Start): TestM (Option GoalState) := do def startProof (start: Start): TestM (Option GoalState) := do
let env ← Lean.MonadEnv.getEnv let env ← Lean.MonadEnv.getEnv
@ -97,7 +100,7 @@ def test_identity: TestM Unit := do
addTest $ LSpec.check tactic ((← state1.serializeGoals (options := ← read)).map (·.name) = addTest $ LSpec.check tactic ((← state1.serializeGoals (options := ← read)).map (·.name) =
#[inner]) #[inner])
let state1parent ← state1.withParentContext do let state1parent ← state1.withParentContext do
serializeExpressionSexp (← instantiateAll state1.parentExpr?.get!) serializeExpressionSexp (← instantiateAll state1.parentExpr?.get!) (sanitize := false)
addTest $ LSpec.test "(1 parent)" (state1parent == s!"(:lambda p (:sort 0) (:lambda h 0 (:subst (:mv {inner}) 1 0)))") addTest $ LSpec.test "(1 parent)" (state1parent == s!"(:lambda p (:sort 0) (:lambda h 0 (:subst (:mv {inner}) 1 0)))")
-- Individual test cases -- Individual test cases
@ -241,15 +244,13 @@ def test_or_comm: TestM Unit := do
| other => do | other => do
addTest $ assertUnreachable $ other.toString addTest $ assertUnreachable $ other.toString
return () return ()
let [state1g0] := state1.goals | fail "Should have 1 goal" let fvP := "_uniq.10"
let (fvP, fvQ, fvH) ← state1.withContext state1g0 do let fvQ := "_uniq.13"
let lctx ← getLCtx let fvH := "_uniq.16"
let #[fvP, fvQ, fvH] := lctx.getFVarIds.map (toString ·.name) | let state1g0 := "_uniq.17"
panic! "Incorrect number of decls"
pure (fvP, fvQ, fvH)
addTest $ LSpec.check tactic ((← state1.serializeGoals (options := ← read)) = addTest $ LSpec.check tactic ((← state1.serializeGoals (options := ← read)) =
#[{ #[{
name := state1g0.name.toString, name := state1g0,
target := { pp? := .some "q p" }, target := { pp? := .some "q p" },
vars := #[ vars := #[
{ name := fvP, userName := "p", type? := .some { pp? := .some "Prop" } }, { name := fvP, userName := "p", type? := .some { pp? := .some "Prop" } },
@ -261,7 +262,7 @@ def test_or_comm: TestM Unit := do
addTest $ LSpec.check "(1 root)" state1.rootExpr?.isNone addTest $ LSpec.check "(1 root)" state1.rootExpr?.isNone
let state1parent ← state1.withParentContext do let state1parent ← state1.withParentContext do
serializeExpressionSexp (← instantiateAll state1.parentExpr?.get!) serializeExpressionSexp (← instantiateAll state1.parentExpr?.get!) (sanitize := false)
addTest $ LSpec.test "(1 parent)" (state1parent == s!"(:lambda p (:sort 0) (:lambda q (:sort 0) (:lambda h ((:c Or) 1 0) (:subst (:mv {state1g0}) 2 1 0))))") addTest $ LSpec.test "(1 parent)" (state1parent == s!"(:lambda p (:sort 0) (:lambda q (:sort 0) (:lambda h ((:c Or) 1 0) (:subst (:mv {state1g0}) 2 1 0))))")
let tactic := "cases h" let tactic := "cases h"
let state2 ← match ← state1.tacticOn (goalId := 0) (tactic := tactic) with let state2 ← match ← state1.tacticOn (goalId := 0) (tactic := tactic) with
@ -271,21 +272,19 @@ def test_or_comm: TestM Unit := do
return () return ()
addTest $ LSpec.check tactic ((← state2.serializeGoals (options := ← read)).map (·.devolatilize) = addTest $ LSpec.check tactic ((← state2.serializeGoals (options := ← read)).map (·.devolatilize) =
#[branchGoal "inl" "p", branchGoal "inr" "q"]) #[branchGoal "inl" "p", branchGoal "inr" "q"])
let [state2g0, state2g1] := state2.goals | let (caseL, caseR) := ("_uniq.64", "_uniq.77")
fail s!"Should have 2 goals, but it has {state2.goals.length}"
let (caseL, caseR) := (state2g0.name.toString, state2g1.name.toString)
addTest $ LSpec.check tactic ((← state2.serializeGoals (options := ← read)).map (·.name) = addTest $ LSpec.check tactic ((← state2.serializeGoals (options := ← read)).map (·.name) =
#[caseL, caseR]) #[caseL, caseR])
addTest $ LSpec.check "(2 parent exists)" state2.parentExpr?.isSome addTest $ LSpec.check "(2 parent exists)" state2.parentExpr?.isSome
addTest $ LSpec.check "(2 root)" state2.rootExpr?.isNone addTest $ LSpec.check "(2 root)" state2.rootExpr?.isNone
let state2parent ← state2.withParentContext do let state2parent ← state2.withParentContext do
serializeExpressionSexp (← instantiateAll state2.parentExpr?.get!) serializeExpressionSexp (← instantiateAll state2.parentExpr?.get!) (sanitize := false)
let orPQ := s!"((:c Or) (:fv {fvP}) (:fv {fvQ}))" let orPQ := s!"((:c Or) (:fv {fvP}) (:fv {fvQ}))"
let orQP := s!"((:c Or) (:fv {fvQ}) (:fv {fvP}))" let orQP := s!"((:c Or) (:fv {fvQ}) (:fv {fvP}))"
let motive := s!"(:lambda t {orPQ} (:forall h ((:c Eq) ((:c Or) (:fv {fvP}) (:fv {fvQ})) (:fv {fvH}) 0) {orQP}))" let motive := s!"(:lambda t._@._hyg.26 {orPQ} (:forall h ((:c Eq) ((:c Or) (:fv {fvP}) (:fv {fvQ})) (:fv {fvH}) 0) {orQP}))"
let caseL := s!"(:lambda h (:fv {fvP}) (:lambda h ((:c Eq) {orPQ} (:fv {fvH}) ((:c Or.inl) (:fv {fvP}) (:fv {fvQ}) 0)) (:subst (:mv {caseL}) (:fv {fvP}) (:fv {fvQ}) 1)))" let caseL := s!"(:lambda h._@._hyg.27 (:fv {fvP}) (:lambda h._@._hyg.28 ((:c Eq) {orPQ} (:fv {fvH}) ((:c Or.inl) (:fv {fvP}) (:fv {fvQ}) 0)) (:subst (:mv {caseL}) (:fv {fvP}) (:fv {fvQ}) 1)))"
let caseR := s!"(:lambda h (:fv {fvQ}) (:lambda h ((:c Eq) {orPQ} (:fv {fvH}) ((:c Or.inr) (:fv {fvP}) (:fv {fvQ}) 0)) (:subst (:mv {caseR}) (:fv {fvP}) (:fv {fvQ}) 1)))" let caseR := s!"(:lambda h._@._hyg.29 (:fv {fvQ}) (:lambda h._@._hyg.30 ((:c Eq) {orPQ} (:fv {fvH}) ((:c Or.inr) (:fv {fvP}) (:fv {fvQ}) 0)) (:subst (:mv {caseR}) (:fv {fvP}) (:fv {fvQ}) 1)))"
let conduit := s!"((:c Eq.refl) {orPQ} (:fv {fvH}))" let conduit := s!"((:c Eq.refl) {orPQ} (:fv {fvH}))"
addTest $ LSpec.test "(2 parent)" (state2parent == addTest $ LSpec.test "(2 parent)" (state2parent ==
s!"((:c Or.casesOn) (:fv {fvP}) (:fv {fvQ}) {motive} (:fv {fvH}) {caseL} {caseR} {conduit})") s!"((:c Or.casesOn) (:fv {fvP}) (:fv {fvQ}) {motive} (:fv {fvH}) {caseL} {caseR} {conduit})")
@ -296,9 +295,8 @@ def test_or_comm: TestM Unit := do
addTest $ assertUnreachable $ other.toString addTest $ assertUnreachable $ other.toString
return () return ()
let state3_1parent ← state3_1.withParentContext do let state3_1parent ← state3_1.withParentContext do
serializeExpressionSexp (← instantiateAll state3_1.parentExpr?.get!) serializeExpressionSexp (← instantiateAll state3_1.parentExpr?.get!) (sanitize := false)
let [state3_1goal0] := state3_1.goals | fail "Should have 1 goal" addTest $ LSpec.test "(3_1 parent)" (state3_1parent == s!"((:c Or.inr) (:fv {fvQ}) (:fv {fvP}) (:mv _uniq.91))")
addTest $ LSpec.test "(3_1 parent)" (state3_1parent == s!"((:c Or.inr) (:fv {fvQ}) (:fv {fvP}) (:mv {state3_1goal0}))")
addTest $ LSpec.check "· apply Or.inr" (state3_1.goals.length = 1) addTest $ LSpec.check "· apply Or.inr" (state3_1.goals.length = 1)
let state4_1 ← match ← state3_1.tacticOn (goalId := 0) (tactic := "assumption") with let state4_1 ← match ← state3_1.tacticOn (goalId := 0) (tactic := "assumption") with
| .success state => pure state | .success state => pure state
@ -564,15 +562,12 @@ def test_nat_zero_add: TestM Unit := do
| other => do | other => do
addTest $ assertUnreachable $ other.toString addTest $ assertUnreachable $ other.toString
return () return ()
let [mvarMotive, mvarMajor, mvarInduct, mvarConduit] := state2.goals |
fail "Incorrect number of goals"
let .num _ major := mvarMajor.name | fail "Incorrect form of mvar id"
addTest $ LSpec.check s!"mapply {recursor}" ((← state2.serializeGoals (options := ← read)).map (·.devolatilizeVars) = addTest $ LSpec.check s!"mapply {recursor}" ((← state2.serializeGoals (options := ← read)).map (·.devolatilizeVars) =
#[ #[
buildNamedGoal mvarMotive.name.toString [("n", "Nat")] "Nat → Prop" (.some "motive"), buildNamedGoal "_uniq.67" [("n", "Nat")] "Nat → Prop" (.some "motive"),
buildNamedGoal mvarMajor.name.toString [("n", "Nat")] "Nat", buildNamedGoal "_uniq.68" [("n", "Nat")] "Nat",
buildNamedGoal mvarInduct.name.toString [("n", "Nat")] "∀ (t : Nat), Nat.below t → ?motive t", buildNamedGoal "_uniq.69" [("n", "Nat")] "∀ (t : Nat), Nat.below t → ?motive t",
buildNamedGoal mvarConduit.name.toString [("n", "Nat")] s!"?motive ?m.{major} = (n + 0 = n)" (.some "conduit") buildNamedGoal "_uniq.70" [("n", "Nat")] "?motive ?m.68 = (n + 0 = n)" (.some "conduit")
]) ])
let tactic := "exact n" let tactic := "exact n"
@ -655,15 +650,13 @@ def test_nat_zero_add_alt: TestM Unit := do
| other => do | other => do
addTest $ assertUnreachable $ other.toString addTest $ assertUnreachable $ other.toString
return () return ()
let [mvarMotive, mvarMajor, mvarInduct, mvarConduit] := state2.goals | let major := "_uniq.68"
fail "Incorrect number of goals"
let .num _ major := mvarMajor.name | fail "Incorrect form of mvar id"
addTest $ LSpec.check s!"mapply {recursor}" ((← state2.serializeGoals (options := ← read)).map (·.devolatilizeVars) = addTest $ LSpec.check s!"mapply {recursor}" ((← state2.serializeGoals (options := ← read)).map (·.devolatilizeVars) =
#[ #[
buildNamedGoal mvarMotive.name.toString [("n", "Nat")] "Nat → Prop" (.some "motive"), buildNamedGoal "_uniq.67" [("n", "Nat")] "Nat → Prop" (.some "motive"),
buildNamedGoal mvarMajor.name.toString [("n", "Nat")] "Nat", buildNamedGoal major [("n", "Nat")] "Nat",
buildNamedGoal mvarInduct.name.toString [("n", "Nat")] "∀ (t : Nat), Nat.below t → ?motive t", buildNamedGoal "_uniq.69" [("n", "Nat")] "∀ (t : Nat), Nat.below t → ?motive t",
buildNamedGoal mvarConduit.name.toString [("n", "Nat")] s!"?motive ?m.{major} = (n + 0 = n)" (.some "conduit") buildNamedGoal "_uniq.70" [("n", "Nat")] "?motive ?m.68 = (n + 0 = n)" (.some "conduit")
]) ])
let tactic := "intro x" let tactic := "intro x"
@ -680,7 +673,8 @@ def test_nat_zero_add_alt: TestM Unit := do
| other => do | other => do
addTest $ assertUnreachable $ other.toString addTest $ assertUnreachable $ other.toString
return () return ()
let [eqL, eqR, eqT] := state3m2.goals | fail "Incorrect number of goals" let (eqL, eqR, eqT) := ("_uniq.88", "_uniq.89", "_uniq.87")
addTest $ LSpec.check tactic $ state3m2.goals.map (·.name.toString) = [eqL, eqR, eqT]
let [_motive, _major, _step, conduit] := state2.goals | panic! "Goals conflict" let [_motive, _major, _step, conduit] := state2.goals | panic! "Goals conflict"
let state2b ← match state3m2.resume [conduit] with let state2b ← match state3m2.resume [conduit] with
| .ok state => pure state | .ok state => pure state
@ -690,86 +684,26 @@ def test_nat_zero_add_alt: TestM Unit := do
let cNatAdd := "(:c HAdd.hAdd) (:c Nat) (:c Nat) (:c Nat) ((:c instHAdd) (:c Nat) (:c instAddNat))" let cNatAdd := "(:c HAdd.hAdd) (:c Nat) (:c Nat) (:c Nat) ((:c instHAdd) (:c Nat) (:c instAddNat))"
let cNat0 := "((:c OfNat.ofNat) (:c Nat) (:lit 0) ((:c instOfNatNat) (:lit 0)))" let cNat0 := "((:c OfNat.ofNat) (:c Nat) (:lit 0) ((:c instOfNatNat) (:lit 0)))"
let fvN ← state2b.withContext conduit do let fvN := "_uniq.63"
let lctx ← getLCtx
pure $ lctx.getFVarIds.get! 0 |>.name
let conduitRight := s!"((:c Eq) (:c Nat) ({cNatAdd} (:fv {fvN}) {cNat0}) (:fv {fvN}))" let conduitRight := s!"((:c Eq) (:c Nat) ({cNatAdd} (:fv {fvN}) {cNat0}) (:fv {fvN}))"
let substOf (mvarId: MVarId) := s!"(:subst (:mv {mvarId.name}) (:fv {fvN}) (:mv {mvarMajor}))" let substOf (mv: String) := s!"(:subst (:mv {mv}) (:fv {fvN}) (:mv {major}))"
let .num _ nL := eqL.name | fail "Incorrect form of mvar id"
let .num _ nR := eqR.name | fail "Incorrect form of mvar id"
let nL' := nL + 4
let nR' := nR + 5
addTest $ LSpec.check "resume" ((← state2b.serializeGoals (options := { ← read with printExprAST := true })) = addTest $ LSpec.check "resume" ((← state2b.serializeGoals (options := { ← read with printExprAST := true })) =
#[ #[
{ {
name := mvarConduit.name.toString, name := "_uniq.70",
userName? := .some "conduit", userName? := .some "conduit",
target := { target := {
pp? := .some s!"(?m.{nL'} ?m.{major} = ?m.{nR'} ?m.{major}) = (n + 0 = n)", pp? := .some "(?m.92 ?m.68 = ?m.94 ?m.68) = (n + 0 = n)",
sexp? := .some s!"((:c Eq) (:sort 0) ((:c Eq) {substOf eqT} {substOf eqL} {substOf eqR}) {conduitRight})", sexp? := .some s!"((:c Eq) (:sort 0) ((:c Eq) {substOf eqT} {substOf eqL} {substOf eqR}) {conduitRight})",
}, },
vars := #[{ vars := #[{
name := fvN.toString, name := fvN,
userName := "n", userName := "n",
type? := .some { pp? := .some "Nat", sexp? := .some "(:c Nat)" }, type? := .some { pp? := .some "Nat", sexp? := .some "(:c Nat)" },
}], }],
} }
]) ])
def test_tactic_failure_unresolved_goals : TestM Unit := do
let state? ← startProof (.expr "∀ (p : Nat → Prop), ∃ (x : Nat), p (0 + x + 0)")
let state0 ← match state? with
| .some state => pure state
| .none => do
addTest $ assertUnreachable "Goal could not parse"
return ()
let tactic := "intro p"
let state1 ← match ← state0.tacticOn 0 tactic with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
let tactic := "exact ⟨0, by simp⟩"
let .failure messages ← state1.tacticOn 0 tactic | addTest $ assertUnreachable s!"{tactic} should fail"
checkEq s!"{tactic} fails" messages #[s!"{← getFileName}:0:12: error: unsolved goals\np : Nat → Prop\n⊢ p 0\n"]
def test_tactic_failure_synthesize_placeholder : TestM Unit := do
let state? ← startProof (.expr "∀ (p q r : Prop) (h : p → q), q ∧ r")
let state0 ← match state? with
| .some state => pure state
| .none => do
addTest $ assertUnreachable "Goal could not parse"
return ()
let tactic := "intro p q r h"
let state1 ← match ← state0.tacticOn 0 tactic with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
let iex : InternalExceptionId := { idx := 4 }
IO.println s!"{← iex.getName}"
let tactic := "simpa [h] using And.imp_left h _"
--let state2 ← match ← state1.tacticOn 0 tactic with
-- | .success state => pure state
-- | other => do
-- addTest $ assertUnreachable $ other.toString
-- return ()
-- Volatile behaviour. This easily changes across Lean versions
--checkEq tactic ((← state2.serializeGoals).map (·.devolatilize)) #[
-- buildGoal [("p", "Prop"), ("q", "Prop"), ("r", "Prop"), ("h", "p → q")] "p ∧ r"
--]
let .failure messages ← state1.tacticOn 0 tactic | addTest $ assertUnreachable s!"{tactic} should fail"
let message := s!"<Pantograph>:0:31: error: don't know how to synthesize placeholder\ncontext:\np q r : Prop\nh : p → q\n⊢ p ∧ r\n"
checkEq s!"{tactic} fails" messages #[message]
def suite (env: Environment): List (String × IO LSpec.TestSeq) := def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
let tests := [ let tests := [
("identity", test_identity), ("identity", test_identity),
@ -782,8 +716,6 @@ def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
("calc", test_calc), ("calc", test_calc),
("Nat.zero_add", test_nat_zero_add), ("Nat.zero_add", test_nat_zero_add),
("Nat.zero_add alt", test_nat_zero_add_alt), ("Nat.zero_add alt", test_nat_zero_add_alt),
("tactic failure with unresolved goals", test_tactic_failure_unresolved_goals),
("tactic failure with synthesize placeholder", test_tactic_failure_synthesize_placeholder),
] ]
tests.map (fun (name, test) => (name, proofRunner env test)) tests.map (fun (name, test) => (name, proofRunner env test))

View File

@ -1,4 +1,3 @@
import Test.Tactic.Assign
import Test.Tactic.Congruence import Test.Tactic.Congruence
import Test.Tactic.MotivatedApply import Test.Tactic.MotivatedApply
import Test.Tactic.NoConfuse import Test.Tactic.NoConfuse

View File

@ -1,33 +0,0 @@
import Lean.Meta
import Lean.Elab
import LSpec
import Test.Common
open Lean
namespace Pantograph.Test.Tactic.Assign
def test_draft : TestT Elab.TermElabM Unit := do
let expr := "forall (p : Prop), (p p) p"
let skeleton := "by\nhave a : p p := sorry\nsorry"
let expr ← parseSentence expr
Meta.forallTelescope expr $ λ _ body => do
let skeleton' ← match Parser.runParserCategory
(env := ← MonadEnv.getEnv)
(catName := `term)
(input := skeleton)
(fileName := ← getFileName) with
| .ok syn => pure syn
| .error error => throwError "Failed to parse: {error}"
-- Apply the tactic
let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
let tactic := Tactic.evalDraft skeleton'
let newGoals ← runTacticOnMVar tactic target.mvarId!
addTest $ LSpec.check "goals" ((← newGoals.mapM (λ g => do exprToStr (← g.getType))) = ["p p", "(p p) p"])
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
[
("draft", test_draft),
] |>.map (λ (name, t) => (name, runTestTermElabM env t))
end Pantograph.Test.Tactic.Assign

View File

@ -28,7 +28,7 @@ def test_congr_arg_list : TestT Elab.TermElabM Unit := do
let results ← Meta.withAssignableSyntheticOpaque do f.apply (← parseSentence "List.reverse") let results ← Meta.withAssignableSyntheticOpaque do f.apply (← parseSentence "List.reverse")
addTest $ LSpec.check "apply" (results.length = 0) addTest $ LSpec.check "apply" (results.length = 0)
addTest $ LSpec.check "h" ((← exprToStr $ ← h.getType) = "?a₁ = ?a₂") addTest $ LSpec.check "h" ((← exprToStr $ ← h.getType) = "?a₁ = ?a₂")
addTest $ LSpec.check "conduit" ((← exprToStr $ ← c.getType) = "(List.reverse ?a₁ = List.reverse ?a₂) = (l1.reverse = l2.reverse)") addTest $ LSpec.check "conduit" ((← exprToStr $ ← c.getType) = "(?a₁.reverse = ?a₂.reverse) = (l1.reverse = l2.reverse)")
def test_congr_arg : TestT Elab.TermElabM Unit := do def test_congr_arg : TestT Elab.TermElabM Unit := do
let expr := "λ (n m: Nat) (h: n = m) => n * n = m * m" let expr := "λ (n m: Nat) (h: n = m) => n * n = m * m"
let expr ← parseSentence expr let expr ← parseSentence expr
@ -37,7 +37,7 @@ def test_congr_arg : TestT Elab.TermElabM Unit := do
let newGoals ← runTacticOnMVar Tactic.evalCongruenceArg target.mvarId! let newGoals ← runTacticOnMVar Tactic.evalCongruenceArg target.mvarId!
addTest $ LSpec.check "goals" ((← newGoals.mapM (λ x => mvarUserNameAndType x)) = addTest $ LSpec.check "goals" ((← newGoals.mapM (λ x => mvarUserNameAndType x)) =
[ [
(`α, "Sort ?u.73"), (`α, "Sort ?u.70"),
(`a₁, "?α"), (`a₁, "?α"),
(`a₂, "?α"), (`a₂, "?α"),
(`f, "?α → Nat"), (`f, "?α → Nat"),
@ -52,7 +52,7 @@ def test_congr_fun : TestT Elab.TermElabM Unit := do
let newGoals ← runTacticOnMVar Tactic.evalCongruenceFun target.mvarId! let newGoals ← runTacticOnMVar Tactic.evalCongruenceFun target.mvarId!
addTest $ LSpec.check "goals" ((← newGoals.mapM (λ x => mvarUserNameAndType x)) = addTest $ LSpec.check "goals" ((← newGoals.mapM (λ x => mvarUserNameAndType x)) =
[ [
(`α, "Sort ?u.165"), (`α, "Sort ?u.159"),
(`f₁, "?α → Nat"), (`f₁, "?α → Nat"),
(`f₂, "?α → Nat"), (`f₂, "?α → Nat"),
(`h, "?f₁ = ?f₂"), (`h, "?f₁ = ?f₂"),

View File

@ -28,7 +28,7 @@ def test_nat_brec_on : TestT Elab.TermElabM Unit := do
(env := ← MonadEnv.getEnv) (env := ← MonadEnv.getEnv)
(catName := `term) (catName := `term)
(input := "@Nat.brecOn") (input := "@Nat.brecOn")
(fileName := ← getFileName) with (fileName := filename) with
| .ok syn => pure syn | .ok syn => pure syn
| .error error => throwError "Failed to parse: {error}" | .error error => throwError "Failed to parse: {error}"
-- Apply the tactic -- Apply the tactic
@ -40,7 +40,7 @@ def test_nat_brec_on : TestT Elab.TermElabM Unit := do
"Nat → Prop", "Nat → Prop",
"Nat", "Nat",
"∀ (t : Nat), Nat.below t → ?motive t", "∀ (t : Nat), Nat.below t → ?motive t",
"?motive ?m.74 = (n + 0 = n)", "?motive ?m.67 = (n + 0 = n)",
]) ])
addTest test addTest test
@ -52,7 +52,7 @@ def test_list_brec_on : TestT Elab.TermElabM Unit := do
(env := ← MonadEnv.getEnv) (env := ← MonadEnv.getEnv)
(catName := `term) (catName := `term)
(input := "@List.brecOn") (input := "@List.brecOn")
(fileName := ← getFileName) with (fileName := filename) with
| .ok syn => pure syn | .ok syn => pure syn
| .error error => throwError "Failed to parse: {error}" | .error error => throwError "Failed to parse: {error}"
-- Apply the tactic -- Apply the tactic
@ -74,7 +74,7 @@ def test_partial_motive_instantiation : TestT Elab.TermElabM Unit := do
(env := ← MonadEnv.getEnv) (env := ← MonadEnv.getEnv)
(catName := `term) (catName := `term)
(input := "@Nat.brecOn") (input := "@Nat.brecOn")
(fileName := ← getFileName) with (fileName := filename) with
| .ok syn => pure syn | .ok syn => pure syn
| .error error => throwError "Failed to parse: {error}" | .error error => throwError "Failed to parse: {error}"
let expr ← parseSentence expr let expr ← parseSentence expr
@ -83,7 +83,7 @@ def test_partial_motive_instantiation : TestT Elab.TermElabM Unit := do
let target ← Meta.mkFreshExprSyntheticOpaqueMVar body let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
let tactic := Tactic.evalMotivatedApply recursor let tactic := Tactic.evalMotivatedApply recursor
let newGoals ← runTacticOnMVar tactic target.mvarId! let newGoals ← runTacticOnMVar tactic target.mvarId!
let majorId := 74 let majorId := 67
addTest $ (LSpec.check "goals" ((← newGoals.mapM (λ g => do exprToStr (← g.getType))) = addTest $ (LSpec.check "goals" ((← newGoals.mapM (λ g => do exprToStr (← g.getType))) =
[ [
"Nat → Prop", "Nat → Prop",
@ -100,7 +100,7 @@ def test_partial_motive_instantiation : TestT Elab.TermElabM Unit := do
addTest $ ← conduit.withContext do addTest $ ← conduit.withContext do
let t := toString (← Meta.ppExpr $ ← conduit.getType) let t := toString (← Meta.ppExpr $ ← conduit.getType)
return LSpec.check "conduit" (t = s!"(Nat.add ?m.{majorId} + 0 = ?m.149 ?m.{majorId}) = (n + 0 = n)") return LSpec.check "conduit" (t = s!"(?m.{majorId}.add + 0 = ?m.138 ?m.{majorId}) = (n + 0 = n)")
def suite (env: Environment): List (String × IO LSpec.TestSeq) := def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
[ [

View File

@ -15,7 +15,7 @@ def test_nat : TestT Elab.TermElabM Unit := do
(env := ← MonadEnv.getEnv) (env := ← MonadEnv.getEnv)
(catName := `term) (catName := `term)
(input := "h") (input := "h")
(fileName := ← getFileName) with (fileName := filename) with
| .ok syn => pure syn | .ok syn => pure syn
| .error error => throwError "Failed to parse: {error}" | .error error => throwError "Failed to parse: {error}"
-- Apply the tactic -- Apply the tactic
@ -32,7 +32,7 @@ def test_nat_fail : TestT Elab.TermElabM Unit := do
(env := ← MonadEnv.getEnv) (env := ← MonadEnv.getEnv)
(catName := `term) (catName := `term)
(input := "h") (input := "h")
(fileName := ← getFileName) with (fileName := filename) with
| .ok syn => pure syn | .ok syn => pure syn
| .error error => throwError "Failed to parse: {error}" | .error error => throwError "Failed to parse: {error}"
-- Apply the tactic -- Apply the tactic
@ -52,7 +52,7 @@ def test_list : TestT Elab.TermElabM Unit := do
(env := ← MonadEnv.getEnv) (env := ← MonadEnv.getEnv)
(catName := `term) (catName := `term)
(input := "h") (input := "h")
(fileName := ← getFileName) with (fileName := filename) with
| .ok syn => pure syn | .ok syn => pure syn
| .error error => throwError "Failed to parse: {error}" | .error error => throwError "Failed to parse: {error}"
-- Apply the tactic -- Apply the tactic

View File

@ -15,7 +15,7 @@ def test_define : TestT Elab.TermElabM Unit := do
(env := ← MonadEnv.getEnv) (env := ← MonadEnv.getEnv)
(catName := `term) (catName := `term)
(input := "Or.inl h") (input := "Or.inl h")
(fileName := ← getFileName) with (fileName := filename) with
| .ok syn => pure syn | .ok syn => pure syn
| .error error => throwError "Failed to parse: {error}" | .error error => throwError "Failed to parse: {error}"
-- Apply the tactic -- Apply the tactic

View File

@ -4,17 +4,17 @@
<svg <svg
width="256" width="256"
height="256" height="256"
viewBox="0 0 67.733332 67.733333" viewBox="0 0 55.900957 55.900957"
version="1.1" version="1.1"
id="svg1" id="svg21534"
xml:space="preserve"
inkscape:version="1.2.2 (b0a8486541, 2022-12-01)"
sodipodi:docname="icon.svg" sodipodi:docname="icon.svg"
inkscape:version="1.3.2 (091e20ef0f, 2023-11-25, custom)"
xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape" xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"
xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd" xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"
xmlns="http://www.w3.org/2000/svg" xmlns="http://www.w3.org/2000/svg"
xmlns:svg="http://www.w3.org/2000/svg"> xmlns:svg="http://www.w3.org/2000/svg"><sodipodi:namedview
<sodipodi:namedview id="namedview21536"
id="namedview1"
pagecolor="#ffffff" pagecolor="#ffffff"
bordercolor="#111111" bordercolor="#111111"
borderopacity="1" borderopacity="1"
@ -23,135 +23,51 @@
inkscape:pagecheckerboard="1" inkscape:pagecheckerboard="1"
inkscape:deskcolor="#d1d1d1" inkscape:deskcolor="#d1d1d1"
inkscape:document-units="px" inkscape:document-units="px"
showguides="true" showgrid="true"
inkscape:zoom="5.1882633" inkscape:zoom="5.1754899"
inkscape:cx="81.819286" inkscape:cx="158.82554"
inkscape:cy="132.22151" inkscape:cy="91.682142"
inkscape:window-width="3774" inkscape:window-width="3777"
inkscape:window-height="2126" inkscape:window-height="2093"
inkscape:window-x="0" inkscape:window-x="0"
inkscape:window-y="0" inkscape:window-y="0"
inkscape:window-maximized="1" inkscape:window-maximized="1"
inkscape:current-layer="layer2"> inkscape:current-layer="layer1"><inkscape:grid
<sodipodi:guide type="xygrid"
position="33.866666,69.8437" id="grid23833"
orientation="-1,0" spacingx="3.4938098"
id="guide1" spacingy="3.4938098"
inkscape:locked="false" empspacing="4" /></sodipodi:namedview><defs
inkscape:label="" id="defs21531" /><g
inkscape:color="rgb(0,134,229)" /> inkscape:label="Layer 1"
<sodipodi:guide
position="-27.673679,33.866666"
orientation="0,1"
id="guide2"
inkscape:locked="false"
inkscape:label=""
inkscape:color="rgb(0,134,229)" />
<sodipodi:guide
position="16.933333,29.94582"
orientation="-1,0"
id="guide3"
inkscape:locked="false"
inkscape:label=""
inkscape:color="rgb(0,134,229)" />
<sodipodi:guide
position="50.799999,37.44627"
orientation="-1,0"
id="guide4"
inkscape:locked="false"
inkscape:label=""
inkscape:color="rgb(0,134,229)" />
<sodipodi:guide
position="31.336956,16.933333"
orientation="0,1"
id="guide5"
inkscape:locked="false"
inkscape:label=""
inkscape:color="rgb(0,134,229)" />
<sodipodi:guide
position="24.528038,25.4"
orientation="0,1"
id="guide6"
inkscape:locked="false"
inkscape:label=""
inkscape:color="rgb(0,134,229)" />
<sodipodi:guide
position="33.866666,50.799999"
orientation="0,1"
id="guide7"
inkscape:locked="false"
inkscape:label=""
inkscape:color="rgb(0,134,229)" />
<sodipodi:guide
position="32.770414,55.033333"
orientation="0,1"
id="guide8"
inkscape:locked="false"
inkscape:label=""
inkscape:color="rgb(0,134,229)" />
<sodipodi:guide
position="25.347689,33.866666"
orientation="1,0"
id="guide9"
inkscape:locked="false" />
<sodipodi:guide
position="25.347689,42.333333"
orientation="0,1"
id="guide10"
inkscape:locked="false"
inkscape:label=""
inkscape:color="rgb(0,134,229)" />
</sodipodi:namedview>
<defs
id="defs1" />
<g
inkscape:groupmode="layer" inkscape:groupmode="layer"
id="layer4" id="layer1"><rect
inkscape:label="bg" /> style="fill:#3e3e3e;fill-opacity:1;fill-rule:evenodd;stroke:none;stroke-width:1.78013;stroke-miterlimit:3.4;stroke-dasharray:none"
<g id="rect26805"
inkscape:groupmode="layer" width="11.502316"
id="layer1" height="2.2512667"
inkscape:label="Circle"> x="33.344425"
<path y="7.6690259"
id="path1" ry="0.28140834"
style="fill:#666b98;fill-rule:evenodd;stroke:#ffffff;stroke-width:0.0191989;stroke-miterlimit:3.4;fill-opacity:1" rx="0.47926313" /><path
d="M 33.866666 0.009818522 A 33.857067 33.857067 0 0 0 0.009818522 33.866666 A 33.857067 33.857067 0 0 0 33.866666 67.723514 A 33.857067 33.857067 0 0 0 67.723514 33.866666 A 33.857067 33.857067 0 0 0 33.866666 0.009818522 z M 33.866666 4.2416015 A 29.624933 29.624933 0 0 1 63.491731 33.866666 A 29.624933 29.624933 0 0 1 33.866666 63.491731 A 29.624933 29.624933 0 0 1 4.2416015 33.866666 A 29.624933 29.624933 0 0 1 33.866666 4.2416015 z " /> style="fill:#3e3e3e;stroke:none;stroke-width:0.218363px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1;fill-opacity:1"
</g> d="m 35.764667,9.9513013 c 0,0 -26.8581417,13.7987337 -28.0863506,14.9501437 -1.250042,1.171878 3.2347846,3.945325 3.2347846,3.945325 l 21.34979,14.934062 6.624567,0.453105 -27.599216,-17.304358 c 0,0 -0.603209,-0.08927 -0.600411,-0.762283 0.0028,-0.673015 27.32022,-16.4227356 27.32022,-16.4227356 z"
<g id="path27381"
inkscape:groupmode="layer" sodipodi:nodetypes="csccccscc" /><path
id="layer2" style="fill:#3e3e3e;stroke:none;stroke-width:0.218363px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1;fill-opacity:1"
inkscape:label="Pantograph-Core"> d="M 10.97848,26.985751 40.537772,9.7943227 41.921795,9.7005084 11.210626,27.421377 Z"
<rect id="path27479" /><path
style="fill:#666b98;fill-opacity:1;fill-rule:evenodd;stroke:#ffffff;stroke-width:0.01905;stroke-miterlimit:3.4" style="fill:#3e3e3e;stroke:none;stroke-width:0.218363px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1;fill-opacity:1"
id="rect8" d="m 7.0509847,25.522367 c -0.8266141,1.386819 -2.4011783,4.48805 -2.4706357,4.90223 -0.069458,0.414182 0.4434324,0.513474 0.8491061,0.757041 C 5.835129,31.425204 19.33424,43.917182 19.33424,43.917182 l 0.324562,-0.539228 c 0,0 -14.2055729,-12.369493 -14.0644435,-12.868167 0.1411292,-0.498672 3.544896,-3.777392 3.544896,-3.777392 L 7.4596884,25.117508 Z"
width="16.942858" id="path27481" /><rect
height="4.2257233" style="fill:#3e3e3e;fill-opacity:1;fill-rule:evenodd;stroke:none;stroke-width:2.11692;stroke-miterlimit:3.4;stroke-dasharray:none;stroke-opacity:1"
x="33.866665" id="rect27483"
y="12.7" width="36.38942"
rx="0.58070719" height="3.6217353"
ry="0.34097314" /> x="13.953447"
<rect y="43.009739"
style="fill:#666b98;fill-opacity:1;fill-rule:evenodd;stroke:#ffffff;stroke-width:0.01905;stroke-miterlimit:3.4" rx="0.43672624"
id="rect1" ry="0.43672624" /><path
width="33.885715" style="fill:none;stroke:#000000;stroke-width:0.218363px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"
height="8.4211359" d="M -2.1119274,7.666599 H 64.179192"
x="16.933332" id="path27487" /></g></svg>
y="42.333332"
rx="0.58070719"
ry="0.34097314" />
<path
style="fill:#666b98;fill-opacity:1;stroke:none;stroke-width:0.264583px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"
d="m 42.338095,16.925724 -16.990406,8.474275 13.121218,16.923808 -4.602241,0.0095 -4.254289,0.0015 -8.564029,-16.934789 17.310554,-8.464751 z"
id="path10"
sodipodi:nodetypes="cccccccc" />
<path
style="fill:none;stroke:#666b98;stroke-width:0.264583px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"
d="M 46.53445,16.925724 26.018901,26.73418"
id="path11" />
<path
style="fill:none;stroke:#666b98;stroke-width:0.264583px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"
d="m 21.048348,25.399999 4.352167,16.934808"
id="path12"
sodipodi:nodetypes="cc" />
</g>
</svg>

Before

Width:  |  Height:  |  Size: 5.2 KiB

After

Width:  |  Height:  |  Size: 3.5 KiB

View File

@ -1,59 +0,0 @@
# Design Rationale
A great problem in machine learning is to use ML agents to automatically prove
mathematical theorems. This sort of proof necessarily involves *search*.
Compatibility for search is the main reason for creating Pantograph. The Lean 4
LSP interface is not conducive to search. Pantograph is designed with this in
mind. It emphasizes the difference between 3 views of a proof:
- **Presentation View**: The view of a written, polished proof. e.g. Mathlib and
math papers are almost always written in this form.
- **Search View**: The view of a proof exploration trajectory. This is not
explicitly supported by Lean LSP.
- **Kernel View**: The proof viewed as a set of metavariables.
Pantograph enables proof agents to operate on the search view.
## Name
The name Pantograph is a pun. It means two things
- A pantograph is an instrument for copying down writing. As an agent explores
the vast proof search space, Pantograph records the current state to ensure
the proof is sound.
- A pantograph is also an equipment for an electric train. It supplies power to
a locomotive. In comparison the (relatively) simple Pantograph software powers
theorem proving projects.
## Caveats and Limitations
Pantograph does not exactly mimic Lean LSP's behaviour. That would not grant the
flexibility it offers. To support tree search means Pantograph has to act
differently from Lean in some times, but never at the sacrifice of soundness.
- When Lean LSP says "don't know how to synthesize placeholder", this indicates
the human operator needs to manually move the cursor to the placeholder and
type in the correct expression. This error therefore should not halt the proof
process, and the placeholder should be turned into a goal.
- When Lean LSP says "unresolved goals", that means a proof cannot finish where
it is supposed to finish at the end of a `by` block. Pantograph will raise the
error in this case, since it indicates the termination of a proof search branch.
- `pick_goal` or `swap` will not work since they run contrary to tree search
paradigms. However, if there are tactics which perform non-trivial operations
to multiple goals at the same time, this constrain could potentially be
relaxed at a cost of great bookkeeping overhead to the user.
Pantograph cannot perform things that are inherently constrained by Lean. These
include:
- If a tactic loses track of metavariables, it will not be caught until the end
of the proof search. This is a bug in the tactic itself.
- Timeouts for executing tactics is not available. Maybe this will change in the
future.
- Interceptions of parsing errors generally cannot be turned into goals (e.g.
`def mystery : Nat := :=`) due to Lean's parsing system.
## References
* [Pantograph Paper](https://arxiv.org/abs/2410.16429)

View File

@ -11,8 +11,8 @@ See `Pantograph/Protocol.lean` for a description of the parameters and return va
* `env.inspect {"name": <name>, "value": <bool>}`: Show the type and package of a * `env.inspect {"name": <name>, "value": <bool>}`: Show the type and package of a
given symbol; If value flag is set, the value is printed or hidden. By default given symbol; If value flag is set, the value is printed or hidden. By default
only the values of definitions are printed. only the values of definitions are printed.
* `env.save { "path": <fileName> }`, `env.load { "path": <fileName> }`: Save/Load the * `env.save { path }`, `env.load { path }`: Save/Load the current environment
current environment to/from a file to/from a file
* `options.set { key: value, ... }`: Set one or more options (not Lean options; those * `options.set { key: value, ... }`: Set one or more options (not Lean options; those
have to be set via command line arguments.), for options, see `Pantograph/Protocol.lean` have to be set via command line arguments.), for options, see `Pantograph/Protocol.lean`
@ -39,16 +39,13 @@ See `Pantograph/Protocol.lean` for a description of the parameters and return va
- `{ "goals": <names> }`: Resume the given goals - `{ "goals": <names> }`: Resume the given goals
* `goal.remove {"stateIds": [<id>]}"`: Drop the goal states specified in the list * `goal.remove {"stateIds": [<id>]}"`: Drop the goal states specified in the list
* `goal.print {"stateId": <id>}"`: Print a goal state * `goal.print {"stateId": <id>}"`: Print a goal state
* `goal.save { "id": <id>, "path": <fileName> }`, `goal.load { "path": <fileName> }`: * `goal.save{ id, path }`, `goal.load { path }`: Save/Load a goal state to/from a
Save/Load a goal state to/from a file. The environment is not carried with the file. The environment is not carried with the state. The user is responsible
state. The user is responsible to ensure the sender/receiver instances share to ensure the sender/receiver instances share the same environment.
the same environment. * `frontend.process { ["fileName": <fileName>",] ["file": <str>], invocations:
* `frontend.process { ["fileName": <fileName>,] ["file": <str>], invocations: <bool>, sorrys: <bool> }`: Executes the Lean frontend on a file, collecting
<bool>, sorrys: <bool>, newConstants: <bool> }`: Executes the Lean frontend on either the tactic invocations (`"invocations": true`) or the sorrys into goal
a file, collecting the tactic invocations (`"invocations": true`), the states (`"sorrys": true`)
sorrys and type errors into goal states (`"sorrys": true`), and new constants
(`"newConstants": true`). In the case of `sorrys`, this command additionally
outputs the position of each captured `sorry`.
## Errors ## Errors

View File

@ -42,11 +42,11 @@
"nixpkgs": "nixpkgs" "nixpkgs": "nixpkgs"
}, },
"locked": { "locked": {
"lastModified": 1736388194, "lastModified": 1731711316,
"narHash": "sha256-ymSrd/A8Pw+9FzbxUbR7CkFHLJK1b4SnFFWg/1e0JeE=", "narHash": "sha256-s5u+A2/Ea9gPveB5wwVM5dWW0NST6kamDsTeovGuLEs=",
"owner": "lenianiva", "owner": "lenianiva",
"repo": "lean4-nix", "repo": "lean4-nix",
"rev": "90f496bc0694fb97bdfa6adedfc2dc2c841a4cf2", "rev": "136fc6057c48de970579e960b62421e9c295b67d",
"type": "github" "type": "github"
}, },
"original": { "original": {

View File

@ -18,50 +18,43 @@
lean4-nix, lean4-nix,
lspec, lspec,
... ...
}: } : flake-parts.lib.mkFlake { inherit inputs; } {
flake-parts.lib.mkFlake {inherit inputs;} {
flake = { flake = {
}; };
systems = [ systems = [
"aarch64-linux"
"aarch64-darwin"
"x86_64-linux" "x86_64-linux"
"x86_64-darwin" "x86_64-darwin"
]; ];
perSystem = { perSystem = { system, pkgs, ... }: let
system,
pkgs,
...
}: let
pkgs = import nixpkgs { pkgs = import nixpkgs {
inherit system; inherit system;
overlays = [(lean4-nix.readToolchainFile ./lean-toolchain)]; overlays = [ (lean4-nix.readToolchainFile ./lean-toolchain) ];
}; };
lspecLib = pkgs.lean.buildLeanPackage { lspecLib = pkgs.lean.buildLeanPackage {
name = "LSpec"; name = "LSpec";
roots = ["Main" "LSpec"]; roots = [ "Main" "LSpec" ];
src = "${lspec}"; src = "${lspec}";
}; };
project = pkgs.lean.buildLeanPackage { project = pkgs.lean.buildLeanPackage {
name = "Pantograph"; name = "Pantograph";
roots = ["Pantograph"]; roots = [ "Pantograph" ];
src = pkgs.lib.cleanSource (pkgs.lib.cleanSourceWith { src = pkgs.lib.cleanSource (pkgs.lib.cleanSourceWith {
src = ./.; src = ./.;
filter = path: type: filter = path: type:
!(pkgs.lib.hasInfix "/Test/" path) !(pkgs.lib.hasInfix "/Test/" path) &&
&& !(pkgs.lib.hasSuffix ".md" path) !(pkgs.lib.hasSuffix ".md" path) &&
&& !(pkgs.lib.hasSuffix "Repl.lean" path); !(pkgs.lib.hasSuffix "Repl.lean" path);
}); });
}; };
repl = pkgs.lean.buildLeanPackage { repl = pkgs.lean.buildLeanPackage {
name = "Repl"; name = "Repl";
roots = ["Main" "Repl"]; roots = [ "Main" "Repl" ];
deps = [project]; deps = [ project ];
src = pkgs.lib.cleanSource (pkgs.lib.cleanSourceWith { src = pkgs.lib.cleanSource (pkgs.lib.cleanSourceWith {
src = ./.; src = ./.;
filter = path: type: filter = path: type:
!(pkgs.lib.hasInfix "/Test/" path) !(pkgs.lib.hasInfix "/Test/" path) &&
&& !(pkgs.lib.hasSuffix ".md" path); !(pkgs.lib.hasSuffix ".md" path);
}); });
}; };
test = pkgs.lean.buildLeanPackage { test = pkgs.lean.buildLeanPackage {
@ -69,8 +62,8 @@
# NOTE: The src directory must be ./. since that is where the import # NOTE: The src directory must be ./. since that is where the import
# root begins (e.g. `import Test.Environment` and not `import # root begins (e.g. `import Test.Environment` and not `import
# Environment`) and thats where `lakefile.lean` resides. # Environment`) and thats where `lakefile.lean` resides.
roots = ["Test.Main"]; roots = [ "Test.Main" ];
deps = [lspecLib repl]; deps = [ lspecLib repl ];
src = pkgs.lib.cleanSource (pkgs.lib.cleanSourceWith { src = pkgs.lib.cleanSource (pkgs.lib.cleanSourceWith {
src = ./.; src = ./.;
filter = path: type: filter = path: type:
@ -89,17 +82,15 @@
leanPkgs = pkgs.lean; leanPkgs = pkgs.lean;
}; };
checks = { checks = {
test = test = pkgs.runCommand "test" {
pkgs.runCommand "test" { buildInputs = [ test.executable pkgs.lean.lean-all ];
buildInputs = [test.executable pkgs.lean.lean-all];
} '' } ''
#export LEAN_SRC_PATH="${./.}" #export LEAN_SRC_PATH="${./.}"
${test.executable}/bin/test > $out ${test.executable}/bin/test > $out
''; '';
}; };
formatter = pkgs.alejandra;
devShells.default = pkgs.mkShell { devShells.default = pkgs.mkShell {
buildInputs = [pkgs.lean.lean-all pkgs.lean.lean]; buildInputs = [ pkgs.lean.lean-all pkgs.lean.lean ];
}; };
}; };
}; };

View File

@ -1 +1 @@
leanprover/lean4:v4.15.0 leanprover/lean4:v4.12.0