Compare commits

...

37 Commits

Author SHA1 Message Date
Leni Aniva f5ed87f740 Merge pull request 'feat: Minor updates to serialization' (#26) from io/serial into dev
Reviewed-on: #26
2023-10-30 14:47:41 -07:00
Leni Aniva 8dd994d1ca
bug: Fix quote escape problem 2023-10-30 14:45:43 -07:00
Leni Aniva d87217c6bb
feat: Print metavariable name in goal 2023-10-30 14:44:06 -07:00
Leni Aniva 796f0d8336 Merge pull request 'feat: Simplify printing of names and expressions' (#25) from io/serial into dev
Reviewed-on: #25
2023-10-29 13:08:05 -07:00
Leni Aniva e5acd4b26c
fix: Sanitize name in universe levels 2023-10-29 13:03:48 -07:00
Leni Aniva 454a5bc6b9
feat: Simplify printing of function applications 2023-10-29 12:50:36 -07:00
Leni Aniva afed5bbc8d
chore: Version bump (breaking change) 2023-10-29 11:57:24 -07:00
Leni Aniva e2526f11b1
feat: Print names in one segment separated with . 2023-10-29 11:56:56 -07:00
Leni Aniva c2d606b9d9
feat: Simplify name printing 2023-10-29 11:18:35 -07:00
Leni Aniva c19fd1bcfb Merge pull request 'Enable handling of m-Coupled goals' (#20) from goal/dependency into dev
Reviewed-on: #20
2023-10-27 19:30:20 -07:00
Leni Aniva 427d819349
feat: Add REPL function for root expression 2023-10-27 15:41:12 -07:00
Leni Aniva ca7a081cac
Merge branch 'dev' into goal/dependency 2023-10-27 15:33:47 -07:00
Leni Aniva 82f5494718
feat: Add REPL command for assigning an expression 2023-10-27 15:32:59 -07:00
Leni Aniva b381d89ff9
feat: Assigning a goal with an expression 2023-10-27 15:15:22 -07:00
Leni Aniva e98fb77f33
refactor: Separate goal printing and processing
Added a test for delta proof variables
2023-10-26 22:47:42 -07:00
Leni Aniva 4ffd226cac
test: m-coupled goals 2023-10-26 11:22:02 -07:00
Leni Aniva 0ecfa9fc26
feat: Display user name in Goal structure
1. Modify `serialize_expression_ast` so its no longer a monad
2. Test existence of root expression
2023-10-25 22:18:59 -07:00
Leni Aniva 0a0f0304a8
feat: Add proof continue and root extraction 2023-10-25 16:03:45 -07:00
Leni Aniva 7dc6e4e549
Add documentation about flake 2023-10-20 12:54:35 -07:00
Leni Aniva ba53e9087b
feat: Add nix flake 2023-10-20 12:41:56 -07:00
Leni Aniva 9447d29e37
Store states instead of goals
1. Rename {Commands, Protocol}, and {Symbols, Symbol}
2. Store the root mvarId in the proof state along with goal indices
3. Add diagnostics function which prints out the state
4. Bump version to 0.2.6 (breaking change)

Documentations pending
2023-10-15 17:15:23 -07:00
Leni Aniva 8c93d30ab7
Rename tactic to goal and restructure 2023-10-15 12:31:22 -07:00
Leni Aniva 42133f9b74
Add holes test stub
Move tests into their own namespaces
2023-10-06 17:31:36 -07:00
Leni Aniva 5b002a9ceb
Fix test failures 2023-10-05 17:51:41 -07:00
Leni Aniva 836a14fa63
Bump Lean version to 4.1.0 2023-10-05 17:49:43 -07:00
Leni Aniva 5f2b394471
Add dependency for lakefile and lean-toolchain 2023-10-02 10:30:58 -07:00
Leni Aniva 2c3a7adb61
Use makefile instead of ad-hoc script 2023-10-02 10:26:19 -07:00
Leni Aniva 8e02e6e7cc Add ready message to indicate the main loop is up 2023-10-02 10:14:03 -07:00
Leni Aniva 1e637dabaa
Bump lean version to 4.0.0 2023-09-13 21:02:26 -07:00
Leni Aniva c4a97d8a76 Merge pull request 'Simplify goal bookkeeping mechanism' (#10) from tactic/book into dev
Reviewed-on: #10
2023-08-30 19:18:36 -07:00
Leni Aniva acfd4e8288
Merge branch 'dev' into tactic/book 2023-08-30 19:17:25 -07:00
Leni Aniva 46347d8244
Add SemihashMap interface, rename proof commands to goal commands, allow deletion 2023-08-30 19:16:33 -07:00
Leni Aniva 71327d2d55
Separate max and imax in sort level 2023-08-27 22:50:18 -07:00
Leni Aniva 8d5d7b6e3e
Version bump to 0.2.4 due to breaking change 2023-08-27 19:59:31 -07:00
Leni Aniva 80ad7a2bd0
Rename proof commands to goal commands 2023-08-27 19:58:52 -07:00
Leni Aniva 0c5f439067
Add SemihashMap structure for goal bookkeeping 2023-08-27 19:53:09 -07:00
Leni Aniva dea63ac5ea Merge pull request 'Remove the obsolete name field from proof tree structure' (#11) from misc/cleanup into dev
Reviewed-on: #11
2023-08-26 18:50:40 -07:00
23 changed files with 1482 additions and 579 deletions

1
.gitignore vendored
View File

@ -1,5 +1,6 @@
.*
!.gitignore
*.olean
/build
/lake-packages

View File

@ -8,7 +8,7 @@ import Pantograph
open Pantograph
/-- Parse a command either in `{ "cmd": ..., "payload": ... }` form or `cmd { ... }` form. -/
def parse_command (s: String): Except String Commands.Command := do
def parseCommand (s: String): Except String Protocol.Command := do
let s := s.trim
match s.get? 0 with
| .some '{' => -- Parse in Json mode
@ -26,9 +26,9 @@ unsafe def loop : MainM Unit := do
let state ← get
let command ← (← IO.getStdin).getLine
if command.trim.length = 0 then return ()
match parse_command command with
match parseCommand command with
| .error error =>
let error := Lean.toJson ({ error := "command", desc := error }: Commands.InteractionError)
let error := Lean.toJson ({ error := "command", desc := error }: Protocol.InteractionError)
-- Using `Lean.Json.compress` here to prevent newline
IO.println error.compress
| .ok command =>
@ -88,7 +88,7 @@ unsafe def main (args: List String): IO Unit := do
let imports:= args.filter (λ s => ¬ (s.startsWith "--"))
let env ← Lean.importModules
(imports := imports.map (λ str => { module := str_to_name str, runtimeOnly := false }))
(imports := imports.toArray.map (λ str => { module := str_to_name str, runtimeOnly := false }))
(opts := {})
(trustLevel := 1)
let context: Context := {
@ -108,6 +108,7 @@ unsafe def main (args: List String): IO Unit := do
errToSorry := false
})
let coreM := metaM.run'
IO.println "ready."
discard <| coreM.toIO coreContext { env := env }
catch ex =>
IO.println "Uncaught IO exception"

20
Makefile Normal file
View File

@ -0,0 +1,20 @@
LIB := build/lib/Pantograph.olean
EXE := build/bin/pantograph
SOURCE := $(wildcard Pantograph/*.lean) $(wildcard *.lean) lean-toolchain
TEST_EXE := build/bin/test
TEST_SOURCE := $(wildcard Test/*.lean)
$(LIB) $(EXE): $(SOURCE)
lake build pantograph
$(TEST_EXE): $(LIB) $(TEST_SOURCE)
lake build test
test: $(TEST_EXE)
lake env $(TEST_EXE)
clean:
lake clean
.PHONY: test clean

View File

@ -1,7 +1,8 @@
import Pantograph.Commands
import Pantograph.Goal
import Pantograph.Protocol
import Pantograph.SemihashMap
import Pantograph.Serial
import Pantograph.Symbols
import Pantograph.Tactic
import Pantograph.Symbol
namespace Pantograph
@ -10,17 +11,16 @@ structure Context where
/-- Stores state of the REPL -/
structure State where
options: Commands.Options := {}
--environments: Array Lean.Environment := #[]
proofTrees: Array ProofTree := #[]
options: Protocol.Options := {}
goalStates: SemihashMap GoalState := SemihashMap.empty
-- State monad
/-- Main state monad for executing commands -/
abbrev MainM := ReaderT Context (StateT State Lean.Elab.TermElabM)
-- For some reason writing `CommandM α := MainM (Except ... α)` disables certain
-- monadic features in `MainM`
abbrev CR α := Except Commands.InteractionError α
-- HACK: For some reason writing `CommandM α := MainM (Except ... α)` disables
-- certain monadic features in `MainM`
abbrev CR α := Except Protocol.InteractionError α
def execute (command: Commands.Command): MainM Lean.Json := do
def execute (command: Protocol.Command): MainM Lean.Json := do
let run { α β: Type } [Lean.FromJson α] [Lean.ToJson β] (comm: α → MainM (CR β)): MainM Lean.Json :=
match Lean.fromJson? command.payload with
| .ok args => do
@ -29,37 +29,43 @@ def execute (command: Commands.Command): MainM Lean.Json := do
| .error ierror => return Lean.toJson ierror
| .error error => return Lean.toJson $ errorCommand s!"Unable to parse json: {error}"
match command.cmd with
| "reset" => run reset
| "expr.echo" => run expr_echo
| "lib.catalog" => run lib_catalog
| "lib.inspect" => run lib_inspect
| "options.set" => run options_set
| "options.print" => run options_print
| "proof.start" => run proof_start
| "proof.tactic" => run proof_tactic
| "proof.printTree" => run proof_print_tree
| "reset" => run reset
| "stat" => run stat
| "expr.echo" => run expr_echo
| "lib.catalog" => run lib_catalog
| "lib.inspect" => run lib_inspect
| "options.set" => run options_set
| "options.print" => run options_print
| "goal.start" => run goal_start
| "goal.tactic" => run goal_tactic
| "goal.delete" => run goal_delete
| "goal.print" => run goal_print
| cmd =>
let error: Commands.InteractionError :=
let error: Protocol.InteractionError :=
errorCommand s!"Unknown command {cmd}"
return Lean.toJson error
where
errorI (type desc: String): Commands.InteractionError := { error := type, desc := desc }
errorI (type desc: String): Protocol.InteractionError := { error := type, desc := desc }
errorCommand := errorI "command"
errorIndex := errorI "index"
-- Command Functions
reset (_: Commands.Reset): MainM (CR Commands.ResetResult) := do
reset (_: Protocol.Reset): MainM (CR Protocol.StatResult) := do
let state ← get
let nTrees := state.proofTrees.size
set { state with proofTrees := #[] }
return .ok { nTrees := nTrees }
lib_catalog (_: Commands.LibCatalog): MainM (CR Commands.LibCatalogResult) := do
let nGoals := state.goalStates.size
set { state with goalStates := SemihashMap.empty }
return .ok { nGoals }
stat (_: Protocol.Stat): MainM (CR Protocol.StatResult) := do
let state ← get
let nGoals := state.goalStates.size
return .ok { nGoals }
lib_catalog (_: Protocol.LibCatalog): MainM (CR Protocol.LibCatalogResult) := do
let env ← Lean.MonadEnv.getEnv
let names := env.constants.fold (init := #[]) (λ acc name info =>
match to_filtered_symbol name info with
| .some x => acc.push x
| .none => acc)
return .ok { symbols := names }
lib_inspect (args: Commands.LibInspect): MainM (CR Commands.LibInspectResult) := do
lib_inspect (args: Protocol.LibInspect): MainM (CR Protocol.LibInspectResult) := do
let state ← get
let env ← Lean.MonadEnv.getEnv
let name := str_to_name args.name
@ -79,7 +85,7 @@ def execute (command: Commands.Command): MainM Lean.Json := do
value? := ← value?.mapM (λ v => serialize_expression state.options v),
module? := module?
}
expr_echo (args: Commands.ExprEcho): MainM (CR Commands.ExprEchoResult) := do
expr_echo (args: Protocol.ExprEcho): MainM (CR Protocol.ExprEchoResult) := do
let state ← get
let env ← Lean.MonadEnv.getEnv
match syntax_from_str env args.expr with
@ -96,7 +102,7 @@ def execute (command: Commands.Command): MainM Lean.Json := do
}
catch exception =>
return .error $ errorI "typing" (← exception.toMessageData.toString)
options_set (args: Commands.OptionsSet): MainM (CR Commands.OptionsSetResult) := do
options_set (args: Protocol.OptionsSet): MainM (CR Protocol.OptionsSetResult) := do
let state ← get
let options := state.options
set { state with
@ -105,15 +111,15 @@ def execute (command: Commands.Command): MainM Lean.Json := do
printJsonPretty := args.printJsonPretty?.getD options.printJsonPretty,
printExprPretty := args.printExprPretty?.getD options.printExprPretty,
printExprAST := args.printExprAST?.getD options.printExprAST,
proofVariableDelta := args.proofVariableDelta?.getD options.proofVariableDelta,
noRepeat := args.noRepeat?.getD options.noRepeat,
printAuxDecls := args.printAuxDecls?.getD options.printAuxDecls,
printImplementationDetailHyps := args.printImplementationDetailHyps?.getD options.printImplementationDetailHyps
}
}
return .ok { }
options_print (_: Commands.OptionsPrint): MainM (CR Commands.OptionsPrintResult) := do
options_print (_: Protocol.OptionsPrint): MainM (CR Protocol.OptionsPrintResult) := do
return .ok (← get).options
proof_start (args: Commands.ProofStart): MainM (CR Commands.ProofStartResult) := do
goal_start (args: Protocol.GoalStart): MainM (CR Protocol.GoalStartResult) := do
let state ← get
let env ← Lean.MonadEnv.getEnv
let expr?: Except _ Lean.Expr ← (match args.expr, args.copyFrom with
@ -128,38 +134,55 @@ def execute (command: Commands.Command): MainM Lean.Json := do
(match env.find? <| str_to_name copyFrom with
| .none => return .error <| errorIndex s!"Symbol not found: {copyFrom}"
| .some cInfo => return .ok cInfo.type)
| .none, .none =>
return .error <| errorI "arguments" "At least one of {expr, copyFrom} must be supplied"
| _, _ => return .error <| errorI "arguments" "Cannot populate both of {expr, copyFrom}")
| _, _ =>
return .error <| errorI "arguments" "Exactly one of {expr, copyFrom} must be supplied")
match expr? with
| .error error => return .error error
| .ok expr =>
let tree ← ProofTree.create expr
-- Put the new tree in the environment
let nextTreeId := state.proofTrees.size
set { state with proofTrees := state.proofTrees.push tree }
return .ok { treeId := nextTreeId }
proof_tactic (args: Commands.ProofTactic): MainM (CR Commands.ProofTacticResult) := do
let goalState ← GoalState.create expr
let (goalStates, stateId) := state.goalStates.insert goalState
set { state with goalStates }
return .ok { stateId }
goal_tactic (args: Protocol.GoalTactic): MainM (CR Protocol.GoalTacticResult) := do
let state ← get
match state.proofTrees.get? args.treeId with
| .none => return .error $ errorIndex "Invalid tree index {args.treeId}"
| .some tree =>
let (result, nextTree) ← ProofTree.execute
(stateId := args.stateId)
(goalId := args.goalId.getD 0)
(tactic := args.tactic) |>.run state.options |>.run tree
match result with
| .invalid message => return .error $ errorIndex message
| .success nextId? goals =>
set { state with proofTrees := state.proofTrees.set! args.treeId nextTree }
return .ok { nextId? := nextId?, goals? := .some goals }
| .failure messages =>
match state.goalStates.get? args.stateId with
| .none => return .error $ errorIndex s!"Invalid state index {args.stateId}"
| .some goalState => do
let nextGoalState?: Except _ GoalState ← match args.tactic?, args.expr? with
| .some tactic, .none => do
pure ( Except.ok (← GoalState.execute goalState args.goalId tactic))
| .none, .some expr => do
pure ( Except.ok (← GoalState.tryAssign goalState args.goalId expr))
| _, _ => pure (Except.error <| errorI "arguments" "Exactly one of {tactic, expr} must be supplied")
match nextGoalState? with
| .error error => return .error error
| .ok (.success nextGoalState) =>
let (goalStates, nextStateId) := state.goalStates.insert nextGoalState
set { state with goalStates }
let goals ← nextGoalState.serializeGoals (parent := .some goalState) (options := state.options)
return .ok {
nextStateId? := .some nextStateId,
goals? := .some goals,
}
| .ok (.parseError message) =>
return .ok { parseError? := .some message }
| .ok (.indexError goalId) =>
return .error $ errorIndex s!"Invalid goal id index {goalId}"
| .ok (.failure messages) =>
return .ok { tacticErrors? := .some messages }
proof_print_tree (args: Commands.ProofPrintTree): MainM (CR Commands.ProofPrintTreeResult) := do
goal_delete (args: Protocol.GoalDelete): MainM (CR Protocol.GoalDeleteResult) := do
let state ← get
match state.proofTrees.get? args.treeId with
| .none => return .error $ errorIndex "Invalid tree index {args.treeId}"
| .some tree =>
return .ok { parents := tree.structure_array }
let goalStates := args.stateIds.foldl (λ map id => map.remove id) state.goalStates
set { state with goalStates }
return .ok {}
goal_print (args: Protocol.GoalPrint): MainM (CR Protocol.GoalPrintResult) := do
let state ← get
match state.goalStates.get? args.stateId with
| .none => return .error $ errorIndex s!"Invalid state index {args.stateId}"
| .some goalState => do
let root? ← goalState.rootExpr?.mapM (λ expr => serialize_expression state.options expr)
return .ok {
root?,
}
end Pantograph

204
Pantograph/Goal.lean Normal file
View File

@ -0,0 +1,204 @@
import Lean
import Pantograph.Symbol
def Lean.MessageLog.getErrorMessages (log : MessageLog) : MessageLog :=
{
msgs := log.msgs.filter fun m => match m.severity with | MessageSeverity.error => true | _ => false
}
namespace Pantograph
open Lean
structure GoalState where
savedState : Elab.Tactic.SavedState
-- The root hole which is the search target
root: MVarId
-- New metavariables acquired in this state
newMVars: SSet MVarId
-- The id of the goal in the parent
parentGoalId: Nat := 0
abbrev M := Elab.TermElabM
protected def GoalState.create (expr: Expr): M GoalState := do
-- May be necessary to immediately synthesise all metavariables if we need to leave the elaboration context.
-- See https://leanprover.zulipchat.com/#narrow/stream/270676-lean4/topic/Unknown.20universe.20metavariable/near/360130070
--Elab.Term.synthesizeSyntheticMVarsNoPostponing
--let expr ← instantiateMVars expr
let goal := (← Meta.mkFreshExprMVar expr (kind := MetavarKind.synthetic) (userName := .anonymous))
let savedStateMonad: Elab.Tactic.TacticM Elab.Tactic.SavedState := MonadBacktrack.saveState
let root := goal.mvarId!
let savedState ← savedStateMonad { elaborator := .anonymous } |>.run' { goals := [root]}
return {
savedState,
root,
newMVars := SSet.insert .empty root,
}
protected def GoalState.goals (state: GoalState): List MVarId := state.savedState.tactic.goals
protected def GoalState.runM {α: Type} (state: GoalState) (m: Elab.TermElabM α) : M α := do
state.savedState.term.restore
m
protected def GoalState.mctx (state: GoalState): MetavarContext :=
state.savedState.term.meta.meta.mctx
protected def GoalState.env (state: GoalState): Environment :=
state.savedState.term.meta.core.env
private def GoalState.mvars (state: GoalState): SSet MVarId :=
state.mctx.decls.foldl (init := .empty) fun acc k _ => acc.insert k
/-- Inner function for executing tactic on goal state -/
def executeTactic (state: Elab.Tactic.SavedState) (goal: MVarId) (tactic: Syntax) :
M (Except (Array String) Elab.Tactic.SavedState):= do
let tacticM (stx: Syntax): Elab.Tactic.TacticM (Except (Array String) Elab.Tactic.SavedState) := do
state.restore
Elab.Tactic.setGoals [goal]
try
Elab.Tactic.evalTactic stx
if (← getThe Core.State).messages.hasErrors then
let messages := (← getThe Core.State).messages.getErrorMessages |>.toList.toArray
let errors ← (messages.map Message.data).mapM fun md => md.toString
return .error errors
else
return .ok (← MonadBacktrack.saveState)
catch exception =>
return .error #[← exception.toMessageData.toString]
tacticM tactic { elaborator := .anonymous } |>.run' state.tactic
/-- Response for executing a tactic -/
inductive TacticResult where
-- Goes to next state
| success (state: GoalState)
-- Tactic failed with messages
| failure (messages: Array String)
-- Could not parse tactic
| parseError (message: String)
-- The goal index is out of bounds
| indexError (goalId: Nat)
/-- Execute tactic on given state -/
protected def GoalState.execute (state: GoalState) (goalId: Nat) (tactic: String):
M TacticResult := do
let goal ← match state.savedState.tactic.goals.get? goalId with
| .some goal => pure $ goal
| .none => return .indexError goalId
let tactic ← match Parser.runParserCategory
(env := ← MonadEnv.getEnv)
(catName := `tactic)
(input := tactic)
(fileName := "<stdin>") with
| .ok stx => pure $ stx
| .error error => return .parseError error
match (← executeTactic (state := state.savedState) (goal := goal) (tactic := tactic)) with
| .error errors =>
return .failure errors
| .ok nextSavedState =>
-- Assert that the definition of metavariables are the same
let nextMCtx := nextSavedState.term.meta.meta.mctx
let prevMCtx := state.savedState.term.meta.meta.mctx
-- Generate a list of mvarIds that exist in the parent state; Also test the
-- assertion that the types have not changed on any mvars.
let newMVars ← nextMCtx.decls.foldlM (fun acc mvarId mvarDecl => do
if let .some prevMVarDecl := prevMCtx.decls.find? mvarId then
assert! prevMVarDecl.type == mvarDecl.type
return acc
else
return acc.insert mvarId
) SSet.empty
return .success {
state with
savedState := nextSavedState
newMVars,
parentGoalId := goalId,
}
protected def GoalState.tryAssign (state: GoalState) (goalId: Nat) (expr: String): M TacticResult := do
let goal ← match state.savedState.tactic.goals.get? goalId with
| .some goal => pure goal
| .none => return .indexError goalId
let expr ← match Parser.runParserCategory
(env := state.env)
(catName := `term)
(input := expr)
(fileName := "<stdin>") with
| .ok syn => pure syn
| .error error => return .parseError error
let tacticM: Elab.Tactic.TacticM TacticResult := do
state.savedState.restore
Elab.Tactic.setGoals [goal]
try
let expr ← Elab.Term.elabTerm (stx := expr) (expectedType? := .none)
-- Attempt to unify the expression
let goalType ← goal.getType
let exprType ← Meta.inferType expr
if !(← Meta.isDefEq goalType exprType) then
return .failure #["Type unification failed", toString (← Meta.ppExpr goalType), toString (← Meta.ppExpr exprType)]
goal.checkNotAssigned `GoalState.tryAssign
goal.assign expr
if (← getThe Core.State).messages.hasErrors then
let messages := (← getThe Core.State).messages.getErrorMessages |>.toList.toArray
let errors ← (messages.map Message.data).mapM fun md => md.toString
return .failure errors
else
let prevMCtx := state.savedState.term.meta.meta.mctx
let nextMCtx ← getMCtx
-- Generate a list of mvarIds that exist in the parent state; Also test the
-- assertion that the types have not changed on any mvars.
let newMVars ← nextMCtx.decls.foldlM (fun acc mvarId mvarDecl => do
if let .some prevMVarDecl := prevMCtx.decls.find? mvarId then
assert! prevMVarDecl.type == mvarDecl.type
return acc
else
return mvarId :: acc
) []
-- The new goals are the newMVars that lack an assignment
Elab.Tactic.setGoals (← newMVars.filterM (λ mvar => do pure !(← mvar.isAssigned)))
let nextSavedState ← MonadBacktrack.saveState
return .success {
state with
savedState := nextSavedState,
newMVars := newMVars.toSSet,
parentGoalId := goalId,
}
catch exception =>
return .failure #[← exception.toMessageData.toString]
tacticM { elaborator := .anonymous } |>.run' state.savedState.tactic
/-- After finishing one branch of a proof (`graftee`), pick up from the point where the proof was left off (`target`) -/
protected def GoalState.continue (target: GoalState) (graftee: GoalState): Except String GoalState :=
if target.root != graftee.root then
.error s!"Roots of two continued goal states do not match: {target.root.name} != {graftee.root.name}"
-- Ensure goals are not dangling
else if ¬ (target.goals.all (λ goal => graftee.mvars.contains goal)) then
.error s!"Some goals in target are not present in the graftee"
else
-- Set goals to the goals that have not been assigned yet, similar to the `focus` tactic.
let unassigned := target.goals.filter (λ goal =>
let mctx := graftee.mctx
¬(mctx.eAssignment.contains goal || mctx.dAssignment.contains goal))
.ok {
savedState := {
term := graftee.savedState.term,
tactic := { goals := unassigned },
},
root := target.root,
newMVars := graftee.newMVars,
}
protected def GoalState.rootExpr? (goalState: GoalState): Option Expr :=
let expr := goalState.mctx.eAssignment.find! goalState.root
let (expr, _) := instantiateMVarsCore (mctx := goalState.mctx) (e := expr)
if expr.hasMVar then
-- Must not assert that the goal state is empty here. We could be in a branch goal.
--assert! ¬goalState.goals.isEmpty
.none
else
assert! goalState.goals.isEmpty
.some expr
end Pantograph

View File

@ -6,7 +6,7 @@ its field names to avoid confusion with error messages generated by the REPL.
-/
import Lean.Data.Json
namespace Pantograph.Commands
namespace Pantograph.Protocol
/-- Main Option structure, placed here to avoid name collision -/
@ -18,9 +18,10 @@ structure Options where
printExprPretty: Bool := true
-- When enabled, print the raw AST of expressions
printExprAST: Bool := false
-- When enabled, the types and values of persistent variables in a proof goal
-- are not shown unless they are new to the proof step. Reduces overhead
proofVariableDelta: Bool := false
-- When enabled, the types and values of persistent variables in a goal
-- are not shown unless they are new to the proof step. Reduces overhead.
-- NOTE: that this assumes the type and assignment of variables can never change.
noRepeat: Bool := false
-- See `pp.auxDecls`
printAuxDecls: Bool := false
-- See `pp.implementationDetailHyps`
@ -43,15 +44,19 @@ structure Expression where
deriving Lean.ToJson
structure Variable where
name: String
/-- The internal name used in raw expressions -/
name: String := ""
/-- The name displayed to the user -/
userName: String
/-- Does the name contain a dagger -/
isInaccessible?: Option Bool := .none
type?: Option Expression := .none
value?: Option Expression := .none
deriving Lean.ToJson
structure Goal where
/-- String case id -/
caseName?: Option String := .none
name: String := ""
/-- Name of the metavariable -/
userName?: Option String := .none
/-- Is the goal in conversion mode -/
isConversion: Bool := false
/-- target expression type -/
@ -80,8 +85,11 @@ structure InteractionError where
structure Reset where
deriving Lean.FromJson
structure ResetResult where
nTrees: Nat
structure Stat where
deriving Lean.FromJson
structure StatResult where
-- Number of goals states
nGoals: Nat
deriving Lean.ToJson
-- Return the type of an expression
@ -117,7 +125,7 @@ structure OptionsSet where
printJsonPretty?: Option Bool
printExprPretty?: Option Bool
printExprAST?: Option Bool
proofVariableDelta?: Option Bool
noRepeat?: Option Bool
printAuxDecls?: Option Bool
printImplementationDetailHyps?: Option Bool
deriving Lean.FromJson
@ -127,35 +135,57 @@ structure OptionsPrint where
deriving Lean.FromJson
abbrev OptionsPrintResult := Options
structure ProofStart where
structure GoalStart where
-- Only one of the fields below may be populated.
expr: Option String -- Proof expression
copyFrom: Option String -- Theorem name
expr: Option String -- Directly parse in an expression
copyFrom: Option String -- Copy the type from a theorem in the environment
deriving Lean.FromJson
structure ProofStartResult where
treeId: Nat := 0 -- Proof tree id
structure GoalStartResult where
stateId: Nat := 0
deriving Lean.ToJson
structure ProofTactic where
structure GoalTactic where
-- Identifiers for tree, state, and goal
treeId: Nat
stateId: Nat
goalId: Option Nat -- Defaults to 0
tactic: String
goalId: Nat := 0
-- One of the fields here must be filled
tactic?: Option String := .none
expr?: Option String := .none
deriving Lean.FromJson
structure ProofTacticResult where
-- Existence of this field shows success
structure GoalTacticResult where
-- The next goal state id. Existence of this field shows success
nextStateId?: Option Nat := .none
-- If the array is empty, it shows the goals have been fully resolved.
goals?: Option (Array Goal) := .none
-- Next proof state id, if successful
nextId?: Option Nat := .none
-- Existence of this field shows failure
-- Existence of this field shows tactic execution failure
tacticErrors?: Option (Array String) := .none
deriving Lean.ToJson
structure ProofPrintTree where
treeId: Nat
deriving Lean.FromJson
structure ProofPrintTreeResult where
-- "" if no parents, otherwise "parentId.goalId"
parents: Array String
-- Existence of this field shows the tactic parsing has failed
parseError?: Option String := .none
deriving Lean.ToJson
end Pantograph.Commands
-- Remove goal states
structure GoalDelete where
stateIds: List Nat
deriving Lean.FromJson
structure GoalDeleteResult where
deriving Lean.ToJson
structure GoalPrint where
stateId: Nat
deriving Lean.FromJson
structure GoalPrintResult where
-- The root expression
root?: Option Expression
deriving Lean.ToJson
-- Diagnostic Options, not available in REPL
structure GoalDiag where
printContext: Bool := true
printValue: Bool := true
printNewMVars: Bool := false
-- Print all mvars
printAll: Bool := false
end Pantograph.Protocol

149
Pantograph/SemihashMap.lean Normal file
View File

@ -0,0 +1,149 @@
namespace Pantograph.SemihashMap
structure Imp (β: Type u) where
data: Array (Option β)
-- Number of elements currently in use
size: Nat
-- Next index that has never been touched
allocFront: Nat
-- Deallocated indices
deallocs: Array Nat
-- Number of valid entries in `deallocs` array
lastDealloc: Nat
namespace Imp
structure WF (m: Imp β): Prop where
capacity: m.data.size = m.deallocs.size
front_dealloc: ∀ i: Fin m.deallocs.size, (i < m.allocFront) → (m.deallocs.get i) < m.allocFront
front_data: ∀ i: Fin m.data.size, (i ≥ m.allocFront) → (m.data.get i).isNone
def empty (capacity := 16): Imp β :=
{
data := mkArray capacity .none,
size := 0,
allocFront := 0,
deallocs := mkArray capacity 0,
lastDealloc := 0,
}
private theorem list_get_replicate (x: α) (i: Fin (List.replicate n x).length):
List.get (List.replicate n x) i = x := by
sorry
theorem empty_wf : WF (empty n: Imp β) := by
unfold empty
apply WF.mk
case capacity =>
conv =>
lhs
congr
simp
conv =>
rhs
congr
simp
simp
case front_dealloc =>
simp_all
intro i
intro a
contradiction
case front_data =>
simp_all
intro i
unfold Imp.data at i
simp at i
conv =>
lhs
unfold Array.get
unfold mkArray
simp [List.replicate]
rewrite [list_get_replicate]
-- FIXME: Merge this with the well-formed versions below so proof and code can
-- mesh seamlessly.
@[inline] def insert (map: Imp β) (v: β): (Imp β × Nat) :=
match map.lastDealloc with
| 0 => -- Capacity is full, buffer expansion is required
if map.size == map.data.size then
let nextIndex := map.data.size
let extendCapacity := map.size
let result: Imp β := {
data := (map.data.append #[Option.some v]).append (mkArray extendCapacity .none),
size := map.size + 1,
allocFront := map.size + 1,
deallocs := mkArray (map.data.size + 1 + extendCapacity) 0,
lastDealloc := 0,
}
(result, nextIndex)
else
let nextIndex := map.size
let result: Imp β := {
map
with
data := map.data.set ⟨nextIndex, sorry⟩ (Option.some v),
size := map.size + 1,
allocFront := map.allocFront + 1,
}
(result, nextIndex)
| (.succ k) => -- Allocation list has space
let nextIndex := map.deallocs.get! k
let result: Imp β := {
map with
data := map.data.set ⟨nextIndex, sorry⟩ (Option.some v),
size := map.size + 1,
lastDealloc := map.lastDealloc - 1
}
(result, nextIndex)
@[inline] def remove (map: Imp β) (index: Fin (map.size)): Imp β :=
have h: index.val < map.data.size := by sorry
match map.data.get ⟨index.val, h⟩ with
| .none => map
| .some _ =>
{
map with
data := map.data.set ⟨index, sorry⟩ .none,
size := map.size - 1,
deallocs := map.deallocs.set ⟨map.lastDealloc, sorry⟩ index,
lastDealloc := map.lastDealloc + 1,
}
/-- Retrieval is efficient -/
@[inline] def get? (map: Imp β) (index: Fin (map.size)): Option β :=
have h: index.val < map.data.size := by sorry
map.data.get ⟨index.val, h⟩
@[inline] def capacity (map: Imp β): Nat := map.data.size
end Imp
/--
This is like a hashmap but you cannot control the keys.
-/
def _root_.Pantograph.SemihashMap β := {m: Imp β // m.WF}
@[inline] def empty (capacity := 16): SemihashMap β :=
⟨ Imp.empty capacity, Imp.empty_wf ⟩
@[inline] def insert (map: SemihashMap β) (v: β): (SemihashMap β × Nat) :=
let ⟨imp, pre⟩ := map
let ⟨result, id⟩ := imp.insert v
( ⟨ result, sorry ⟩, id)
@[inline] def remove (map: SemihashMap β) (index: Nat): SemihashMap β :=
let ⟨imp, pre⟩ := map
let result := imp.remove ⟨index, sorry⟩
⟨ result, sorry ⟩
@[inline] def get? (map: SemihashMap β) (index: Nat): Option β :=
let ⟨imp, _⟩ := map
imp.get? ⟨index, sorry⟩
@[inline] def size (map: SemihashMap β): Nat :=
let ⟨imp, _⟩ := map
imp.size
end Pantograph.SemihashMap

View File

@ -3,7 +3,8 @@ All serialisation functions
-/
import Lean
import Pantograph.Commands
import Pantograph.Protocol
import Pantograph.Goal
namespace Pantograph
open Lean
@ -28,165 +29,147 @@ def syntax_from_str (env: Environment) (s: String): Except String Syntax :=
def syntax_to_expr_type (syn: Syntax): Elab.TermElabM (Except String Expr) := do
try
let expr ← Elab.Term.elabType syn
-- Immediately synthesise all metavariables if we need to leave the elaboration context.
-- See https://leanprover.zulipchat.com/#narrow/stream/270676-lean4/topic/Unknown.20universe.20metavariable/near/360130070
--Elab.Term.synthesizeSyntheticMVarsNoPostponing
let expr ← instantiateMVars expr
return .ok expr
catch ex => return .error (← ex.toMessageData.toString)
def syntax_to_expr (syn: Syntax): Elab.TermElabM (Except String Expr) := do
try
let expr ← Elab.Term.elabTerm (stx := syn) (expectedType? := .none)
-- Immediately synthesise all metavariables if we need to leave the elaboration context.
-- See https://leanprover.zulipchat.com/#narrow/stream/270676-lean4/topic/Unknown.20universe.20metavariable/near/360130070
--Elab.Term.synthesizeSyntheticMVarsNoPostponing
let expr ← instantiateMVars expr
return .ok expr
catch ex => return .error (← ex.toMessageData.toString)
--- Output Functions ---
def type_expr_to_bound (expr: Expr): MetaM Commands.BoundExpression := do
def type_expr_to_bound (expr: Expr): MetaM Protocol.BoundExpression := do
Meta.forallTelescope expr fun arr body => do
let binders ← arr.mapM fun fvar => do
return (toString (← fvar.fvarId!.getUserName), toString (← Meta.ppExpr (← fvar.fvarId!.getType)))
return { binders, target := toString (← Meta.ppExpr body) }
private def name_to_ast: Lean.Name → String
| .anonymous
| .num _ _ => ":anon"
| n@(.str _ _) => toString n
private def level_depth: Level → Nat
| .zero => 0
| .succ l => 1 + (level_depth l)
| .max u v | .imax u v => 1 + max (level_depth u) (level_depth v)
| .param _ | .mvar _ => 0
theorem level_depth_max_imax (u v: Level): (level_depth (Level.max u v) = level_depth (Level.imax u v)) := by
constructor
theorem level_max_depth_decrease (u v: Level): (level_depth u < level_depth (Level.max u v)) := by
have h1: level_depth (Level.max u v) = 1 + Nat.max (level_depth u) (level_depth v) := by constructor
rewrite [h1]
simp_arith
conv =>
rhs
apply Nat.max_def
sorry
theorem level_offset_decrease (u v: Level): (level_depth u ≤ level_depth (Level.max u v).getLevelOffset) := sorry
def name_to_ast (name: Name) (sanitize: Bool := true): String :=
let internal := name.isInaccessibleUserName || name.hasMacroScopes
if sanitize && internal then "_"
else toString name |> enclose_if_escaped
where
enclose_if_escaped (n: String) :=
let quote := "\""
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)` -/
def serialize_sort_level_ast (level: Level): String :=
partial def serialize_sort_level_ast (level: Level) (sanitize: Bool): String :=
let k := level.getOffset
let u := level.getLevelOffset
let u_str := match u with
| .zero => "0"
| .succ _ => panic! "getLevelOffset should not return .succ"
| .max v w | .imax v w =>
let v := serialize_sort_level_ast v
let w := serialize_sort_level_ast w
s!"(max {v} {w})"
| .max v w =>
let v := serialize_sort_level_ast v sanitize
let w := serialize_sort_level_ast w sanitize
s!"(:max {v} {w})"
| .imax v w =>
let v := serialize_sort_level_ast v sanitize
let w := serialize_sort_level_ast w sanitize
s!"(:imax {v} {w})"
| .param name =>
let name := name_to_ast name
let name := name_to_ast name sanitize
s!"{name}"
| .mvar id =>
let name := name_to_ast id.name
s!"(:mvar {name})"
let name := name_to_ast id.name sanitize
s!"(:mv {name})"
match k, u with
| 0, _ => u_str
| _, .zero => s!"{k}"
| _, _ => s!"(+ {u_str} {k})"
termination_by serialize_sort_level_ast level => level_depth level
decreasing_by
. sorry
/--
Completely serializes an expression tree. Json not used due to compactness
-/
def serialize_expression_ast (expr: Expr): MetaM String := do
match expr with
| .bvar deBruijnIndex =>
-- This is very common so the index alone is shown. Literals are handled below.
-- The raw de Bruijn index should never appear in an unbound setting. In
-- Lean these are handled using a `#` prefix.
return s!"{deBruijnIndex}"
| .fvar fvarId =>
let name := (← fvarId.getDecl).userName
return s!"(:fv {name})"
| .mvar mvarId =>
let name := name_to_ast mvarId.name
return s!"(:mv {name})"
| .sort level =>
let level := serialize_sort_level_ast level
return s!"(:sort {level})"
| .const declName _ =>
-- The universe level of the const expression is elided since it should be
-- inferrable from surrounding expression
return s!"(:c {declName})"
| .app fn arg =>
let fn' ← serialize_expression_ast fn
let arg' ← serialize_expression_ast arg
return s!"({fn'} {arg'})"
| .lam binderName binderType body binderInfo =>
let binderName' := name_to_ast binderName
let binderType' ← serialize_expression_ast binderType
let body' ← serialize_expression_ast body
let binderInfo' := binder_info_to_ast binderInfo
return s!"(:lambda {binderName'} {binderType'} {body'}{binderInfo'})"
| .forallE binderName binderType body binderInfo =>
let binderName' := name_to_ast binderName
let binderType' ← serialize_expression_ast binderType
let body' ← serialize_expression_ast body
let binderInfo' := binder_info_to_ast binderInfo
return s!"(:forall {binderName'} {binderType'} {body'}{binderInfo'})"
| .letE name type value body _ =>
-- Dependent boolean flag diacarded
let name' := name_to_ast name
let type' ← serialize_expression_ast type
let value' ← serialize_expression_ast value
let body' ← serialize_expression_ast body
return s!"(:let {name'} {type'} {value'} {body'})"
| .lit v =>
-- To not burden the downstream parser who needs to handle this, the literal
-- is wrapped in a :lit sexp.
let v' := match v with
| .natVal val => toString val
| .strVal val => s!"\"{val}\""
return s!"(:lit {v'})"
| .mdata _ expr =>
-- NOTE: Equivalent to expr itself, but mdata influences the prettyprinter
-- It may become necessary to incorporate the metadata.
return (← serialize_expression_ast expr)
| .proj typeName idx struct =>
let struct' ← serialize_expression_ast struct
return s!"(:proj {typeName} {idx} {struct'})"
partial def serialize_expression_ast (expr: Expr) (sanitize: Bool := true): String :=
self expr
where
self (e: Expr): String :=
match e with
| .bvar deBruijnIndex =>
-- This is very common so the index alone is shown. Literals are handled below.
-- The raw de Bruijn index should never appear in an unbound setting. In
-- Lean these are handled using a `#` prefix.
s!"{deBruijnIndex}"
| .fvar fvarId =>
let name := of_name fvarId.name
s!"(:fv {name})"
| .mvar mvarId =>
let name := of_name mvarId.name
s!"(:mv {name})"
| .sort level =>
let level := serialize_sort_level_ast level sanitize
s!"(:sort {level})"
| .const declName _ =>
-- The universe level of the const expression is elided since it should be
-- inferrable from surrounding expression
s!"(:c {declName})"
| .app _ _ =>
let fn' := self e.getAppFn
let args := e.getAppArgs.map self |>.toList
let args := " ".intercalate args
s!"({fn'} {args})"
| .lam binderName binderType body binderInfo =>
let binderName' := of_name binderName
let binderType' := self binderType
let body' := self body
let binderInfo' := binder_info_to_ast binderInfo
s!"(:lambda {binderName'} {binderType'} {body'}{binderInfo'})"
| .forallE binderName binderType body binderInfo =>
let binderName' := of_name binderName
let binderType' := self binderType
let body' := self body
let binderInfo' := binder_info_to_ast binderInfo
s!"(:forall {binderName'} {binderType'} {body'}{binderInfo'})"
| .letE name type value body _ =>
-- Dependent boolean flag diacarded
let name' := name_to_ast name
let type' := self type
let value' := self value
let body' := self body
s!"(:let {name'} {type'} {value'} {body'})"
| .lit v =>
-- To not burden the downstream parser who needs to handle this, the literal
-- is wrapped in a :lit sexp.
let v' := match v with
| .natVal val => toString val
| .strVal val => s!"\"{val}\""
s!"(:lit {v'})"
| .mdata _ inner =>
-- NOTE: Equivalent to expr itself, but mdata influences the prettyprinter
-- It may become necessary to incorporate the metadata.
self inner
| .proj typeName idx struct =>
let struct' := self struct
s!"(:proj {typeName} {idx} {struct'})"
-- Elides all unhygenic names
binder_info_to_ast : Lean.BinderInfo → String
| .default => ""
| .implicit => " :implicit"
| .strictImplicit => " :strictImplicit"
| .instImplicit => " :instImplicit"
of_name (name: Name) := name_to_ast name sanitize
def serialize_expression (options: Commands.Options) (e: Expr): MetaM Commands.Expression := do
def serialize_expression (options: Protocol.Options) (e: Expr): MetaM Protocol.Expression := do
let pp := toString (← Meta.ppExpr e)
let pp?: Option String := match options.printExprPretty with
| true => .some pp
| false => .none
let sexp: String := (← serialize_expression_ast e)
| true => .some pp
| false => .none
let sexp: String := serialize_expression_ast e
let sexp?: Option String := match options.printExprAST with
| true => .some sexp
| false => .none
| true => .some sexp
| false => .none
return {
pp?,
sexp?
}
/-- Adapted from ppGoal -/
def serialize_goal (options: Commands.Options) (mvarDecl: MetavarDecl) (parentDecl?: Option MetavarDecl)
: MetaM Commands.Goal := do
def serialize_goal (options: Protocol.Options) (goal: MVarId) (mvarDecl: MetavarDecl) (parentDecl?: Option MetavarDecl)
: MetaM Protocol.Goal := do
-- Options for printing; See Meta.ppGoal for details
let showLetValues := true
let ppAuxDecls := options.printAuxDecls
@ -194,29 +177,32 @@ def serialize_goal (options: Commands.Options) (mvarDecl: MetavarDecl) (parentDe
let lctx := mvarDecl.lctx
let lctx := lctx.sanitizeNames.run' { options := (← getOptions) }
Meta.withLCtx lctx mvarDecl.localInstances do
let ppVarNameOnly (localDecl: LocalDecl): MetaM Commands.Variable := do
let ppVarNameOnly (localDecl: LocalDecl): MetaM Protocol.Variable := do
match localDecl with
| .cdecl _ _ varName _ _ _ =>
let varName := varName.simpMacroScopes
| .cdecl _ fvarId userName _ _ _ =>
let userName := userName.simpMacroScopes
return {
name := toString varName,
name := of_name fvarId.name,
userName:= of_name userName.simpMacroScopes,
}
| .ldecl _ _ varName _ _ _ _ => do
| .ldecl _ fvarId userName _ _ _ _ => do
return {
name := toString varName,
name := of_name fvarId.name,
userName := toString userName.simpMacroScopes,
}
let ppVar (localDecl : LocalDecl) : MetaM Commands.Variable := do
let ppVar (localDecl : LocalDecl) : MetaM Protocol.Variable := do
match localDecl with
| .cdecl _ _ varName type _ _ =>
let varName := varName.simpMacroScopes
| .cdecl _ fvarId userName type _ _ =>
let userName := userName.simpMacroScopes
let type ← instantiateMVars type
return {
name := toString varName,
isInaccessible? := .some varName.isInaccessibleUserName
name := of_name fvarId.name,
userName:= of_name userName,
isInaccessible? := .some userName.isInaccessibleUserName
type? := .some (← serialize_expression options type)
}
| .ldecl _ _ varName type val _ _ => do
let varName := varName.simpMacroScopes
| .ldecl _ fvarId userName type val _ _ => do
let userName := userName.simpMacroScopes
let type ← instantiateMVars type
let value? ← if showLetValues then
let val ← instantiateMVars val
@ -224,8 +210,9 @@ def serialize_goal (options: Commands.Options) (mvarDecl: MetavarDecl) (parentDe
else
pure $ .none
return {
name := toString varName,
isInaccessible? := .some varName.isInaccessibleUserName
name := of_name fvarId.name,
userName:= of_name userName,
isInaccessible? := .some userName.isInaccessibleUserName
type? := .some (← serialize_expression options type)
value? := value?
}
@ -235,21 +222,80 @@ def serialize_goal (options: Commands.Options) (mvarDecl: MetavarDecl) (parentDe
if skip then
return acc
else
let nameOnly := options.proofVariableDelta && (parentDecl?.map
let nameOnly := options.noRepeat && (parentDecl?.map
(λ decl => decl.lctx.find? localDecl.fvarId |>.isSome) |>.getD false)
let var ← match nameOnly with
| true => ppVarNameOnly localDecl
| false => ppVar localDecl
return var::acc
return {
caseName? := match mvarDecl.userName with
| Name.anonymous => .none
| name => .some <| toString name,
isConversion := "| " == (Meta.getGoalPrefix mvarDecl)
name := of_name goal.name,
userName? := if mvarDecl.userName == .anonymous then .none else .some (of_name mvarDecl.userName),
isConversion := isLHSGoal? mvarDecl.type |>.isSome,
target := (← serialize_expression options (← instantiateMVars mvarDecl.type)),
vars := vars.reverse.toArray
}
where
of_name (n: Name) := name_to_ast n (sanitize := false)
protected def GoalState.serializeGoals (state: GoalState) (parent: Option GoalState := .none) (options: Protocol.Options := {}): MetaM (Array Protocol.Goal):= do
let goals := state.goals.toArray
state.savedState.term.meta.restore
let parentDecl? := parent.bind (λ parentState =>
let parentGoal := parentState.goals.get! state.parentGoalId
parentState.mctx.findDecl? parentGoal)
goals.mapM fun goal => do
match state.mctx.findDecl? goal with
| .some mvarDecl =>
let serializedGoal ← serialize_goal options goal mvarDecl (parentDecl? := parentDecl?)
pure serializedGoal
| .none => throwError s!"Metavariable does not exist in context {goal.name}"
/-- Print the metavariables in a readable format -/
protected def GoalState.print (goalState: GoalState) (options: Protocol.GoalDiag := {}): MetaM Unit := do
let savedState := goalState.savedState
savedState.term.meta.restore
let goals := savedState.tactic.goals
let mctx ← getMCtx
let root := goalState.root
-- Print the root
match mctx.decls.find? root with
| .some decl => printMVar ">" root decl
| .none => IO.println s!">{root.name}: ??"
goals.forM (fun mvarId => do
if mvarId != root then
match mctx.decls.find? mvarId with
| .some decl => printMVar "⊢" mvarId decl
| .none => IO.println s!"⊢{mvarId.name}: ??"
)
let goals := goals.toSSet
mctx.decls.forM (fun mvarId decl => do
if goals.contains mvarId || mvarId == root then
pure ()
-- Always print the root goal
else if mvarId == goalState.root then
printMVar (pref := ">") mvarId decl
-- Print the remainig ones that users don't see in Lean
else if options.printAll then
let pref := if goalState.newMVars.contains mvarId then "~" else " "
printMVar pref mvarId decl
else
pure ()
--IO.println s!" {mvarId.name}{userNameToString decl.userName}"
)
where
printMVar (pref: String) (mvarId: MVarId) (decl: MetavarDecl): MetaM Unit := do
if options.printContext then
decl.lctx.fvarIdToDecl.forM printFVar
let type_sexp := serialize_expression_ast (← instantiateMVars decl.type) (sanitize := false)
IO.println s!"{pref}{mvarId.name}{userNameToString decl.userName}: {← Meta.ppExpr decl.type} {type_sexp}"
if options.printValue then
if let Option.some value := (← getMCtx).eAssignment.find? mvarId then
IO.println s!" = {← Meta.ppExpr value}"
printFVar (fvarId: FVarId) (decl: LocalDecl): MetaM Unit := do
IO.println s!" | {fvarId.name}{userNameToString decl.userName}: {← Meta.ppExpr decl.type}"
userNameToString : Name → String
| .anonymous => ""
| other => s!"[{other}]"
end Pantograph

View File

@ -1,10 +1,8 @@
/-
- Manages the visibility status of symbols
-/
import Lean.Declaration
namespace Pantograph
/-- Converts a symbol of the form `aa.bb.cc` to a name -/
def str_to_name (s: String): Lean.Name :=
(s.splitOn ".").foldl Lean.Name.str Lean.Name.anonymous

View File

@ -1,121 +0,0 @@
import Lean
import Pantograph.Symbols
import Pantograph.Serial
/-
The proof state manipulation system
A proof state is launched by providing
1. Environment: `Environment`
2. Expression: `Expr`
The expression becomes the first meta variable in the saved tactic state
`Elab.Tactic.SavedState`.
From this point on, any proof which extends
`Elab.Term.Context` and
-/
def Lean.MessageLog.getErrorMessages (log : MessageLog) : MessageLog :=
{
msgs := log.msgs.filter fun m => match m.severity with | MessageSeverity.error => true | _ => false
}
namespace Pantograph
open Lean
structure ProofState where
goals : List MVarId
savedState : Elab.Tactic.SavedState
parent : Option Nat := none
parentGoalId : Nat := 0
structure ProofTree where
-- Set of proof states
states : Array ProofState := #[]
abbrev M := Elab.TermElabM
def ProofTree.create (expr: Expr): M ProofTree := do
let expr ← instantiateMVars expr
let goal := (← Meta.mkFreshExprMVar expr (kind := MetavarKind.synthetic))
let savedStateMonad: Elab.Tactic.TacticM Elab.Tactic.SavedState := MonadBacktrack.saveState
let savedState ← savedStateMonad { elaborator := .anonymous } |>.run' { goals := [goal.mvarId!]}
return {
states := #[{
savedState := savedState,
goals := [goal.mvarId!]
}]
}
-- Print the tree structures in readable form
def ProofTree.structure_array (tree: ProofTree): Array String :=
tree.states.map λ state => match state.parent with
| .none => ""
| .some parent => s!"{parent}.{state.parentGoalId}"
def execute_tactic (state: Elab.Tactic.SavedState) (goal: MVarId) (tactic: String) :
M (Except (Array String) (Elab.Tactic.SavedState × List MVarId)):= do
let tacticM (stx: Syntax): Elab.Tactic.TacticM (Except (Array String) (Elab.Tactic.SavedState × List MVarId)) := do
state.restore
Elab.Tactic.setGoals [goal]
try
Elab.Tactic.evalTactic stx
if (← getThe Core.State).messages.hasErrors then
let messages := (← getThe Core.State).messages.getErrorMessages |>.toList.toArray
let errors ← (messages.map Message.data).mapM fun md => md.toString
return .error errors
else
return .ok (← MonadBacktrack.saveState, ← Elab.Tactic.getUnsolvedGoals)
catch exception =>
return .error #[← exception.toMessageData.toString]
match Parser.runParserCategory
(env := ← MonadEnv.getEnv)
(catName := `tactic)
(input := tactic)
(fileName := "<stdin>") with
| Except.error err => return .error #[err]
| Except.ok stx => tacticM stx { elaborator := .anonymous } |>.run' state.tactic
/-- Response for executing a tactic -/
inductive TacticResult where
-- Invalid id
| invalid (message: String): TacticResult
-- Goes to next state
| success (nextId?: Option Nat) (goals: Array Commands.Goal)
-- Fails with messages
| failure (messages: Array String)
/-- Execute tactic on given state -/
def ProofTree.execute (stateId: Nat) (goalId: Nat) (tactic: String):
Commands.OptionsT StateRefT ProofTree M TacticResult := do
let options ← read
let tree ← get
match tree.states.get? stateId with
| .none => return .invalid s!"Invalid state id {stateId}"
| .some state =>
match state.goals.get? goalId with
| .none => return .invalid s!"Invalid goal id {goalId}"
| .some goal =>
match (← execute_tactic (state := state.savedState) (goal := goal) (tactic := tactic)) with
| .error errors =>
return .failure errors
| .ok (nextState, nextGoals) =>
let nextId := tree.states.size
if nextGoals.isEmpty then
return .success .none #[]
else
let proofState: ProofState := {
savedState := nextState,
goals := nextGoals,
parent := stateId,
parentGoalId := goalId
}
modify fun s => { s with states := s.states.push proofState }
let parentDecl? := (← MonadMCtx.getMCtx).findDecl? goal
let goals ← nextGoals.mapM fun mvarId => do
match (← MonadMCtx.getMCtx).findDecl? mvarId with
| .some mvarDecl => serialize_goal options mvarDecl (parentDecl? := parentDecl?)
| .none => throwError mvarId
return .success (.some nextId) goals.toArray
end Pantograph

View File

@ -1,5 +1,5 @@
namespace Pantograph
def version := "0.2.3"
def version := "0.2.7"
end Pantograph

View File

@ -6,11 +6,11 @@ An interaction system for Lean 4.
## Installation
Install `elan` and `lean4`. Then, execute
Install `elan` and `lake`. Execute
``` sh
lake build
make build/bin/pantograph
```
Then, setup the `LEAN_PATH` environment variable so it contains the library path of lean libraries. The libraries must be built in advance. For example, if `mathlib4` is stored at `../lib/mathlib4`,
setup the `LEAN_PATH` environment variable so it contains the library path of lean libraries. The libraries must be built in advance. For example, if `mathlib4` is stored at `../lib/mathlib4`,
``` sh
LIB="../lib"
LIB_MATHLIB="$LIB/mathlib4/lake-packages"
@ -18,12 +18,12 @@ export LEAN_PATH="$LIB/mathlib4/build/lib:$LIB_MATHLIB/aesop/build/lib:$LIB_MATH
LEAN_PATH=$LEAN_PATH build/bin/pantograph $@
```
Note that `lean-toolchain` must be present in the `$PWD` in order to run Pantograph! This is because Pantograph taps into Lean's internals.
The provided `flake.nix` has a develop environment with Lean already setup.
## Usage
``` sh
build/bin/pantograph MODULES|LEAN_OPTIONS
pantograph MODULES|LEAN_OPTIONS
```
The REPL loop accepts commands as single-line JSON inputs and outputs either an
@ -36,29 +36,30 @@ command { ... }
The list of available commands can be found in `Pantograph/Commands.lean` and below. An
empty command aborts the REPL.
The `Pantograph` executable must be run with a list of modules to import. It can
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)
```
$ build/bin/Pantograph Init
$ pantograph Init
lib.catalog
lib.inspect {"name": "Nat.le_add_left"}
```
Example with `mathlib4` (~90k symbols, may stack overflow, see troubleshooting)
```
$ lake env build/bin/Pantograph Mathlib.Analysis.Seminorm
$ pantograph Mathlib.Analysis.Seminorm
lib.catalog
```
Example proving a theorem: (alternatively use `proof.start {"copyFrom": "Nat.add_comm"}`) to prime the proof
Example proving a theorem: (alternatively use `goal.start {"copyFrom": "Nat.add_comm"}`) to prime the proof
```
$ env build/bin/Pantograph Init
proof.start {"expr": "∀ (n m : Nat), n + m = m + n"}
proof.tactic {"treeId": 0, "stateId": 0, "goalId": 0, "tactic": "intro n m"}
proof.tactic {"treeId": 0, "stateId": 1, "goalId": 0, "tactic": "assumption"}
proof.printTree {"treeId": 0}
proof.tactic {"treeId": 0, "stateId": 1, "goalId": 0, "tactic": "rw [Nat.add_comm]"}
proof.printTree {"treeId": 0}
$ pantograph Init
goal.start {"expr": "∀ (n m : Nat), n + m = m + n"}
goal.tactic {"goalId": 0, "tactic": "intro n m"}
goal.tactic {"goalId": 1, "tactic": "assumption"}
goal.delete {"goalIds": [0]}
stat {}
goal.tactic {"goalId": 1, "tactic": "rw [Nat.add_comm]"}
stat
```
where the application of `assumption` should lead to a failure.
@ -74,9 +75,11 @@ See `Pantograph/Commands.lean` for a description of the parameters and return va
- `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/Commands.lean`
- `options.print`: Display the current set of options
- `proof.start {["name": <name>], ["expr": <expr>], ["copyFrom": <symbol>]}`: Start a new proof state from a given expression or symbol
- `proof.tactic {"treeId": <id>, "stateId": <id>, "goalId": <id>, "tactic": string}`: Execute a tactic on a given proof state
- `proof.printTree {"treeId": <id>}`: Print the topological structure of a proof tree
- `goal.start {["name": <name>], ["expr": <expr>], ["copyFrom": <symbol>]}`: Start a new goal from a given expression or symbol
- `goal.tactic {"stateId": <id>, "goalId": <id>, ["tactic": <tactic>], ["expr": <expr>]}`: Execute a tactic string on a given goal
- `goal.remove {"stateIds": [<id>]}"`: Remove a bunch of stored goals.
- `goal.print {"stateId": <id>}"`: Print a goal state
- `stat`: Display resource usage
## Errors
@ -104,5 +107,5 @@ ulimit -s unlimited
The tests are based on `LSpec`. To run tests,
``` sh
test/all.sh
make test
```

20
Test/Common.lean Normal file
View File

@ -0,0 +1,20 @@
import Pantograph.Protocol
namespace Pantograph
namespace Protocol
/-- Set internal names to "" -/
def Goal.devolatilize (goal: Goal): Goal :=
{
goal with
name := "",
vars := goal.vars.map removeInternalAux,
}
where removeInternalAux (v: Variable): Variable :=
{
v with
name := ""
}
end Protocol
end Pantograph

101
Test/Holes.lean Normal file
View File

@ -0,0 +1,101 @@
import LSpec
import Pantograph.Goal
import Pantograph.Serial
namespace Pantograph.Test.Holes
open Pantograph
open Lean
abbrev TestM := StateRefT LSpec.TestSeq (ReaderT Commands.Options M)
deriving instance DecidableEq, Repr for Commands.Expression
deriving instance DecidableEq, Repr for Commands.Variable
deriving instance DecidableEq, Repr for Commands.Goal
def add_test (test: LSpec.TestSeq): TestM Unit := do
set $ (← get) ++ test
def start_goal (hole: String): TestM (Option GoalState) := do
let env ← Lean.MonadEnv.getEnv
let syn? := syntax_from_str env hole
add_test $ LSpec.check s!"Parsing {hole}" (syn?.isOk)
match syn? with
| .error error =>
IO.println error
return Option.none
| .ok syn =>
let expr? ← syntax_to_expr syn
add_test $ LSpec.check s!"Elaborating" expr?.isOk
match expr? with
| .error error =>
IO.println error
return Option.none
| .ok expr =>
let goal ← GoalState.create (expr := expr)
return Option.some goal
def assert_unreachable (message: String): LSpec.TestSeq := LSpec.check message false
def build_goal (nameType: List (String × String)) (target: String): Commands.Goal :=
{
target := { pp? := .some target},
vars := (nameType.map fun x => ({
name := x.fst,
type? := .some { pp? := .some x.snd },
isInaccessible? := .some false
})).toArray
}
-- Like `build_goal` but allow certain variables to be elided.
def build_goal_selective (nameType: List (String × Option String)) (target: String): Commands.Goal :=
{
target := { pp? := .some target},
vars := (nameType.map fun x => ({
name := x.fst,
type? := x.snd.map (λ type => { pp? := type }),
isInaccessible? := x.snd.map (λ _ => false)
})).toArray
}
def construct_sigma: TestM Unit := do
let goal? ← start_goal "∀ (n m: Nat), n + m = m + n"
add_test $ LSpec.check "Start goal" goal?.isSome
if let .some goal := goal? then
return ()
def proof_runner (env: Lean.Environment) (tests: TestM Unit): IO LSpec.TestSeq := do
let termElabM := tests.run LSpec.TestSeq.done |>.run {} -- with default options
let coreContext: Lean.Core.Context := {
currNamespace := str_to_name "Aniva",
openDecls := [], -- No 'open' directives needed
fileName := "<Pantograph>",
fileMap := { source := "", positions := #[0], lines := #[1] }
}
let metaM := termElabM.run' (ctx := {
declName? := some "_pantograph",
errToSorry := false
})
let coreM := metaM.run'
match ← (coreM.run' coreContext { env := env }).toBaseIO with
| .error exception =>
return LSpec.test "Exception" (s!"internal exception #{← exception.toMessageData.toString}" = "")
| .ok (_, a) =>
return a
def suite: IO LSpec.TestSeq := do
let env: Lean.Environment ← Lean.importModules
(imports := #["Init"].map (λ str => { module := str_to_name str, runtimeOnly := false }))
(opts := {})
(trustLevel := 1)
let tests := [
("Σ'", construct_sigma)
]
let tests ← tests.foldlM (fun acc tests => do
let (name, tests) := tests
let tests ← proof_runner env tests
return acc ++ (LSpec.group name tests)) LSpec.TestSeq.done
return LSpec.group "Holes" tests
end Pantograph.Test.Holes

View File

@ -2,7 +2,7 @@
-/
import LSpec
import Pantograph
namespace Pantograph.Test
namespace Pantograph.Test.Integration
open Pantograph
def subroutine_named_step (name cmd: String) (payload: List (String × Lean.Json))
@ -15,7 +15,7 @@ def subroutine_step (cmd: String) (payload: List (String × Lean.Json))
def subroutine_runner (steps: List (MainM LSpec.TestSeq)): IO LSpec.TestSeq := do
-- Setup the environment for execution
let env ← Lean.importModules
(imports := [{module := Lean.Name.str .anonymous "Init", runtimeOnly := false }])
(imports := #[{module := Lean.Name.str .anonymous "Init", runtimeOnly := false }])
(opts := {})
(trustLevel := 1)
let context: Context := {
@ -45,28 +45,28 @@ def subroutine_runner (steps: List (MainM LSpec.TestSeq)): IO LSpec.TestSeq := d
def test_option_modify : IO LSpec.TestSeq :=
let pp? := Option.some "∀ (n : Nat), n + 1 = Nat.succ n"
let sexp? := Option.some "(: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)))"
let sexp? := Option.some "(: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)))"
let module? := Option.some "Init.Data.Nat.Basic"
let options: Commands.Options := {}
let options: Protocol.Options := {}
subroutine_runner [
subroutine_step "lib.inspect"
[("name", .str "Nat.add_one")]
(Lean.toJson ({
type := { pp? }, module? }:
Commands.LibInspectResult)),
Protocol.LibInspectResult)),
subroutine_step "options.set"
[("printExprAST", .bool true)]
(Lean.toJson ({ }:
Commands.OptionsSetResult)),
Protocol.OptionsSetResult)),
subroutine_step "lib.inspect"
[("name", .str "Nat.add_one")]
(Lean.toJson ({
type := { pp?, sexp? }, module? }:
Commands.LibInspectResult)),
Protocol.LibInspectResult)),
subroutine_step "options.print"
[]
(Lean.toJson ({ options with printExprAST := true }:
Commands.OptionsPrintResult))
Protocol.OptionsPrintResult))
]
def test_malformed_command : IO LSpec.TestSeq :=
let invalid := "invalid"
@ -75,19 +75,39 @@ def test_malformed_command : IO LSpec.TestSeq :=
[("name", .str "Nat.add_one")]
(Lean.toJson ({
error := "command", desc := s!"Unknown command {invalid}"}:
Commands.InteractionError)),
Protocol.InteractionError)),
subroutine_named_step "JSON Deserialization" "expr.echo"
[(invalid, .str "Random garbage data")]
(Lean.toJson ({
error := "command", desc := s!"Unable to parse json: Pantograph.Commands.ExprEcho.expr: String expected"}:
Commands.InteractionError))
error := "command", desc := s!"Unable to parse json: Pantograph.Protocol.ExprEcho.expr: String expected"}:
Protocol.InteractionError))
]
def test_tactic : IO LSpec.TestSeq :=
let goal: Protocol.Goal := {
name := "_uniq.10",
target := { pp? := .some "∀ (q : Prop), x q → q x" },
vars := #[{ name := "_uniq.9", userName := "x", isInaccessible? := .some false, type? := .some { pp? := .some "Prop" }}],
}
subroutine_runner [
subroutine_step "goal.start"
[("expr", .str "∀ (p q: Prop), p q → q p")]
(Lean.toJson ({stateId := 0}:
Protocol.GoalStartResult)),
subroutine_step "goal.tactic"
[("stateId", .num 0), ("goalId", .num 0), ("tactic", .str "intro x")]
(Lean.toJson ({
nextStateId? := .some 1,
goals? := #[goal],
}:
Protocol.GoalTacticResult))
]
def test_integration: IO LSpec.TestSeq := do
def suite: IO LSpec.TestSeq := do
return LSpec.group "Integration" $
(LSpec.group "Option modify" (← test_option_modify)) ++
(LSpec.group "Malformed command" (← test_malformed_command))
(LSpec.group "Malformed command" (← test_malformed_command)) ++
(LSpec.group "Tactic" (← test_tactic))
end Pantograph.Test
end Pantograph.Test.Integration

View File

@ -1,4 +1,5 @@
import LSpec
--import Test.Holes
import Test.Integration
import Test.Proofs
import Test.Serial
@ -10,9 +11,10 @@ unsafe def main := do
Lean.initSearchPath (← Lean.findSysroot)
let suites := [
test_integration,
test_proofs,
test_serial
--Holes.suite,
Integration.suite,
Proofs.suite,
Serial.suite
]
let all ← suites.foldlM (λ acc m => do pure $ acc ++ (← m)) LSpec.TestSeq.done
LSpec.lspecIO $ all

View File

@ -1,8 +1,23 @@
/-
Tests pertaining to goals with no interdependencies
-/
import LSpec
import Pantograph.Tactic
import Pantograph.Goal
import Pantograph.Serial
import Test.Common
namespace Pantograph.Test
namespace Pantograph
def TacticResult.toString : TacticResult → String
| .success state => s!".success ({state.goals.length} goals)"
| .failure messages =>
let messages := "\n".intercalate messages.toList
s!".failure {messages}"
| .parseError error => s!".parseError {error}"
| .indexError index => s!".indexError {index}"
end Pantograph
namespace Pantograph.Test.Proofs
open Pantograph
open Lean
@ -10,74 +25,62 @@ inductive Start where
| copy (name: String) -- Start from some name in the environment
| expr (expr: String) -- Start from some expression
abbrev TestM := ReaderT Commands.Options StateRefT ProofTree M
abbrev TestM := StateRefT LSpec.TestSeq (ReaderT Protocol.Options M)
def start_proof (start: Start): M (LSpec.TestSeq × Option ProofTree) := do
deriving instance DecidableEq, Repr for Protocol.Expression
deriving instance DecidableEq, Repr for Protocol.Variable
deriving instance DecidableEq, Repr for Protocol.Goal
def addTest (test: LSpec.TestSeq): TestM Unit := do
set $ (← get) ++ test
def startProof (start: Start): TestM (Option GoalState) := do
let env ← Lean.MonadEnv.getEnv
let mut testSeq := LSpec.TestSeq.done
match start with
| .copy name =>
let cInfo? := str_to_name name |> env.find?
testSeq := testSeq ++ LSpec.check s!"Symbol exists {name}" cInfo?.isSome
addTest $ LSpec.check s!"Symbol exists {name}" cInfo?.isSome
match cInfo? with
| .some cInfo =>
let state ← ProofTree.create
(expr := cInfo.type)
return (testSeq, Option.some state)
let goal ← GoalState.create (expr := cInfo.type)
return Option.some goal
| .none =>
return (testSeq, Option.none)
return Option.none
| .expr expr =>
let syn? := syntax_from_str env expr
testSeq := testSeq ++ LSpec.check s!"Parsing {expr}" (syn?.isOk)
addTest $ LSpec.check s!"Parsing {expr}" (syn?.isOk)
match syn? with
| .error error =>
IO.println error
return (testSeq, Option.none)
return Option.none
| .ok syn =>
let expr? ← syntax_to_expr syn
testSeq := testSeq ++ LSpec.check s!"Elaborating" expr?.isOk
let expr? ← syntax_to_expr_type syn
addTest $ LSpec.check s!"Elaborating" expr?.isOk
match expr? with
| .error error =>
IO.println error
return (testSeq, Option.none)
return Option.none
| .ok expr =>
let state ← ProofTree.create
(expr := expr)
return (testSeq, Option.some state)
let goal ← GoalState.create (expr := expr)
return Option.some goal
deriving instance DecidableEq, Repr for Commands.Expression
deriving instance DecidableEq, Repr for Commands.Variable
deriving instance DecidableEq, Repr for Commands.Goal
deriving instance DecidableEq, Repr for TacticResult
def assertUnreachable (message: String): LSpec.TestSeq := LSpec.check message false
/-- Check the output of each proof step -/
def proof_step (stateId: Nat) (goalId: Nat) (tactic: String)
(expected: TacticResult) : TestM LSpec.TestSeq := do
let options ← read
let result: TacticResult ← ProofTree.execute stateId goalId tactic |>.run options
match expected, result with
| .success (.some i) #[], .success (.some _) goals =>
-- If the goals are omitted but the next state is specified, we imply that
-- the tactic succeeded.
let expected := .success (.some i) goals
return LSpec.test s!"{stateId}.{goalId} {tactic}" (result = expected)
| _, _ =>
return LSpec.test s!"{stateId}.{goalId} {tactic}" (result = expected)
/-- Check that the tree structure is correct -/
def proof_inspect (expected: Array String) : TestM LSpec.TestSeq := do
let result := (← get).structure_array
return LSpec.test s!"tree structure" (result = expected)
def proof_runner (env: Lean.Environment) (options: Commands.Options) (start: Start) (steps: List (TestM LSpec.TestSeq)): IO LSpec.TestSeq := do
let termElabM := do
let (testSeq, state?) ← start_proof start
match state? with
| .none => return testSeq
| .some state => steps.foldlM (fun tests m => do pure $ tests ++ (← m)) testSeq |>.run options |>.run' state
def buildGoal (nameType: List (String × String)) (target: String) (userName?: Option String := .none): Protocol.Goal :=
{
userName?,
target := { pp? := .some target},
vars := (nameType.map fun x => ({
userName := x.fst,
type? := .some { pp? := .some x.snd },
isInaccessible? := .some false
})).toArray
}
def proofRunner (env: Lean.Environment) (tests: TestM Unit): IO LSpec.TestSeq := do
let termElabM := tests.run LSpec.TestSeq.done |>.run {} -- with default options
let coreContext: Lean.Core.Context := {
currNamespace := str_to_name "Aniva",
currNamespace := Name.append .anonymous "Aniva",
openDecls := [], -- No 'open' directives needed
fileName := "<Pantograph>",
fileMap := { source := "", positions := #[0], lines := #[1] }
@ -90,41 +93,117 @@ def proof_runner (env: Lean.Environment) (options: Commands.Options) (start: Sta
match ← (coreM.run' coreContext { env := env }).toBaseIO with
| .error exception =>
return LSpec.test "Exception" (s!"internal exception #{← exception.toMessageData.toString}" = "")
| .ok a => return a
def build_goal (nameType: List (String × String)) (target: String): Commands.Goal :=
{
target := { pp? := .some target},
vars := (nameType.map fun x => ({
name := x.fst,
type? := .some { pp? := .some x.snd },
isInaccessible? := .some false
})).toArray
}
| .ok (_, a) =>
return a
-- Individual test cases
example: ∀ (a b: Nat), a + b = b + a := by
intro n m
rw [Nat.add_comm]
def proof_nat_add_comm (env: Lean.Environment): IO LSpec.TestSeq := do
let goal1: Commands.Goal := build_goal [("n", "Nat"), ("m", "Nat")] "n + m = m + n"
proof_runner env {} (.copy "Nat.add_comm") [
proof_step 0 0 "intro n m"
(.success (.some 1) #[goal1]),
proof_step 1 0 "assumption"
(.failure #[s!"tactic 'assumption' failed\nn m : Nat\n⊢ n + m = m + n"]),
proof_step 1 0 "rw [Nat.add_comm]"
(.success .none #[])
]
def proof_nat_add_comm_manual (env: Lean.Environment): IO LSpec.TestSeq := do
let goal1: Commands.Goal := build_goal [("n", "Nat"), ("m", "Nat")] "n + m = m + n"
proof_runner env {} (.expr "∀ (a b: Nat), a + b = b + a") [
proof_step 0 0 "intro n m"
(.success (.some 1) #[goal1]),
proof_step 1 0 "assumption"
(.failure #[s!"tactic 'assumption' failed\nn m : Nat\n⊢ n + m = m + n"]),
proof_step 1 0 "rw [Nat.add_comm]"
(.success .none #[])
]
def proof_nat_add_comm (manual: Bool): TestM Unit := do
let state? ← startProof <| match manual with
| false => .copy "Nat.add_comm"
| true => .expr "∀ (a b: Nat), a + b = b + a"
addTest $ LSpec.check "Start goal" state?.isSome
let state0 ← match state? with
| .some state => pure state
| .none => do
addTest $ assertUnreachable "Goal could not parse"
return ()
let state1 ← match ← state0.execute (goalId := 0) (tactic := "intro n m") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check "intro n m" ((← state1.serializeGoals (options := ← read)).map (·.devolatilize) =
#[buildGoal [("n", "Nat"), ("m", "Nat")] "n + m = m + n"])
match ← state1.execute (goalId := 0) (tactic := "assumption") with
| .failure #[message] =>
addTest $ LSpec.check "assumption" (message = "tactic 'assumption' failed\nn m : Nat\n⊢ n + m = m + n")
| other => do
addTest $ assertUnreachable $ other.toString
let state2 ← match ← state1.execute (goalId := 0) (tactic := "rw [Nat.add_comm]") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.test "rw [Nat.add_comm]" state2.goals.isEmpty
return ()
def proof_delta_variable: TestM Unit := do
let options: Protocol.Options := { noRepeat := true }
let state? ← startProof <| .expr "∀ (a b: Nat), a + b = b + a"
addTest $ LSpec.check "Start goal" state?.isSome
let state0 ← match state? with
| .some state => pure state
| .none => do
addTest $ assertUnreachable "Goal could not parse"
return ()
let state1 ← match ← state0.execute (goalId := 0) (tactic := "intro n") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check "intro n" ((← state1.serializeGoals (parent := state0) options).map (·.devolatilize) =
#[buildGoalSelective [("n", .some "Nat")] "∀ (b : Nat), n + b = b + n"])
let state2 ← match ← state1.execute (goalId := 0) (tactic := "intro m") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check "intro m" ((← state2.serializeGoals (parent := state1) options).map (·.devolatilize) =
#[buildGoalSelective [("n", .none), ("m", .some "Nat")] "n + m = m + n"])
return ()
where
-- Like `buildGoal` but allow certain variables to be elided.
buildGoalSelective (nameType: List (String × Option String)) (target: String): Protocol.Goal :=
{
target := { pp? := .some target},
vars := (nameType.map fun x => ({
userName := x.fst,
type? := x.snd.map (λ type => { pp? := type }),
isInaccessible? := x.snd.map (λ _ => false)
})).toArray
}
example (w x y z : Nat) (p : Nat → Prop)
(h : p (x * y + z * w * x)) : p (x * w * z + y * x) := by
simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm, Nat.mul_comm, Nat.mul_assoc, Nat.mul_left_comm] at *
assumption
def proof_arith: TestM Unit := do
let state? ← startProof (.expr "∀ (w x y z : Nat) (p : Nat → Prop) (h : p (x * y + z * w * x)), p (x * w * z + y * x)")
let state0 ← match state? with
| .some state => pure state
| .none => do
addTest $ assertUnreachable "Goal could not parse"
return ()
let state1 ← match ← state0.execute (goalId := 0) (tactic := "intros") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check "intros" (state1.goals.length = 1)
addTest $ LSpec.test "(1 root)" state1.rootExpr?.isNone
let state2 ← match ← state1.execute (goalId := 0) (tactic := "simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm, Nat.mul_comm, Nat.mul_assoc, Nat.mul_left_comm] at *") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check "simp ..." (state2.goals.length = 1)
addTest $ LSpec.check "(2 root)" state2.rootExpr?.isNone
let state3 ← match ← state2.execute (goalId := 0) (tactic := "assumption") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.test "assumption" state3.goals.isEmpty
addTest $ LSpec.check "(3 root)" state3.rootExpr?.isSome
return ()
-- Two ways to write the same theorem
example: ∀ (p q: Prop), p q → q p := by
@ -141,80 +220,183 @@ example: ∀ (p q: Prop), p q → q p := by
assumption
. apply Or.inl
assumption
def proof_or_comm (env: Lean.Environment): IO LSpec.TestSeq := do
let typeProp: Commands.Expression := { pp? := .some "Prop" }
let branchGoal (caseName name: String): Commands.Goal := {
caseName? := .some caseName,
target := { pp? := .some "q p" },
vars := #[
{ name := "p", type? := .some typeProp, isInaccessible? := .some false },
{ name := "q", type? := .some typeProp, isInaccessible? := .some false },
{ name := "h✝", type? := .some { pp? := .some name }, isInaccessible? := .some true }
]
}
proof_runner env {} (.expr "∀ (p q: Prop), p q → q p") [
proof_step 0 0 "intro p q h"
(.success (.some 1) #[build_goal [("p", "Prop"), ("q", "Prop"), ("h", "p q")] "q p"]),
proof_step 1 0 "cases h"
(.success (.some 2) #[branchGoal "inl" "p", branchGoal "inr" "q"]),
proof_inspect #["", "0.0", "1.0"],
proof_step 2 0 "apply Or.inr"
(.success (.some 3) #[]),
proof_inspect #["", "0.0", "1.0", "2.0"],
proof_step 3 0 "assumption"
(.success .none #[]),
proof_step 2 1 "apply Or.inl"
(.success (.some 4) #[]),
proof_step 4 0 "assumption"
(.success .none #[]),
proof_inspect #["", "0.0", "1.0", "2.0", "2.1"]
]
def proof_or_comm: TestM Unit := do
let state? ← startProof (.expr "∀ (p q: Prop), p q → q p")
let state0 ← match state? with
| .some state => pure state
| .none => do
addTest $ assertUnreachable "Goal could not parse"
return ()
example (w x y z : Nat) (p : Nat → Prop)
(h : p (x * y + z * w * x)) : p (x * w * z + y * x) := by
simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm, Nat.mul_comm, Nat.mul_assoc, Nat.mul_left_comm] at *
assumption
def proof_arith_1 (env: Lean.Environment): IO LSpec.TestSeq := do
proof_runner env {} (.expr "∀ (w x y z : Nat) (p : Nat → Prop) (h : p (x * y + z * w * x)), p (x * w * z + y * x)") [
proof_step 0 0 "intros"
(.success (.some 1) #[]),
proof_step 1 0 "simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm, Nat.mul_comm, Nat.mul_assoc, Nat.mul_left_comm] at *"
(.success (.some 2) #[]),
proof_step 2 0 "assumption"
(.success .none #[])
]
let state1 ← match ← state0.execute (goalId := 0) (tactic := "intro p q h") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check "intro n m" ((← state1.serializeGoals (options := ← read)).map (·.devolatilize) =
#[buildGoal [("p", "Prop"), ("q", "Prop"), ("h", "p q")] "q p"])
let state2 ← match ← state1.execute (goalId := 0) (tactic := "cases h") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check "cases h" ((← state2.serializeGoals (options := ← read)).map (·.devolatilize) =
#[branchGoal "inl" "p", branchGoal "inr" "q"])
def build_goal_selective (nameType: List (String × Option String)) (target: String): Commands.Goal :=
{
target := { pp? := .some target},
vars := (nameType.map fun x => ({
name := x.fst,
type? := x.snd.map (λ type => { pp? := type }),
isInaccessible? := x.snd.map (λ _ => false)
})).toArray
}
def proof_delta_variable (env: Lean.Environment): IO LSpec.TestSeq := do
let goal1: Commands.Goal := build_goal_selective [("n", .some "Nat")] "∀ (b : Nat), n + b = b + n"
let goal2: Commands.Goal := build_goal_selective [("n", .none), ("m", .some "Nat")] "n + m = m + n"
proof_runner env { proofVariableDelta := true } (.expr "∀ (a b: Nat), a + b = b + a") [
proof_step 0 0 "intro n"
(.success (.some 1) #[goal1]),
proof_step 1 0 "intro m"
(.success (.some 2) #[goal2])
]
let state3_1 ← match ← state2.execute (goalId := 0) (tactic := "apply Or.inr") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check "· apply Or.inr" (state3_1.goals.length = 1)
let state4_1 ← match ← state3_1.execute (goalId := 0) (tactic := "assumption") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check " assumption" state4_1.goals.isEmpty
addTest $ LSpec.check "(4_1 root)" state4_1.rootExpr?.isNone
let state3_2 ← match ← state2.execute (goalId := 1) (tactic := "apply Or.inl") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check "· apply Or.inl" (state3_2.goals.length = 1)
let state4_2 ← match ← state3_2.execute (goalId := 0) (tactic := "assumption") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check " assumption" state4_2.goals.isEmpty
addTest $ LSpec.check "(4_2 root)" state4_2.rootExpr?.isNone
-- Ensure the proof can continue from `state4_2`.
let state2b ← match state2.continue state4_2 with
| .error msg => do
addTest $ assertUnreachable $ msg
return ()
| .ok state => pure state
addTest $ LSpec.test "(resume)" (state2b.goals == [state2.goals.get! 0])
let state3_1 ← match ← state2b.execute (goalId := 0) (tactic := "apply Or.inr") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check "· apply Or.inr" (state3_1.goals.length = 1)
let state4_1 ← match ← state3_1.execute (goalId := 0) (tactic := "assumption") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check " assumption" state4_1.goals.isEmpty
addTest $ LSpec.check "(4_1 root)" state4_1.rootExpr?.isSome
def test_proofs : IO LSpec.TestSeq := do
return ()
where
typeProp: Protocol.Expression := { pp? := .some "Prop" }
branchGoal (caseName varName: String): Protocol.Goal := {
userName? := .some caseName,
target := { pp? := .some "q p" },
vars := #[
{ userName := "p", type? := .some typeProp, isInaccessible? := .some false },
{ userName := "q", type? := .some typeProp, isInaccessible? := .some false },
{ userName := "h✝", type? := .some { pp? := .some varName }, isInaccessible? := .some true }
]
}
/-- M-coupled goals -/
def proof_m_couple: TestM Unit := do
let state? ← startProof (.expr "(2: Nat) ≤ 5")
let state0 ← match state? with
| .some state => pure state
| .none => do
addTest $ assertUnreachable "Goal could not parse"
return ()
let state1 ← match ← state0.execute (goalId := 0) (tactic := "apply Nat.le_trans") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check "apply Nat.le_trans" ((← state1.serializeGoals (options := ← read)).map (·.target.pp?) =
#[.some "2 ≤ ?m", .some "?m ≤ 5", .some "Nat"])
addTest $ LSpec.test "(1 root)" state1.rootExpr?.isNone
-- Set m to 3
let state2 ← match ← state1.execute (goalId := 2) (tactic := "exact 3") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.test "(1b root)" state2.rootExpr?.isNone
let state1b ← match state1.continue state2 with
| .error msg => do
addTest $ assertUnreachable $ msg
return ()
| .ok state => pure state
addTest $ LSpec.check "exact 3" ((← state1b.serializeGoals (options := ← read)).map (·.target.pp?) =
#[.some "2 ≤ 3", .some "3 ≤ 5"])
addTest $ LSpec.test "(2 root)" state1b.rootExpr?.isNone
return ()
def proof_proposition_generation: TestM Unit := do
let state? ← startProof (.expr "Σ' p:Prop, p")
let state0 ← match state? with
| .some state => pure state
| .none => do
addTest $ assertUnreachable "Goal could not parse"
return ()
let state1 ← match ← state0.execute (goalId := 0) (tactic := "apply PSigma.mk") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check "apply PSigma.mk" ((← state1.serializeGoals (options := ← read)).map (·.devolatilize) =
#[
buildGoal [] "?fst" (userName? := .some "snd"),
buildGoal [] "Prop" (userName? := .some "fst")
])
if let #[goal1, goal2] := ← state1.serializeGoals (options := { (← read) with printExprAST := true }) then
addTest $ LSpec.test "(1 reference)" (goal1.target.sexp? = .some s!"(:mv {goal2.name})")
addTest $ LSpec.test "(1 root)" state1.rootExpr?.isNone
let state2 ← match ← state1.tryAssign (goalId := 0) (expr := "λ (x: Nat) => _") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check ":= λ (x: Nat), _" ((← state2.serializeGoals (options := ← read)).map (·.target.pp?) =
#[.some "Nat → Prop", .some "∀ (x : Nat), ?m.29 x"])
addTest $ LSpec.test "(2 root)" state2.rootExpr?.isNone
let state3 ← match ← state2.tryAssign (goalId := 1) (expr := "fun x => Eq.refl x") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check ":= Eq.refl" ((← state3.serializeGoals (options := ← read)).map (·.target.pp?) =
#[])
addTest $ LSpec.test "(3 root)" state3.rootExpr?.isSome
return ()
def suite: IO LSpec.TestSeq := do
let env: Lean.Environment ← Lean.importModules
(imports := ["Init"].map (λ str => { module := str_to_name str, runtimeOnly := false }))
(imports := #[{ module := Name.append .anonymous "Init", runtimeOnly := false}])
(opts := {})
(trustLevel := 1)
let tests := [
("Nat.add_comm", proof_nat_add_comm false),
("Nat.add_comm manual", proof_nat_add_comm true),
("Nat.add_comm delta", proof_delta_variable),
("arithmetic", proof_arith),
("Or.comm", proof_or_comm),
("2 < 5", proof_m_couple),
("Proposition Generation", proof_proposition_generation)
]
let tests ← tests.foldlM (fun acc tests => do
let (name, tests) := tests
let tests ← proofRunner env tests
return acc ++ (LSpec.group name tests)) LSpec.TestSeq.done
return LSpec.group "Proofs" $
(LSpec.group "Nat.add_comm" $ (← proof_nat_add_comm env)) ++
(LSpec.group "Nat.add_comm manual" $ (← proof_nat_add_comm_manual env)) ++
(LSpec.group "Or.comm" $ (← proof_or_comm env)) ++
(LSpec.group "Arithmetic 1" $ (← proof_arith_1 env)) ++
(LSpec.group "Delta variable" $ (← proof_delta_variable env))
end Pantograph.Test
return LSpec.group "Proofs" tests
end Pantograph.Test.Proofs

View File

@ -1,19 +1,27 @@
import LSpec
import Pantograph.Serial
import Pantograph.Symbols
import Pantograph.Symbol
namespace Pantograph.Test
namespace Pantograph.Test.Serial
open Pantograph
open Lean
deriving instance Repr, DecidableEq for Commands.BoundExpression
deriving instance Repr, DecidableEq for Protocol.BoundExpression
def test_str_to_name: LSpec.TestSeq :=
LSpec.test "Symbol parsing" (Name.str (.str (.str .anonymous "Lean") "Meta") "run" = Pantograph.str_to_name "Lean.Meta.run")
LSpec.test "Symbol parsing" (Name.str (.str (.str .anonymous "Lean") "Meta") "run" = Pantograph.str_to_name "Lean.Meta.run")
def test_name_to_ast: LSpec.TestSeq :=
let quote := "\""
let escape := "\\"
LSpec.test "a.b.1" (name_to_ast (Name.num (.str (.str .anonymous "a") "b") 1) = "a.b.1") ++
LSpec.test "seg.«a.b»" (name_to_ast (Name.str (.str .anonymous "seg") "a.b") = s!"{quote}seg.«a.b»{quote}") ++
-- Pathological test case
LSpec.test s!"«̈{escape}{quote}»" (name_to_ast (Name.str .anonymous s!"{escape}{quote}") = s!"{quote}«{escape}{quote}»{quote}")
def test_expr_to_binder (env: Environment): IO LSpec.TestSeq := do
let entries: List (String × Commands.BoundExpression) := [
let entries: List (String × Protocol.BoundExpression) := [
("Nat.add_comm", { binders := #[("n", "Nat"), ("m", "Nat")], target := "n + m = m + n" }),
("Nat.le_of_succ_le", { binders := #[("n", "Nat"), ("m", "Nat"), ("h", "Nat.succ n ≤ m")], target := "n ≤ m" })
]
@ -36,10 +44,10 @@ def test_expr_to_binder (env: Environment): IO LSpec.TestSeq := do
def test_sexp_of_symbol (env: Environment): IO LSpec.TestSeq := do
let entries: List (String × String) := [
-- This one contains unhygienic variable names which must be suppressed
("Nat.add", "(:forall :anon (:c Nat) (:forall :anon (:c Nat) (:c Nat)))"),
("Nat.add", "(:forall _ (:c Nat) (:forall _ (:c Nat) (:c Nat)))"),
-- 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.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)"),
("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)) :implicit) :implicit)"),
-- Handling of higher order types
("Or", "(:forall a (:sort 0) (:forall b (:sort 0) (:sort 0)))"),
("List", "(:forall α (:sort (+ u 1)) (:sort (+ u 1)))")
@ -47,8 +55,8 @@ def test_sexp_of_symbol (env: Environment): IO LSpec.TestSeq := do
let metaM: MetaM LSpec.TestSeq := entries.foldlM (λ suites (symbol, target) => do
let env ← MonadEnv.getEnv
let expr := str_to_name symbol |> env.find? |>.get! |>.type
let test := LSpec.check symbol ((serialize_expression_ast expr) = target)
return LSpec.TestSeq.append suites test) LSpec.TestSeq.done |>.run'
let test := LSpec.check symbol ((serialize_expression_ast expr) = target)
return LSpec.TestSeq.append suites test) LSpec.TestSeq.done
let coreM := metaM.run'
let coreContext: Core.Context := {
currNamespace := Lean.Name.str .anonymous "Aniva"
@ -62,15 +70,16 @@ def test_sexp_of_symbol (env: Environment): IO LSpec.TestSeq := do
| .ok a => return a
def test_serial: IO LSpec.TestSeq := do
def suite: IO LSpec.TestSeq := do
let env: Environment ← importModules
(imports := ["Init"].map (λ str => { module := str_to_name str, runtimeOnly := false }))
(imports := #["Init"].map (λ str => { module := str_to_name str, runtimeOnly := false }))
(opts := {})
(trustLevel := 1)
return LSpec.group "Serialisation" $
return LSpec.group "Serialization" $
(LSpec.group "str_to_name" test_str_to_name) ++
(LSpec.group "name_to_ast" test_name_to_ast) ++
(LSpec.group "Expression binder" (← test_expr_to_binder env)) ++
(LSpec.group "Sexp from symbol" (← test_sexp_of_symbol env))
end Pantograph.Test
end Pantograph.Test.Serial

View File

@ -1,3 +0,0 @@
#!/bin/bash
lake build test && lake env build/bin/test

202
flake.lock Normal file
View File

@ -0,0 +1,202 @@
{
"nodes": {
"flake-parts": {
"inputs": {
"nixpkgs-lib": "nixpkgs-lib"
},
"locked": {
"lastModified": 1696343447,
"narHash": "sha256-B2xAZKLkkeRFG5XcHHSXXcP7To9Xzr59KXeZiRf4vdQ=",
"owner": "hercules-ci",
"repo": "flake-parts",
"rev": "c9afaba3dfa4085dbd2ccb38dfade5141e33d9d4",
"type": "github"
},
"original": {
"owner": "hercules-ci",
"repo": "flake-parts",
"type": "github"
}
},
"flake-utils": {
"locked": {
"lastModified": 1656928814,
"narHash": "sha256-RIFfgBuKz6Hp89yRr7+NR5tzIAbn52h8vT6vXkYjZoM=",
"owner": "numtide",
"repo": "flake-utils",
"rev": "7e2a3b3dfd9af950a856d66b0a7d01e3c18aa249",
"type": "github"
},
"original": {
"owner": "numtide",
"repo": "flake-utils",
"type": "github"
}
},
"lean": {
"inputs": {
"flake-utils": "flake-utils",
"lean4-mode": "lean4-mode",
"nix": "nix",
"nixpkgs": "nixpkgs_2"
},
"locked": {
"lastModified": 1695693562,
"narHash": "sha256-6qbCafG0bL5KxQt2gL6hV4PFDsEMM0UXfldeOOqxsaE=",
"owner": "leanprover",
"repo": "lean4",
"rev": "a832f398b80a5ebb820d27b9e55ec949759043ff",
"type": "github"
},
"original": {
"owner": "leanprover",
"ref": "v4.1.0",
"repo": "lean4",
"type": "github"
}
},
"lean4-mode": {
"flake": false,
"locked": {
"lastModified": 1676498134,
"narHash": "sha256-u3WvyKxOViZG53hkb8wd2/Og6muTecbh+NdflIgVeyk=",
"owner": "leanprover",
"repo": "lean4-mode",
"rev": "2c6ef33f476fdf5eb5e4fa4fa023ba8b11372440",
"type": "github"
},
"original": {
"owner": "leanprover",
"repo": "lean4-mode",
"type": "github"
}
},
"lowdown-src": {
"flake": false,
"locked": {
"lastModified": 1633514407,
"narHash": "sha256-Dw32tiMjdK9t3ETl5fzGrutQTzh2rufgZV4A/BbxuD4=",
"owner": "kristapsdz",
"repo": "lowdown",
"rev": "d2c2b44ff6c27b936ec27358a2653caaef8f73b8",
"type": "github"
},
"original": {
"owner": "kristapsdz",
"repo": "lowdown",
"type": "github"
}
},
"nix": {
"inputs": {
"lowdown-src": "lowdown-src",
"nixpkgs": "nixpkgs",
"nixpkgs-regression": "nixpkgs-regression"
},
"locked": {
"lastModified": 1657097207,
"narHash": "sha256-SmeGmjWM3fEed3kQjqIAO8VpGmkC2sL1aPE7kKpK650=",
"owner": "NixOS",
"repo": "nix",
"rev": "f6316b49a0c37172bca87ede6ea8144d7d89832f",
"type": "github"
},
"original": {
"owner": "NixOS",
"repo": "nix",
"type": "github"
}
},
"nixpkgs": {
"locked": {
"lastModified": 1653988320,
"narHash": "sha256-ZaqFFsSDipZ6KVqriwM34T739+KLYJvNmCWzErjAg7c=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "2fa57ed190fd6c7c746319444f34b5917666e5c1",
"type": "github"
},
"original": {
"owner": "NixOS",
"ref": "nixos-22.05-small",
"repo": "nixpkgs",
"type": "github"
}
},
"nixpkgs-lib": {
"locked": {
"dir": "lib",
"lastModified": 1696019113,
"narHash": "sha256-X3+DKYWJm93DRSdC5M6K5hLqzSya9BjibtBsuARoPco=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "f5892ddac112a1e9b3612c39af1b72987ee5783a",
"type": "github"
},
"original": {
"dir": "lib",
"owner": "NixOS",
"ref": "nixos-unstable",
"repo": "nixpkgs",
"type": "github"
}
},
"nixpkgs-regression": {
"locked": {
"lastModified": 1643052045,
"narHash": "sha256-uGJ0VXIhWKGXxkeNnq4TvV3CIOkUJ3PAoLZ3HMzNVMw=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "215d4d0fd80ca5163643b03a33fde804a29cc1e2",
"type": "github"
},
"original": {
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "215d4d0fd80ca5163643b03a33fde804a29cc1e2",
"type": "github"
}
},
"nixpkgs_2": {
"locked": {
"lastModified": 1686089707,
"narHash": "sha256-LTNlJcru2qJ0XhlhG9Acp5KyjB774Pza3tRH0pKIb3o=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "af21c31b2a1ec5d361ed8050edd0303c31306397",
"type": "github"
},
"original": {
"owner": "NixOS",
"ref": "nixpkgs-unstable",
"repo": "nixpkgs",
"type": "github"
}
},
"nixpkgs_3": {
"locked": {
"lastModified": 1697456312,
"narHash": "sha256-roiSnrqb5r+ehnKCauPLugoU8S36KgmWraHgRqVYndo=",
"owner": "nixos",
"repo": "nixpkgs",
"rev": "ca012a02bf8327be9e488546faecae5e05d7d749",
"type": "github"
},
"original": {
"owner": "nixos",
"ref": "nixos-unstable",
"repo": "nixpkgs",
"type": "github"
}
},
"root": {
"inputs": {
"flake-parts": "flake-parts",
"lean": "lean",
"nixpkgs": "nixpkgs_3"
}
}
},
"root": "root",
"version": 7
}

38
flake.nix Normal file
View File

@ -0,0 +1,38 @@
{
description = "Pantograph";
inputs = {
nixpkgs.url = "github:nixos/nixpkgs/nixos-unstable";
flake-parts.url = "github:hercules-ci/flake-parts";
lean.url = "github:leanprover/lean4?ref=v4.1.0";
};
outputs = inputs @ {
self,
nixpkgs,
flake-parts,
lean,
...
} : flake-parts.lib.mkFlake { inherit inputs; } {
flake = {
};
systems = [
"x86_64-linux"
"x86_64-darwin"
];
perSystem = { system, pkgs, ... }: let
leanPkgs = lean.packages.${system};
project = leanPkgs.buildLeanPackage {
name = "Pantograph";
roots = [ "Main" "Pantograph" ];
src = ./.;
};
in rec {
packages = project // {
inherit (leanPkgs) lean;
default = packages.executable;
};
devShells.default = project.devShell;
};
};
}

View File

@ -1,33 +1,11 @@
{"version": 4,
{"version": 5,
"packagesDir": "lake-packages",
"packages":
[{"git":
{"url": "https://github.com/lurk-lab/LSpec.git",
"subDir?": null,
"rev": "88f7d23e56a061d32c7173cea5befa4b2c248b41",
"opts": {},
"name": "LSpec",
"inputRev?": "88f7d23e56a061d32c7173cea5befa4b2c248b41"}},
{"git":
{"url": "https://github.com/leanprover-community/mathlib4.git",
"subDir?": null,
"rev": "8e5a00a8afc8913c0584cb85f37951995275fd87",
"name": "mathlib",
"inputRev?": "8e5a00a8afc8913c0584cb85f37951995275fd87"}},
{"git":
{"url": "https://github.com/gebner/quote4",
"subDir?": null,
"rev": "c71f94e34c1cda52eef5c93dc9da409ab2727420",
"name": "Qq",
"inputRev?": "master"}},
{"git":
{"url": "https://github.com/JLimperg/aesop",
"subDir?": null,
"rev": "cdc00b640d0179910ebaa9c931e3b733a04b881c",
"name": "aesop",
"inputRev?": "master"}},
{"git":
{"url": "https://github.com/leanprover/std4",
"subDir?": null,
"rev": "6006307d2ceb8743fea7e00ba0036af8654d0347",
"name": "std",
"inputRev?": "main"}}]}
"inputRev?": "88f7d23e56a061d32c7173cea5befa4b2c248b41",
"inherited": false}}]}

View File

@ -1 +1 @@
leanprover/lean4:nightly-2023-08-12
leanprover/lean4:4.1.0