Compare commits

...

430 Commits

Author SHA1 Message Date
Leni Aniva 4f6ccd3e82 Merge pull request 'feat: Extract used constants from invocation' (#119) from frontend/data into dev
Reviewed-on: #119
2024-11-10 21:29:34 -08:00
Leni Aniva 77b577d0e3
Merge branch 'dev' into frontend/data 2024-11-08 14:52:03 -08:00
Leni Aniva d7c9590780
feat: Extract used constants from invocation 2024-11-05 14:37:06 -08:00
Leni Aniva 8fe4c78c2a
doc: Change license to Apache2 2024-10-21 09:59:13 -07:00
Leni Aniva a11127a64e Merge pull request 'feat: Capture environment in drafting' (#113) from frontend/environment into dev
Reviewed-on: #113
2024-10-12 16:59:41 -07:00
Leni Aniva 72e41e1e1e
Merge branch 'dev' into frontend/environment 2024-10-12 16:57:55 -07:00
Leni Aniva 5b278d68d4 Merge pull request 'feat: Let tactic in REPL' (#111) from repl/tactic-let into dev
Reviewed-on: #111
2024-10-12 16:54:12 -07:00
Leni Aniva 946e688dec
test(frontend): Environment capture 2024-10-12 16:52:36 -07:00
Leni Aniva 5a2ae880f4
feat: Capture environment in drafting 2024-10-12 16:46:44 -07:00
Leni Aniva 645d9c9250
feat: Let tactic in REPL 2024-10-12 16:17:21 -07:00
Leni Aniva e0ba65a7cd Merge pull request 'fix: Delayed MVars in MetaTranslate' (#110) from bug/frontend-translate-delayed-mvar into dev
Reviewed-on: #110
2024-10-09 18:08:09 -07:00
Leni Aniva 641f8c3883
fix: Translate level mvars 2024-10-09 15:49:10 -07:00
Leni Aniva 0bac4fdecd
Merge branch 'dev' into bug/frontend-translate-delayed-mvar 2024-10-08 23:53:57 -07:00
Leni Aniva 1cd41b4993 Merge pull request 'feat: Catch and print IO errors in REPL' (#109) from repl/io-exception into dev
Reviewed-on: #109
2024-10-08 23:50:36 -07:00
Leni Aniva f03c47207b
Merge branch 'dev' into repl/io-exception 2024-10-08 23:49:51 -07:00
Leni Aniva 0e8c9f890b
fix: Translate fvars in pending context 2024-10-08 14:28:35 -07:00
Leni Aniva 420e863756
fix: Delayed mvars in MetaTranslate 2024-10-08 10:32:16 -07:00
Leni Aniva 1f4f2d7d6d Merge pull request 'chore: Update Lean to v4.12.0' (#108) from misc/version into dev
Reviewed-on: #108
2024-10-08 09:49:08 -07:00
Leni Aniva 05d0b7739a
feat: Catch IO errors in json format 2024-10-08 00:45:58 -07:00
Leni Aniva 5e776a1b49
feat: Catch and print IO errors 2024-10-08 00:17:31 -07:00
Leni Aniva 2e1276c21c
chore: Update LSpec dependency 2024-10-08 00:15:30 -07:00
Leni Aniva c3494edc75
fix: Flake build 2024-10-06 16:46:39 -07:00
Leni Aniva 25dd1a32ba
Merge branch 'dev' into misc/version 2024-10-06 16:12:36 -07:00
Leni Aniva 9119f47a8f chore: Remove more thin wrappers 2024-10-06 16:12:22 -07:00
Leni Aniva 8d774d3281 feat: Remove most filters on catalog 2024-10-06 16:12:22 -07:00
Leni Aniva c3076cbb7d
chore: Update Lean to v4.12.0 2024-10-06 16:10:18 -07:00
Leni Aniva 22ddfaaf21 Merge pull request 'feat: Error reporting in frontend' (#107) from frontend/error into dev
Reviewed-on: #107
2024-10-05 22:39:23 -07:00
Leni Aniva d0321e72dd
feat: Add message diagnostics to frontend.process 2024-10-05 14:49:17 -07:00
Leni Aniva 452c390711 Merge pull request 'feat: Collect holes in Lean file and put them into a `GoalState`' (#99) from frontend/collect-holes into dev
Reviewed-on: #99
2024-10-03 15:43:00 -07:00
Leni Aniva 10cb32e03f
Merge branch 'dev' into frontend/collect-holes 2024-10-03 11:47:38 -07:00
Leni Aniva a03eeddc9b
fix: Variable duplication in nested translation 2024-10-03 11:46:09 -07:00
Leni Aniva 530a1a1a97
fix: Extracting `sorry`s from coupled goals 2024-10-03 11:35:54 -07:00
Leni Aniva b174b4ea79 Merge pull request 'fix: Tactics should produce `.syntheticOpaque` goals' (#100) from goal/tactic into dev
Reviewed-on: #100
2024-10-03 08:47:30 -07:00
Leni Aniva ed1f96d7f7
Merge branch 'dev' into goal/tactic 2024-10-03 01:38:10 -07:00
Leni Aniva 143cd289bb
fix: Extraction of sorry's from nested tactics 2024-10-03 01:29:46 -07:00
Leni Aniva 18cd1d0388
fix: Extracting sorrys from sketches 2024-10-02 22:22:20 -07:00
Leni Aniva bec84f857b
fix: repl build failure 2024-09-09 18:43:34 -07:00
Leni Aniva fe8b259e4f
feat: Set root when there's just one mvar 2024-09-09 17:37:59 -07:00
Leni Aniva f729a357b9
Merge branch 'dev' into frontend/collect-holes 2024-09-09 17:35:10 -07:00
Leni Aniva 9075ded885
feat: Set `automaticMode` to true by default 2024-09-09 17:29:43 -07:00
Leni Aniva 9f0de0957e
doc: Update documentation for frontend command 2024-09-09 12:39:32 -07:00
Leni Aniva 762a139e78
feat: Export frontend functions 2024-09-09 12:30:32 -07:00
Leni Aniva 4f5950ed78
feat: Convert holes to goals 2024-09-09 12:26:46 -07:00
Leni Aniva 08fb53c020
test: Frontend process testing 2024-09-09 10:18:20 -07:00
Leni Aniva 8e3241c02a
refactor: Move all frontend functions to `Frontend` 2024-09-08 15:02:43 -07:00
Leni Aniva 5e99237e09
fix: Tactics should produce `.syntheticOpaque` goals 2024-09-08 14:13:39 -07:00
Leni Aniva 860344f9c5
refactor: Factor out `FrontendM` driver 2024-09-08 13:44:46 -07:00
Leni Aniva 27e4e45418 Merge pull request 'feat: Automatic Mode' (#92) from goal/automatic into dev
Reviewed-on: #92
2024-09-08 12:25:06 -07:00
Leni Aniva b645d79fda
Merge branch 'dev' into goal/automatic 2024-09-08 12:13:42 -07:00
Leni Aniva e36954a589 Merge pull request 'feat: Expose `GoalState` functions' (#94) from lib/export into dev
Reviewed-on: #94
2024-09-08 12:10:46 -07:00
Leni Aniva 414f1c70fd
Merge branch 'dev' into lib/export 2024-09-08 12:01:02 -07:00
Leni Aniva 25bb964604
test: Automatic mode testing
refactor: Simplified integration test structure
2024-09-08 11:57:39 -07:00
Leni Aniva 7c49fcff27
refactor: Un-export two field accessor functions
User should use `lean_ctor_get`
2024-09-08 11:53:54 -07:00
Leni Aniva f11c5ebaa3
doc: Add GPL License 2024-09-07 14:11:04 -07:00
Leni Aniva e4d53733d0
feat: Simplify repl 2024-09-07 14:03:29 -07:00
Leni Aniva 68dac4c951
chore: Version bump to 0.2.18 2024-09-07 13:55:41 -07:00
Leni Aniva 4042ec707e
refactor: Use `Meta.mapMetaM` 2024-09-07 13:54:52 -07:00
Leni Aniva 8394e1b468
feat: Expose `conv` and `calc` tactics 2024-09-07 13:47:55 -07:00
Leni Aniva 9b3eef35ec
fix: Forgot to include the current goals in resume 2024-09-06 22:22:19 -07:00
Leni Aniva a7b30af36b
refactor: Refactor REPL out of main library
fix: Calc previous rhs not found bug
2024-09-06 22:01:36 -07:00
Leni Aniva e2ad6ce6b3
doc: Documentation for automatic mode 2024-09-06 21:32:02 -07:00
Leni Aniva 37473b3efb
feat: Automatic mode (auto resume) 2024-09-06 21:30:11 -07:00
Leni Aniva 82d99ccf9b
refactor: Use `MVarId` across the board 2024-09-06 21:07:12 -07:00
Leni Aniva 02556f3c79
feat: Expose `GoalState` functions 2024-09-05 11:56:06 -07:00
Leni Aniva 9c40a83956
fix: Instantiate type when detecting `eq` 2024-09-03 19:05:16 -07:00
Leni Aniva f8df2599f9
fix: Use `replaceMainGoal` instead of `setGoals` 2024-09-03 14:18:47 -07:00
Leni Aniva 8d2cd6dfc7
fix: Bindings in prograde tactics 2024-09-03 14:15:52 -07:00
Leni Aniva 948b535b5d Merge pull request 'feat: Prograde tactics' (#83) from tactic/eval into dev
Reviewed-on: #83
2024-08-31 20:04:38 -07:00
Leni Aniva edec0f5733
feat: Use CoreM for diag monad 2024-08-26 13:42:14 -04:00
Leni Aniva 0c529c5cd9
Merge branch 'misc/test-driver' into tactic/eval 2024-08-18 12:24:26 -07:00
Leni Aniva 76765c913c
test: Use `lake test`. Retired `Makefile` 2024-08-18 12:22:59 -07:00
Leni Aniva 3733c10a4e
refactor: Unify call convention
Induction like tactics should return `Array InductionSubgoal`. Branching
tactics should return their branch first.
2024-08-17 16:47:21 -07:00
Leni Aniva 5d43068ec3
fix: Flake check failure 2024-08-17 02:07:17 -07:00
Leni Aniva f87eed817f
build: Move non-package output to legacyPackages 2024-08-17 01:59:48 -07:00
Leni Aniva 43e11f1ba3
refactor: Always display isInaccessible 2024-08-17 00:53:38 -07:00
Leni Aniva 0c469027c6
fix: Refactor mvar collection in assign tactic 2024-08-17 00:50:02 -07:00
Leni Aniva e1b7eaab12
fix: Let tactic not bringing binder into scope 2024-08-17 00:47:12 -07:00
Leni Aniva d17b21e282
fix: Use `getMVarsNoDelayed` 2024-08-16 00:32:34 -07:00
Leni Aniva 5b4f8a37eb
refactor: All Tactic/ tactics into MetaM form 2024-08-15 23:41:17 -07:00
Leni Aniva 1e7a186bb1
refactor: MetaM form of define (evaluate) 2024-08-15 23:23:17 -07:00
Leni Aniva 9b0456a5e0
refactor: MetaM form of have and let 2024-08-15 23:17:15 -07:00
Leni Aniva 7968072097
refactor: Remove the newMVarSet mechanism
This field has ambiguous purpose and does not account for different
types of mvars
2024-08-15 22:53:42 -07:00
Leni Aniva e07f9d9b3f
Merge branch 'dev' into tactic/eval 2024-08-15 22:45:43 -07:00
Leni Aniva 56100a30af Merge pull request 'feat: Condensed interface' (#85) from serial/expr into dev
Reviewed-on: #85
2024-08-15 22:41:58 -07:00
Leni Aniva e943a4b065
refactor: Assign into its own tactic 2024-08-15 22:39:40 -07:00
Leni Aniva 0bc7bc5856
refactor: Remove export of Lean functions
If the user wishes to use Lean functions, they should add the bindings manually.
2024-08-14 01:20:56 -07:00
Leni Aniva caac70f0cf
feat: Move non package outputs to dependencies 2024-08-04 17:52:36 -07:00
Leni Aniva 64269868d5
feat: Expose project and leanPkgs in flake 2024-08-04 17:32:20 -07:00
Leni Aniva c9ee31bbfd
feat: Export `mkFun` 2024-08-02 22:33:03 -07:00
Leni Aniva 394fb73137
feat: Add direct expression to string 2024-08-02 22:00:27 -07:00
Leni Aniva c0e2a592ea
feat: Expose `mkAppM'` 2024-08-02 21:44:46 -07:00
Leni Aniva 2c08ef1e23
refactor: Remove old `visibleFVars` interface 2024-08-02 19:53:19 -07:00
Leni Aniva 651afa75f4
feat: Filter in `visibleFVarsOfMVar` 2024-08-02 19:49:11 -07:00
Leni Aniva abef7a6f0d
feat: Export fvar names function 2024-07-31 00:00:33 -07:00
Leni Aniva caa463f410
feat: Export GoalState.goalsArray 2024-07-30 17:02:41 -07:00
Leni Aniva 3ca52517ab
feat: Refactor out projToApp 2024-07-30 13:30:41 -07:00
Leni Aniva 1c9a411d4d
feat: Export constant info type/value 2024-07-29 18:39:22 -07:00
Leni Aniva 7b5567d784
fix: Name internal order 2024-07-28 14:19:47 -07:00
Leni Aniva 29f437f859
feat: Export GoalState.create 2024-07-28 13:58:20 -07:00
Leni Aniva 4c81f226d1
feat: Expose environment functions 2024-07-28 13:46:14 -07:00
Leni Aniva 9db5463499
feat: Export `GoalState.resume` 2024-07-27 18:20:34 -07:00
Leni Aniva bf941cd686
feat: Expose parent and root expr functions 2024-07-27 17:39:51 -07:00
Leni Aniva 2682ce5b7b
refactor: Move condensed functions to condensed 2024-07-23 11:57:12 -07:00
Leni Aniva 3b415e8dc1
chore: Rename exports 2024-07-23 05:16:46 -07:00
Leni Aniva 431ca4e481
fix: Move elab context to condensed 2024-07-22 17:57:01 -07:00
Leni Aniva eb5ee8c57c
feat: Expose TermElab context and state 2024-07-22 17:34:14 -07:00
Leni Aniva 94c7b021f7
fix: Signature of ppExpr 2024-07-15 12:22:47 -07:00
Leni Aniva 193d94e798
feat: Expression creation and pretty printing 2024-07-15 11:42:02 -07:00
Leni Aniva a7fe7cbd7c
Merge branch 'misc/version' into serial/expr 2024-07-15 09:53:36 -07:00
Leni Aniva df8b6602ee
Merge branch 'misc/version' into tactic/eval 2024-07-06 20:00:12 -07:00
Leni Aniva 9b1dd0ffda
chore: Update flake 2024-07-06 19:58:55 -07:00
Leni Aniva 4549ae1f65
Merge branch 'misc/version' into tactic/eval 2024-07-06 19:56:31 -07:00
Leni Aniva c404564a2b
chore: Bump Lean version to 4.10.0-rc1 2024-07-06 19:53:50 -07:00
Leni Aniva 6ddde2963d
test: Eval instantiate 2024-06-27 14:51:16 -04:00
Leni Aniva fc0d872343
refactor: Simplify proof test infrastructure 2024-06-27 14:34:21 -04:00
Leni Aniva 2d2ff24017
feat: FFI interface for `evaluate` tactic 2024-06-25 17:10:31 -04:00
Leni Aniva 7acf1ffdf1
refactor: Move `have` to prograde tactic 2024-06-25 16:58:35 -04:00
Leni Aniva 58f9d72288
test: Evaluate tactic context 2024-06-25 16:18:31 -04:00
Leni Aniva c0124b347f
Merge branch 'serial/expr' into tactic/eval 2024-06-25 16:05:20 -04:00
Leni Aniva 8e78718447
feat: Extract MetaM context and state from goal 2024-06-25 15:54:55 -04:00
Leni Aniva ffbea41f62
feat: Condensed interface 2024-06-25 15:13:58 -04:00
Leni Aniva e282d9f781
test: Evaluation tactic 2024-06-25 11:03:08 -04:00
Leni Aniva 25a7025c25
feat: Evaluation tactic 2024-06-23 15:01:51 -07:00
Leni Aniva 472cd54868 Merge pull request 'refactor: Cleanup the congruence tactics' (#81) from tactic/congruence into dev
Reviewed-on: #81
2024-06-23 13:35:36 -07:00
Leni Aniva fbe6e8fcb3
Merge branch 'dev' into tactic/congruence 2024-06-23 13:35:07 -07:00
Leni Aniva 361e2e8926 Merge pull request 'fix: aux lemmas in env inspect' (#82) from env/inspect into dev
Reviewed-on: #82
2024-06-23 13:33:35 -07:00
Leni Aniva aceee85b05
Merge branch 'env/inspect' into tactic/congruence 2024-06-16 13:46:18 -07:00
Leni Aniva 8707dbc9bb
fix: aux lemmas in env inspect 2024-06-16 13:44:57 -07:00
Leni Aniva f80d90ce87
fix: Goal diag missing newline character 2024-06-14 11:59:02 -07:00
Leni Aniva b3a60fcea8
refactor: Rename TacticExecute to SyntheticTactic 2024-06-13 14:25:05 -07:00
Leni Aniva bd20bf76da Merge pull request 'feat: Elementarized tactics with motives, congruence, and absurdity' (#72) from goal/mapply into dev
Reviewed-on: #72
2024-06-12 13:52:45 -07:00
Leni Aniva 2d2cf75183
Merge branch 'dev' into goal/mapply 2024-06-12 13:44:49 -07:00
Leni Aniva c0e6e3ec39
Merge branch 'parse/level' into goal/mapply 2024-06-11 15:21:35 -07:00
Leni Aniva 773a0afbd8
feat: Handling of universe level names in elab 2024-06-11 12:44:42 -07:00
Leni Aniva 3a53493089
feat: Show delayed assignment in goal diag 2024-06-05 16:14:52 -07:00
Leni Aniva 6dcff8b151
fix: Print diag in mvar context 2024-06-05 15:56:20 -07:00
Leni Aniva 3c90c94645
fix: Execute instantiateAll in goal state diag 2024-06-05 13:45:13 -07:00
Leni Aniva 67e7f22b0a Merge pull request 'feat: Extraction of tactics from compiler' (#76) from compile/tactic into dev
Reviewed-on: #76
2024-05-31 20:23:50 -07:00
Leni Aniva a2c5c7448c
chore: Code simplification, version bump 2024-05-31 20:23:10 -07:00
Leni Aniva 855e771609
feat: Add compilation unit boundary command 2024-05-31 16:35:46 -07:00
Leni Aniva b9b16ba0e9
refactor: Code cleanup 2024-05-28 20:24:23 -07:00
Leni Aniva 09628309a9
feat: Basic tactic extraction (before/after/tactic) 2024-05-28 17:25:22 -07:00
Leni Aniva bd42c396d7
chore: Code cleanup 2024-05-20 14:19:10 -07:00
Leni Aniva bbc00cbbb8
feat: Congruence tactic FFI interface and tests 2024-05-20 14:00:04 -07:00
Leni Aniva 75df7268c5
test: Simplify testing structure for tactics 2024-05-20 11:55:38 -07:00
Leni Aniva 92acf7782c
test: CongruenceArg tactic 2024-05-20 11:51:35 -07:00
Leni Aniva cf1c884c8c
Merge branch 'dev' into goal/mapply 2024-05-20 11:08:14 -07:00
Leni Aniva cc74d41b15
feat: Congruence tactics 2024-05-20 10:55:52 -07:00
Leni Aniva 2f951c8fef
fix: Decoupling of mvars during instantiation 2024-05-19 15:43:10 -07:00
Leni Aniva 0aec757601 Merge pull request 'doc: README.md fix' (#73) from doc/readme into dev
Reviewed-on: #73
2024-05-17 20:33:18 -07:00
Leni Aniva e05c01109c
Merge branch 'dev' into doc/readme 2024-05-17 20:32:56 -07:00
Leni Aniva e165e41efa
chore: Version bump to v4.8.0-rc1 2024-05-17 20:31:45 -07:00
Leni Aniva 6ad24b72d4
fix: Nested delayed assignment instantiation 2024-05-16 10:31:38 -07:00
Leni Aniva cf17428001
fix: Panic in partial instantiation 2024-05-15 21:34:36 -07:00
Leni Aniva 5c7bb288b2
feat: Display full free variable list in subst 2024-05-14 19:09:04 -07:00
Leni Aniva bc09f4a29d
refactor: Expr related functions to Expr.lean 2024-05-13 13:58:50 -07:00
Leni Aniva f813d4a8dd
refactor: Delayed mvar instantiation function 2024-05-13 13:49:05 -07:00
Leni Aniva c04b363de7
feat: Handle delay assigned mvars 2024-05-12 22:33:38 -07:00
Leni Aniva 03ecb6cf19
feat: Partial instantiate metavariables 2024-05-11 20:01:34 -07:00
Leni Aniva 0b88f6708e
test: Delayed mvar assignment for mapply 2024-05-09 14:02:43 -07:00
Leni Aniva e58dbc66a9
fix: Consistent naming in library functions 2024-05-08 20:51:36 -07:00
Leni Aniva 66a5dfcf3c
feat: Diagnostics command for FFI users 2024-05-08 12:41:21 -07:00
Leni Aniva 69ec70ffbe
feat: Do not explicitly show delay assigned mvar 2024-05-06 22:39:17 -07:00
Leni Aniva aa106f7591
feat: Do not filter mvars from mapply 2024-05-06 22:20:20 -07:00
Leni Aniva 679871cbc6
fix: NoConfuse arg name 2024-05-05 13:26:46 -07:00
Leni Aniva 2937675044
feat: Library interface for calling no_confuse 2024-05-05 13:25:48 -07:00
Leni Aniva cf1289f159
feat: NoConfuse tactic 2024-05-05 13:24:29 -07:00
Leni Aniva 1e1995255a
test: mapply captures dependent types 2024-05-05 10:36:43 -07:00
Leni Aniva 63417ef179
fix: Motive extra arguments not instiantiated 2024-05-05 00:43:32 -07:00
Leni Aniva 4cff6677d2
chore: Lean version bump to 4.8.0-rc1 2024-05-04 23:36:42 -07:00
Leni Aniva 6ffb227cd6
feat: Conduit modus ponens 2024-04-22 10:02:09 -07:00
Leni Aniva feff62a3c5
fix: Remove determination of major 2024-04-22 09:52:13 -07:00
Leni Aniva 3812aa56ec
feat: Phantom var in mapply 2024-04-22 00:11:41 -07:00
Leni Aniva 4a92e655f6
test: Tactic test stub 2024-04-20 13:09:41 -07:00
Leni Aniva 398b1c39ed
refactor: Common tactic execute function 2024-04-19 12:37:17 -07:00
Leni Aniva fec13ddb51
chore: Code cleanup 2024-04-18 14:19:25 -07:00
Leni Aniva 7531ad628c
doc: Documentation about conditional arguments 2024-04-15 20:00:59 -07:00
Leni Aniva 52e5b5df50
doc: README.md fix 2024-04-15 19:57:05 -07:00
Leni Aniva 7aa7e6d7e9
feat: Library interface for mapply 2024-04-15 12:56:28 -07:00
Leni Aniva dbd54f7679
feat: Implement the mapply tactic 2024-04-15 12:47:02 -07:00
Leni Aniva 75b4648ba9
feat: mapply stub 2024-04-14 15:40:57 -07:00
Leni Aniva b954f12526
refactor: Move all tactic operations to the bottom 2024-04-13 19:41:49 -07:00
Leni Aniva adbb07af2d
fix: Option setting in REPL 2024-04-12 22:39:47 -07:00
Leni Aniva 72dd20ea87 Merge pull request 'feat: Let tactic' (#70) from goal/let into dev
Reviewed-on: #70
2024-04-12 21:42:32 -07:00
Leni Aniva 614b9aa4ae
Merge branch 'dev' into goal/let 2024-04-12 21:41:56 -07:00
Leni Aniva b45b90b810
test: Metavariable name matches in let 2024-04-12 21:41:16 -07:00
Leni Aniva 07094730b7 Merge pull request 'feat: Option to collect dependent metavariables' (#69) from serial/goal into dev
Reviewed-on: #69
2024-04-12 21:33:00 -07:00
Leni Aniva 77907fd060
feat: `goalLet` function 2024-04-12 21:30:56 -07:00
Leni Aniva 4ee955c21f
test: Tests the `let` tactic 2024-04-12 21:16:00 -07:00
Leni Aniva 4b01af7cef
Merge branch 'dev' into serial/goal 2024-04-12 20:52:38 -07:00
Leni Aniva 00a3613036 Merge pull request 'fix: Prevent incorrect inheritance of calc rhs' (#66) from goal/calc into dev
Reviewed-on: #66
2024-04-12 20:52:17 -07:00
Leni Aniva e5d55e31ff
feat: Print expression dependent mvars 2024-04-12 20:51:54 -07:00
Leni Aniva 8e377c2092
refactor: CamelCase rename 2024-04-12 16:34:21 -07:00
Leni Aniva 991ee5ad94
refactor: Rename functions to camel case 2024-04-12 12:37:37 -07:00
Leni Aniva 7a4d462a87
Merge branch 'dev' into goal/calc 2024-04-11 17:58:45 -07:00
Leni Aniva 4d4f660f3f
chore: Update version 2024-04-11 17:57:24 -07:00
Leni Aniva a864c4d3ff
refactor: Code simplification 2024-04-11 16:29:47 -07:00
Leni Aniva e834765896
refactor: Code simplification 2024-04-11 16:25:17 -07:00
Leni Aniva dc6e79def7
doc: Update error message in interaction 2024-04-11 16:18:04 -07:00
Leni Aniva 036fab0ad6
fix: Prevent incorrect inheritance of calc rhs 2024-04-11 16:15:58 -07:00
Leni Aniva f20ee8dc87 Merge pull request 'feat: Add support for the `have`, `conv`, and `calc` tactics' (#59) from goal/have-conv-calc into dev
Reviewed-on: #59
2024-04-11 15:36:19 -07:00
Leni Aniva a41b95e540 Merge branch 'dev' into goal/have-conv-calc 2024-04-11 15:35:30 -07:00
Leni Aniva a11df9f2e9 feat: Print recursor rules 2024-04-11 15:35:14 -07:00
Leni Aniva ed220bc7fb doc: New tactics in README.md 2024-04-11 15:13:12 -07:00
Leni Aniva 7eb5419f36 feat: REPL interface for `calc` 2024-04-11 15:11:10 -07:00
Leni Aniva 6d85c19589 feat: Add library bindings for calc 2024-04-11 15:04:36 -07:00
Leni Aniva 6b44d9ef14 fix: Remove `calcPrevRhs?` in non-calc tactics 2024-04-11 15:03:14 -07:00
Leni Aniva 535770bbd7 feat: Calc tactic 2024-04-11 14:59:55 -07:00
Leni Aniva 823c9635c7 fix: Leading element in .proj sexp 2024-04-09 10:06:26 -07:00
Leni Aniva 55b44c3fa1 fix: Serialization of .proj 2024-04-09 10:03:36 -07:00
Leni Aniva 30c1fd894f fix: Coupling from unrelated goals 2024-04-09 09:11:15 -07:00
Leni Aniva f02f9592d7 feat: Focus command 2024-04-08 13:12:51 -07:00
Leni Aniva 0e63583a1d refactor: Monads in library 2024-04-08 12:54:02 -07:00
Leni Aniva d4e49310f0 feat: FFI interface to conv functions 2024-04-08 12:50:41 -07:00
Leni Aniva 2f48cfbc19 doc: Remove outdated comments 2024-04-08 12:45:03 -07:00
Leni Aniva 22bb818a1c refactor: Use the `tactic interface for `conv 2024-04-08 12:32:27 -07:00
Leni Aniva 63e64a1e9f feat: Conv tactic functions 2024-04-08 12:26:22 -07:00
Leni Aniva 7af24a4f0a Merge branch 'dev' into goal/have-conv-calc 2024-04-08 10:38:18 -07:00
Leni Aniva 09189ce600 perf: Lazy run print monads 2024-04-08 10:32:13 -07:00
Leni Aniva 19d2f5ff3f feat: Conv tactic mode 2024-04-07 17:03:49 -07:00
Leni Aniva d50720f622 refactor: Metavariable set diff function 2024-04-07 14:32:25 -07:00
Leni Aniva d9ed051b4d feat: Partial implementation of `conv` 2024-04-07 14:22:20 -07:00
Leni Aniva 38cb91652f Merge branch 'dev' into goal/have-conv-calc 2024-04-06 22:04:52 -07:00
Leni Aniva 013cb8bb57 Merge pull request 'fix: Auto bound implicit in elab' (#60) from elab/level into dev
Reviewed-on: #60
2024-04-06 22:04:31 -07:00
Leni Aniva 7fe73551c3 feat: The `have` tactic 2024-04-06 21:52:25 -07:00
Leni Aniva 5a60ca74d5 fix: Auto bound implicit in elab 2024-04-06 17:45:36 -07:00
Leni Aniva 41cb3f68cd test: Tests for conv and calc 2024-04-06 17:22:09 -07:00
Leni Aniva 058f5a98b2 feat: Bindings for the `have` tactic 2024-04-06 16:40:22 -07:00
Leni Aniva 1b7b6a644b feat: `GoalState.tryHave` tactic (tests failing) 2024-04-06 16:33:20 -07:00
Leni Aniva 042dc8f530 doc: Documentation for `nix flake check` 2024-04-06 14:15:58 -07:00
Leni Aniva 92351c9a3d test: Move parallelism to Test/Main.lean 2024-04-06 14:14:30 -07:00
Leni Aniva 8a447e67cd test: Parallel testing infrastructure 2024-04-06 14:07:13 -07:00
Leni Aniva ed196494c1 Merge pull request 'feat: Instantiate mvars during echo' (#56) from expr/echo into dev
Reviewed-on: #56
2024-03-31 17:10:29 -07:00
Leni Aniva 8b43dc0f25 feat: Instantiate mvars during echo 2024-03-31 17:09:24 -07:00
Leni Aniva 744c9ee286 Merge pull request 'feat: Specify type in echo' (#55) from expr/echo into dev
Reviewed-on: #55
2024-03-31 16:45:43 -07:00
Leni Aniva 9c8cc33e07 Merge pull request 'fix: Instantiation causes infinite loop' (#54) from output/expr into dev
Reviewed-on: #54
2024-03-31 16:43:53 -07:00
Leni Aniva 216bb9e920 test: Library test 2024-03-31 16:43:30 -07:00
Leni Aniva f462843218 docs: Update README.md 2024-03-31 16:12:23 -07:00
Leni Aniva a1ed8f4b3d refactor: Use library functions when possible 2024-03-31 16:11:41 -07:00
Leni Aniva 7988a25ce8 refactor: Use library goalStartExpr function 2024-03-31 16:06:30 -07:00
Leni Aniva 2802cc204f feat: Specify type in echo 2024-03-31 15:55:08 -07:00
Leni Aniva e9c9548f17 fix: unfoldAuxLemma should be coreM 2024-03-31 15:40:14 -07:00
Leni Aniva 2b71203c1e fix: Instantiation causes infinite loop 2024-03-30 00:17:16 -07:00
Leni Aniva f939388dbf Merge pull request 'feat: Instantiation tests' (#52) from io/serial into dev
Reviewed-on: #52
2024-03-30 00:08:32 -07:00
Leni Aniva 2c48ff9e42 Merge branch 'dev' into io/serial 2024-03-30 00:07:46 -07:00
Leni Aniva 621b10c354 Merge pull request 'fix: Build failure on macOS due to LLVM version' (#53) from misc/toolchain into dev
Reviewed-on: #53
2024-03-30 00:07:26 -07:00
Leni Aniva 73e4c1d81c doc: Reason why not to follow nixpkgs 2024-03-30 00:03:37 -07:00
Leni Aniva 7f6b57bc08 Merge branch 'dev' into misc/toolchain 2024-03-30 00:01:24 -07:00
Leni Aniva 140055b16b fix: Update flake so lean builds on Darwin 2024-03-29 23:59:14 -07:00
Leni Aniva 1bea2ca4e1 fix: Lean build failure on macOS 2024-03-29 23:50:30 -07:00
Leni Aniva e09a6c7c9d Merge pull request 'feat: Query arbitrary assignment in goal' (#47) from goal/relation into dev
Reviewed-on: #47
2024-03-29 23:48:20 -07:00
Leni Aniva 10e6877f0e Merge branch 'dev' into goal/relation 2024-03-29 23:47:09 -07:00
Leni Aniva 252f85e66c feat: Instantiation tests
Note that delay assigned metavariables are not instantiated.
2024-03-29 23:46:08 -07:00
Leni Aniva 14011945a0 Merge pull request 'chore: Version bump and toolchain cleanup' (#51) from misc/toolchain into dev
Reviewed-on: #51
2024-03-28 22:36:25 -07:00
Leni Aniva 2ea8b1c73c Merge branch 'dev' into misc/toolchain 2024-03-28 22:35:48 -07:00
Leni Aniva 431e81ca2f Merge pull request 'feat: Remove display of implementation details' (#50) from io/serial into dev
Reviewed-on: #50
2024-03-28 22:35:37 -07:00
Leni Aniva cfd74aba91 build: Dev shell 2024-03-28 22:26:46 -07:00
Leni Aniva 4a1114ab00 build: Ignore test files when building target 2024-03-28 22:23:19 -07:00
Leni Aniva 4a89aaf70e doc: Main README.md 2024-03-28 22:12:11 -07:00
Leni Aniva 46faa5c089 chore: Version bump 2024-03-28 22:08:22 -07:00
Leni Aniva e79e386b39 test: Catalog has no numeric symbols 2024-03-28 20:44:09 -07:00
Leni Aniva 8fa1a7d383 feat: Stop cataloging internal/detail dependencies 2024-03-28 19:49:44 -07:00
Leni Aniva 9e68a9cae4 test: Elimination of aux lemmas 2024-03-28 19:27:45 -07:00
Leni Aniva a698a4250f feat: Unfold aux lemmas when printing root expr 2024-03-28 18:56:42 -07:00
Leni Aniva 47fabf333b doc: Update README.md 2024-03-28 11:37:07 -07:00
Leni Aniva 62d20be841 build: Nix build targets and checks 2024-03-28 11:33:15 -07:00
Leni Aniva 516ab15961 feat: Bump toolchain version 2024-03-28 00:06:35 -07:00
Leni Aniva f016d60d07 chore: Version bump to 0.2.13 2024-03-16 19:00:28 -07:00
Leni Aniva aae19ec942 chore: Version bump to 4.8.0 prerelease 2024-03-15 18:44:28 -07:00
Leni Aniva 81aabc52ea chore: Lean version bump to 4.7.0-rc2
Multithreading in ABI was not stabilized in 4.1.0
2024-03-15 06:01:25 -07:00
Leni Aniva e6dbf88ce2 fix: Use Arrays only in the ABI 2024-03-14 22:40:14 -07:00
Leni Aniva 3debcc021a feat(lib): Export goal.print function 2024-03-14 16:34:01 -07:00
Leni Aniva 4eec930dd4 fix: Pass options by reference 2024-03-11 21:31:59 -07:00
Leni Aniva ef864ea16d feat(lib): Option creation function 2024-03-10 15:33:32 -07:00
Leni Aniva 0b91c41ad2 fix: Execute expr parsing within goal.start 2024-03-10 15:09:38 -07:00
Leni Aniva a5b0721482 feat(lib): Expose goal state interface 2024-03-10 08:13:10 -07:00
Leni Aniva 996f16bbb8 feat(lib): CoreM execution function 2024-03-10 06:41:35 -07:00
Leni Aniva f18a9dd1d5 refactor: Move some functions to `Library.lean` 2024-03-09 20:37:48 -08:00
Leni Aniva eeb149a32c feat(lib): Search path function 2024-03-09 19:36:25 -08:00
Leni Aniva 2ad7ad8778 feat(lib): Catalog command FFI 2024-03-09 16:50:36 -08:00
Leni Aniva 7bc0f82654 feat: Add exported version function 2024-03-08 23:50:44 -08:00
Leni Aniva 267d635c05 feat(build): Add shared facet for lean_lib 2024-03-06 15:27:22 -08:00
Leni Aniva 93b7d8b67d feat: Output shared library in flake 2024-03-06 15:26:35 -08:00
Leni Aniva 7e28ded23f test: More diagnostics for tests 2024-03-06 15:14:08 -08:00
Leni Aniva cb0712ccf6 Merge pull request 'feat: Print parent expression assignment' (#45) from goal/relation into dev
Reviewed-on: #45
2024-02-15 14:55:02 -08:00
Leni Aniva 111781816f test: Delayed metavariable assignment 2024-02-15 14:47:09 -08:00
Leni Aniva 18c318cb73 Merge branch 'dev' into goal/relation 2024-02-15 14:39:30 -08:00
Leni Aniva 0254759581 Merge pull request 'feat: Add leanpkgs to the flake output' (#46) from nix/toolchain into dev
Reviewed-on: #46
2024-02-15 14:30:30 -08:00
Leni Aniva df4e044e5f chore: Expose `leanPkgs` in flake 2024-02-13 15:30:56 -05:00
Leni Aniva 5f5d06f1d8 feat: Add lake and lean to the package output 2024-02-05 11:50:22 -08:00
Leni Aniva 4acd367ca7 chore: Version bump to 0.2.12-alpha 2024-01-30 17:45:32 -08:00
Leni Aniva fe5c1eda7d feat: Prevent crash during rootExpr call 2024-01-30 17:22:20 -08:00
Leni Aniva 40d61fecc5 doc: Correct comment about parent filling expr 2024-01-30 16:37:35 -08:00
Leni Aniva 25f3a2f19d feat: Print parent expression assignment 2024-01-24 18:19:04 -08:00
Leni Aniva d5ef05a7b0 Merge pull request 'test: Option controlled mvar instantiation' (#44) from goal/diag into dev
Reviewed-on: #44
2024-01-17 22:27:44 -08:00
Leni Aniva 34d9b02797 Merge branch 'dev' into goal/diag 2024-01-17 14:03:19 -08:00
Leni Aniva 30eda7ef8c Merge pull request 'feat: Print inductives, constructors, and recursors in env.inspect' (#43) from env/inspect into dev
Reviewed-on: #43
2024-01-17 14:02:55 -08:00
Leni Aniva 6a81d83c1f test: Option controlled mvar instantiation 2024-01-16 16:44:54 -08:00
Leni Aniva 50ac2fea4b feat: Print constructor and recursor info 2024-01-16 14:11:52 -08:00
Leni Aniva 6fb1b2e787 feat: Print inductives in env.inspect 2024-01-16 13:29:30 -08:00
Leni Aniva 6692303da6 test: Simplify monad execution 2024-01-07 14:14:20 -08:00
Leni Aniva a8bfa56587 Merge pull request 'feat: Add definitions and theorems to the environment' (#41) from env/add-decl into dev
Reviewed-on: #41
2023-12-26 12:41:01 -08:00
Leni Aniva 1c370ef2ae refactor: Rename Test/{Catalog,Environment} 2023-12-26 12:22:57 -05:00
Leni Aniva dc90b6b73e chore: Move environment functions to its own file
Symbol.lean is now subsumed
2023-12-15 13:40:36 -05:00
Leni Aniva da194a1165 refactor: env. operations into its own file 2023-12-15 13:37:55 -05:00
Leni Aniva aef93cf506 fix: Force instantiate all mvars in env.add 2023-12-15 13:07:59 -05:00
Leni Aniva a540dd4540 test: env.add 2023-12-14 11:11:24 -08:00
Leni Aniva 85eb42207c fix: env_add monads 2023-12-14 05:52:12 -08:00
Leni Aniva 69be7c3920 Merge branch 'dev' into env/add-decl 2023-12-14 05:48:49 -08:00
Leni Aniva 83ff58dffc Merge pull request 'feat: Change the main interaction monad' (#40) from core/loop into dev
Reviewed-on: #40
2023-12-14 05:46:39 -08:00
Leni Aniva 3c96a7c0ea feat: env_add command 2023-12-13 19:35:32 -08:00
Leni Aniva ff4671cdd0 chore: Rename lib. commands to env.
This is done to improve clarity and align with Lean's terminology
2023-12-12 18:56:25 -08:00
Leni Aniva 085b12c255 feat: Use CoreM as the main interaction monad 2023-12-12 18:39:02 -08:00
Leni Aniva ac9f6f810c doc: TermElabM metavariable generation 2023-12-08 17:32:30 -08:00
Leni Aniva bd0c66facc fix: Consolidate TermElabM blocks 2023-12-08 17:31:25 -08:00
Leni Aniva 2fe4fa9bc4 fix: Change the main interaction monad to MetaM 2023-12-08 16:17:16 -08:00
Leni Aniva d7fcc502f9 chore: Version downgrade to 0.2.10-alpha
There is a currently known bug
2023-12-07 12:38:02 -08:00
Leni Aniva 94c4b2cfe3 Merge pull request 'fix: Printing projection leads to crash' (#37) from io/sexp into dev
Reviewed-on: #37
2023-12-07 12:33:01 -08:00
Leni Aniva 924a67f46d doc: getUsedConstants bug about projections 2023-12-06 15:05:04 -08:00
Leni Aniva 8a8db545a5 fix: Printing projection leads to crash 2023-12-05 22:45:59 -08:00
Leni Aniva f2b54ec018 Merge pull request 'feat: Handling of private names' (#36) from library/catalog into dev
Reviewed-on: #36
2023-12-05 20:22:38 -08:00
Leni Aniva 3c2d93259f Merge branch 'dev' into library/catalog 2023-12-05 20:21:22 -08:00
Leni Aniva 079f12d6d3 chore: Version bump 2023-12-05 20:21:07 -08:00
Leni Aniva d846210b9e Merge pull request 'feat: Print structural projection as application' (#35) from io/serial into dev
Reviewed-on: #35
2023-12-05 20:20:51 -08:00
Leni Aniva dbfee00420 feat!: Display public name only if name is private 2023-12-05 20:20:08 -08:00
Leni Aniva cdb1e8576f feat: Display whether a symbol is private 2023-12-05 19:07:00 -08:00
Leni Aniva c80d7567b6 feat: Expose _private names 2023-12-04 23:36:09 -08:00
Leni Aniva f72a82a4c9 feat: Remove stem deduce
Some private subproofs are not shown in the catalog and this breaks
dependencies
2023-12-04 16:40:15 -08:00
Leni Aniva 35f411041e feat: Remove printing projections 2023-12-04 16:21:02 -08:00
Leni Aniva 860d2e239a feat: Remove | in symbol output 2023-11-27 09:54:41 -08:00
Leni Aniva e0cfdfaf16 chore: Version bump to 0.2.9 2023-11-26 23:48:47 -08:00
Leni Aniva fe850ded98 feat: Shorter symbol category 2023-11-26 22:14:58 -08:00
Leni Aniva aaebb6b121 feat: Read dependencies of library symbols 2023-11-25 15:07:56 -08:00
Leni Aniva a1d991f5db fix: Rectify error format 2023-11-09 22:24:17 -08:00
Leni Aniva cc9e659c06 Merge pull request 'feat: Allow selective continuation of goals' (#27) from goal/continuation into dev
Reviewed-on: #27
2023-11-07 16:49:55 -08:00
Leni Aniva a491316541 fix: Do not show parent state in continue 2023-11-07 13:10:14 -08:00
Leni Aniva e654613182 fix: New goal state not inserted correctly 2023-11-07 13:07:50 -08:00
Leni Aniva d35803791e Merge branch 'dev' into goal/continuation 2023-11-07 12:11:14 -08:00
Leni Aniva d9745094fa fix: Remove the error prone SemihashMap 2023-11-07 12:09:54 -08:00
Leni Aniva 53b63bf46c fix: Remove the error prone SemihashMap 2023-11-07 12:04:17 -08:00
Leni Aniva 4396da3e65 chore: Code formatting 2023-11-06 12:20:08 -08:00
Leni Aniva ce585f7288 feat: Print the root mvar name 2023-11-06 11:51:31 -08:00
Leni Aniva 32fedede6a Merge branch 'dev' into goal/continuation 2023-11-06 11:45:24 -08:00
Leni Aniva 8182da436d chore: Remove unnecessary unsafe's 2023-11-06 11:43:57 -08:00
Leni Aniva c6bb4be597 chore: Update documentation 2023-11-06 11:04:28 -08:00
Leni Aniva ce1cb13e54 fix: Use Lean's built in name parser
The `str_to_name` parser cannot handle numerical names and escapes.
2023-11-06 10:45:11 -08:00
Leni Aniva a5b5e01858 chore: Version bump to 0.2.8 2023-11-04 15:54:28 -07:00
Leni Aniva 4be9dbc84a feat: Goal continuation fails if target has goals 2023-11-04 15:53:57 -07:00
Leni Aniva 97d658cfc5 feat: Add goal.continue command 2023-11-04 15:51:09 -07:00
Leni Aniva 333355a85d feat: Partial state continuation 2023-11-04 15:33:53 -07:00
Leni Aniva 4a4a33cea7 test: Separate mvar coupling tests 2023-11-04 15:01:41 -07:00
Leni Aniva 1638c308a9 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 59ac83f0b7 bug: Fix quote escape problem 2023-10-30 14:45:43 -07:00
Leni Aniva d1c0dc376f feat: Print metavariable name in goal 2023-10-30 14:44:06 -07:00
Leni Aniva 6cf328a84f 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 1a99a2e7b2 fix: Sanitize name in universe levels 2023-10-29 13:03:48 -07:00
Leni Aniva 60854525b9 feat: Simplify printing of function applications 2023-10-29 12:50:36 -07:00
Leni Aniva e523e8bcc6 chore: Version bump (breaking change) 2023-10-29 11:57:24 -07:00
Leni Aniva de250eafd0 feat: Print names in one segment separated with . 2023-10-29 11:56:56 -07:00
Leni Aniva c0dfa04b18 feat: Simplify name printing 2023-10-29 11:18:35 -07:00
Leni Aniva 4ce932eb3b 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 045181356c feat: Add REPL function for root expression 2023-10-27 15:41:12 -07:00
Leni Aniva 41e1f64d44 Merge branch 'dev' into goal/dependency 2023-10-27 15:33:47 -07:00
Leni Aniva 3b1746490d feat: Add REPL command for assigning an expression 2023-10-27 15:32:59 -07:00
Leni Aniva f064bb21a4 feat: Assigning a goal with an expression 2023-10-27 15:15:22 -07:00
Leni Aniva 269e5c707c refactor: Separate goal printing and processing
Added a test for delta proof variables
2023-10-26 22:47:42 -07:00
Leni Aniva c852db2f46 test: m-coupled goals 2023-10-26 11:22:02 -07:00
Leni Aniva 8029298db7 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 d991533170 feat: Add proof continue and root extraction 2023-10-25 16:03:45 -07:00
Leni Aniva a9294e0338 Add documentation about flake 2023-10-20 12:54:35 -07:00
Leni Aniva 3d7d5d6b4d feat: Add nix flake 2023-10-20 12:41:56 -07:00
Leni Aniva 538ba6e7d7 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 41db295ff5 Rename tactic to goal and restructure 2023-10-15 12:31:22 -07:00
Leni Aniva 7a5fe554ba Add holes test stub
Move tests into their own namespaces
2023-10-06 17:31:36 -07:00
Leni Aniva 13f3460e9a Fix test failures 2023-10-05 17:51:41 -07:00
Leni Aniva a8cf94ccb1 Bump Lean version to 4.1.0 2023-10-05 17:49:43 -07:00
Leni Aniva 0948e71d60 Add dependency for lakefile and lean-toolchain 2023-10-02 10:30:58 -07:00
Leni Aniva 6d15d1e670 Use makefile instead of ad-hoc script 2023-10-02 10:26:19 -07:00
Leni Aniva 35b391881e Add ready message to indicate the main loop is up 2023-10-02 10:14:03 -07:00
Leni Aniva d7077ce854 Bump lean version to 4.0.0 2023-09-13 21:02:26 -07:00
Leni Aniva 75f43786fb 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 f538f580bd Merge branch 'dev' into tactic/book 2023-08-30 19:17:25 -07:00
Leni Aniva f1f1c20ff9 Add SemihashMap interface, rename proof commands to goal commands, allow deletion 2023-08-30 19:16:33 -07:00
Leni Aniva 6b96f7893f Separate max and imax in sort level 2023-08-27 22:50:18 -07:00
Leni Aniva b98304f78a Version bump to 0.2.4 due to breaking change 2023-08-27 19:59:31 -07:00
Leni Aniva a6e337a89e Rename proof commands to goal commands 2023-08-27 19:58:52 -07:00
Leni Aniva a86af1bc57 Add SemihashMap structure for goal bookkeeping 2023-08-27 19:53:09 -07:00
Leni Aniva b74119e378 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
Leni Aniva 9c4c43a9f1 Remove the obsolete name field from proof tree structure 2023-08-26 18:50:15 -07:00
Leni Aniva bd4fbcc369 Add test cases for command error categories 2023-08-24 23:12:18 -07:00
Leni Aniva ff8fed8741 Classify JSON error as command error
Also add documentation for this
2023-08-24 22:51:40 -07:00
Leni Aniva 98edaa3297 Merge pull request 'Add more serialisation options' (#2) from io/serial into dev
Reviewed-on: #2
2023-08-23 13:29:00 -07:00
Leni Aniva 1f27532769 Merge branch 'dev' into io/serial 2023-08-23 13:25:08 -07:00
Leni Aniva 0c330c8778 Unify json and unknown error into command error 2023-08-23 13:00:11 -07:00
Leni Aniva 59c046efc6 Add proper printing of sorts 2023-08-23 12:51:06 -07:00
Leni Aniva a8cbb3be4f Move all json-string functions to Main.lean 2023-08-22 09:54:37 -07:00
Leni Aniva 96cbbf2551 Add compressed json print option; Rearrange commands into hierarchy 2023-08-16 19:25:32 -07:00
Leni Aniva b2ba26528d Add proof variable delta; Bump version to 0.2.1 2023-08-15 15:40:54 -07:00
Leni Aniva 7771408de1 Add expression sexp printing (2/2) 2023-08-14 21:43:40 -07:00
Leni Aniva 9eadd1d4d4 Add expression sexp printing (1/2, tests pending) 2023-08-14 17:07:53 -07:00
Leni Aniva 5cedb9d88c version bump, restructure 2023-08-13 21:19:06 -07:00
Leni Aniva 622aa7f969 Add documentation; Remove mathlib dependency 2023-06-09 14:45:45 -07:00
Leni Aniva 4613777607 Add json goal printing 2023-05-27 23:10:39 -07:00
Leni Aniva 3e05722d1e Add back the clear command to reset state 2023-05-26 16:55:33 -07:00
Leni Aniva 068a188fea Add expr.type 2023-05-25 13:40:03 -07:00
Leni Aniva e0c5f76451 Rename tactic failure mode to avoid confusion
Clean up README
2023-05-24 23:11:17 -07:00
Leni Aniva da1cdf3d16 Update gitignore to exclude hidden files 2023-05-24 09:32:19 -07:00
Leni Aniva 1ed1aff7c9 Add documentation about options 2023-05-24 00:55:54 -07:00
Leni Aniva 95ed7d115c Add expression binding printing and import Lean 2023-05-24 00:54:48 -07:00
Leni Aniva 1fed222f56 Use TermElabM as the main monad stack instead of IO 2023-05-23 05:12:46 -07:00
Leni Aniva 94bc3355a2 Save core state in proofs 2023-05-22 22:48:48 -07:00
Leni Aniva ba779766c0 Rename ids so they are consistent 2023-05-22 19:51:16 -07:00
Leni Aniva 1ad45f650f Remove testing stub in README.md 2023-05-22 19:12:07 -07:00
Leni Aniva 0f8df08dd5 Add module name for symbol 2023-05-22 16:00:41 -07:00
Leni Aniva 116c7ff4c6 Add option id handling with ? 2023-05-22 14:56:43 -07:00
Leni Aniva 6a71dad389 Add option format for proof output and test cases 2023-05-22 14:49:56 -07:00
Leni Aniva 1bf929b1e4 Add testing stub 2023-05-22 11:47:46 -07:00
Leni Aniva 46ccad1669 Add default arguments for Json 2023-05-22 00:49:37 -07:00
Leni Aniva 76d76630ee Add manifest file 2023-05-21 23:30:41 -07:00
Leni Aniva 083ec8beec Add REPL tactics 2023-05-21 17:41:39 -07:00
Leni Aniva 15aab3d31f Remove ExceptT from main monad
Allow pretty printing of expr
2023-05-20 15:58:38 -07:00
Leni Aniva 2a4d348aab Add expression IO stub for constant types 2023-05-20 14:04:09 -07:00
Leni Aniva 8127e9ba06 Add alternative command input format and IO stub 2023-05-20 13:03:12 -07:00
Leni Aniva e246fd961f Add tactic state manipulation 2023-05-17 21:58:03 -07:00
Leni Aniva 4d636ec12b Add stack size troubleshooting 2023-05-14 15:22:41 -07:00
Leni Aniva d3af535652 Add unsafe filtering in catalog 2023-05-12 16:12:21 -07:00
Leni Aniva 7c96479bb5 Add working catalog code and example 2023-05-12 01:08:36 -07:00
Leni Aniva b5cb464694 Add README and catalog functions 2023-05-09 22:51:19 -07:00
Leni Aniva f6a520c7a0 Separate commands into its own file 2023-05-09 18:01:09 -07:00
Leni Aniva 1a611c1415 Add REPL 2023-05-09 16:39:24 -07:00
44 changed files with 6154 additions and 16 deletions

4
.gitignore vendored
View File

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

190
LICENSE Normal file
View File

@ -0,0 +1,190 @@
Apache License
Version 2.0, January 2004
http://www.apache.org/licenses/
TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION
1. Definitions.
"License" shall mean the terms and conditions for use, reproduction,
and distribution as defined by Sections 1 through 9 of this document.
"Licensor" shall mean the copyright owner or entity authorized by
the copyright owner that is granting the License.
"Legal Entity" shall mean the union of the acting entity and all
other entities that control, are controlled by, or are under common
control with that entity. For the purposes of this definition,
"control" means (i) the power, direct or indirect, to cause the
direction or management of such entity, whether by contract or
otherwise, or (ii) ownership of fifty percent (50%) or more of the
outstanding shares, or (iii) beneficial ownership of such entity.
"You" (or "Your") shall mean an individual or Legal Entity
exercising permissions granted by this License.
"Source" form shall mean the preferred form for making modifications,
including but not limited to software source code, documentation
source, and configuration files.
"Object" form shall mean any form resulting from mechanical
transformation or translation of a Source form, including but
not limited to compiled object code, generated documentation,
and conversions to other media types.
"Work" shall mean the work of authorship, whether in Source or
Object form, made available under the License, as indicated by a
copyright notice that is included in or attached to the work
(an example is provided in the Appendix below).
"Derivative Works" shall mean any work, whether in Source or Object
form, that is based on (or derived from) the Work and for which the
editorial revisions, annotations, elaborations, or other modifications
represent, as a whole, an original work of authorship. For the purposes
of this License, Derivative Works shall not include works that remain
separable from, or merely link (or bind by name) to the interfaces of,
the Work and Derivative Works thereof.
"Contribution" shall mean any work of authorship, including
the original version of the Work and any modifications or additions
to that Work or Derivative Works thereof, that is intentionally
submitted to Licensor for inclusion in the Work by the copyright owner
or by an individual or Legal Entity authorized to submit on behalf of
the copyright owner. For the purposes of this definition, "submitted"
means any form of electronic, verbal, or written communication sent
to the Licensor or its representatives, including but not limited to
communication on electronic mailing lists, source code control systems,
and issue tracking systems that are managed by, or on behalf of, the
Licensor for the purpose of discussing and improving the Work, but
excluding communication that is conspicuously marked or otherwise
designated in writing by the copyright owner as "Not a Contribution."
"Contributor" shall mean Licensor and any individual or Legal Entity
on behalf of whom a Contribution has been received by Licensor and
subsequently incorporated within the Work.
2. Grant of Copyright License. Subject to the terms and conditions of
this License, each Contributor hereby grants to You a perpetual,
worldwide, non-exclusive, no-charge, royalty-free, irrevocable
copyright license to reproduce, prepare Derivative Works of,
publicly display, publicly perform, sublicense, and distribute the
Work and such Derivative Works in Source or Object form.
3. Grant of Patent License. Subject to the terms and conditions of
this License, each Contributor hereby grants to You a perpetual,
worldwide, non-exclusive, no-charge, royalty-free, irrevocable
(except as stated in this section) patent license to make, have made,
use, offer to sell, sell, import, and otherwise transfer the Work,
where such license applies only to those patent claims licensable
by such Contributor that are necessarily infringed by their
Contribution(s) alone or by combination of their Contribution(s)
with the Work to which such Contribution(s) was submitted. If You
institute patent litigation against any entity (including a
cross-claim or counterclaim in a lawsuit) alleging that the Work
or a Contribution incorporated within the Work constitutes direct
or contributory patent infringement, then any patent licenses
granted to You under this License for that Work shall terminate
as of the date such litigation is filed.
4. Redistribution. You may reproduce and distribute copies of the
Work or Derivative Works thereof in any medium, with or without
modifications, and in Source or Object form, provided that You
meet the following conditions:
(a) You must give any other recipients of the Work or
Derivative Works a copy of this License; and
(b) You must cause any modified files to carry prominent notices
stating that You changed the files; and
(c) You must retain, in the Source form of any Derivative Works
that You distribute, all copyright, patent, trademark, and
attribution notices from the Source form of the Work,
excluding those notices that do not pertain to any part of
the Derivative Works; and
(d) If the Work includes a "NOTICE" text file as part of its
distribution, then any Derivative Works that You distribute must
include a readable copy of the attribution notices contained
within such NOTICE file, excluding those notices that do not
pertain to any part of the Derivative Works, in at least one
of the following places: within a NOTICE text file distributed
as part of the Derivative Works; within the Source form or
documentation, if provided along with the Derivative Works; or,
within a display generated by the Derivative Works, if and
wherever such third-party notices normally appear. The contents
of the NOTICE file are for informational purposes only and
do not modify the License. You may add Your own attribution
notices within Derivative Works that You distribute, alongside
or as an addendum to the NOTICE text from the Work, provided
that such additional attribution notices cannot be construed
as modifying the License.
You may add Your own copyright statement to Your modifications and
may provide additional or different license terms and conditions
for use, reproduction, or distribution of Your modifications, or
for any such Derivative Works as a whole, provided Your use,
reproduction, and distribution of the Work otherwise complies with
the conditions stated in this License.
5. Submission of Contributions. Unless You explicitly state otherwise,
any Contribution intentionally submitted for inclusion in the Work
by You to the Licensor shall be under the terms and conditions of
this License, without any additional terms or conditions.
Notwithstanding the above, nothing herein shall supersede or modify
the terms of any separate license agreement you may have executed
with Licensor regarding such Contributions.
6. Trademarks. This License does not grant permission to use the trade
names, trademarks, service marks, or product names of the Licensor,
except as required for reasonable and customary use in describing the
origin of the Work and reproducing the content of the NOTICE file.
7. Disclaimer of Warranty. Unless required by applicable law or
agreed to in writing, Licensor provides the Work (and each
Contributor provides its Contributions) on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
implied, including, without limitation, any warranties or conditions
of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A
PARTICULAR PURPOSE. You are solely responsible for determining the
appropriateness of using or redistributing the Work and assume any
risks associated with Your exercise of permissions under this License.
8. Limitation of Liability. In no event and under no legal theory,
whether in tort (including negligence), contract, or otherwise,
unless required by applicable law (such as deliberate and grossly
negligent acts) or agreed to in writing, shall any Contributor be
liable to You for damages, including any direct, indirect, special,
incidental, or consequential damages of any character arising as a
result of this License or out of the use or inability to use the
Work (including but not limited to damages for loss of goodwill,
work stoppage, computer failure or malfunction, or any and all
other commercial damages or losses), even if such Contributor
has been advised of the possibility of such damages.
9. Accepting Warranty or Additional Liability. While redistributing
the Work or Derivative Works thereof, You may choose to offer,
and charge a fee for, acceptance of support, warranty, indemnity,
or other liability obligations and/or rights consistent with this
License. However, in accepting such obligations, You may act only
on Your own behalf and on Your sole responsibility, not on behalf
of any other Contributor, and only if You agree to indemnify,
defend, and hold each Contributor harmless for any liability
incurred by, or claims asserted against, such Contributor by reason
of your accepting any such warranty or additional liability.
END OF TERMS AND CONDITIONS
Copyright 2024 Leni Aniva
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.

View File

@ -1,4 +1,72 @@
import Pantograph
import Lean.Data.Json
import Lean.Environment
def main : IO Unit :=
IO.println s!"Hello, {hello}!"
import Pantograph
import Repl
-- Main IO functions
open Pantograph.Repl
open Pantograph.Protocol
/-- Parse a command either in `{ "cmd": ..., "payload": ... }` form or `cmd { ... }` form. -/
def parseCommand (s: String): Except String Command := do
let s := s.trim
match s.get? 0 with
| .some '{' => -- Parse in Json mode
Lean.fromJson? (← Lean.Json.parse s)
| .some _ => -- Parse in line mode
let offset := s.posOf ' ' |> s.offsetOfPos
if offset = s.length then
return { cmd := s.take offset, payload := Lean.Json.null }
else
let payload ← s.drop offset |> Lean.Json.parse
return { cmd := s.take offset, payload := payload }
| .none => throw "Command is empty"
partial def loop : MainM Unit := do
let state ← get
let command ← (← IO.getStdin).getLine
if command.trim.length = 0 then return ()
match parseCommand command with
| .error error =>
let error := Lean.toJson ({ error := "command", desc := error }: InteractionError)
-- Using `Lean.Json.compress` here to prevent newline
IO.println error.compress
| .ok command =>
try
let ret ← execute command
let str := match state.options.printJsonPretty with
| true => ret.pretty
| false => ret.compress
IO.println str
catch e =>
let message ← e.toMessageData.toString
let error := Lean.toJson ({ error := "main", desc := message }: InteractionError)
IO.println error.compress
loop
unsafe def main (args: List String): IO Unit := do
-- NOTE: A more sophisticated scheme of command line argument handling is needed.
-- Separate imports and options
if args == ["--version"] then do
IO.println s!"{Pantograph.version}"
return
Pantograph.initSearch ""
let coreContext ← args.filterMap (λ s => if s.startsWith "--" then .some <| s.drop 2 else .none)
|>.toArray |> Pantograph.createCoreContext
let imports:= args.filter (λ s => ¬ (s.startsWith "--"))
let coreState ← Pantograph.createCoreState imports.toArray
let context: Context := {
imports
}
try
let coreM := loop.run context |>.run' {}
IO.println "ready."
discard <| coreM.toIO coreContext coreState
catch ex =>
let message := ex.toString
let error := Lean.toJson ({ error := "io", desc := message }: InteractionError)
IO.println error.compress

View File

@ -1 +1,8 @@
def hello := "world"
import Pantograph.Condensed
import Pantograph.Environment
import Pantograph.Frontend
import Pantograph.Goal
import Pantograph.Library
import Pantograph.Protocol
import Pantograph.Serial
import Pantograph.Version

95
Pantograph/Condensed.lean Normal file
View File

@ -0,0 +1,95 @@
/- structures for FFI based interface -/
import Lean
import Pantograph.Goal
import Pantograph.Expr
open Lean
namespace Pantograph
namespace Condensed
-- Mirrors Lean's LocalDecl
structure LocalDecl where
-- Default value is for testing
fvarId: FVarId := { name := .anonymous }
userName: Name
-- Normalized expression
type : Expr
value? : Option Expr := .none
structure Goal where
mvarId: MVarId := { name := .anonymous }
userName: Name := .anonymous
context: Array LocalDecl
target: Expr
@[export pantograph_goal_is_lhs]
def isLHS (g: Goal) : Bool := isLHSGoal? g.target |>.isSome
-- Functions for creating contexts and states
@[export pantograph_elab_context]
def elabContext: Elab.Term.Context := {
errToSorry := false
}
end Condensed
-- Get the list of visible (by default) free variables from a goal
@[export pantograph_visible_fvars_of_mvar]
protected def visibleFVarsOfMVar (mctx: MetavarContext) (mvarId: MVarId): Option (Array FVarId) := do
let mvarDecl ← mctx.findDecl? mvarId
let lctx := mvarDecl.lctx
return lctx.decls.foldl (init := #[]) fun r decl? => match decl? with
| some decl => if decl.isAuxDecl decl.isImplementationDetail then r else r.push decl.fvarId
| none => r
@[export pantograph_to_condensed_goal_m]
def toCondensedGoal (mvarId: MVarId): MetaM Condensed.Goal := do
let ppAuxDecls := Meta.pp.auxDecls.get (← getOptions)
let ppImplDetailHyps := Meta.pp.implementationDetailHyps.get (← getOptions)
let mvarDecl ← mvarId.getDecl
let lctx := mvarDecl.lctx
let lctx := lctx.sanitizeNames.run' { options := (← getOptions) }
Meta.withLCtx lctx mvarDecl.localInstances do
let ppVar (localDecl : LocalDecl) : MetaM Condensed.LocalDecl := do
match localDecl with
| .cdecl _ fvarId userName type _ _ =>
let type ← instantiate type
return { fvarId, userName, type }
| .ldecl _ fvarId userName type value _ _ => do
let userName := userName.simpMacroScopes
let type ← instantiate type
let value ← instantiate value
return { fvarId, userName, type, value? := .some value }
let vars ← lctx.foldlM (init := []) fun acc (localDecl : LocalDecl) => do
let skip := !ppAuxDecls && localDecl.isAuxDecl ||
!ppImplDetailHyps && localDecl.isImplementationDetail
if skip then
return acc
else
let var ← ppVar localDecl
return var::acc
return {
mvarId,
userName := mvarDecl.userName,
context := vars.reverse.toArray,
target := ← instantiate mvarDecl.type
}
where
instantiate := instantiateAll
@[export pantograph_goal_state_to_condensed_m]
protected def GoalState.toCondensed (state: GoalState):
CoreM (Array Condensed.Goal):= do
let metaM := do
let goals := state.goals.toArray
goals.mapM fun goal => do
match state.mctx.findDecl? goal with
| .some _ =>
let serializedGoal ← toCondensedGoal goal
pure serializedGoal
| .none => throwError s!"Metavariable does not exist in context {goal.name}"
metaM.run' (s := state.savedState.term.meta.meta)
end Pantograph

153
Pantograph/Environment.lean Normal file
View File

@ -0,0 +1,153 @@
import Pantograph.Protocol
import Pantograph.Serial
import Lean
open Lean
open Pantograph
namespace Pantograph.Environment
@[export pantograph_is_name_internal]
def isNameInternal (n: Name): Bool :=
-- Returns true if the name is an implementation detail which should not be shown to the user.
n.isAuxLemma n.hasMacroScopes
/-- Catalog all the non-internal and safe names -/
@[export pantograph_environment_catalog]
def env_catalog (env: Environment): Array Name := env.constants.fold (init := #[]) (λ acc name _ =>
match isNameInternal name with
| false => acc.push name
| true => acc)
@[export pantograph_environment_module_of_name]
def module_of_name (env: Environment) (name: Name): Option Name := do
let moduleId ← env.getModuleIdxFor? name
return env.allImportedModuleNames.get! moduleId.toNat
def toCompactSymbolName (n: Name) (info: ConstantInfo): String :=
let pref := match info with
| .axiomInfo _ => "a"
| .defnInfo _ => "d"
| .thmInfo _ => "t"
| .opaqueInfo _ => "o"
| .quotInfo _ => "q"
| .inductInfo _ => "i"
| .ctorInfo _ => "c"
| .recInfo _ => "r"
s!"{pref}{toString n}"
def toFilteredSymbol (n: Lean.Name) (info: Lean.ConstantInfo): Option String :=
if isNameInternal n || info.isUnsafe
then Option.none
else Option.some <| toCompactSymbolName n info
def catalog (_: Protocol.EnvCatalog): CoreM Protocol.EnvCatalogResult := do
let env ← Lean.MonadEnv.getEnv
let names := env.constants.fold (init := #[]) (λ acc name info =>
match toFilteredSymbol name info with
| .some x => acc.push x
| .none => acc)
return { symbols := names }
def inspect (args: Protocol.EnvInspect) (options: @&Protocol.Options): CoreM (Protocol.CR Protocol.EnvInspectResult) := do
let env ← Lean.MonadEnv.getEnv
let name := args.name.toName
let info? := env.find? name
let info ← match info? with
| none => return .error $ Protocol.errorIndex s!"Symbol not found {args.name}"
| some info => pure info
let module? := env.getModuleIdxFor? name >>=
(λ idx => env.allImportedModuleNames.get? idx.toNat) |>.map toString
let value? := match args.value?, info with
| .some true, _ => info.value?
| .some false, _ => .none
| .none, .defnInfo _ => info.value?
| .none, _ => .none
let type ← unfoldAuxLemmas info.type
let value? ← value?.mapM (λ v => unfoldAuxLemmas v)
-- Information common to all symbols
let core := {
type := ← (serializeExpression options type).run',
isUnsafe := info.isUnsafe,
value? := ← value?.mapM (λ v => serializeExpression options v |>.run'),
publicName? := Lean.privateToUserName? name |>.map (·.toString),
-- BUG: Warning: getUsedConstants here will not include projections. This is a known bug.
typeDependency? := if args.dependency?.getD false
then .some <| type.getUsedConstants.map (λ n => serializeName n)
else .none,
valueDependency? := if args.dependency?.getD false
then value?.map (λ e =>
e.getUsedConstants.filter (!isNameInternal ·) |>.map (λ n => serializeName n) )
else .none,
module? := module?
}
let result ← match info with
| .inductInfo induct => pure { core with inductInfo? := .some {
numParams := induct.numParams,
numIndices := induct.numIndices,
all := induct.all.toArray.map (·.toString),
ctors := induct.ctors.toArray.map (·.toString),
isRec := induct.isRec,
isReflexive := induct.isReflexive,
isNested := induct.isNested,
} }
| .ctorInfo ctor => pure { core with constructorInfo? := .some {
induct := ctor.induct.toString,
cidx := ctor.cidx,
numParams := ctor.numParams,
numFields := ctor.numFields,
} }
| .recInfo r => pure { core with recursorInfo? := .some {
all := r.all.toArray.map (·.toString),
numParams := r.numParams,
numIndices := r.numIndices,
numMotives := r.numMotives,
numMinors := r.numMinors,
rules := ← r.rules.toArray.mapM (λ rule => do
pure {
ctor := rule.ctor.toString,
nFields := rule.nfields,
rhs := ← (serializeExpression options rule.rhs).run',
})
k := r.k,
} }
| _ => pure core
return .ok result
def addDecl (args: Protocol.EnvAdd): CoreM (Protocol.CR Protocol.EnvAddResult) := do
let env ← Lean.MonadEnv.getEnv
let tvM: Elab.TermElabM (Except String (Expr × Expr)) := do
let type ← match parseTerm env args.type with
| .ok syn => do
match ← elabTerm syn with
| .error e => return .error e
| .ok expr => pure expr
| .error e => return .error e
let value ← match parseTerm env args.value with
| .ok syn => do
try
let expr ← Elab.Term.elabTerm (stx := syn) (expectedType? := .some type)
Lean.Elab.Term.synthesizeSyntheticMVarsNoPostponing
let expr ← instantiateMVars expr
pure $ expr
catch ex => return .error (← ex.toMessageData.toString)
| .error e => return .error e
pure $ .ok (type, value)
let (type, value) ← match ← tvM.run' (ctx := {}) |>.run' with
| .ok t => pure t
| .error e => return .error $ Protocol.errorExpr e
let constant := Lean.Declaration.defnDecl <| Lean.mkDefinitionValEx
(name := args.name.toName)
(levelParams := [])
(type := type)
(value := value)
(hints := Lean.mkReducibilityHintsRegularEx 1)
(safety := Lean.DefinitionSafety.safe)
(all := [])
let env' ← match env.addDecl (← getOptions) constant with
| .error e => do
let options ← Lean.MonadOptions.getOptions
let desc ← (e.toMessageData options).toString
return .error $ { error := "kernel", desc }
| .ok env' => pure env'
Lean.MonadEnv.modifyEnv (λ _ => env')
return .ok {}
end Pantograph.Environment

162
Pantograph/Expr.lean Normal file
View File

@ -0,0 +1,162 @@
import Lean
import Std.Data.HashMap
open Lean
namespace Pantograph
structure ProjectionApplication where
projector: Name
numParams: Nat
inner: Expr
@[export pantograph_expr_proj_to_app]
def exprProjToApp (env: Environment) (e: Expr): ProjectionApplication :=
let (typeName, idx, inner) := match e with
| .proj typeName idx inner => (typeName, idx, inner)
| _ => panic! "Argument must be proj"
let ctor := getStructureCtor env typeName
let fieldName := getStructureFields env typeName |>.get! idx
let projector := getProjFnForField? env typeName fieldName |>.get!
{
projector,
numParams := ctor.numParams,
inner,
}
def _root_.Lean.Name.isAuxLemma (n : Lean.Name) : Bool := n matches .num (.str _ "_auxLemma") _
/-- Unfold all lemmas created by `Lean.Meta.mkAuxLemma`. These end in `_auxLemma.nn` where `nn` is a number. -/
@[export pantograph_unfold_aux_lemmas]
def unfoldAuxLemmas (e : Expr) : CoreM Expr := do
Lean.Meta.deltaExpand e Lean.Name.isAuxLemma
/--
Force the instantiation of delayed metavariables even if they cannot be fully
instantiated. This is used during resumption to provide diagnostic data about
the current goal.
Since Lean 4 does not have an `Expr` constructor corresponding to delayed
metavariables, any delayed metavariables must be recursively handled by this
function to ensure that nested delayed metavariables can be properly processed.
The caveat is this recursive call will lead to infinite recursion if a loop
between metavariable assignment exists.
This function ensures any metavariable in the result is either
1. Delayed assigned with its pending mvar not assigned in any form
2. Not assigned (delay or not)
-/
partial def instantiateDelayedMVars (eOrig: Expr) : MetaM Expr := do
--let padding := String.join $ List.replicate level "│ "
--IO.println s!"{padding}Starting {toString eOrig}"
let mut result ← Meta.transform (← instantiateMVars eOrig)
(pre := fun e => e.withApp fun f args => do
let .mvar mvarId := f | return .continue
--IO.println s!"{padding}├V {e}"
let mvarDecl ← mvarId.getDecl
-- This is critical to maintaining the interdependency of metavariables.
-- Without setting `.syntheticOpaque`, Lean's metavariable elimination
-- system will not make the necessary delayed assigned mvars in case of
-- nested mvars.
mvarId.setKind .syntheticOpaque
mvarId.withContext do
let lctx ← MonadLCtx.getLCtx
if mvarDecl.lctx.any (λ decl => !lctx.contains decl.fvarId) then
let violations := mvarDecl.lctx.decls.foldl (λ acc decl? => match decl? with
| .some decl => if lctx.contains decl.fvarId then acc else acc ++ [decl.fvarId.name]
| .none => acc) []
panic! s!"In the context of {mvarId.name}, there are local context variable violations: {violations}"
if let .some assign ← getExprMVarAssignment? mvarId then
--IO.println s!"{padding}├A ?{mvarId.name}"
assert! !(← mvarId.isDelayedAssigned)
return .visit (mkAppN assign args)
else if let some { fvars, mvarIdPending } ← getDelayedMVarAssignment? mvarId then
--let substTableStr := String.intercalate ", " $ Array.zipWith fvars args (λ fvar assign => s!"{fvar.fvarId!.name} := {assign}") |>.toList
--IO.println s!"{padding}├MD ?{mvarId.name} := ?{mvarIdPending.name} [{substTableStr}]"
if args.size < fvars.size then
throwError "Not enough arguments to instantiate a delay assigned mvar. This is due to bad implementations of a tactic: {args.size} < {fvars.size}. Expr: {toString e}; Origin: {toString eOrig}"
--if !args.isEmpty then
--IO.println s!"{padding}├── Arguments Begin"
let args ← args.mapM self
--if !args.isEmpty then
--IO.println s!"{padding}├── Arguments End"
if !(← mvarIdPending.isAssignedOrDelayedAssigned) then
--IO.println s!"{padding}├T1"
let result := mkAppN f args
return .done result
let pending ← mvarIdPending.withContext do
let inner ← instantiateDelayedMVars (.mvar mvarIdPending) --(level := level + 1)
--IO.println s!"{padding}├Pre: {inner}"
pure <| (← inner.abstractM fvars).instantiateRev args
-- Tail arguments
let result := mkAppRange pending fvars.size args.size args
--IO.println s!"{padding}├MD {result}"
return .done result
else
assert! !(← mvarId.isAssigned)
assert! !(← mvarId.isDelayedAssigned)
--if !args.isEmpty then
-- IO.println s!"{padding}├── Arguments Begin"
let args ← args.mapM self
--if !args.isEmpty then
-- IO.println s!"{padding}├── Arguments End"
--IO.println s!"{padding}├M ?{mvarId.name}"
return .done (mkAppN f args))
--IO.println s!"{padding}└Result {result}"
return result
where
self e := instantiateDelayedMVars e --(level := level + 1)
/--
Convert an expression to an equiavlent form with
1. No nested delayed assigned mvars
2. No aux lemmas
3. No assigned mvars
-/
@[export pantograph_instantiate_all_m]
def instantiateAll (e: Expr): MetaM Expr := do
let e ← instantiateDelayedMVars e
let e ← unfoldAuxLemmas e
return e
structure DelayedMVarInvocation where
mvarIdPending: MVarId
args: Array (FVarId × (Option Expr))
-- Extra arguments applied to the result of this substitution
tail: Array Expr
-- The pending mvar of any delayed assigned mvar must not be assigned in any way.
@[export pantograph_to_delayed_mvar_invocation_m]
def toDelayedMVarInvocation (e: Expr): MetaM (Option DelayedMVarInvocation) := do
let .mvar mvarId := e.getAppFn | return .none
let .some decl ← getDelayedMVarAssignment? mvarId | return .none
let mvarIdPending := decl.mvarIdPending
let mvarDecl ← mvarIdPending.getDecl
-- Print the function application e. See Lean's `withOverApp`
let args := e.getAppArgs
assert! args.size ≥ decl.fvars.size
assert! !(← mvarIdPending.isAssigned)
assert! !(← mvarIdPending.isDelayedAssigned)
let fvarArgMap: Std.HashMap FVarId Expr := Std.HashMap.ofList $ (decl.fvars.map (·.fvarId!) |>.zip args).toList
let subst ← mvarDecl.lctx.foldlM (init := []) λ acc localDecl => do
let fvarId := localDecl.fvarId
let a := fvarArgMap[fvarId]?
return acc ++ [(fvarId, a)]
assert! decl.fvars.all (λ fvar => mvarDecl.lctx.findFVar? fvar |>.isSome)
return .some {
mvarIdPending,
args := subst.toArray,
tail := args.toList.drop decl.fvars.size |>.toArray,
}
end Pantograph

4
Pantograph/Frontend.lean Normal file
View File

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

View File

@ -0,0 +1,120 @@
import Lean.Parser
import Lean.Elab.Frontend
open Lean
namespace Lean.FileMap
/-- Extract the range of a `Syntax` expressed as lines and columns. -/
-- Extracted from the private declaration `Lean.Elab.formatStxRange`,
-- in `Lean.Elab.InfoTree.Main`.
@[export pantograph_frontend_stx_range]
protected def stxRange (fileMap : FileMap) (stx : Syntax) : Position × Position :=
let pos := stx.getPos?.getD 0
let endPos := stx.getTailPos?.getD pos
(fileMap.toPosition pos, fileMap.toPosition endPos)
end Lean.FileMap
namespace Lean.PersistentArray
/--
Drop the first `n` elements of a `PersistentArray`, returning the results as a `List`.
-/
-- We can't remove the `[Inhabited α]` hypotheses here until
-- `PersistentArray`'s `GetElem` instance also does.
protected def drop [Inhabited α] (t : PersistentArray α) (n : Nat) : List α :=
List.range (t.size - n) |>.map fun i => t.get! (n + i)
end Lean.PersistentArray
namespace Pantograph.Frontend
abbrev FrontendM := Elab.Frontend.FrontendM
structure CompilationStep where
fileName : String
fileMap : FileMap
src : Substring
stx : Syntax
before : Environment
after : Environment
msgs : List Message
trees : List Elab.InfoTree
namespace CompilationStep
@[export pantograph_frontend_compilation_step_message_strings_m]
def messageStrings (step: CompilationStep) : IO (Array String) := do
List.toArray <$> step.msgs.mapM (·.toString)
end CompilationStep
/--
Process one command, returning a `CompilationStep` and
`done : Bool`, indicating whether this was the last command.
-/
@[export pantograph_frontend_process_one_command_m]
def processOneCommand: FrontendM (CompilationStep × Bool) := do
let s := (← get).commandState
let before := s.env
let done ← Elab.Frontend.processCommand
let stx := (← get).commands.back
let src := (← read).inputCtx.input.toSubstring.extract (← get).cmdPos (← get).parserState.pos
let s' := (← get).commandState
let after := s'.env
let msgs := s'.messages.toList.drop s.messages.toList.length
let trees := s'.infoState.trees.drop s.infoState.trees.size
let ⟨_, fileName, fileMap⟩ := (← read).inputCtx
return ({ fileName, fileMap, src, stx, before, after, msgs, trees }, done)
partial def mapCompilationSteps { α } (f: CompilationStep → IO α) : FrontendM (List α) := do
let (cmd, done) ← processOneCommand
if done then
if cmd.src.isEmpty then
return []
else
return [← f cmd]
else
return (← f cmd) :: (← mapCompilationSteps f)
@[export pantograph_frontend_find_source_path_m]
def findSourcePath (module : Name) : IO System.FilePath := do
return System.FilePath.mk ((← findOLean module).toString.replace ".lake/build/lib/" "") |>.withExtension "lean"
/--
Use with
```lean
let m: FrontendM α := ...
let (context, state) ← createContextStateFromFile ...
m.run context |>.run' state
```
-/
@[export pantograph_frontend_create_context_state_from_file_m]
def createContextStateFromFile
(file : String) -- Content of the file
(fileName : String := "<anonymous>")
(env? : Option Lean.Environment := .none) -- If set to true, assume there's no header.
(opts : Options := {})
: IO (Elab.Frontend.Context × Elab.Frontend.State) := unsafe do
--let file ← IO.FS.readFile (← findSourcePath module)
let inputCtx := Parser.mkInputContext file fileName
let (env, parserState, messages) ← match env? with
| .some env => pure (env, {}, .empty)
| .none =>
let (header, parserState, messages) ← Parser.parseHeader inputCtx
let (env, messages) ← Elab.processHeader header opts messages inputCtx
pure (env, parserState, messages)
let commandState := Elab.Command.mkState env messages opts
let context: Elab.Frontend.Context := { inputCtx }
let state: Elab.Frontend.State := {
commandState := { commandState with infoState.enabled := true },
parserState,
cmdPos := parserState.pos
}
return (context, state)
end Pantograph.Frontend

View File

@ -0,0 +1,223 @@
/- Adapted from https://github.com/semorrison/lean-training-data -/
import Lean.Elab.Import
import Lean.Elab.Command
import Lean.Elab.InfoTree
import Pantograph.Frontend.Basic
import Pantograph.Frontend.MetaTranslate
import Pantograph.Goal
import Pantograph.Protocol
open Lean
namespace Lean.Elab.Info
/-- The `Syntax` for a `Lean.Elab.Info`, if there is one. -/
protected def stx? : Info → Option Syntax
| .ofTacticInfo info => info.stx
| .ofTermInfo info => info.stx
| .ofCommandInfo info => info.stx
| .ofMacroExpansionInfo info => info.stx
| .ofOptionInfo info => info.stx
| .ofFieldInfo info => info.stx
| .ofCompletionInfo info => info.stx
| .ofUserWidgetInfo info => info.stx
| .ofCustomInfo info => info.stx
| .ofFVarAliasInfo _ => none
| .ofFieldRedeclInfo info => info.stx
| .ofOmissionInfo info => info.stx
/-- Is the `Syntax` for this `Lean.Elab.Info` original, or synthetic? -/
protected def isOriginal (i : Info) : Bool :=
match i.stx? with
| none => true -- Somewhat unclear what to do with `FVarAliasInfo`, so be conservative.
| some stx => match stx.getHeadInfo with
| .original .. => true
| _ => false
end Lean.Elab.Info
namespace Lean.Elab.TacticInfo
/-- Find the name for the outermost `Syntax` in this `TacticInfo`. -/
def name? (t : TacticInfo) : Option Name :=
match t.stx with
| Syntax.node _ n _ => some n
| _ => none
/-- Decide whether a tactic is "substantive",
or is merely a tactic combinator (e.g. `by`, `;`, multiline tactics, parenthesized tactics). -/
def isSubstantive (t : TacticInfo) : Bool :=
match t.name? with
| none => false
| some `null => false
| some ``cdot => false
| some ``cdotTk => false
| some ``Lean.Parser.Term.byTactic => false
| some ``Lean.Parser.Tactic.tacticSeq => false
| some ``Lean.Parser.Tactic.tacticSeq1Indented => false
| some ``Lean.Parser.Tactic.«tactic_<;>_» => false
| some ``Lean.Parser.Tactic.paren => false
| _ => true
end Lean.Elab.TacticInfo
namespace Lean.Elab.InfoTree
/--
Keep `.node` nodes and `.hole` nodes satisfying predicates.
Returns a `List InfoTree`, although in most situations this will be a singleton.
-/
partial def filter (p : Info → Bool) (m : MVarId → Bool := fun _ => false) :
InfoTree → List InfoTree
| .context ctx tree => tree.filter p m |>.map (.context ctx)
| .node info children =>
if p info then
[.node info (children.toList.map (filter p m)).join.toPArray']
else
(children.toList.map (filter p m)).join
| .hole mvar => if m mvar then [.hole mvar] else []
end Lean.Elab.InfoTree
namespace Pantograph.Frontend
-- Info tree filtering functions
structure TacticInvocation where
info : Elab.TacticInfo
ctx : Elab.ContextInfo
children : PersistentArray Elab.InfoTree
namespace TacticInvocation
/-- Return the range of the tactic, as a pair of file positions. -/
@[export pantograph_frontend_tactic_invocation_range]
protected def range (t : TacticInvocation) : Position × Position := t.ctx.fileMap.stxRange t.info.stx
/-- Pretty print a tactic. -/
protected def pp (t : TacticInvocation) : IO Format :=
t.ctx.runMetaM {} try
Lean.PrettyPrinter.ppTactic ⟨t.info.stx⟩
catch _ =>
pure "<failed to pretty print>"
/-- Run a tactic on the goals stored in a `TacticInvocation`. -/
protected def runMetaMGoalsBefore (t : TacticInvocation) (x : List MVarId → MetaM α) : IO α := do
t.ctx.runMetaM {} <| Meta.withMCtx t.info.mctxBefore <| x t.info.goalsBefore
/-- Run a tactic on the after goals stored in a `TacticInvocation`. -/
protected def runMetaMGoalsAfter (t : TacticInvocation) (x : List MVarId → MetaM α) : IO α := do
t.ctx.runMetaM {} <| Meta.withMCtx t.info.mctxAfter <| x t.info.goalsAfter
/-- Run a tactic on the main goal stored in a `TacticInvocation`. -/
protected def runMetaM (t : TacticInvocation) (x : MVarId → MetaM α) : IO α := do
match t.info.goalsBefore.head? with
| none => throw <| IO.userError s!"No goals at {← t.pp}"
| some g => t.runMetaMGoalsBefore fun _ => do g.withContext <| x g
protected def goalState (t : TacticInvocation) : IO (List Format) := do
t.runMetaMGoalsBefore (fun gs => gs.mapM fun g => do Meta.ppGoal g)
protected def goalStateAfter (t : TacticInvocation) : IO (List Format) := do
t.runMetaMGoalsAfter (fun gs => gs.mapM fun g => do Meta.ppGoal g)
protected def ppExpr (t : TacticInvocation) (e : Expr) : IO Format :=
t.runMetaM (fun _ => do Meta.ppExpr (← instantiateMVars e))
protected def usedConstants (t: TacticInvocation) : NameSet :=
let info := t.info
info.goalsBefore
|>.filterMap info.mctxAfter.getExprAssignmentCore?
|>.map Expr.getUsedConstantsAsSet
|>.foldl .union .empty
end TacticInvocation
/-- Analogue of `Lean.Elab.InfoTree.findInfo?`, but that returns a list of all results. -/
partial def findAllInfo (t : Elab.InfoTree) (context?: Option Elab.ContextInfo) (pred : Elab.Info → Bool) :
List (Elab.Info × Option Elab.ContextInfo × PersistentArray Elab.InfoTree) :=
match t with
| .context inner t => findAllInfo t (inner.mergeIntoOuter? context?) pred
| .node i children =>
(if pred i then [(i, context?, children)] else []) ++ children.toList.bind (fun t => findAllInfo t context? pred)
| _ => []
/-- Return all `TacticInfo` nodes in an `InfoTree` corresponding to tactics,
each equipped with its relevant `ContextInfo`, and any children info trees. -/
private def collectTacticNodes (t : Elab.InfoTree) : List TacticInvocation :=
let infos := findAllInfo t none fun i => match i with
| .ofTacticInfo _ => true
| _ => false
infos.filterMap fun p => match p with
| (.ofTacticInfo i, some ctx, children) => .some ⟨i, ctx, children⟩
| _ => none
def collectTactics (t : Elab.InfoTree) : List TacticInvocation :=
collectTacticNodes t |>.filter fun i => i.info.isSubstantive
@[export pantograph_frontend_collect_tactics_from_compilation_step_m]
def collectTacticsFromCompilationStep (step : CompilationStep) : IO (List Protocol.InvokedTactic) := do
let tacticInfoTrees := step.trees.bind λ tree => tree.filter λ
| info@(.ofTacticInfo _) => info.isOriginal
| _ => false
let tactics := tacticInfoTrees.bind collectTactics
tactics.mapM λ invocation => do
let goalBefore := (Format.joinSep (← invocation.goalState) "\n").pretty
let goalAfter := (Format.joinSep (← invocation.goalStateAfter) "\n").pretty
let tactic ← invocation.ctx.runMetaM {} do
let t ← PrettyPrinter.ppTactic ⟨invocation.info.stx⟩
return t.pretty
let usedConstants := invocation.usedConstants.toArray.map λ n => n.toString
return {
goalBefore,
goalAfter,
tactic,
usedConstants,
}
structure InfoWithContext where
info: Elab.Info
context?: Option Elab.ContextInfo := .none
private def collectSorrysInTree (t : Elab.InfoTree) : List InfoWithContext :=
let infos := findAllInfo t none fun i => match i with
| .ofTermInfo { expectedType?, expr, stx, .. } =>
expr.isSorry ∧ expectedType?.isSome ∧ stx.isOfKind `Lean.Parser.Term.sorry
| .ofTacticInfo { stx, goalsBefore, .. } =>
-- The `sorry` term is distinct from the `sorry` tactic
let isSorry := stx.isOfKind `Lean.Parser.Tactic.tacticSorry
isSorry ∧ !goalsBefore.isEmpty
| _ => false
infos.map fun (info, context?, _) => { info, context? }
-- NOTE: Plural deliberately not spelled "sorries"
@[export pantograph_frontend_collect_sorrys_m]
def collectSorrys (step: CompilationStep) : List InfoWithContext :=
step.trees.bind collectSorrysInTree
/--
Since we cannot directly merge `MetavarContext`s, we have to get creative. This
function duplicates frozen mvars in term and tactic info nodes, and add them to
the current `MetavarContext`.
-/
@[export pantograph_frontend_sorrys_to_goal_state]
def sorrysToGoalState (sorrys : List InfoWithContext) : MetaM GoalState := do
assert! !sorrys.isEmpty
let goalsM := sorrys.mapM λ i => do
match i.info with
| .ofTermInfo termInfo => do
let mvarId ← MetaTranslate.translateMVarFromTermInfo termInfo i.context?
return [mvarId]
| .ofTacticInfo tacticInfo => do
MetaTranslate.translateMVarFromTacticInfoBefore tacticInfo i.context?
| _ => panic! "Invalid info"
let goals := List.join (← goalsM.run {} |>.run' {})
let root := match goals with
| [] => panic! "No MVars generated"
| [g] => g
| _ => { name := .anonymous }
GoalState.createFromMVars goals root
end Pantograph.Frontend

View File

@ -0,0 +1,164 @@
import Lean.Meta
import Std.Data.HashMap
open Lean
namespace Pantograph.Frontend
namespace MetaTranslate
structure Context where
sourceMCtx : MetavarContext := {}
sourceLCtx : LocalContext := {}
abbrev FVarMap := Std.HashMap FVarId FVarId
structure State where
-- Stores mapping from old to new mvar/fvars
mvarMap: Std.HashMap MVarId MVarId := {}
fvarMap: Std.HashMap FVarId FVarId := {}
/-
Monadic state for translating a frozen meta state. The underlying `MetaM`
operates in the "target" context and state.
-/
abbrev MetaTranslateM := ReaderT Context StateRefT State MetaM
def getSourceLCtx : MetaTranslateM LocalContext := do pure (← read).sourceLCtx
def getSourceMCtx : MetaTranslateM MetavarContext := do pure (← read).sourceMCtx
def addTranslatedFVar (src dst: FVarId) : MetaTranslateM Unit := do
modifyGet λ state => ((), { state with fvarMap := state.fvarMap.insert src dst })
def addTranslatedMVar (src dst: MVarId) : MetaTranslateM Unit := do
modifyGet λ state => ((), { state with mvarMap := state.mvarMap.insert src dst })
def saveFVarMap : MetaTranslateM FVarMap := do
return (← get).fvarMap
def restoreFVarMap (map: FVarMap) : MetaTranslateM Unit := do
modifyGet λ state => ((), { state with fvarMap := map })
def resetFVarMap : MetaTranslateM Unit := do
modifyGet λ state => ((), { state with fvarMap := {} })
mutual
private partial def translateLevel (srcLevel: Level) : MetaTranslateM Level := do
let sourceMCtx ← getSourceMCtx
let (_, level) := instantiateLevelMVarsImp sourceMCtx srcLevel
match level with
| .zero => return .zero
| .succ inner => do
let inner' ← translateLevel inner
return .succ inner'
| .max l1 l2 => do
let l1' ← translateLevel l1
let l2' ← translateLevel l2
return .max l1' l2'
| .imax l1 l2 => do
let l1' ← translateLevel l1
let l2' ← translateLevel l2
return .imax l1' l2'
| .param p => return .param p
| .mvar _ =>
Meta.mkFreshLevelMVar
private partial def translateExpr (srcExpr: Expr) : MetaTranslateM Expr := do
let sourceMCtx ← getSourceMCtx
-- We want to create as few mvars as possible
let (srcExpr, _) := instantiateMVarsCore (mctx := sourceMCtx) srcExpr
--IO.println s!"Transform src: {srcExpr}"
let result ← Core.transform srcExpr λ e => do
let state ← get
match e with
| .fvar fvarId =>
let .some fvarId' := state.fvarMap[fvarId]? | panic! s!"FVar id not registered: {fvarId.name}"
assert! (← getLCtx).contains fvarId'
return .done $ .fvar fvarId'
| .mvar mvarId => do
-- Must not be assigned
assert! !(sourceMCtx.eAssignment.contains mvarId)
match state.mvarMap[mvarId]? with
| .some mvarId' => do
return .done $ .mvar mvarId'
| .none => do
-- Entering another LCtx, must save the current one
let fvarMap ← saveFVarMap
let mvarId' ← translateMVarId mvarId
restoreFVarMap fvarMap
return .done $ .mvar mvarId'
| .sort level => do
let level' ← translateLevel level
return .done $ .sort level'
| _ => return .continue
Meta.check result
return result
partial def translateLocalInstance (srcInstance: LocalInstance) : MetaTranslateM LocalInstance := do
return {
className := srcInstance.className,
fvar := ← translateExpr srcInstance.fvar
}
partial def translateLocalDecl (srcLocalDecl: LocalDecl) : MetaTranslateM LocalDecl := do
let fvarId ← mkFreshFVarId
addTranslatedFVar srcLocalDecl.fvarId fvarId
match srcLocalDecl with
| .cdecl index _ userName type bi kind => do
--IO.println s!"[CD] {userName} {toString type}"
return .cdecl index fvarId userName (← translateExpr type) bi kind
| .ldecl index _ userName type value nonDep kind => do
--IO.println s!"[LD] {toString type} := {toString value}"
return .ldecl index fvarId userName (← translateExpr type) (← translateExpr value) nonDep kind
partial def translateLCtx : MetaTranslateM LocalContext := do
resetFVarMap
let lctx ← MonadLCtx.getLCtx
assert! lctx.isEmpty
(← getSourceLCtx).foldlM (λ lctx srcLocalDecl => do
let localDecl ← Meta.withLCtx lctx #[] do
translateLocalDecl srcLocalDecl
pure $ lctx.addDecl localDecl
) lctx
partial def translateMVarId (srcMVarId: MVarId) : MetaTranslateM MVarId := do
if let .some mvarId' := (← get).mvarMap[srcMVarId]? then
return mvarId'
let mvarId' ← Meta.withLCtx .empty #[] do
let srcDecl := (← getSourceMCtx).findDecl? srcMVarId |>.get!
withTheReader Context (λ ctx => { ctx with sourceLCtx := srcDecl.lctx }) do
let lctx' ← translateLCtx
let localInstances' ← srcDecl.localInstances.mapM translateLocalInstance
Meta.withLCtx lctx' localInstances' do
let target' ← translateExpr srcDecl.type
let mvar' ← Meta.mkFreshExprMVar target' srcDecl.kind srcDecl.userName
let mvarId' := mvar'.mvarId!
if let .some { fvars, mvarIdPending }:= (← getSourceMCtx).getDelayedMVarAssignmentExp srcMVarId then
-- Map the fvars in the pending context.
let mvarIdPending' ← translateMVarId mvarIdPending
let fvars' ← mvarIdPending'.withContext $ fvars.mapM translateExpr
assignDelayedMVar mvarId' fvars' mvarIdPending'
pure mvarId'
addTranslatedMVar srcMVarId mvarId'
return mvarId'
end
def translateMVarFromTermInfo (termInfo : Elab.TermInfo) (context? : Option Elab.ContextInfo)
: MetaTranslateM MVarId := do
withTheReader Context (λ ctx => { ctx with
sourceMCtx := context?.map (·.mctx) |>.getD {},
sourceLCtx := termInfo.lctx,
}) do
let type := termInfo.expectedType?.get!
let lctx' ← translateLCtx
let mvar ← Meta.withLCtx lctx' #[] do
let type' ← translateExpr type
Meta.mkFreshExprSyntheticOpaqueMVar type'
return mvar.mvarId!
def translateMVarFromTacticInfoBefore (tacticInfo : Elab.TacticInfo) (_context? : Option Elab.ContextInfo)
: MetaTranslateM (List MVarId) := do
withTheReader Context (λ ctx => { ctx with sourceMCtx := tacticInfo.mctxBefore }) do
tacticInfo.goalsBefore.mapM translateMVarId
end MetaTranslate
export MetaTranslate (MetaTranslateM)
end Pantograph.Frontend

397
Pantograph/Goal.lean Normal file
View File

@ -0,0 +1,397 @@
/-
Functions for handling metavariables
All the functions starting with `try` resume their inner monadic state.
-/
import Pantograph.Tactic
import Lean
namespace Pantograph
open Lean
def filename: String := "<pantograph>"
/--
Represents an interconnected set of metavariables, or a state in proof search
-/
structure GoalState where
savedState : Elab.Tactic.SavedState
-- The root hole which is the search target
root: MVarId
-- Parent state metavariable source
parentMVar?: Option MVarId
-- Existence of this field shows that we are currently in `conv` mode.
-- (convRhs, goal, dormant)
convMVar?: Option (MVarId × MVarId × List MVarId) := .none
-- Previous RHS for calc, so we don't have to repeat it every time
-- WARNING: If using `state with` outside of `calc`, this must be set to `.none`
calcPrevRhs?: Option (MVarId × Expr) := .none
@[export pantograph_goal_state_create_m]
protected def GoalState.create (expr: Expr): Elab.TermElabM 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 root ← Meta.mkFreshExprMVar expr (kind := MetavarKind.synthetic) (userName := .anonymous)
let savedStateMonad: Elab.Tactic.TacticM Elab.Tactic.SavedState := MonadBacktrack.saveState
let savedState ← savedStateMonad { elaborator := .anonymous } |>.run' { goals := [root.mvarId!]}
return {
root := root.mvarId!,
savedState,
parentMVar? := .none,
}
@[export pantograph_goal_state_create_from_mvars_m]
protected def GoalState.createFromMVars (goals: List MVarId) (root: MVarId): MetaM GoalState := do
let savedStateMonad: Elab.Tactic.TacticM Elab.Tactic.SavedState := MonadBacktrack.saveState
let savedState ← savedStateMonad { elaborator := .anonymous } |>.run' { goals } |>.run' {}
return {
root,
savedState,
parentMVar? := .none,
}
@[export pantograph_goal_state_is_conv]
protected def GoalState.isConv (state: GoalState): Bool :=
state.convMVar?.isSome
protected def GoalState.goals (state: GoalState): List MVarId :=
state.savedState.tactic.goals
@[export pantograph_goal_state_goals]
protected def GoalState.goalsArray (state: GoalState): Array MVarId := state.goals.toArray
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
@[export pantograph_goal_state_meta_context_of_goal]
protected def GoalState.metaContextOfGoal (state: GoalState) (mvarId: MVarId): Option Meta.Context := do
let mvarDecl ← state.mctx.findDecl? mvarId
return { lctx := mvarDecl.lctx, localInstances := mvarDecl.localInstances }
protected def GoalState.metaState (state: GoalState): Meta.State :=
state.savedState.term.meta.meta
protected def GoalState.withContext (state: GoalState) (mvarId: MVarId) (m: MetaM α): MetaM α := do
mvarId.withContext m |>.run' (← read) state.metaState
protected def GoalState.withParentContext { n } [MonadControlT MetaM n] [Monad n] (state: GoalState): n α → n α :=
Meta.mapMetaM <| state.withContext state.parentMVar?.get!
protected def GoalState.withRootContext { n } [MonadControlT MetaM n] [Monad n] (state: GoalState): n α → n α :=
Meta.mapMetaM <| state.withContext state.root
private def GoalState.mvars (state: GoalState): SSet MVarId :=
state.mctx.decls.foldl (init := .empty) fun acc k _ => acc.insert k
protected def GoalState.restoreMetaM (state: GoalState): MetaM Unit :=
state.savedState.term.meta.restore
protected def GoalState.restoreElabM (state: GoalState): Elab.TermElabM Unit :=
state.savedState.term.restore
private def GoalState.restoreTacticM (state: GoalState) (goal: MVarId): Elab.Tactic.TacticM Unit := do
state.savedState.restore
Elab.Tactic.setGoals [goal]
@[export pantograph_goal_state_focus]
protected def GoalState.focus (state: GoalState) (goalId: Nat): Option GoalState := do
let goal ← state.savedState.tactic.goals.get? goalId
return {
state with
savedState := {
state.savedState with
tactic := { goals := [goal] },
},
calcPrevRhs? := .none,
}
/-- Immediately bring all parent goals back into scope. Used in automatic mode -/
@[export pantograph_goal_state_immediate_resume_parent]
protected def GoalState.immediateResume (state: GoalState) (parent: GoalState): GoalState :=
-- Prune parents solved goals
let mctx := state.mctx
let parentGoals := parent.goals.filter $ λ goal => mctx.eAssignment.contains goal
{
state with
savedState := {
state.savedState with
tactic := { goals := state.goals ++ parentGoals },
},
}
/--
Brings into scope a list of goals
-/
@[export pantograph_goal_state_resume]
protected def GoalState.resume (state: GoalState) (goals: List MVarId): Except String GoalState :=
if ¬ (goals.all (λ goal => state.mvars.contains goal)) then
let invalid_goals := goals.filter (λ goal => ¬ state.mvars.contains goal) |>.map (·.name.toString)
.error s!"Goals {invalid_goals} are not in scope"
else
-- Set goals to the goals that have not been assigned yet, similar to the `focus` tactic.
let unassigned := goals.filter (λ goal =>
let mctx := state.mctx
¬(mctx.eAssignment.contains goal || mctx.dAssignment.contains goal))
.ok {
state with
savedState := {
term := state.savedState.term,
tactic := { goals := unassigned },
},
}
/--
Brings into scope all goals from `branch`
-/
@[export pantograph_goal_state_continue]
protected def GoalState.continue (target: GoalState) (branch: GoalState): Except String GoalState :=
if !target.goals.isEmpty then
.error s!"Target state has unresolved goals"
else if target.root != branch.root then
.error s!"Roots of two continued goal states do not match: {target.root.name} != {branch.root.name}"
else
target.resume (goals := branch.goals)
@[export pantograph_goal_state_root_expr]
protected def GoalState.rootExpr? (goalState: GoalState): Option Expr := do
if goalState.root.name == .anonymous then
.none
let expr ← goalState.mctx.eAssignment.find? goalState.root
let (expr, _) := instantiateMVarsCore (mctx := goalState.mctx) (e := expr)
if expr.hasExprMVar 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
return expr
@[export pantograph_goal_state_parent_expr]
protected def GoalState.parentExpr? (goalState: GoalState): Option Expr := do
let parent ← goalState.parentMVar?
let expr := goalState.mctx.eAssignment.find! parent
let (expr, _) := instantiateMVarsCore (mctx := goalState.mctx) (e := expr)
return expr
@[export pantograph_goal_state_get_mvar_e_assignment]
protected def GoalState.getMVarEAssignment (goalState: GoalState) (mvarId: MVarId): Option Expr := do
let expr ← goalState.mctx.eAssignment.find? mvarId
let (expr, _) := instantiateMVarsCore (mctx := goalState.mctx) (e := expr)
return expr
--- Tactic execution functions ---
protected def GoalState.step (state: GoalState) (goal: MVarId) (tacticM: Elab.Tactic.TacticM Unit)
: Elab.TermElabM GoalState := do
unless (← getMCtx).decls.contains goal do
throwError s!"Goal is not in context: {goal.name}"
goal.checkNotAssigned `GoalState.step
let (_, newGoals) ← tacticM { elaborator := .anonymous } |>.run { goals := [goal] }
let nextElabState ← MonadBacktrack.saveState
return {
state with
savedState := { term := nextElabState, tactic := newGoals },
parentMVar? := .some goal,
calcPrevRhs? := .none,
}
/-- 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 given action cannot be executed in the state
| invalidAction (message: String)
/-- Executes a `TacticM` monads on this `GoalState`, collecting the errors as necessary -/
protected def GoalState.tryTacticM (state: GoalState) (goal: MVarId) (tacticM: Elab.Tactic.TacticM Unit):
Elab.TermElabM TacticResult := do
try
let nextState ← state.step goal tacticM
return .success nextState
catch exception =>
return .failure #[← exception.toMessageData.toString]
/-- Execute a string tactic on given state. Restores TermElabM -/
protected def GoalState.tryTactic (state: GoalState) (goal: MVarId) (tactic: String):
Elab.TermElabM TacticResult := do
state.restoreElabM
let tactic ← match Parser.runParserCategory
(env := ← MonadEnv.getEnv)
(catName := if state.isConv then `conv else `tactic)
(input := tactic)
(fileName := filename) with
| .ok stx => pure $ stx
| .error error => return .parseError error
state.tryTacticM goal $ Elab.Tactic.evalTactic tactic
protected def GoalState.tryAssign (state: GoalState) (goal: MVarId) (expr: String):
Elab.TermElabM TacticResult := do
state.restoreElabM
let expr ← match Parser.runParserCategory
(env := ← MonadEnv.getEnv)
(catName := `term)
(input := expr)
(fileName := filename) with
| .ok syn => pure syn
| .error error => return .parseError error
state.tryTacticM goal $ Tactic.evalAssign expr
-- Specialized Tactics
protected def GoalState.tryLet (state: GoalState) (goal: MVarId) (binderName: String) (type: String):
Elab.TermElabM TacticResult := do
state.restoreElabM
let type ← match Parser.runParserCategory
(env := ← MonadEnv.getEnv)
(catName := `term)
(input := type)
(fileName := filename) with
| .ok syn => pure syn
| .error error => return .parseError error
state.tryTacticM goal $ Tactic.evalLet binderName.toName type
/-- Enter conv tactic mode -/
protected def GoalState.conv (state: GoalState) (goal: MVarId):
Elab.TermElabM TacticResult := do
if state.convMVar?.isSome then
return .invalidAction "Already in conv state"
goal.checkNotAssigned `GoalState.conv
let tacticM : Elab.Tactic.TacticM (Elab.Tactic.SavedState × MVarId) := do
state.restoreTacticM goal
-- See Lean.Elab.Tactic.Conv.convTarget
let convMVar ← Elab.Tactic.withMainContext do
let (rhs, newGoal) ← Elab.Tactic.Conv.mkConvGoalFor (← Elab.Tactic.getMainTarget)
Elab.Tactic.replaceMainGoal [newGoal.mvarId!]
pure rhs.mvarId!
return (← MonadBacktrack.saveState, convMVar)
try
let (nextSavedState, convRhs) ← tacticM { elaborator := .anonymous } |>.run' state.savedState.tactic
-- Other goals are now dormant
let otherGoals := state.goals.filter $ λ g => g != goal
return .success {
root := state.root,
savedState := nextSavedState
parentMVar? := .some goal,
convMVar? := .some (convRhs, goal, otherGoals),
calcPrevRhs? := .none
}
catch exception =>
return .failure #[← exception.toMessageData.toString]
/-- Exit from `conv` mode. Resumes all goals before the mode starts and applys the conv -/
@[export pantograph_goal_state_conv_exit_m]
protected def GoalState.convExit (state: GoalState):
Elab.TermElabM TacticResult := do
let (convRhs, convGoal, _) ← match state.convMVar? with
| .some mvar => pure mvar
| .none => return .invalidAction "Not in conv state"
let tacticM : Elab.Tactic.TacticM Elab.Tactic.SavedState:= do
-- Vide `Lean.Elab.Tactic.Conv.convert`
state.savedState.restore
-- Close all existing goals with `refl`
for mvarId in (← Elab.Tactic.getGoals) do
liftM <| mvarId.refl <|> mvarId.inferInstance <|> pure ()
Elab.Tactic.pruneSolvedGoals
unless (← Elab.Tactic.getGoals).isEmpty do
throwError "convert tactic failed, there are unsolved goals\n{Elab.goalsToMessageData (← Elab.Tactic.getGoals)}"
Elab.Tactic.setGoals [convGoal]
let targetNew ← instantiateMVars (.mvar convRhs)
let proof ← instantiateMVars (.mvar convGoal)
Elab.Tactic.liftMetaTactic1 fun mvarId => mvarId.replaceTargetEq targetNew proof
MonadBacktrack.saveState
try
let nextSavedState ← tacticM { elaborator := .anonymous } |>.run' state.savedState.tactic
return .success {
root := state.root,
savedState := nextSavedState
parentMVar? := .some convGoal,
convMVar? := .none
calcPrevRhs? := .none
}
catch exception =>
return .failure #[← exception.toMessageData.toString]
protected def GoalState.calcPrevRhsOf? (state: GoalState) (goal: MVarId): Option Expr := do
let (mvarId, rhs) ← state.calcPrevRhs?
if mvarId == goal then
.some rhs
else
.none
@[export pantograph_goal_state_try_calc_m]
protected def GoalState.tryCalc (state: GoalState) (goal: MVarId) (pred: String):
Elab.TermElabM TacticResult := do
state.restoreElabM
if state.convMVar?.isSome then
return .invalidAction "Cannot initiate `calc` while in `conv` state"
let `(term|$pred) ← match Parser.runParserCategory
(env := state.env)
(catName := `term)
(input := pred)
(fileName := filename) with
| .ok syn => pure syn
| .error error => return .parseError error
goal.checkNotAssigned `GoalState.tryCalc
let calcPrevRhs? := state.calcPrevRhsOf? goal
let decl ← goal.getDecl
let target ← instantiateMVars decl.type
let tag := decl.userName
try
goal.withContext do
let mut step ← Elab.Term.elabType <| ← do
if let some prevRhs := calcPrevRhs? then
Elab.Term.annotateFirstHoleWithType pred (← Meta.inferType prevRhs)
else
pure pred
let some (_, lhs, rhs) ← Elab.Term.getCalcRelation? step |
throwErrorAt pred "invalid 'calc' step, relation expected{indentExpr step}"
if let some prevRhs := calcPrevRhs? then
unless ← Meta.isDefEqGuarded lhs prevRhs do
throwErrorAt pred "invalid 'calc' step, left-hand-side is{indentD m!"{lhs} : {← Meta.inferType lhs}"}\nprevious right-hand-side is{indentD m!"{prevRhs} : {← Meta.inferType prevRhs}"}" -- "
-- Creates a mvar to represent the proof that the calc tactic solves the
-- current branch
-- In the Lean `calc` tactic this is gobbled up by
-- `withCollectingNewGoalsFrom`
let mut proof ← Meta.mkFreshExprMVarAt (← getLCtx) (← Meta.getLocalInstances) step
(userName := tag ++ `calc)
let mvarBranch := proof.mvarId!
let mut proofType ← Meta.inferType proof
let mut remainder? := Option.none
-- The calc tactic either solves the main goal or leaves another relation.
-- Replace the main goal, and save the new goal if necessary
unless ← Meta.isDefEq proofType target do
let rec throwFailed :=
throwError "'calc' tactic failed, has type{indentExpr proofType}\nbut it is expected to have type{indentExpr target}"
let some (_, _, rhs) ← Elab.Term.getCalcRelation? proofType | throwFailed
let some (r, _, rhs') ← Elab.Term.getCalcRelation? target | throwFailed
let lastStep := mkApp2 r rhs rhs'
let lastStepGoal ← Meta.mkFreshExprSyntheticOpaqueMVar lastStep tag
(proof, proofType) ← Elab.Term.mkCalcTrans proof proofType lastStepGoal lastStep
unless ← Meta.isDefEq proofType target do throwFailed
remainder? := .some lastStepGoal.mvarId!
goal.assign proof
let goals := [ mvarBranch ] ++ remainder?.toList
let calcPrevRhs? := remainder?.map $ λ g => (g, rhs)
return .success {
root := state.root,
savedState := {
term := ← MonadBacktrack.saveState,
tactic := { goals },
},
parentMVar? := .some goal,
calcPrevRhs?
}
catch exception =>
return .failure #[← exception.toMessageData.toString]
end Pantograph

205
Pantograph/Library.lean Normal file
View File

@ -0,0 +1,205 @@
import Pantograph.Condensed
import Pantograph.Environment
import Pantograph.Goal
import Pantograph.Protocol
import Pantograph.Serial
import Pantograph.Version
import Lean
namespace Lean
/-- This is better than the default version since it handles `.` and doesn't
crash the program when it fails. -/
def setOptionFromString' (opts : Options) (entry : String) : ExceptT String IO Options := do
let ps := (entry.splitOn "=").map String.trim
let [key, val] ← pure ps | throw "invalid configuration option entry, it must be of the form '<key> = <value>'"
let key := key.toName
let defValue ← getOptionDefaultValue key
match defValue with
| DataValue.ofString _ => pure $ opts.setString key val
| DataValue.ofBool _ =>
match val with
| "true" => pure $ opts.setBool key true
| "false" => pure $ opts.setBool key false
| _ => throw s!"invalid Bool option value '{val}'"
| DataValue.ofName _ => pure $ opts.setName key val.toName
| DataValue.ofNat _ =>
match val.toNat? with
| none => throw s!"invalid Nat option value '{val}'"
| some v => pure $ opts.setNat key v
| DataValue.ofInt _ =>
match val.toInt? with
| none => throw s!"invalid Int option value '{val}'"
| some v => pure $ opts.setInt key v
| DataValue.ofSyntax _ => throw s!"invalid Syntax option value"
end Lean
open Lean
namespace Pantograph
def runMetaM { α } (metaM: MetaM α): CoreM α :=
metaM.run'
def runTermElabM { α } (termElabM: Elab.TermElabM α): CoreM α :=
termElabM.run' (ctx := Condensed.elabContext) |>.run'
def errorI (type desc: String): Protocol.InteractionError := { error := type, desc := desc }
/-- Adds the given paths to Lean package search path -/
@[export pantograph_init_search]
unsafe def initSearch (sp: String): IO Unit := do
Lean.enableInitializersExecution
Lean.initSearchPath (← Lean.findSysroot) (sp := System.SearchPath.parse sp)
/-- Creates a Core.Context object needed to run all monads -/
@[export pantograph_create_core_context]
def createCoreContext (options: Array String): IO Core.Context := do
let options? ← options.foldlM setOptionFromString' Options.empty |>.run
let options ← match options? with
| .ok options => pure options
| .error e => throw $ IO.userError s!"Options cannot be parsed: {e}"
return {
currNamespace := Name.str .anonymous "Aniva"
openDecls := [], -- No 'open' directives needed
fileName := "<Pantograph>",
fileMap := { source := "", positions := #[0] },
options := options
}
/-- Creates a Core.State object needed to run all monads -/
@[export pantograph_create_core_state]
def createCoreState (imports: Array String): IO Core.State := do
let env ← Lean.importModules
(imports := imports.map (λ str => { module := str.toName, runtimeOnly := false }))
(opts := {})
(trustLevel := 1)
return { env := env }
@[export pantograph_env_add_m]
def envAdd (name: String) (type: String) (value: String) (isTheorem: Bool):
CoreM (Protocol.CR Protocol.EnvAddResult) :=
Environment.addDecl { name, type, value, isTheorem }
@[export pantograph_parse_elab_type_m]
def parseElabType (type: String): Elab.TermElabM (Protocol.CR Expr) := do
let env ← MonadEnv.getEnv
let syn ← match parseTerm env type with
| .error str => return .error $ errorI "parsing" str
| .ok syn => pure syn
match ← elabType syn with
| .error str => return .error $ errorI "elab" str
| .ok expr => return .ok (← instantiateMVars expr)
/-- This must be a TermElabM since the parsed expr contains extra information -/
@[export pantograph_parse_elab_expr_m]
def parseElabExpr (expr: String) (expectedType?: Option String := .none): Elab.TermElabM (Protocol.CR Expr) := do
let env ← MonadEnv.getEnv
let expectedType? ← match ← expectedType?.mapM parseElabType with
| .none => pure $ .none
| .some (.ok t) => pure $ .some t
| .some (.error e) => return .error e
let syn ← match parseTerm env expr with
| .error str => return .error $ errorI "parsing" str
| .ok syn => pure syn
match ← elabTerm syn expectedType? with
| .error str => return .error $ errorI "elab" str
| .ok expr => return .ok (← instantiateMVars expr)
@[export pantograph_expr_echo_m]
def exprEcho (expr: String) (expectedType?: Option String := .none) (levels: Array String := #[]) (options: @&Protocol.Options := {}):
CoreM (Protocol.CR Protocol.ExprEchoResult) :=
runTermElabM $ Elab.Term.withLevelNames (levels.toList.map (·.toName)) do
let expr ← match ← parseElabExpr expr expectedType? with
| .error e => return .error e
| .ok expr => pure expr
try
let type ← unfoldAuxLemmas (← Meta.inferType expr)
return .ok {
type := (← serializeExpression options type),
expr := (← serializeExpression options expr)
}
catch exception =>
return .error $ errorI "typing" (← exception.toMessageData.toString)
@[export pantograph_goal_start_expr_m]
def goalStartExpr (expr: String) (levels: Array String): CoreM (Protocol.CR GoalState) :=
runTermElabM $ Elab.Term.withLevelNames (levels.toList.map (·.toName)) do
let expr ← match ← parseElabType expr with
| .error e => return .error e
| .ok expr => pure $ expr
return .ok $ ← GoalState.create expr
@[export pantograph_goal_resume]
def goalResume (target: GoalState) (goals: Array String): Except String GoalState :=
target.resume (goals.map (λ n => { name := n.toName }) |>.toList)
@[export pantograph_goal_serialize_m]
def goalSerialize (state: GoalState) (options: @&Protocol.Options): CoreM (Array Protocol.Goal) :=
runMetaM <| state.serializeGoals (parent := .none) options
@[export pantograph_goal_print_m]
def goalPrint (state: GoalState) (options: @&Protocol.Options): CoreM Protocol.GoalPrintResult :=
runMetaM do
state.restoreMetaM
return {
root? := ← state.rootExpr?.mapM (λ expr =>
state.withRootContext do
serializeExpression options (← instantiateAll expr)),
parent? := ← state.parentExpr?.mapM (λ expr =>
state.withParentContext do
serializeExpression options (← instantiateAll expr)),
}
@[export pantograph_goal_tactic_m]
def goalTactic (state: GoalState) (goal: MVarId) (tactic: String): CoreM TacticResult :=
runTermElabM <| state.tryTactic goal tactic
@[export pantograph_goal_assign_m]
def goalAssign (state: GoalState) (goal: MVarId) (expr: String): CoreM TacticResult :=
runTermElabM <| state.tryAssign goal expr
@[export pantograph_goal_have_m]
protected def GoalState.tryHave (state: GoalState) (goal: MVarId) (binderName: String) (type: String): CoreM TacticResult := do
let type ← match (← parseTermM type) with
| .ok syn => pure syn
| .error error => return .parseError error
runTermElabM do
state.restoreElabM
state.tryTacticM goal $ Tactic.evalHave binderName.toName type
@[export pantograph_goal_try_define_m]
protected def GoalState.tryDefine (state: GoalState) (goal: MVarId) (binderName: String) (expr: String): CoreM TacticResult := do
let expr ← match (← parseTermM expr) with
| .ok syn => pure syn
| .error error => return .parseError error
runTermElabM do
state.restoreElabM
state.tryTacticM goal (Tactic.evalDefine binderName.toName expr)
@[export pantograph_goal_try_motivated_apply_m]
protected def GoalState.tryMotivatedApply (state: GoalState) (goal: MVarId) (recursor: String):
Elab.TermElabM TacticResult := do
state.restoreElabM
let recursor ← match (← parseTermM recursor) with
| .ok syn => pure syn
| .error error => return .parseError error
state.tryTacticM goal (tacticM := Tactic.evalMotivatedApply recursor)
@[export pantograph_goal_try_no_confuse_m]
protected def GoalState.tryNoConfuse (state: GoalState) (goal: MVarId) (eq: String):
Elab.TermElabM TacticResult := do
state.restoreElabM
let eq ← match (← parseTermM eq) with
| .ok syn => pure syn
| .error error => return .parseError error
state.tryTacticM goal (tacticM := Tactic.evalNoConfuse eq)
@[export pantograph_goal_let_m]
def goalLet (state: GoalState) (goal: MVarId) (binderName: String) (type: String): CoreM TacticResult :=
runTermElabM <| state.tryLet goal binderName type
@[export pantograph_goal_conv_m]
def goalConv (state: GoalState) (goal: MVarId): CoreM TacticResult :=
runTermElabM <| state.conv goal
@[export pantograph_goal_conv_exit_m]
def goalConvExit (state: GoalState): CoreM TacticResult :=
runTermElabM <| state.convExit
@[export pantograph_goal_calc_m]
def goalCalc (state: GoalState) (goal: MVarId) (pred: String): CoreM TacticResult :=
runTermElabM <| state.tryCalc goal pred
end Pantograph

321
Pantograph/Protocol.lean Normal file
View File

@ -0,0 +1,321 @@
/-
All the command input/output structures are stored here
Note that no command other than `InteractionError` may have `error` as one of
its field names to avoid confusion with error messages generated by the REPL.
-/
import Lean.Data.Json
namespace Pantograph.Protocol
/-- Main Option structure, placed here to avoid name collision -/
structure Options where
-- When false, suppress newlines in Json objects. Useful for machine-to-machine interaction.
-- This should be false` by default to avoid any surprises with parsing.
printJsonPretty: Bool := false
-- When enabled, pretty print every expression
printExprPretty: Bool := true
-- When enabled, print the raw AST of expressions
printExprAST: Bool := false
printDependentMVars: 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`
printImplementationDetailHyps: Bool := false
-- If this is set to `true`, goals will never go dormant, so you don't have to manage resumption
automaticMode: Bool := true
deriving Lean.ToJson
abbrev OptionsT := ReaderT Options
--- Expression Objects ---
structure BoundExpression where
binders: Array (String × String)
target: String
deriving Lean.ToJson
structure Expression where
-- Pretty printed expression
pp?: Option String := .none
-- AST structure
sexp?: Option String := .none
dependentMVars?: Option (Array String) := .none
deriving Lean.ToJson
structure Variable where
/-- The internal name used in raw expressions -/
name: String := ""
/-- The name displayed to the user -/
userName: String
/-- Does the name contain a dagger -/
isInaccessible: Bool := false
type?: Option Expression := .none
value?: Option Expression := .none
deriving Lean.ToJson
structure Goal where
name: String := ""
/-- Name of the metavariable -/
userName?: Option String := .none
/-- Is the goal in conversion mode -/
isConversion: Bool := false
/-- target expression type -/
target: Expression
/-- Variables -/
vars: Array Variable := #[]
deriving Lean.ToJson
--- Individual Commands and return types ---
structure Command where
cmd: String
payload: Lean.Json
deriving Lean.FromJson
structure InteractionError where
error: String
desc: String
deriving Lean.ToJson
def errorIndex (desc: String): InteractionError := { error := "index", desc }
def errorExpr (desc: String): InteractionError := { error := "expr", desc }
--- Individual command and return types ---
structure Reset where
deriving Lean.FromJson
structure Stat where
deriving Lean.FromJson
structure StatResult where
-- Number of goals states
nGoals: Nat
deriving Lean.ToJson
-- Return the type of an expression
structure ExprEcho where
expr: String
type?: Option String
-- universe levels
levels: Option (Array String) := .none
deriving Lean.FromJson
structure ExprEchoResult where
expr: Expression
type: Expression
deriving Lean.ToJson
-- Print all symbols in environment
structure EnvCatalog where
deriving Lean.FromJson
structure EnvCatalogResult where
symbols: Array String
deriving Lean.ToJson
-- Print the type of a symbol
structure EnvInspect where
name: String
-- If true/false, show/hide the value expressions; By default definitions
-- values are shown and theorem values are hidden.
value?: Option Bool := .some false
-- If true, show the type and value dependencies
dependency?: Option Bool := .some false
deriving Lean.FromJson
-- See `InductiveVal`
structure InductInfo where
numParams: Nat
numIndices: Nat
all: Array String
ctors: Array String
isRec: Bool := false
isReflexive: Bool := false
isNested: Bool := false
deriving Lean.ToJson
-- See `ConstructorVal`
structure ConstructorInfo where
induct: String
cidx: Nat
numParams: Nat
numFields: Nat
deriving Lean.ToJson
/-- See `Lean/Declaration.lean` -/
structure RecursorRule where
ctor: String
nFields: Nat
rhs: Expression
deriving Lean.ToJson
structure RecursorInfo where
all: Array String
numParams: Nat
numIndices: Nat
numMotives: Nat
numMinors: Nat
rules: Array RecursorRule
k: Bool
deriving Lean.ToJson
structure EnvInspectResult where
type: Expression
isUnsafe: Bool := false
value?: Option Expression := .none
module?: Option String := .none
-- If the name is private, displays the public facing name
publicName?: Option String := .none
typeDependency?: Option (Array String) := .none
valueDependency?: Option (Array String) := .none
inductInfo?: Option InductInfo := .none
constructorInfo?: Option ConstructorInfo := .none
recursorInfo?: Option RecursorInfo := .none
deriving Lean.ToJson
structure EnvAdd where
name: String
type: String
value: String
isTheorem: Bool
deriving Lean.FromJson
structure EnvAddResult where
deriving Lean.ToJson
/-- Set options; See `Options` struct above for meanings -/
structure OptionsSet where
printJsonPretty?: Option Bool
printExprPretty?: Option Bool
printExprAST?: Option Bool
printDependentMVars?: Option Bool
noRepeat?: Option Bool
printAuxDecls?: Option Bool
printImplementationDetailHyps?: Option Bool
automaticMode?: Option Bool
deriving Lean.FromJson
structure OptionsSetResult where
deriving Lean.ToJson
structure OptionsPrint where
deriving Lean.FromJson
structure GoalStart where
-- Only one of the fields below may be populated.
expr: Option String -- Directly parse in an expression
-- universe levels
levels: Option (Array String) := .none
copyFrom: Option String -- Copy the type from a theorem in the environment
deriving Lean.FromJson
structure GoalStartResult where
stateId: Nat := 0
-- Name of the root metavariable
root: String
deriving Lean.ToJson
structure GoalTactic where
-- Identifiers for tree, state, and goal
stateId: Nat
goalId: Nat := 0
-- One of the fields here must be filled
tactic?: Option String := .none
expr?: Option String := .none
have?: Option String := .none
let?: Option String := .none
calc?: Option String := .none
-- true to enter `conv`, `false` to exit. In case of exit the `goalId` is ignored.
conv?: Option Bool := .none
-- In case of the `have` tactic, the new free variable name is provided here
binderName?: Option String := .none
deriving Lean.FromJson
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
-- Existence of this field shows tactic execution failure
tacticErrors?: Option (Array String) := .none
-- Existence of this field shows the tactic parsing has failed
parseError?: Option String := .none
deriving Lean.ToJson
structure GoalContinue where
-- State from which the continuation acquires the context
target: Nat
-- One of the following must be supplied
-- The state which is an ancestor of `target` where goals will be extracted from
branch?: Option Nat := .none
-- Or, the particular goals that should be brought back into scope
goals?: Option (Array String) := .none
deriving Lean.FromJson
structure GoalContinueResult where
nextStateId: Nat
goals: (Array Goal)
deriving Lean.ToJson
-- Remove goal states
structure GoalDelete where
-- This is ok being a List because it doesn't show up in the ABI
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 := .none
-- The filling expression of the parent goal
parent?: 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
instantiate: Bool := true
printSexp: Bool := false
/-- Executes the Lean compiler on a single file -/
structure FrontendProcess where
-- One of these two must be supplied: Either supply the file name or the content.
fileName?: Option String := .none
file?: Option String := .none
-- If set to true, collect tactic invocations
invocations: Bool := false
-- If set to true, collect `sorry`s
sorrys: Bool := false
deriving Lean.FromJson
structure InvokedTactic where
goalBefore: String
goalAfter: String
tactic: String
-- List of used constants
usedConstants: Array String
deriving Lean.ToJson
structure CompilationUnit where
-- String boundaries of compilation units
boundary: (Nat × Nat)
-- Tactic invocations
invocations?: Option (List InvokedTactic) := .none
goalStateId?: Option Nat := .none
goals: Array Goal := #[]
messages: Array String := #[]
deriving Lean.ToJson
structure FrontendProcessResult where
units: List CompilationUnit
deriving Lean.ToJson
abbrev CR α := Except InteractionError α
end Pantograph.Protocol

362
Pantograph/Serial.lean Normal file
View File

@ -0,0 +1,362 @@
/-
All serialisation functions;
This replicates the behaviour of `Scope`s in `Lean/Elab/Command.lean` without
using `Scope`s.
-/
import Lean
import Pantograph.Condensed
import Pantograph.Expr
import Pantograph.Goal
import Pantograph.Protocol
open Lean
-- Symbol processing functions --
namespace Pantograph
--- Input Functions ---
/-- Read syntax object from string -/
def parseTerm (env: Environment) (s: String): Except String Syntax :=
Parser.runParserCategory
(env := env)
(catName := `term)
(input := s)
(fileName := "<stdin>")
def parseTermM [Monad m] [MonadEnv m] (s: String): m (Except String Syntax) := do
return Parser.runParserCategory
(env := ← MonadEnv.getEnv)
(catName := `term)
(input := s)
(fileName := "<stdin>")
/-- Parse a syntax object. May generate additional metavariables! -/
def elabType (syn: Syntax): Elab.TermElabM (Except String Expr) := do
try
let expr ← Elab.Term.elabType syn
return .ok expr
catch ex => return .error (← ex.toMessageData.toString)
def elabTerm (syn: Syntax) (expectedType? : Option Expr := .none): Elab.TermElabM (Except String Expr) := do
try
let expr ← Elab.Term.elabTerm (stx := syn) expectedType?
return .ok expr
catch ex => return .error (← ex.toMessageData.toString)
--- Output Functions ---
def typeExprToBound (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) }
def serializeName (name: Name) (sanitize: Bool := true): String :=
let internal := name.isInaccessibleUserName || name.hasMacroScopes
if sanitize && internal then "_"
else toString name |> addQuotes
where
addQuotes (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)` -/
partial def serializeSortLevel (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 =>
let v := serializeSortLevel v sanitize
let w := serializeSortLevel w sanitize
s!"(:max {v} {w})"
| .imax v w =>
let v := serializeSortLevel v sanitize
let w := serializeSortLevel w sanitize
s!"(:imax {v} {w})"
| .param name =>
let name := serializeName name sanitize
s!"{name}"
| .mvar id =>
let name := serializeName id.name sanitize
s!"(:mv {name})"
match k, u with
| 0, _ => u_str
| _, .zero => s!"{k}"
| _, _ => s!"(+ {u_str} {k})"
/--
Completely serializes an expression tree. Json not used due to compactness
A `_` symbol in the AST indicates automatic deductions not present in the original expression.
-/
partial def serializeExpressionSexp (expr: Expr) (sanitize: Bool := true): MetaM String := do
self expr
where
delayedMVarToSexp (e: Expr): MetaM (Option String) := do
let .some invocation ← toDelayedMVarInvocation e | return .none
let callee ← self $ .mvar invocation.mvarIdPending
let sites ← invocation.args.mapM (λ (fvarId, arg) => do
let arg := match arg with
| .some arg => arg
| .none => .fvar fvarId
self arg
)
let tailArgs ← invocation.tail.mapM self
let sites := " ".intercalate sites.toList
let result := if tailArgs.isEmpty then
s!"(:subst {callee} {sites})"
else
let tailArgs := " ".intercalate tailArgs.toList
s!"((:subst {callee} {sites}) {tailArgs})"
return .some result
self (e: Expr): MetaM String := do
if let .some result ← delayedMVarToSexp e then
return result
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.
pure s!"{deBruijnIndex}"
| .fvar fvarId =>
let name := ofName fvarId.name
pure s!"(:fv {name})"
| .mvar mvarId => do
let pref := if ← mvarId.isDelayedAssigned then "mvd" else "mv"
let name := ofName mvarId.name
pure s!"(:{pref} {name})"
| .sort level =>
let level := serializeSortLevel level sanitize
pure s!"(:sort {level})"
| .const declName _ =>
-- The universe level of the const expression is elided since it should be
-- inferrable from surrounding expression
pure s!"(:c {declName})"
| .app _ _ => do
let fn' ← self e.getAppFn
let args := (← e.getAppArgs.mapM self) |>.toList
let args := " ".intercalate args
pure s!"({fn'} {args})"
| .lam binderName binderType body binderInfo => do
let binderName' := ofName binderName
let binderType' ← self binderType
let body' ← self body
let binderInfo' := binderInfoSexp binderInfo
pure s!"(:lambda {binderName'} {binderType'} {body'}{binderInfo'})"
| .forallE binderName binderType body binderInfo => do
let binderName' := ofName binderName
let binderType' ← self binderType
let body' ← self body
let binderInfo' := binderInfoSexp binderInfo
pure s!"(:forall {binderName'} {binderType'} {body'}{binderInfo'})"
| .letE name type value body _ => do
-- Dependent boolean flag diacarded
let name' := serializeName name
let type' ← self type
let value' ← self value
let body' ← self body
pure 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}\""
pure 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 _ _ _ => do
let env ← getEnv
let projApp := exprProjToApp env e
let autos := String.intercalate " " (List.replicate projApp.numParams "_")
let inner ← self projApp.inner
pure s!"((:c {projApp.projector}) {autos} {inner})"
-- Elides all unhygenic names
binderInfoSexp : Lean.BinderInfo → String
| .default => ""
| .implicit => " :implicit"
| .strictImplicit => " :strictImplicit"
| .instImplicit => " :instImplicit"
ofName (name: Name) := serializeName name sanitize
def serializeExpression (options: @&Protocol.Options) (e: Expr): MetaM Protocol.Expression := do
let pp?: Option String ← match options.printExprPretty with
| true => pure $ .some $ toString $ ← Meta.ppExpr e
| false => pure $ .none
let sexp?: Option String ← match options.printExprAST with
| true => pure $ .some $ ← serializeExpressionSexp e
| false => pure $ .none
let dependentMVars? ← match options.printDependentMVars with
| true => pure $ .some $ (← Meta.getMVars e).map (λ mvarId => mvarId.name.toString)
| false => pure $ .none
return {
pp?,
sexp?
dependentMVars?,
}
/-- Adapted from ppGoal -/
def serializeGoal (options: @&Protocol.Options) (goal: MVarId) (mvarDecl: MetavarDecl) (parentDecl?: Option MetavarDecl := .none)
: MetaM Protocol.Goal := do
-- Options for printing; See Meta.ppGoal for details
let showLetValues := true
let ppAuxDecls := options.printAuxDecls
let ppImplDetailHyps := options.printImplementationDetailHyps
let lctx := mvarDecl.lctx
let lctx := lctx.sanitizeNames.run' { options := (← getOptions) }
Meta.withLCtx lctx mvarDecl.localInstances do
let ppVarNameOnly (localDecl: LocalDecl): MetaM Protocol.Variable := do
match localDecl with
| .cdecl _ fvarId userName _ _ _ =>
return {
name := ofName fvarId.name,
userName:= ofName userName.simpMacroScopes,
isInaccessible := userName.isInaccessibleUserName
}
| .ldecl _ fvarId userName _ _ _ _ => do
return {
name := ofName fvarId.name,
userName := toString userName.simpMacroScopes,
isInaccessible := userName.isInaccessibleUserName
}
let ppVar (localDecl : LocalDecl) : MetaM Protocol.Variable := do
match localDecl with
| .cdecl _ fvarId userName type _ _ =>
let userName := userName.simpMacroScopes
let type ← instantiate type
return {
name := ofName fvarId.name,
userName:= ofName userName,
isInaccessible := userName.isInaccessibleUserName
type? := .some (← serializeExpression options type)
}
| .ldecl _ fvarId userName type val _ _ => do
let userName := userName.simpMacroScopes
let type ← instantiate type
let value? ← if showLetValues then
let val ← instantiate val
pure $ .some (← serializeExpression options val)
else
pure $ .none
return {
name := ofName fvarId.name,
userName:= ofName userName,
isInaccessible := userName.isInaccessibleUserName
type? := .some (← serializeExpression options type)
value? := value?
}
let vars ← lctx.foldlM (init := []) fun acc (localDecl : LocalDecl) => do
let skip := !ppAuxDecls && localDecl.isAuxDecl ||
!ppImplDetailHyps && localDecl.isImplementationDetail
if skip then
return acc
else
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 {
name := ofName goal.name,
userName? := if mvarDecl.userName == .anonymous then .none else .some (ofName mvarDecl.userName),
isConversion := isLHSGoal? mvarDecl.type |>.isSome,
target := (← serializeExpression options (← instantiate mvarDecl.type)),
vars := vars.reverse.toArray
}
where
instantiate := instantiateAll
ofName (n: Name) := serializeName n (sanitize := false)
protected def GoalState.serializeGoals
(state: GoalState)
(parent: Option GoalState := .none)
(options: @&Protocol.Options := {}):
MetaM (Array Protocol.Goal):= do
state.restoreMetaM
let goals := state.goals.toArray
let parentDecl? := parent.bind (λ parentState => parentState.mctx.findDecl? state.parentMVar?.get!)
goals.mapM fun goal => do
match state.mctx.findDecl? goal with
| .some mvarDecl =>
let serializedGoal ← serializeGoal 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 -/
@[export pantograph_goal_state_diag_m]
protected def GoalState.diag (goalState: GoalState) (parent?: Option GoalState := .none) (options: Protocol.GoalDiag := {}): CoreM String := do
let metaM: MetaM String := do
goalState.restoreMetaM
let savedState := goalState.savedState
let goals := savedState.tactic.goals
let mctx ← getMCtx
let root := goalState.root
-- Print the root
let result: String ← match mctx.decls.find? root with
| .some decl => printMVar ">" root decl
| .none => pure s!">{root.name}: ??"
let resultGoals ← goals.filter (· != root) |>.mapM (fun mvarId =>
match mctx.decls.find? mvarId with
| .some decl => printMVar "⊢" mvarId decl
| .none => pure s!"⊢{mvarId.name}: ??"
)
let goals := goals.toSSet
let resultOthers ← mctx.decls.toList.filter (λ (mvarId, _) =>
!(goals.contains mvarId || mvarId == root) && options.printAll)
|>.mapM (fun (mvarId, decl) => do
let pref := if parentHasMVar mvarId then " " else "~"
printMVar pref mvarId decl
)
pure $ result ++ "\n" ++ (resultGoals.map (· ++ "\n") |> String.join) ++ (resultOthers.map (· ++ "\n") |> String.join)
metaM.run' {}
where
printMVar (pref: String) (mvarId: MVarId) (decl: MetavarDecl): MetaM String := mvarId.withContext do
let resultFVars: List String ←
if options.printContext then
decl.lctx.fvarIdToDecl.toList.mapM (λ (fvarId, decl) =>
do pure $ (← printFVar fvarId decl) ++ "\n")
else
pure []
let type ← if options.instantiate
then instantiateAll decl.type
else pure $ decl.type
let type_sexp ← if options.printSexp then
let sexp ← serializeExpressionSexp type (sanitize := false)
pure <| " " ++ sexp
else
pure ""
let resultMain: String := s!"{pref}{mvarId.name}{userNameToString decl.userName}: {← Meta.ppExpr decl.type}{type_sexp}"
let resultValue: String ←
if options.printValue then
if let .some value ← getExprMVarAssignment? mvarId then
let value ← if options.instantiate
then instantiateAll value
else pure $ value
pure s!"\n := {← Meta.ppExpr value}"
else if let .some { mvarIdPending, .. } ← getDelayedMVarAssignment? mvarId then
pure s!"\n ::= {mvarIdPending.name}"
else
pure ""
else
pure ""
pure $ (String.join resultFVars) ++ resultMain ++ resultValue
printFVar (fvarId: FVarId) (decl: LocalDecl): MetaM String := do
pure s!" | {fvarId.name}{userNameToString decl.userName}: {← Meta.ppExpr decl.type}"
userNameToString : Name → String
| .anonymous => ""
| other => s!"[{other}]"
parentHasMVar (mvarId: MVarId): Bool := parent?.map (λ state => state.mctx.decls.contains mvarId) |>.getD true
end Pantograph

5
Pantograph/Tactic.lean Normal file
View File

@ -0,0 +1,5 @@
import Pantograph.Tactic.Assign
import Pantograph.Tactic.Congruence
import Pantograph.Tactic.MotivatedApply
import Pantograph.Tactic.NoConfuse
import Pantograph.Tactic.Prograde

View File

@ -0,0 +1,31 @@
import Lean
open Lean
namespace Pantograph.Tactic
/-- WARNING: This should be used with a function like `elabTermWithHoles` that properly collects the mvar information from `expr`. -/
def assign (goal: MVarId) (expr: Expr) (nextGoals: List MVarId): MetaM (List MVarId) := do
goal.checkNotAssigned `Pantograph.Tactic.assign
-- This run of the unifier is critical in resolving mvars in passing
let exprType ← Meta.inferType expr
let goalType ← goal.getType
unless ← Meta.isDefEq goalType exprType do
throwError s!"{← Meta.ppExpr expr} : {← Meta.ppExpr exprType} ≠ {← Meta.ppExpr goalType}"
goal.assign expr
nextGoals.filterM (not <$> ·.isAssigned)
def evalAssign : Elab.Tactic.Tactic := fun stx => Elab.Tactic.withMainContext do
let target ← Elab.Tactic.getMainTarget
let goal ← Elab.Tactic.getMainGoal
goal.checkNotAssigned `Pantograph.Tactic.evalAssign
let (expr, nextGoals) ← Elab.Tactic.elabTermWithHoles stx
(expectedType? := .some target)
(tagSuffix := .anonymous )
(allowNaturalHoles := true)
goal.assign expr
Elab.Tactic.replaceMainGoal nextGoals
end Pantograph.Tactic

View File

@ -0,0 +1,98 @@
import Lean
open Lean
namespace Pantograph.Tactic
def congruenceArg (mvarId: MVarId): MetaM (List MVarId) := mvarId.withContext do
mvarId.checkNotAssigned `Pantograph.Tactic.congruenceArg
let target ← mvarId.getType
let .some (β, _, _) := (← instantiateMVars target).eq? | throwError "Goal is not an Eq"
let userName := (← mvarId.getDecl).userName
let u ← Meta.mkFreshLevelMVar
let α ← Meta.mkFreshExprSyntheticOpaqueMVar (mkSort u)
(tag := userName ++ `α)
let f ← Meta.mkFreshExprSyntheticOpaqueMVar (.forallE .anonymous α β .default)
(tag := userName ++ `f)
let a₁ ← Meta.mkFreshExprSyntheticOpaqueMVar α
(tag := userName ++ `a₁)
let a₂ ← Meta.mkFreshExprSyntheticOpaqueMVar α
(tag := userName ++ `a₂)
let h ← Meta.mkFreshExprSyntheticOpaqueMVar (← Meta.mkEq a₁ a₂)
(tag := userName ++ `h)
let conduitType ← Meta.mkEq (← Meta.mkEq (.app f a₁) (.app f a₂)) target
let conduit ← Meta.mkFreshExprSyntheticOpaqueMVar conduitType
(tag := userName ++ `conduit)
mvarId.assign $ ← Meta.mkEqMP conduit (← Meta.mkCongrArg f h)
let result := [α, a₁, a₂, f, h, conduit]
return result.map (·.mvarId!)
def evalCongruenceArg: Elab.Tactic.TacticM Unit := do
let goal ← Elab.Tactic.getMainGoal
let nextGoals ← congruenceArg goal
Elab.Tactic.replaceMainGoal nextGoals
def congruenceFun (mvarId: MVarId): MetaM (List MVarId) := mvarId.withContext do
mvarId.checkNotAssigned `Pantograph.Tactic.congruenceFun
let target ← mvarId.getType
let .some (β, _, _) := (← instantiateMVars target).eq? | throwError "Goal is not an Eq"
let userName := (← mvarId.getDecl).userName
let u ← Meta.mkFreshLevelMVar
let α ← Meta.mkFreshExprSyntheticOpaqueMVar (mkSort u)
(tag := userName ++ `α)
let fType := .forallE .anonymous α β .default
let f₁ ← Meta.mkFreshExprSyntheticOpaqueMVar fType
(tag := userName ++ `f₁)
let f₂ ← Meta.mkFreshExprSyntheticOpaqueMVar fType
(tag := userName ++ `f₂)
let a ← Meta.mkFreshExprSyntheticOpaqueMVar α
(tag := userName ++ `a)
let h ← Meta.mkFreshExprSyntheticOpaqueMVar (← Meta.mkEq f₁ f₂)
(tag := userName ++ `h)
let conduitType ← Meta.mkEq (← Meta.mkEq (.app f₁ a) (.app f₂ a)) target
let conduit ← Meta.mkFreshExprSyntheticOpaqueMVar conduitType
(tag := userName ++ `conduit)
mvarId.assign $ ← Meta.mkEqMP conduit (← Meta.mkCongrFun h a)
let result := [α, f₁, f₂, h, a, conduit]
return result.map (·.mvarId!)
def evalCongruenceFun: Elab.Tactic.TacticM Unit := do
let goal ← Elab.Tactic.getMainGoal
let nextGoals ← congruenceFun goal
Elab.Tactic.replaceMainGoal nextGoals
def congruence (mvarId: MVarId): MetaM (List MVarId) := mvarId.withContext do
mvarId.checkNotAssigned `Pantograph.Tactic.congruence
let target ← mvarId.getType
let .some (β, _, _) := (← instantiateMVars target).eq? | throwError "Goal is not an Eq"
let userName := (← mvarId.getDecl).userName
let u ← Meta.mkFreshLevelMVar
let α ← Meta.mkFreshExprSyntheticOpaqueMVar (mkSort u)
(tag := userName ++ `α)
let fType := .forallE .anonymous α β .default
let f₁ ← Meta.mkFreshExprSyntheticOpaqueMVar fType
(tag := userName ++ `f₁)
let f₂ ← Meta.mkFreshExprSyntheticOpaqueMVar fType
(tag := userName ++ `f₂)
let a₁ ← Meta.mkFreshExprSyntheticOpaqueMVar α
(tag := userName ++ `a₁)
let a₂ ← Meta.mkFreshExprSyntheticOpaqueMVar α
(tag := userName ++ `a₂)
let h₁ ← Meta.mkFreshExprSyntheticOpaqueMVar (← Meta.mkEq f₁ f₂)
(tag := userName ++ `h₁)
let h₂ ← Meta.mkFreshExprSyntheticOpaqueMVar (← Meta.mkEq a₁ a₂)
(tag := userName ++ `h₂)
let conduitType ← Meta.mkEq (← Meta.mkEq (.app f₁ a₁) (.app f₂ a₂)) target
let conduit ← Meta.mkFreshExprSyntheticOpaqueMVar conduitType
(tag := userName ++ `conduit)
mvarId.assign $ ← Meta.mkEqMP conduit (← Meta.mkCongr h₁ h₂)
let result := [α, f₁, f₂, a₁, a₂, h₁, h₂, conduit]
return result.map (·.mvarId!)
def evalCongruence: Elab.Tactic.TacticM Unit := do
let goal ← Elab.Tactic.getMainGoal
let nextGoals ← congruence goal
Elab.Tactic.replaceMainGoal nextGoals
end Pantograph.Tactic

View File

@ -0,0 +1,106 @@
import Lean
open Lean
namespace Pantograph.Tactic
def getForallArgsBody: Expr → List Expr × Expr
| .forallE _ d b _ =>
let (innerArgs, innerBody) := getForallArgsBody b
(d :: innerArgs, innerBody)
| e => ([], e)
def replaceForallBody: Expr → Expr → Expr
| .forallE param domain body binderInfo, target =>
let body := replaceForallBody body target
.forallE param domain body binderInfo
| _, target => target
structure RecursorWithMotive where
args: List Expr
body: Expr
-- .bvar index for the motive and major from the body
iMotive: Nat
namespace RecursorWithMotive
protected def nArgs (info: RecursorWithMotive): Nat := info.args.length
protected def getMotiveType (info: RecursorWithMotive): Expr :=
let level := info.nArgs - info.iMotive - 1
let a := info.args.get! level
a
protected def surrogateMotiveType (info: RecursorWithMotive) (mvars: Array Expr) (resultant: Expr): MetaM Expr := do
let motiveType := Expr.instantiateRev info.getMotiveType mvars
let resultantType ← Meta.inferType resultant
return replaceForallBody motiveType resultantType
protected def conduitType (info: RecursorWithMotive) (mvars: Array Expr) (resultant: Expr): MetaM Expr := do
let motiveCall := Expr.instantiateRev info.body mvars
Meta.mkEq motiveCall resultant
end RecursorWithMotive
def getRecursorInformation (recursorType: Expr): Option RecursorWithMotive := do
let (args, body) := getForallArgsBody recursorType
if ¬ body.isApp then
.none
let iMotive ← match body.getAppFn with
| .bvar iMotive => pure iMotive
| _ => .none
return {
args,
body,
iMotive,
}
def collectMotiveArguments (forallBody: Expr): SSet Nat :=
match forallBody with
| .app (.bvar i) _ => SSet.empty.insert i
| _ => SSet.empty
/-- Applies a symbol of the type `∀ (motive: α → Sort u) (a: α)..., (motive α)` -/
def motivatedApply (mvarId: MVarId) (recursor: Expr) : MetaM (Array Meta.InductionSubgoal) := mvarId.withContext do
mvarId.checkNotAssigned `Pantograph.Tactic.motivatedApply
let recursorType ← Meta.inferType recursor
let resultant ← mvarId.getType
let tag ← mvarId.getTag
let info ← match getRecursorInformation recursorType with
| .some info => pure info
| .none => throwError "Recursor return type does not correspond with the invocation of a motive: {← Meta.ppExpr recursorType}"
let rec go (i: Nat) (prev: Array Expr): MetaM (Array Expr) := do
if i ≥ info.nArgs then
return prev
else
let argType := info.args.get! i
-- If `argType` has motive references, its goal needs to be placed in it
let argType := argType.instantiateRev prev
let bvarIndex := info.nArgs - i - 1
let argGoal ← if bvarIndex = info.iMotive then
let surrogateMotiveType ← info.surrogateMotiveType prev resultant
Meta.mkFreshExprSyntheticOpaqueMVar surrogateMotiveType (tag := tag ++ `motive)
else
Meta.mkFreshExprSyntheticOpaqueMVar argType (tag := .anonymous)
let prev := prev ++ [argGoal]
go (i + 1) prev
termination_by info.nArgs - i
let mut newMVars ← go 0 #[]
-- Create the conduit type which proves the result of the motive is equal to the goal
let conduitType ← info.conduitType newMVars resultant
let goalConduit ← Meta.mkFreshExprSyntheticOpaqueMVar conduitType (tag := `conduit)
mvarId.assign $ ← Meta.mkEqMP goalConduit (mkAppN recursor newMVars)
newMVars := newMVars ++ [goalConduit]
return newMVars.map (λ mvar => { mvarId := mvar.mvarId!})
def evalMotivatedApply : Elab.Tactic.Tactic := fun stx => Elab.Tactic.withMainContext do
let recursor ← Elab.Term.elabTerm (stx := stx) .none
let nextGoals ← motivatedApply (← Elab.Tactic.getMainGoal) recursor
Elab.Tactic.replaceMainGoal $ nextGoals.toList.map (·.mvarId)
end Pantograph.Tactic

View File

@ -0,0 +1,22 @@
import Lean
open Lean
namespace Pantograph.Tactic
def noConfuse (mvarId: MVarId) (h: Expr): MetaM Unit := mvarId.withContext do
mvarId.checkNotAssigned `Pantograph.Tactic.noConfuse
let target ← mvarId.getType
let noConfusion ← Meta.mkNoConfusion (target := target) (h := h)
unless ← Meta.isDefEq (← Meta.inferType noConfusion) target do
throwError "invalid noConfuse call: The resultant type {← Meta.ppExpr $ ← Meta.inferType noConfusion} cannot be unified with {← Meta.ppExpr target}"
mvarId.assign noConfusion
def evalNoConfuse: Elab.Tactic.Tactic := λ stx => do
let goal ← Elab.Tactic.getMainGoal
let h ← goal.withContext $ Elab.Term.elabTerm (stx := stx) .none
noConfuse goal h
Elab.Tactic.replaceMainGoal []
end Pantograph.Tactic

View File

@ -0,0 +1,88 @@
/- Prograde (forward) reasoning tactics -/
import Lean
open Lean
namespace Pantograph.Tactic
private def mkUpstreamMVar (goal: MVarId) : MetaM Expr := do
Meta.mkFreshExprSyntheticOpaqueMVar (← goal.getType) (tag := ← goal.getTag)
/-- Introduces a fvar to the current mvar -/
def define (mvarId: MVarId) (binderName: Name) (expr: Expr): MetaM (FVarId × MVarId) := mvarId.withContext do
mvarId.checkNotAssigned `Pantograph.Tactic.define
let type ← Meta.inferType expr
Meta.withLetDecl binderName type expr λ fvar => do
let mvarUpstream ← mkUpstreamMVar mvarId
mvarId.assign $ ← Meta.mkLetFVars #[fvar] mvarUpstream
pure (fvar.fvarId!, mvarUpstream.mvarId!)
def evalDefine (binderName: Name) (expr: Syntax): Elab.Tactic.TacticM Unit := do
let goal ← Elab.Tactic.getMainGoal
let expr ← goal.withContext $ Elab.Term.elabTerm (stx := expr) (expectedType? := .none)
let (_, mvarId) ← define goal binderName expr
Elab.Tactic.replaceMainGoal [mvarId]
structure BranchResult where
fvarId?: Option FVarId := .none
branch: MVarId
main: MVarId
def «have» (mvarId: MVarId) (binderName: Name) (type: Expr): MetaM BranchResult := mvarId.withContext do
mvarId.checkNotAssigned `Pantograph.Tactic.have
let lctx ← MonadLCtx.getLCtx
-- The branch goal inherits the same context, but with a different type
let mvarBranch ← Meta.mkFreshExprMVarAt lctx (← Meta.getLocalInstances) type
-- Create the context for the `upstream` goal
let fvarId ← mkFreshFVarId
let lctxUpstream := lctx.mkLocalDecl fvarId binderName type
let mvarUpstream ←
withTheReader Meta.Context (fun ctx => { ctx with lctx := lctxUpstream }) do
Meta.withNewLocalInstances #[.fvar fvarId] 0 do
let mvarUpstream ← mkUpstreamMVar mvarId
--let expr: Expr := .app (.lam binderName type mvarBranch .default) mvarUpstream
mvarId.assign $ ← Meta.mkLambdaFVars #[.fvar fvarId] mvarUpstream
pure mvarUpstream
return {
fvarId? := .some fvarId,
branch := mvarBranch.mvarId!,
main := mvarUpstream.mvarId!,
}
def evalHave (binderName: Name) (type: Syntax): Elab.Tactic.TacticM Unit := do
let goal ← Elab.Tactic.getMainGoal
let nextGoals: List MVarId ← goal.withContext do
let type ← Elab.Term.elabType (stx := type)
let result ← «have» goal binderName type
pure [result.branch, result.main]
Elab.Tactic.replaceMainGoal nextGoals
def «let» (mvarId: MVarId) (binderName: Name) (type: Expr): MetaM BranchResult := mvarId.withContext do
mvarId.checkNotAssigned `Pantograph.Tactic.let
let lctx ← MonadLCtx.getLCtx
-- The branch goal inherits the same context, but with a different type
let mvarBranch ← Meta.mkFreshExprMVarAt lctx (← Meta.getLocalInstances) type (userName := binderName)
assert! ¬ type.hasLooseBVars
let mvarUpstream ← Meta.withLetDecl binderName type mvarBranch $ λ fvar => do
let mvarUpstream ← mkUpstreamMVar mvarId
mvarId.assign $ ← Meta.mkLetFVars #[fvar] mvarUpstream
pure mvarUpstream
return {
branch := mvarBranch.mvarId!,
main := mvarUpstream.mvarId!,
}
def evalLet (binderName: Name) (type: Syntax): Elab.Tactic.TacticM Unit := do
let goal ← Elab.Tactic.getMainGoal
let type ← goal.withContext $ Elab.Term.elabType (stx := type)
let result ← «let» goal binderName type
Elab.Tactic.replaceMainGoal [result.branch, result.main]
end Pantograph.Tactic

6
Pantograph/Version.lean Normal file
View File

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

180
README.md Normal file
View File

@ -0,0 +1,180 @@
# Pantograph
A Machine-to-Machine interaction system for Lean 4.
![Pantograph](doc/icon.svg)
Pantograph provides interfaces to execute proofs, construct expressions, and
examine the symbol list of a Lean project for machine learning.
## Installation
For Nix users, run
``` sh
nix build .#{sharedLib,executable}
```
to build either the shared library or executable.
Install `elan` and `lake`, and run
``` sh
lake build
```
This builds the executable in `.lake/build/bin/pantograph-repl`.
## Executable Usage
``` sh
pantograph MODULES|LEAN_OPTIONS
```
The REPL loop accepts commands as single-line JSON inputs and outputs either an
`Error:` (indicating malformed command) or a JSON return value indicating the
result of a command execution. The command can be passed in one of two formats
```
command { ... }
{ "cmd": command, "payload": ... }
```
The list of available commands can be found in `Pantograph/Protocol.lean` and below. An
empty command aborts the REPL.
The `pantograph` executable must be run with a list of modules to import. It can
also accept lean options of the form `--key=value` e.g. `--pp.raw=true`.
Example: (~5k symbols)
```
$ pantograph Init
env.catalog
env.inspect {"name": "Nat.le_add_left"}
```
Example with `mathlib4` (~90k symbols, may stack overflow, see troubleshooting)
```
$ pantograph Mathlib.Analysis.Seminorm
env.catalog
```
Example proving a theorem: (alternatively use `goal.start {"copyFrom": "Nat.add_comm"}`) to prime the proof
```
$ pantograph Init
goal.start {"expr": "∀ (n m : Nat), n + m = m + n"}
goal.tactic {"stateId": 0, "goalId": 0, "tactic": "intro n m"}
goal.tactic {"stateId": 1, "goalId": 0, "tactic": "assumption"}
goal.delete {"stateIds": [0]}
stat {}
goal.tactic {"stateId": 1, "goalId": 0, "tactic": "rw [Nat.add_comm]"}
stat
```
where the application of `assumption` should lead to a failure.
### Commands
See `Pantograph/Protocol.lean` for a description of the parameters and return values in JSON.
* `reset`: Delete all cached expressions and proof trees
* `stat`: Display resource usage
* `expr.echo {"expr": <expr>, "type": <optional expected type>, ["levels": [<levels>]]}`: Determine the
type of an expression and format it.
* `env.catalog`: Display a list of all safe Lean symbols in the current environment
* `env.inspect {"name": <name>, "value": <bool>}`: Show the type and package of a
given symbol; If value flag is set, the value is printed or hidden. By default
only the values of definitions are printed.
* `options.set { key: value, ... }`: Set one or more options (not Lean options; those
have to be set via command line arguments.), for options, see `Pantograph/Protocol.lean`
One particular option for interest for machine learning researchers is the
automatic mode (flag: `"automaticMode"`). By default it is turned on, with
all goals automatically resuming. This makes Pantograph act like a gym,
with no resumption necessary to manage your goals.
* `options.print`: Display the current set of options
* `goal.start {["name": <name>], ["expr": <expr>], ["levels": [<levels>]], ["copyFrom": <symbol>]}`:
Start a new proof from a given expression or symbol
* `goal.tactic {"stateId": <id>, "goalId": <id>, ...}`: Execute a tactic string on a
given goal. The tactic is supplied as additional key-value pairs in one of the following formats:
- `{ "tactic": <tactic> }`: Execute an ordinary tactic
- `{ "expr": <expr> }`: Assign the given proof term to the current goal
- `{ "have": <expr>, "binderName": <name> }`: Execute `have` and creates a branch goal
- `{ "calc": <expr> }`: Execute one step of a `calc` tactic. Each step must
be of the form `lhs op rhs`. An `lhs` of `_` indicates that it should be set
to the previous `rhs`.
- `{ "conv": <bool> }`: Enter or exit conversion tactic mode. In the case of
exit, the goal id is ignored.
* `goal.continue {"stateId": <id>, ["branch": <id>], ["goals": <names>]}`:
Execute continuation/resumption
- `{ "branch": <id> }`: Continue on branch state. The current state must have no goals.
- `{ "goals": <names> }`: Resume the given goals
* `goal.remove {"stateIds": [<id>]}"`: Drop the goal states specified in the list
* `goal.print {"stateId": <id>}"`: Print a goal state
* `frontend.process { ["fileName": <fileName>",] ["file": <str>], invocations:
<bool>, sorrys: <bool> }`: Executes the Lean frontend on a file, collecting
either the tactic invocations (`"invocations": true`) or the sorrys into goal
states (`"sorrys": true`)
### Errors
When an error pertaining to the execution of a command happens, the returning JSON structure is
``` json
{ "error": "type", "desc": "description" }
```
Common error forms:
* `command`: Indicates malformed command structure which results from either
invalid command or a malformed JSON structure that cannot be fed to an
individual command.
* `index`: Indicates an invariant maintained by the output of one command and
input of another is broken. For example, attempting to query a symbol not
existing in the library or indexing into a non-existent proof state.
### Project Environment
To use Pantograph in a project environment, 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`,
the environment might be setup like this:
``` sh
LIB="../lib"
LIB_MATHLIB="$LIB/mathlib4/lake-packages"
export LEAN_PATH="$LIB/mathlib4/build/lib:$LIB_MATHLIB/aesop/build/lib:$LIB_MATHLIB/Qq/build/lib:$LIB_MATHLIB/std/build/lib"
LEAN_PATH=$LEAN_PATH build/bin/pantograph $@
```
The `$LEAN_PATH` executable of any project can be extracted by
``` sh
lake env printenv LEAN_PATH
```
### Troubleshooting
If lean encounters stack overflow problems when printing catalog, execute this before running lean:
```sh
ulimit -s unlimited
```
## Library Usage
`Pantograph/Library.lean` exposes a series of interfaces which allow FFI call
with `Pantograph` which mirrors the REPL commands above. It is recommended to
call Pantograph via this FFI since it provides a tremendous speed up.
The executable can be used as-is, but linking against the shared library
requires the presence of `lean-all`. Note that there isn't a 1-1 correspondence
between executable (REPL) commands and library functions.
Inject any project path via the `pantograph_init_search` function.
## Developing
A Lean development shell is provided in the Nix flake.
### Testing
The tests are based on `LSpec`. To run tests, use either
``` sh
nix flake check
```
or
``` sh
lake test
```
You can run an individual test by specifying a prefix
``` sh
lake test -- "Tactic/No Confuse"
```

260
Repl.lean Normal file
View File

@ -0,0 +1,260 @@
import Std.Data.HashMap
import Pantograph
namespace Pantograph.Repl
structure Context where
imports: List String
/-- Stores state of the REPL -/
structure State where
options: Protocol.Options := {}
nextId: Nat := 0
goalStates: Std.HashMap Nat GoalState := Std.HashMap.empty
/-- Main state monad for executing commands -/
abbrev MainM := ReaderT Context (StateT State Lean.CoreM)
-- HACK: For some reason writing `CommandM α := MainM (Except ... α)` disables
-- certain monadic features in `MainM`
abbrev CR α := Except Protocol.InteractionError α
def runMetaInMainM { α } (metaM: Lean.MetaM α): MainM α :=
metaM.run'
def runTermElabInMainM { α } (termElabM: Lean.Elab.TermElabM α) : MainM α :=
termElabM.run' (ctx := Condensed.elabContext) |>.run'
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
match (← comm args) with
| .ok result => return Lean.toJson result
| .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
| "stat" => run stat
| "expr.echo" => run expr_echo
| "env.catalog" => run env_catalog
| "env.inspect" => run env_inspect
| "env.add" => run env_add
| "options.set" => run options_set
| "options.print" => run options_print
| "goal.start" => run goal_start
| "goal.tactic" => run goal_tactic
| "goal.continue" => run goal_continue
| "goal.delete" => run goal_delete
| "goal.print" => run goal_print
| "frontend.process" => run frontend_process
| cmd =>
let error: Protocol.InteractionError :=
errorCommand s!"Unknown command {cmd}"
return Lean.toJson error
where
errorCommand := errorI "command"
errorIndex := errorI "index"
newGoalState (goalState: GoalState) : MainM Nat := do
let state ← get
let stateId := state.nextId
set { state with
goalStates := state.goalStates.insert stateId goalState,
nextId := state.nextId + 1
}
return stateId
-- Command Functions
reset (_: Protocol.Reset): MainM (CR Protocol.StatResult) := do
let state ← get
let nGoals := state.goalStates.size
set { state with nextId := 0, goalStates := .empty }
return .ok { nGoals }
stat (_: Protocol.Stat): MainM (CR Protocol.StatResult) := do
let state ← get
let nGoals := state.goalStates.size
return .ok { nGoals }
env_catalog (args: Protocol.EnvCatalog): MainM (CR Protocol.EnvCatalogResult) := do
let result ← Environment.catalog args
return .ok result
env_inspect (args: Protocol.EnvInspect): MainM (CR Protocol.EnvInspectResult) := do
let state ← get
Environment.inspect args state.options
env_add (args: Protocol.EnvAdd): MainM (CR Protocol.EnvAddResult) := do
Environment.addDecl args
expr_echo (args: Protocol.ExprEcho): MainM (CR Protocol.ExprEchoResult) := do
let state ← get
exprEcho args.expr (expectedType? := args.type?) (levels := args.levels.getD #[]) (options := state.options)
options_set (args: Protocol.OptionsSet): MainM (CR Protocol.OptionsSetResult) := do
let state ← get
let options := state.options
set { state with
options := {
-- FIXME: This should be replaced with something more elegant
printJsonPretty := args.printJsonPretty?.getD options.printJsonPretty,
printExprPretty := args.printExprPretty?.getD options.printExprPretty,
printExprAST := args.printExprAST?.getD options.printExprAST,
printDependentMVars := args.printDependentMVars?.getD options.printDependentMVars,
noRepeat := args.noRepeat?.getD options.noRepeat,
printAuxDecls := args.printAuxDecls?.getD options.printAuxDecls,
printImplementationDetailHyps := args.printImplementationDetailHyps?.getD options.printImplementationDetailHyps
automaticMode := args.automaticMode?.getD options.automaticMode,
}
}
return .ok { }
options_print (_: Protocol.OptionsPrint): MainM (CR Protocol.Options) := do
return .ok (← get).options
goal_start (args: Protocol.GoalStart): MainM (CR Protocol.GoalStartResult) := do
let env ← Lean.MonadEnv.getEnv
let expr?: Except _ GoalState ← runTermElabInMainM (match args.expr, args.copyFrom with
| .some expr, .none => goalStartExpr expr (args.levels.getD #[])
| .none, .some copyFrom =>
(match env.find? <| copyFrom.toName with
| .none => return .error <| errorIndex s!"Symbol not found: {copyFrom}"
| .some cInfo => return .ok (← GoalState.create cInfo.type))
| _, _ =>
return .error <| errorI "arguments" "Exactly one of {expr, copyFrom} must be supplied")
match expr? with
| .error error => return .error error
| .ok goalState =>
let stateId ← newGoalState goalState
return .ok { stateId, root := goalState.root.name.toString }
goal_tactic (args: Protocol.GoalTactic): MainM (CR Protocol.GoalTacticResult) := do
let state ← get
let .some goalState := state.goalStates[args.stateId]? |
return .error $ errorIndex s!"Invalid state index {args.stateId}"
let .some goal := goalState.goals.get? args.goalId |
return .error $ errorIndex s!"Invalid goal index {args.goalId}"
let nextGoalState?: Except _ TacticResult ← runTermElabInMainM do
match args.tactic?, args.expr?, args.have?, args.let?, args.calc?, args.conv? with
| .some tactic, .none, .none, .none, .none, .none => do
pure <| Except.ok <| ← goalState.tryTactic goal tactic
| .none, .some expr, .none, .none, .none, .none => do
pure <| Except.ok <| ← goalState.tryAssign goal expr
| .none, .none, .some type, .none, .none, .none => do
let binderName := args.binderName?.getD ""
pure <| Except.ok <| ← goalState.tryHave goal binderName type
| .none, .none, .none, .some type, .none, .none => do
let binderName := args.binderName?.getD ""
pure <| Except.ok <| ← goalState.tryLet goal binderName type
| .none, .none, .none, .none, .some pred, .none => do
pure <| Except.ok <| ← goalState.tryCalc goal pred
| .none, .none, .none, .none, .none, .some true => do
pure <| Except.ok <| ← goalState.conv goal
| .none, .none, .none, .none, .none, .some false => do
pure <| Except.ok <| ← goalState.convExit
| _, _, _, _, _, _ =>
let error := errorI "arguments" "Exactly one of {tactic, expr, have, calc, conv} must be supplied"
pure $ Except.error $ error
match nextGoalState? with
| .error error => return .error error
| .ok (.success nextGoalState) => do
let nextGoalState ← match state.options.automaticMode, args.conv? with
| true, .none => do
let .ok result := nextGoalState.resume (nextGoalState.goals ++ goalState.goals) |
throwError "Resuming known goals"
pure result
| true, .some true => pure nextGoalState
| true, .some false => do
let .some (_, _, dormantGoals) := goalState.convMVar? |
throwError "If conv exit succeeded this should not fail"
let .ok result := nextGoalState.resume (nextGoalState.goals ++ dormantGoals) |
throwError "Resuming known goals"
pure result
| false, _ => pure nextGoalState
let nextStateId ← newGoalState nextGoalState
let goals ← nextGoalState.serializeGoals (parent := .some goalState) (options := state.options) |>.run'
return .ok {
nextStateId? := .some nextStateId,
goals? := .some goals,
}
| .ok (.parseError message) =>
return .ok { parseError? := .some message }
| .ok (.invalidAction message) =>
return .error $ errorI "invalid" message
| .ok (.failure messages) =>
return .ok { tacticErrors? := .some messages }
goal_continue (args: Protocol.GoalContinue): MainM (CR Protocol.GoalContinueResult) := do
let state ← get
let .some target := state.goalStates[args.target]? |
return .error $ errorIndex s!"Invalid state index {args.target}"
let nextState? ← match args.branch?, args.goals? with
| .some branchId, .none => do
match state.goalStates[branchId]? with
| .none => return .error $ errorIndex s!"Invalid state index {branchId}"
| .some branch => pure $ target.continue branch
| .none, .some goals =>
pure $ goalResume target goals
| _, _ => return .error <| errorI "arguments" "Exactly one of {branch, goals} must be supplied"
match nextState? with
| .error error => return .error <| errorI "structure" error
| .ok nextGoalState =>
let nextStateId := state.nextId
set { state with
goalStates := state.goalStates.insert nextStateId nextGoalState,
nextId := state.nextId + 1
}
let goals ← goalSerialize nextGoalState (options := state.options)
return .ok {
nextStateId,
goals,
}
goal_delete (args: Protocol.GoalDelete): MainM (CR Protocol.GoalDeleteResult) := do
let state ← get
let goalStates := args.stateIds.foldl (λ map id => map.erase id) state.goalStates
set { state with goalStates }
return .ok {}
goal_print (args: Protocol.GoalPrint): MainM (CR Protocol.GoalPrintResult) := do
let state ← get
let .some goalState := state.goalStates[args.stateId]? |
return .error $ errorIndex s!"Invalid state index {args.stateId}"
let result ← runMetaInMainM <| goalPrint goalState state.options
return .ok result
frontend_process (args: Protocol.FrontendProcess): MainM (CR Protocol.FrontendProcessResult) := do
let options := (← get).options
try
let (fileName, file) ← match args.fileName?, args.file? with
| .some fileName, .none => do
let file ← IO.FS.readFile fileName
pure (fileName, file)
| .none, .some file =>
pure ("<anonymous>", file)
| _, _ => return .error <| errorI "arguments" "Exactly one of {fileName, file} must be supplied"
let env?: Option Lean.Environment ← if args.fileName?.isSome then
pure .none
else do
let env ← Lean.MonadEnv.getEnv
pure <| .some env
let (context, state) ← do Frontend.createContextStateFromFile file fileName env? {}
let frontendM := Frontend.mapCompilationSteps λ step => do
let boundary := (step.src.startPos.byteIdx, step.src.stopPos.byteIdx)
let invocations?: Option (List Protocol.InvokedTactic) ← if args.invocations then
let invocations ← Frontend.collectTacticsFromCompilationStep step
pure $ .some invocations
else
pure .none
let sorrys := if args.sorrys then
Frontend.collectSorrys step
else
[]
let messages ← step.messageStrings
return (step.before, boundary, invocations?, sorrys, messages)
let li ← frontendM.run context |>.run' state
let units ← li.mapM λ (env, boundary, invocations?, sorrys, messages) => Lean.withEnv env do
let (goalStateId?, goals) ← if sorrys.isEmpty then do
pure (.none, #[])
else do
let goalState ← runMetaInMainM $ Frontend.sorrysToGoalState sorrys
let stateId ← newGoalState goalState
let goals ← goalSerialize goalState options
pure (.some stateId, goals)
return {
boundary,
invocations?,
goalStateId?,
goals,
messages,
}
return .ok { units }
catch e =>
return .error $ errorI "frontend" (← e.toMessageData.toString)
end Pantograph.Repl

155
Test/Common.lean Normal file
View File

@ -0,0 +1,155 @@
import Pantograph.Goal
import Pantograph.Library
import Pantograph.Protocol
import Pantograph.Condensed
import Lean
import LSpec
open Lean
namespace Pantograph
deriving instance Repr for Expr
-- Use strict equality check for expressions
instance : BEq Expr := ⟨Expr.equal⟩
def uniq (n: Nat): Name := .num (.str .anonymous "_uniq") n
-- Auxiliary functions
namespace Protocol
def Goal.devolatilizeVars (goal: Goal): Goal :=
{
goal with
vars := goal.vars.map removeInternalAux,
}
where removeInternalAux (v: Variable): Variable :=
{
v with
name := ""
}
/-- Set internal names to "" -/
def Goal.devolatilize (goal: Goal): Goal :=
{
goal.devolatilizeVars with
name := "",
}
deriving instance DecidableEq, Repr for Name
deriving instance DecidableEq, Repr for Expression
deriving instance DecidableEq, Repr for Variable
deriving instance DecidableEq, Repr for Goal
deriving instance DecidableEq, Repr for ExprEchoResult
deriving instance DecidableEq, Repr for InteractionError
deriving instance DecidableEq, Repr for Option
end Protocol
namespace Condensed
deriving instance BEq, Repr for LocalDecl
deriving instance BEq, Repr for Goal
protected def LocalDecl.devolatilize (decl: LocalDecl): LocalDecl :=
{
decl with fvarId := { name := .anonymous }
}
protected def Goal.devolatilize (goal: Goal): Goal :=
{
goal with
mvarId := { name := .anonymous },
context := goal.context.map LocalDecl.devolatilize
}
end Condensed
def GoalState.get! (state: GoalState) (i: Nat): MVarId := state.goals.get! i
def GoalState.tacticOn (state: GoalState) (goalId: Nat) (tactic: String) := state.tryTactic (state.goals.get! goalId) tactic
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}"
| .invalidAction error => s!".invalidAction {error}"
namespace Test
def expectationFailure (desc: String) (error: String): LSpec.TestSeq := LSpec.test desc (LSpec.ExpectationFailure "ok _" error)
def assertUnreachable (message: String): LSpec.TestSeq := LSpec.check message false
def parseFailure (error: String) := expectationFailure "parse" error
def elabFailure (error: String) := expectationFailure "elab" error
def runCoreMSeq (env: Environment) (coreM: CoreM LSpec.TestSeq) (options: Array String := #[]): IO LSpec.TestSeq := do
let coreContext: Core.Context ← createCoreContext options
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 runMetaMSeq (env: Environment) (metaM: MetaM LSpec.TestSeq): IO LSpec.TestSeq :=
runCoreMSeq env metaM.run'
def runTermElabMInMeta { α } (termElabM: Lean.Elab.TermElabM α): Lean.MetaM α :=
termElabM.run' (ctx := Condensed.elabContext)
def runTermElabMSeq (env: Environment) (termElabM: Elab.TermElabM LSpec.TestSeq): IO LSpec.TestSeq :=
runMetaMSeq env $ termElabM.run' (ctx := Condensed.elabContext)
def exprToStr (e: Expr): Lean.MetaM String := toString <$> Meta.ppExpr e
def strToTermSyntax [Monad m] [MonadEnv m] (s: String): m Syntax := do
let .ok stx := Parser.runParserCategory
(env := ← MonadEnv.getEnv)
(catName := `term)
(input := s)
(fileName := filename) | panic! s!"Failed to parse {s}"
return stx
def parseSentence (s: String): Elab.TermElabM Expr := do
let stx ← match Parser.runParserCategory
(env := ← MonadEnv.getEnv)
(catName := `term)
(input := s)
(fileName := filename) with
| .ok syn => pure syn
| .error error => throwError "Failed to parse: {error}"
Elab.Term.elabTerm (stx := stx) .none
def runTacticOnMVar (tacticM: Elab.Tactic.TacticM Unit) (goal: MVarId): Elab.TermElabM (List MVarId) := do
let (_, newGoals) ← tacticM { elaborator := .anonymous } |>.run { goals := [goal] }
return newGoals.goals
def mvarUserNameAndType (mvarId: MVarId): MetaM (Name × String) := do
let name := (← mvarId.getDecl).userName
let t ← exprToStr (← mvarId.getType)
return (name, t)
-- Monadic testing
abbrev TestT := StateT LSpec.TestSeq
def addTest [Monad m] (test: LSpec.TestSeq): TestT m Unit := do
set $ (← get) ++ test
def runTest [Monad m] (t: TestT m Unit): m LSpec.TestSeq :=
Prod.snd <$> t.run LSpec.TestSeq.done
def runTestTermElabM (env: Environment) (t: TestT Elab.TermElabM Unit):
IO LSpec.TestSeq :=
runTermElabMSeq env $ runTest t
def cdeclOf (userName: Name) (type: Expr): Condensed.LocalDecl :=
{ userName, type }
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 },
})).toArray
}
end Test
end Pantograph

107
Test/Environment.lean Normal file
View File

@ -0,0 +1,107 @@
import LSpec
import Pantograph.Serial
import Pantograph.Environment
import Test.Common
import Lean
open Lean
namespace Pantograph.Test.Environment
open Pantograph
deriving instance DecidableEq, Repr for Protocol.InductInfo
deriving instance DecidableEq, Repr for Protocol.ConstructorInfo
deriving instance DecidableEq, Repr for Protocol.RecursorRule
deriving instance DecidableEq, Repr for Protocol.RecursorInfo
deriving instance DecidableEq, Repr for Protocol.EnvInspectResult
def test_catalog: IO LSpec.TestSeq := do
let env: Environment ← importModules
(imports := #[`Init])
(opts := {})
(trustLevel := 1)
let inner: CoreM LSpec.TestSeq := do
let catalogResult ← Environment.catalog {}
let symbolsWithNum := env.constants.fold (init := #[]) (λ acc name info =>
match (Environment.toFilteredSymbol name info).isSome && (name matches .num _ _) with
| false => acc
| true => acc.push name
)
return LSpec.check "No num symbols" (symbolsWithNum.size == 0)
runCoreMSeq env inner
def test_symbol_visibility: IO LSpec.TestSeq := do
let entries: List (Name × Bool) := [
("Nat.add_comm".toName, false),
("foo.bla.Init.Data.List.Basic.2.1.Init.Lean.Expr._hyg.4".toName, true),
("Init.Data.Nat.Basic._auxLemma.4".toName, true),
]
let suite := entries.foldl (λ suites (symbol, target) =>
let test := LSpec.check symbol.toString ((Environment.isNameInternal symbol) == target)
LSpec.TestSeq.append suites test) LSpec.TestSeq.done
return suite
inductive ConstantCat where
| induct (info: Protocol.InductInfo)
| ctor (info: Protocol.ConstructorInfo)
| recursor (info: Protocol.RecursorInfo)
def test_inspect: IO LSpec.TestSeq := do
let env: Environment ← importModules
(imports := #[`Init])
(opts := {})
(trustLevel := 1)
let testCases: List (String × ConstantCat) := [
("Or", ConstantCat.induct {
numParams := 2,
numIndices := 0,
all := #["Or"],
ctors := #["Or.inl", "Or.inr"],
}),
("Except.ok", ConstantCat.ctor {
induct := "Except",
cidx := 1,
numParams := 2,
numFields := 1,
}),
("Eq.rec", ConstantCat.recursor {
all := #["Eq"],
numParams := 2,
numIndices := 1,
numMotives := 1,
numMinors := 1,
rules := #[{ ctor := "Eq.refl", nFields := 0, rhs := { pp? := .some "fun {α} a motive refl => refl" } }]
k := true,
}),
("ForM.rec", ConstantCat.recursor {
all := #["ForM"],
numParams := 3,
numIndices := 0,
numMotives := 1,
numMinors := 1,
rules := #[{ ctor := "ForM.mk", nFields := 1, rhs := { pp? := .some "fun m γ α motive mk forM => mk forM" } }]
k := false,
})
]
let inner: CoreM LSpec.TestSeq := do
testCases.foldlM (λ acc (name, cat) => do
let args: Protocol.EnvInspect := { name := name }
let result ← match ← Environment.inspect args (options := {}) with
| .ok result => pure $ result
| .error e => panic! s!"Error: {e.desc}"
let p := match cat with
| .induct info => LSpec.test name (result.inductInfo? == .some info)
| .ctor info => LSpec.test name (result.constructorInfo? == .some info)
| .recursor info => LSpec.test name (result.recursorInfo? == .some info)
return LSpec.TestSeq.append acc p
) LSpec.TestSeq.done
runCoreMSeq env inner
def suite: List (String × IO LSpec.TestSeq) :=
[
("Catalog", test_catalog),
("Symbol Visibility", test_symbol_visibility),
("Inspect", test_inspect),
]
end Pantograph.Test.Environment

191
Test/Frontend.lean Normal file
View File

@ -0,0 +1,191 @@
import LSpec
import Pantograph
import Repl
import Test.Common
open Lean Pantograph
namespace Pantograph.Test.Frontend
def collectSorrysFromSource (source: String) : MetaM (List GoalState) := do
let filename := "<anonymous>"
let (context, state) ← do Frontend.createContextStateFromFile source filename (← getEnv) {}
let m := Frontend.mapCompilationSteps λ step => do
return (step.before, Frontend.collectSorrys step)
let li ← m.run context |>.run' state
let goalStates ← li.filterMapM λ (env, sorrys) => withEnv env do
if sorrys.isEmpty then
return .none
let goalState ← Frontend.sorrysToGoalState sorrys
return .some goalState
return goalStates
def test_multiple_sorrys_in_proof : TestT MetaM Unit := do
let sketch := "
theorem plus_n_Sm_proved_formal_sketch : ∀ n m : Nat, n + (m + 1) = (n + m) + 1 := by
have h_nat_add_succ: ∀ n m : Nat, n = m := sorry
sorry
"
let goalStates ← (collectSorrysFromSource sketch).run' {}
let [goalState] := goalStates | panic! "Incorrect number of states"
addTest $ LSpec.check "goals" ((← goalState.serializeGoals (options := {})).map (·.devolatilize) = #[
{
target := { pp? := "∀ (n m : Nat), n = m" },
vars := #[
]
},
{
target := { pp? := "∀ (n m : Nat), n + (m + 1) = n + m + 1" },
vars := #[{
userName := "h_nat_add_succ",
type? := .some { pp? := "∀ (n m : Nat), n = m" },
}],
}
])
def test_sorry_in_middle: TestT MetaM Unit := do
let sketch := "
example : ∀ (n m: Nat), n + m = m + n := by
intros n m
sorry
"
let goalStates ← (collectSorrysFromSource sketch).run' {}
let [goalState] := goalStates | panic! s!"Incorrect number of states: {goalStates.length}"
addTest $ LSpec.check "goals" ((← goalState.serializeGoals (options := {})).map (·.devolatilize) = #[
{
target := { pp? := "n + m = m + n" },
vars := #[{
userName := "n",
type? := .some { pp? := "Nat" },
}, {
userName := "m",
type? := .some { pp? := "Nat" },
}
],
}
])
def test_sorry_in_induction : TestT MetaM Unit := do
let sketch := "
example : ∀ (n m: Nat), n + m = m + n := by
intros n m
induction n with
| zero =>
have h1 : 0 + m = m := sorry
sorry
| succ n ih =>
have h2 : n + m = m := sorry
sorry
"
let goalStates ← (collectSorrysFromSource sketch).run' {}
let [goalState] := goalStates | panic! s!"Incorrect number of states: {goalStates.length}"
addTest $ LSpec.check "goals" ((← goalState.serializeGoals (options := {})).map (·.devolatilize) = #[
{
target := { pp? := "0 + m = m" },
vars := #[{
userName := "m",
type? := .some { pp? := "Nat" },
}]
},
{
userName? := .some "zero",
target := { pp? := "0 + m = m + 0" },
vars := #[{
userName := "m",
type? := .some { pp? := "Nat" },
}, {
userName := "h1",
type? := .some { pp? := "0 + m = m" },
}]
},
{
target := { pp? := "n + m = m" },
vars := #[{
userName := "m",
type? := .some { pp? := "Nat" },
}, {
userName := "n",
type? := .some { pp? := "Nat" },
}, {
userName := "ih",
type? := .some { pp? := "n + m = m + n" },
}]
},
{
userName? := .some "succ",
target := { pp? := "n + 1 + m = m + (n + 1)" },
vars := #[{
userName := "m",
type? := .some { pp? := "Nat" },
}, {
userName := "n",
type? := .some { pp? := "Nat" },
}, {
userName := "ih",
type? := .some { pp? := "n + m = m + n" },
}, {
userName := "h2",
type? := .some { pp? := "n + m = m" },
}]
}
])
def test_sorry_in_coupled: TestT MetaM Unit := do
let sketch := "
example : ∀ (y: Nat), ∃ (x: Nat), y + 1 = x := by
intro y
apply Exists.intro
case h => sorry
case w => sorry
"
let goalStates ← (collectSorrysFromSource sketch).run' {}
let [goalState] := goalStates | panic! s!"Incorrect number of states: {goalStates.length}"
addTest $ LSpec.check "goals" ((← goalState.serializeGoals (options := {})).map (·.devolatilize) = #[
{
target := { pp? := "y + 1 = ?w" },
vars := #[{
userName := "y",
type? := .some { pp? := "Nat" },
}
],
},
{
userName? := .some "w",
target := { pp? := "Nat" },
vars := #[{
userName := "y",
type? := .some { pp? := "Nat" },
}
],
}
])
def test_environment_capture: TestT MetaM Unit := do
let sketch := "
def mystery (n: Nat) := n + 1
example (n: Nat) : mystery n + 1 = n + 2 := sorry
"
let goalStates ← (collectSorrysFromSource sketch).run' {}
let [goalState] := goalStates | panic! s!"Incorrect number of states: {goalStates.length}"
addTest $ LSpec.check "goals" ((← goalState.serializeGoals (options := {})).map (·.devolatilize) = #[
{
target := { pp? := "mystery n + 1 = n + 2" },
vars := #[{
userName := "n",
type? := .some { pp? := "Nat" },
}],
}
])
def suite (env : Environment): List (String × IO LSpec.TestSeq) :=
let tests := [
("multiple_sorrys_in_proof", test_multiple_sorrys_in_proof),
("sorry_in_middle", test_sorry_in_middle),
("sorry_in_induction", test_sorry_in_induction),
("sorry_in_coupled", test_sorry_in_coupled),
("environment_capture", test_environment_capture),
]
tests.map (fun (name, test) => (name, runMetaMSeq env $ runTest test))
end Pantograph.Test.Frontend

258
Test/Integration.lean Normal file
View File

@ -0,0 +1,258 @@
/- Integration test for the REPL
-/
import LSpec
import Pantograph
import Repl
import Test.Common
namespace Pantograph.Test.Integration
open Pantograph.Repl
def step { α } [Lean.ToJson α] (cmd: String) (payload: List (String × Lean.Json))
(expected: α) (name? : Option String := .none): MainM LSpec.TestSeq := do
let payload := Lean.Json.mkObj payload
let name := name?.getD s!"{cmd} {payload.compress}"
let result ← Repl.execute { cmd, payload }
return LSpec.test name (toString result = toString (Lean.toJson expected))
abbrev Test := List (MainM LSpec.TestSeq)
def test_elab : Test :=
[
step "expr.echo"
[("expr", .str "λ {α : Sort (u + 1)} => List α"), ("levels", .arr #["u"])]
(Lean.toJson ({
type := { pp? := .some "{α : Type u} → Type u" },
expr := { pp? := .some "fun {α} => List α" }
}: Protocol.ExprEchoResult)),
]
def test_option_modify : Test :=
let pp? := Option.some "∀ (n : Nat), n + 1 = n.succ"
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: Protocol.Options := {}
[
step "env.inspect" [("name", .str "Nat.add_one")]
({ type := { pp? }, module? }: Protocol.EnvInspectResult),
step "options.set" [("printExprAST", .bool true)]
({ }: Protocol.OptionsSetResult),
step "env.inspect" [("name", .str "Nat.add_one")]
({ type := { pp?, sexp? }, module? }: Protocol.EnvInspectResult),
step "options.print" []
({ options with printExprAST := true }: Protocol.Options),
]
def test_malformed_command : Test :=
let invalid := "invalid"
[
step invalid [("name", .str "Nat.add_one")]
({ error := "command", desc := s!"Unknown command {invalid}" }: Protocol.InteractionError)
(name? := .some "Invalid Command"),
step "expr.echo" [(invalid, .str "Random garbage data")]
({ error := "command", desc := s!"Unable to parse json: Pantograph.Protocol.ExprEcho.expr: String expected" }:
Protocol.InteractionError)
(name? := .some "JSON Deserialization")
]
def test_tactic : Test :=
let goal1: Protocol.Goal := {
name := "_uniq.11",
target := { pp? := .some "∀ (q : Prop), x q → q x" },
vars := #[{ name := "_uniq.10", userName := "x", type? := .some { pp? := .some "Prop" }}],
}
let goal2: Protocol.Goal := {
name := "_uniq.17",
target := { pp? := .some "x y → y x" },
vars := #[
{ name := "_uniq.10", userName := "x", type? := .some { pp? := .some "Prop" }},
{ name := "_uniq.16", userName := "y", type? := .some { pp? := .some "Prop" }}
],
}
[
step "goal.start" [("expr", .str "∀ (p q: Prop), p q → q p")]
({ stateId := 0, root := "_uniq.9" }: Protocol.GoalStartResult),
step "goal.tactic" [("stateId", .num 0), ("goalId", .num 0), ("tactic", .str "intro x")]
({ nextStateId? := .some 1, goals? := #[goal1], }: Protocol.GoalTacticResult),
step "goal.print" [("stateId", .num 1)]
({ parent? := .some { pp? := .some "fun x => ?m.12 x" }, }: Protocol.GoalPrintResult),
step "goal.tactic" [("stateId", .num 1), ("goalId", .num 0), ("tactic", .str "intro y")]
({ nextStateId? := .some 2, goals? := #[goal2], }: Protocol.GoalTacticResult),
]
def test_automatic_mode (automatic: Bool): Test :=
let varsPQ := #[
{ name := "_uniq.10", userName := "p", type? := .some { pp? := .some "Prop" }},
{ name := "_uniq.13", userName := "q", type? := .some { pp? := .some "Prop" }}
]
let goal1: Protocol.Goal := {
name := "_uniq.17",
target := { pp? := .some "q p" },
vars := varsPQ ++ #[
{ name := "_uniq.16", userName := "h", type? := .some { pp? := .some "p q" }}
],
}
let goal2l: Protocol.Goal := {
name := "_uniq.59",
userName? := .some "inl",
target := { pp? := .some "q p" },
vars := varsPQ ++ #[
{ name := "_uniq.47", userName := "h✝", type? := .some { pp? := .some "p" }, isInaccessible := true}
],
}
let goal2r: Protocol.Goal := {
name := "_uniq.72",
userName? := .some "inr",
target := { pp? := .some "q p" },
vars := varsPQ ++ #[
{ name := "_uniq.60", userName := "h✝", type? := .some { pp? := .some "q" }, isInaccessible := true}
],
}
let goal3l: Protocol.Goal := {
name := "_uniq.78",
userName? := .some "inl.h",
target := { pp? := .some "p" },
vars := varsPQ ++ #[
{ name := "_uniq.47", userName := "h✝", type? := .some { pp? := .some "p" }, isInaccessible := true}
],
}
[
step "options.set" [("automaticMode", .bool automatic)]
({}: Protocol.OptionsSetResult),
step "goal.start" [("expr", .str "∀ (p q: Prop), p q → q p")]
({ stateId := 0, root := "_uniq.9" }: Protocol.GoalStartResult),
step "goal.tactic" [("stateId", .num 0), ("goalId", .num 0), ("tactic", .str "intro p q h")]
({ nextStateId? := .some 1, goals? := #[goal1], }: Protocol.GoalTacticResult),
step "goal.tactic" [("stateId", .num 1), ("goalId", .num 0), ("tactic", .str "cases h")]
({ nextStateId? := .some 2, goals? := #[goal2l, goal2r], }: Protocol.GoalTacticResult),
let goals? := if automatic then #[goal3l, goal2r] else #[goal3l]
step "goal.tactic" [("stateId", .num 2), ("goalId", .num 0), ("tactic", .str "apply Or.inr")]
({ nextStateId? := .some 3, goals?, }: Protocol.GoalTacticResult),
]
def test_env_add_inspect : Test :=
let name1 := "Pantograph.mystery"
let name2 := "Pantograph.mystery2"
[
step "env.add"
[
("name", .str name1),
("type", .str "Prop → Prop → Prop"),
("value", .str "λ (a b: Prop) => Or a b"),
("isTheorem", .bool false)
]
({}: Protocol.EnvAddResult),
step "env.inspect" [("name", .str name1)]
({
value? := .some { pp? := .some "fun a b => a b" },
type := { pp? := .some "Prop → Prop → Prop" },
}:
Protocol.EnvInspectResult),
step "env.add"
[
("name", .str name2),
("type", .str "Nat → Int"),
("value", .str "λ (a: Nat) => a + 1"),
("isTheorem", .bool false)
]
({}: Protocol.EnvAddResult),
step "env.inspect" [("name", .str name2)]
({
value? := .some { pp? := .some "fun a => ↑a + 1" },
type := { pp? := .some "Nat → Int" },
}:
Protocol.EnvInspectResult)
]
example : ∀ (p: Prop), p → p := by
intro p h
exact h
def test_frontend_process : Test :=
[
let file := "example : ∀ (p q: Prop), p → p q := by\n intro p q h\n exact Or.inl h"
let goal1 := "p q : Prop\nh : p\n⊢ p q"
step "frontend.process"
[
("file", .str file),
("invocations", .bool true),
("sorrys", .bool false),
]
({
units := [{
boundary := (0, file.utf8ByteSize),
invocations? := .some [
{
goalBefore := "⊢ ∀ (p q : Prop), p → p q",
goalAfter := goal1,
tactic := "intro p q h",
usedConstants := #[],
},
{
goalBefore := goal1 ,
goalAfter := "",
tactic := "exact Or.inl h",
usedConstants := #["Or.inl"],
},
]
}],
}: Protocol.FrontendProcessResult),
]
example : 1 + 2 = 3 := rfl
example (p: Prop): p → p := by simp
def test_frontend_process_sorry : Test :=
let solved := "example : 1 + 2 = 3 := rfl\n"
let withSorry := "example (p: Prop): p → p := sorry"
[
let file := s!"{solved}{withSorry}"
let goal1: Protocol.Goal := {
name := "_uniq.6",
target := { pp? := .some "p → p" },
vars := #[{ name := "_uniq.4", userName := "p", type? := .some { pp? := .some "Prop" }}],
}
step "frontend.process"
[
("file", .str file),
("invocations", .bool false),
("sorrys", .bool true),
]
({
units := [{
boundary := (0, solved.utf8ByteSize),
}, {
boundary := (solved.utf8ByteSize, solved.utf8ByteSize + withSorry.utf8ByteSize),
goalStateId? := .some 0,
goals := #[goal1],
messages := #["<anonymous>:2:0: warning: declaration uses 'sorry'\n"],
}],
}: Protocol.FrontendProcessResult),
]
def runTest (env: Lean.Environment) (steps: Test): IO LSpec.TestSeq := do
-- Setup the environment for execution
let context: Context := {
imports := ["Init"]
}
let commands: MainM LSpec.TestSeq :=
steps.foldlM (λ suite step => do
let result ← step
return suite ++ result) LSpec.TestSeq.done
runCoreMSeq env <| commands.run context |>.run' {}
def suite (env : Lean.Environment): List (String × IO LSpec.TestSeq) :=
let tests := [
("expr.echo", test_elab),
("options.set options.print", test_option_modify),
("Malformed command", test_malformed_command),
("Tactic", test_tactic),
("Manual Mode", test_automatic_mode false),
("Automatic Mode", test_automatic_mode true),
("env.add env.inspect", test_env_add_inspect),
("frontend.process invocation", test_frontend_process),
("frontend.process sorry", test_frontend_process_sorry),
]
tests.map (fun (name, test) => (name, runTest env test))
end Pantograph.Test.Integration

38
Test/Library.lean Normal file
View File

@ -0,0 +1,38 @@
import LSpec
import Lean
import Pantograph.Library
import Test.Common
open Lean
open Pantograph
namespace Pantograph.Test.Library
def test_expr_echo (env: Environment): IO LSpec.TestSeq := do
let inner: CoreM LSpec.TestSeq := do
let prop_and_proof := "⟨∀ (x: Prop), x → x, λ (x: Prop) (h: x) => h⟩"
let tests := LSpec.TestSeq.done
let echoResult ← exprEcho prop_and_proof (options := {})
let tests := tests.append (LSpec.test "fail" (echoResult.toOption == .some {
type := { pp? := "?m.2" }, expr := { pp? := "?m.3" }
}))
let echoResult ← exprEcho prop_and_proof (expectedType? := .some "Σ' p:Prop, p") (options := { printExprAST := true })
let tests := tests.append (LSpec.test "fail" (echoResult.toOption == .some {
type := {
pp? := "(p : Prop) ×' p",
sexp? := "((:c PSigma) (:sort 0) (:lambda p (:sort 0) 0))",
},
expr := {
pp? := "⟨∀ (x : Prop), x → x, fun x h => h⟩",
sexp? := "((:c PSigma.mk) (:sort 0) (:lambda p (:sort 0) 0) (:forall x (:sort 0) (:forall _ 0 1)) (:lambda x (:sort 0) (:lambda h 0 0)))",
}
}))
return tests
runCoreMSeq env (options := #["pp.proofs.threshold=100"]) inner
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
[
("expr_echo", test_expr_echo env),
]
end Pantograph.Test.Library

60
Test/Main.lean Normal file
View File

@ -0,0 +1,60 @@
import LSpec
import Test.Environment
import Test.Frontend
import Test.Integration
import Test.Library
import Test.Metavar
import Test.Proofs
import Test.Serial
import Test.Tactic
-- Test running infrastructure
namespace Pantograph.Test
def addPrefix (pref: String) (tests: List (String × α)): List (String × α) :=
tests.map (λ (name, x) => (pref ++ "/" ++ name, x))
/-- Runs test in parallel. Filters test name if given -/
def runTestGroup (filter: Option String) (tests: List (String × IO LSpec.TestSeq)): IO LSpec.TestSeq := do
let tests: List (String × IO LSpec.TestSeq) := match filter with
| .some filter => tests.filter (λ (name, _) => filter.isPrefixOf name)
| .none => tests
let tasks: List (String × Task _) ← tests.mapM (λ (name, task) => do
return (name, ← EIO.asTask task))
let all := tasks.foldl (λ acc (name, task) =>
let v: Except IO.Error LSpec.TestSeq := Task.get task
match v with
| .ok case => acc ++ (LSpec.group name case)
| .error e => acc ++ (expectationFailure name e.toString)
) LSpec.TestSeq.done
return all
end Pantograph.Test
open Pantograph.Test
/-- Main entry of tests; Provide an argument to filter tests by prefix -/
def main (args: List String) := do
let name_filter := args.head?
Lean.initSearchPath (← Lean.findSysroot)
let env_default: Lean.Environment ← Lean.importModules
(imports := #[`Init])
(opts := {})
(trustLevel := 1)
let suites: List (String × List (String × IO LSpec.TestSeq)) := [
("Environment", Environment.suite),
("Frontend", Frontend.suite env_default),
("Integration", Integration.suite env_default),
("Library", Library.suite env_default),
("Metavar", Metavar.suite env_default),
("Proofs", Proofs.suite env_default),
("Serial", Serial.suite env_default),
("Tactic/Congruence", Tactic.Congruence.suite env_default),
("Tactic/Motivated Apply", Tactic.MotivatedApply.suite env_default),
("Tactic/No Confuse", Tactic.NoConfuse.suite env_default),
("Tactic/Prograde", Tactic.Prograde.suite env_default),
]
let tests: List (String × IO LSpec.TestSeq) := suites.foldl (λ acc (name, suite) => acc ++ (addPrefix name suite)) []
LSpec.lspecIO (← runTestGroup name_filter tests)

285
Test/Metavar.lean Normal file
View File

@ -0,0 +1,285 @@
import LSpec
import Pantograph.Goal
import Pantograph.Serial
import Test.Common
import Lean
namespace Pantograph.Test.Metavar
open Pantograph
open Lean
abbrev TestM := StateRefT LSpec.TestSeq (ReaderT Protocol.Options Elab.TermElabM)
def addTest (test: LSpec.TestSeq): TestM Unit := do
set $ (← get) ++ test
-- Tests that all delay assigned mvars are instantiated
def test_instantiate_mvar: TestM Unit := do
let env ← Lean.MonadEnv.getEnv
let value := "@Nat.le_trans 2 2 5 (@of_eq_true (@LE.le Nat instLENat 2 2) (@eq_true (@LE.le Nat instLENat 2 2) (@Nat.le_refl 2))) (@of_eq_true (@LE.le Nat instLENat 2 5) (@eq_true_of_decide (@LE.le Nat instLENat 2 5) (@Nat.decLe 2 5) (@Eq.refl Bool Bool.true)))"
let syn ← match parseTerm env value with
| .ok s => pure $ s
| .error e => do
addTest $ assertUnreachable e
return ()
let expr ← match ← elabTerm syn with
| .ok expr => pure $ expr
| .error e => do
addTest $ assertUnreachable e
return ()
let t ← Lean.Meta.inferType expr
addTest $ LSpec.check "typing" ((toString (← serializeExpressionSexp t)) =
"((:c LE.le) (:c Nat) (:c instLENat) ((:c OfNat.ofNat) (:mv _uniq.2) (:lit 2) (:mv _uniq.3)) ((:c OfNat.ofNat) (:mv _uniq.14) (:lit 5) (:mv _uniq.15)))")
return ()
def startProof (expr: String): TestM (Option GoalState) := do
let env ← Lean.MonadEnv.getEnv
let syn? := parseTerm env expr
addTest $ LSpec.check s!"Parsing {expr}" (syn?.isOk)
match syn? with
| .error error =>
IO.println error
return Option.none
| .ok syn =>
let expr? ← elabType syn
addTest $ 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 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 },
})).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 ← createCoreContext #[]
let metaM := termElabM.run' (ctx := Condensed.elabContext)
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
/-- M-coupled goals -/
def test_m_couple: TestM Unit := do
let state? ← startProof "(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.tacticOn (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.tacticOn (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 state2.continue state1 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
def test_m_couple_simp: TestM Unit := do
let state? ← startProof "(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.tacticOn (goalId := 0) (tactic := "apply Nat.le_trans") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
let serializedState1 ← state1.serializeGoals (options := { ← read with printDependentMVars := true })
addTest $ LSpec.check "apply Nat.le_trans" (serializedState1.map (·.target.pp?) =
#[.some "2 ≤ ?m", .some "?m ≤ 5", .some "Nat"])
addTest $ LSpec.check "(metavariables)" (serializedState1.map (·.target.dependentMVars?.get!) =
#[#["_uniq.38"], #["_uniq.38"], #[]])
let state2 ← match ← state1.tacticOn (goalId := 2) (tactic := "exact 2") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.test "(1b root)" state2.rootExpr?.isNone
let state1b ← match state2.continue state1 with
| .error msg => do
addTest $ assertUnreachable $ msg
return ()
| .ok state => pure state
addTest $ LSpec.check "exact 2" ((← state1b.serializeGoals (options := ← read)).map (·.target.pp?) =
#[.some "2 ≤ 2", .some "2 ≤ 5"])
addTest $ LSpec.test "(2 root)" state1b.rootExpr?.isNone
let state3 ← match ← state1b.tacticOn (goalId := 0) (tactic := "simp") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
let state4 ← match state3.continue state1b with
| .error msg => do
addTest $ assertUnreachable $ msg
return ()
| .ok state => pure state
let state5 ← match ← state4.tacticOn (goalId := 0) (tactic := "simp") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
state5.restoreMetaM
let root ← match state5.rootExpr? with
| .some e => pure e
| .none =>
addTest $ assertUnreachable "(5 root)"
return ()
let rootStr: String := toString (← Lean.Meta.ppExpr root)
addTest $ LSpec.check "(5 root)" (rootStr = "Nat.le_trans (of_eq_true (Init.Data.Nat.Basic._auxLemma.4 2)) (of_eq_true (eq_true_of_decide (Eq.refl true)))")
let unfoldedRoot ← unfoldAuxLemmas root
addTest $ LSpec.check "(5 root)" ((toString (← Lean.Meta.ppExpr unfoldedRoot)) =
"Nat.le_trans (of_eq_true (eq_true (Nat.le_refl 2))) (of_eq_true (eq_true_of_decide (Eq.refl true)))")
return ()
def test_proposition_generation: TestM Unit := do
let state? ← startProof "Σ' 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.tacticOn (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 (state1.get! 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 "?m.29 x"])
addTest $ LSpec.test "(2 root)" state2.rootExpr?.isNone
let assign := "Eq.refl x"
let state3 ← match ← state2.tryAssign (state2.get! 0) (expr := assign) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check s!":= {assign}" ((← state3.serializeGoals (options := ← read)).map (·.target.pp?) =
#[])
addTest $ LSpec.test "(3 root)" state3.rootExpr?.isSome
return ()
def test_partial_continuation: TestM Unit := do
let state? ← startProof "(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.tacticOn (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"])
let state2 ← match ← state1.tacticOn (goalId := 2) (tactic := "apply Nat.succ") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check "apply Nat.succ" ((← state2.serializeGoals (options := ← read)).map (·.target.pp?) =
#[.some "Nat"])
-- Execute a partial continuation
let coupled_goals := state1.goals ++ state2.goals
let state1b ← match state2.resume (goals := coupled_goals) with
| .error msg => do
addTest $ assertUnreachable $ msg
return ()
| .ok state => pure state
addTest $ LSpec.check "(continue)" ((← state1b.serializeGoals (options := ← read)).map (·.target.pp?) =
#[.some "2 ≤ ?m.succ", .some "?m.succ ≤ 5", .some "Nat"])
addTest $ LSpec.test "(2 root)" state1b.rootExpr?.isNone
-- Roundtrip
--let coupled_goals := coupled_goals.map (λ g =>
-- { name := str_to_name $ serializeName g.name (sanitize := false)})
let coupled_goals := coupled_goals.map (λ g => serializeName g.name (sanitize := false))
let coupled_goals := coupled_goals.map (λ g => { name := g.toName })
let state1b ← match state2.resume (goals := coupled_goals) with
| .error msg => do
addTest $ assertUnreachable $ msg
return ()
| .ok state => pure state
addTest $ LSpec.check "(continue)" ((← state1b.serializeGoals (options := ← read)).map (·.target.pp?) =
#[.some "2 ≤ ?m.succ", .some "?m.succ ≤ 5", .some "Nat"])
addTest $ LSpec.test "(2 root)" state1b.rootExpr?.isNone
-- Continuation should fail if the state does not exist:
match state0.resume coupled_goals with
| .error error => addTest $ LSpec.check "(continuation failure message)" (error = "Goals [_uniq.40, _uniq.41, _uniq.38, _uniq.47] are not in scope")
| .ok _ => addTest $ assertUnreachable "(continuation failure)"
-- Continuation should fail if some goals have not been solved
match state2.continue state1 with
| .error error => addTest $ LSpec.check "(continuation failure message)" (error = "Target state has unresolved goals")
| .ok _ => addTest $ assertUnreachable "(continuation failure)"
return ()
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
let tests := [
("Instantiate", test_instantiate_mvar),
("2 < 5", test_m_couple),
("2 < 5", test_m_couple_simp),
("Proposition Generation", test_proposition_generation),
("Partial Continuation", test_partial_continuation)
]
tests.map (fun (name, test) => (name, proofRunner env test))
end Pantograph.Test.Metavar

724
Test/Proofs.lean Normal file
View File

@ -0,0 +1,724 @@
/-
Tests pertaining to goals with no interdependencies
-/
import LSpec
import Pantograph.Goal
import Pantograph.Serial
import Test.Common
namespace Pantograph.Test.Proofs
open Pantograph
open Lean
inductive Start where
| copy (name: String) -- Start from some name in the environment
| expr (expr: String) -- Start from some expression
abbrev TestM := StateRefT LSpec.TestSeq (ReaderT Protocol.Options Elab.TermElabM)
def addTest (test: LSpec.TestSeq): TestM Unit := do
set $ (← get) ++ test
def startProof (start: Start): TestM (Option GoalState) := do
let env ← Lean.MonadEnv.getEnv
match start with
| .copy name =>
let cInfo? := name.toName |> env.find?
addTest $ LSpec.check s!"Symbol exists {name}" cInfo?.isSome
match cInfo? with
| .some cInfo =>
let goal ← GoalState.create (expr := cInfo.type)
return Option.some goal
| .none =>
return Option.none
| .expr expr =>
let syn? := parseTerm env expr
addTest $ LSpec.check s!"Parsing {expr}" (syn?.isOk)
match syn? with
| .error error =>
IO.println error
return Option.none
| .ok syn =>
let expr? ← elabType syn
addTest $ 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 buildNamedGoal (name: String) (nameType: List (String × String)) (target: String)
(userName?: Option String := .none): Protocol.Goal :=
{
name,
userName?,
target := { pp? := .some target},
vars := (nameType.map fun x => ({
userName := x.fst,
type? := .some { pp? := .some x.snd },
})).toArray
}
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 },
})).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 ← createCoreContext #[]
let metaM := termElabM.run' (ctx := Condensed.elabContext)
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 test_identity: TestM Unit := do
let state? ← startProof (.expr "∀ (p: Prop), p → p")
let state0 ← match state? with
| .some state => pure state
| .none => do
addTest $ assertUnreachable "Goal could not parse"
return ()
let tactic := "intro p h"
let state1 ← match ← state0.tacticOn 0 tactic with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
let inner := "_uniq.12"
addTest $ LSpec.check tactic ((← state1.serializeGoals (options := ← read)).map (·.name) =
#[inner])
let state1parent ← state1.withParentContext do
serializeExpressionSexp (← instantiateAll state1.parentExpr?.get!) (sanitize := false)
addTest $ LSpec.test "(1 parent)" (state1parent == s!"(:lambda p (:sort 0) (:lambda h 0 (:subst (:mv {inner}) 1 0)))")
-- Individual test cases
example: ∀ (a b: Nat), a + b = b + a := by
intro n m
rw [Nat.add_comm]
def test_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.tacticOn 0 "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.tacticOn 0 "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.tacticOn 0 "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 test_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.tacticOn (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.tacticOn (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 }),
})).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 test_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 tactic := "intros"
let state1 ← match ← state0.tacticOn (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check tactic (state1.goals.length = 1)
addTest $ LSpec.test "(1 root)" state1.rootExpr?.isNone
let state2 ← match ← state1.tacticOn (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 tactic := "assumption"
let state3 ← match ← state2.tacticOn (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.test tactic 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
intro p q h
cases h
apply Or.inr
assumption
apply Or.inl
assumption
example: ∀ (p q: Prop), p q → q p := by
intro p q h
cases h
. apply Or.inr
assumption
. apply Or.inl
assumption
def test_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 ()
addTest $ LSpec.check "(0 parent)" state0.parentExpr?.isNone
addTest $ LSpec.check "(0 root)" state0.rootExpr?.isNone
let tactic := "intro p q h"
let state1 ← match ← state0.tacticOn (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
let fvP := "_uniq.10"
let fvQ := "_uniq.13"
let fvH := "_uniq.16"
let state1g0 := "_uniq.17"
addTest $ LSpec.check tactic ((← state1.serializeGoals (options := ← read)) =
#[{
name := state1g0,
target := { pp? := .some "q p" },
vars := #[
{ name := fvP, userName := "p", type? := .some { pp? := .some "Prop" } },
{ name := fvQ, userName := "q", type? := .some { pp? := .some "Prop" } },
{ name := fvH, userName := "h", type? := .some { pp? := .some "p q" } }
]
}])
addTest $ LSpec.check "(1 parent)" state1.parentExpr?.isSome
addTest $ LSpec.check "(1 root)" state1.rootExpr?.isNone
let state1parent ← state1.withParentContext do
serializeExpressionSexp (← instantiateAll state1.parentExpr?.get!) (sanitize := false)
addTest $ LSpec.test "(1 parent)" (state1parent == s!"(:lambda p (:sort 0) (:lambda q (:sort 0) (:lambda h ((:c Or) 1 0) (:subst (:mv {state1g0}) 2 1 0))))")
let tactic := "cases h"
let state2 ← match ← state1.tacticOn (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check tactic ((← state2.serializeGoals (options := ← read)).map (·.devolatilize) =
#[branchGoal "inl" "p", branchGoal "inr" "q"])
let (caseL, caseR) := ("_uniq.64", "_uniq.77")
addTest $ LSpec.check tactic ((← state2.serializeGoals (options := ← read)).map (·.name) =
#[caseL, caseR])
addTest $ LSpec.check "(2 parent exists)" state2.parentExpr?.isSome
addTest $ LSpec.check "(2 root)" state2.rootExpr?.isNone
let state2parent ← state2.withParentContext do
serializeExpressionSexp (← instantiateAll state2.parentExpr?.get!) (sanitize := false)
let orPQ := s!"((:c Or) (:fv {fvP}) (:fv {fvQ}))"
let orQP := s!"((:c Or) (:fv {fvQ}) (:fv {fvP}))"
let motive := s!"(:lambda t._@._hyg.26 {orPQ} (:forall h ((:c Eq) ((:c Or) (:fv {fvP}) (:fv {fvQ})) (:fv {fvH}) 0) {orQP}))"
let caseL := s!"(:lambda h._@._hyg.27 (:fv {fvP}) (:lambda h._@._hyg.28 ((:c Eq) {orPQ} (:fv {fvH}) ((:c Or.inl) (:fv {fvP}) (:fv {fvQ}) 0)) (:subst (:mv {caseL}) (:fv {fvP}) (:fv {fvQ}) 1)))"
let caseR := s!"(:lambda h._@._hyg.29 (:fv {fvQ}) (:lambda h._@._hyg.30 ((:c Eq) {orPQ} (:fv {fvH}) ((:c Or.inr) (:fv {fvP}) (:fv {fvQ}) 0)) (:subst (:mv {caseR}) (:fv {fvP}) (:fv {fvQ}) 1)))"
let conduit := s!"((:c Eq.refl) {orPQ} (:fv {fvH}))"
addTest $ LSpec.test "(2 parent)" (state2parent ==
s!"((:c Or.casesOn) (:fv {fvP}) (:fv {fvQ}) {motive} (:fv {fvH}) {caseL} {caseR} {conduit})")
let state3_1 ← match ← state2.tacticOn (goalId := 0) (tactic := "apply Or.inr") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
let state3_1parent ← state3_1.withParentContext do
serializeExpressionSexp (← instantiateAll state3_1.parentExpr?.get!) (sanitize := false)
addTest $ LSpec.test "(3_1 parent)" (state3_1parent == s!"((:c Or.inr) (:fv {fvQ}) (:fv {fvP}) (:mv _uniq.91))")
addTest $ LSpec.check "· apply Or.inr" (state3_1.goals.length = 1)
let state4_1 ← match ← state3_1.tacticOn (goalId := 0) (tactic := "assumption") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check " assumption" state4_1.goals.isEmpty
let state4_1parent ← instantiateAll state4_1.parentExpr?.get!
addTest $ LSpec.test "(4_1 parent)" state4_1parent.isFVar
addTest $ LSpec.check "(4_1 root)" state4_1.rootExpr?.isNone
let state3_2 ← match ← state2.tacticOn (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.tacticOn (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 state4_2.continue state2 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.tacticOn (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.tacticOn (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
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 },
{ userName := "q", type? := .some typeProp },
{ userName := "h✝", type? := .some { pp? := .some varName }, isInaccessible := true }
]
}
example : ∀ (a b c1 c2: Nat), (b + a) + c1 = (b + a) + c2 → (a + b) + c1 = (b + a) + c2 := by
intro a b c1 c2 h
conv =>
lhs
congr
. rw [Nat.add_comm]
. rfl
exact h
def test_conv: TestM Unit := do
let state? ← startProof (.expr "∀ (a b c1 c2: Nat), (b + a) + c1 = (b + a) + c2 → (a + b) + c1 = (b + a) + c2")
let state0 ← match state? with
| .some state => pure state
| .none => do
addTest $ assertUnreachable "Goal could not parse"
return ()
let tactic := "intro a b c1 c2 h"
let state1 ← match ← state0.tacticOn (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check tactic ((← state1.serializeGoals (options := ← read)).map (·.devolatilize) =
#[interiorGoal [] "a + b + c1 = b + a + c2"])
let state2 ← match ← state1.conv (state1.get! 0) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check "conv => ..." ((← state2.serializeGoals (options := ← read)).map (·.devolatilize) =
#[{ interiorGoal [] "a + b + c1 = b + a + c2" with isConversion := true }])
let convTactic := "rhs"
let state3R ← match ← state2.tacticOn (goalId := 0) convTactic with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check s!" {convTactic} (discard)" ((← state3R.serializeGoals (options := ← read)).map (·.devolatilize) =
#[{ interiorGoal [] "b + a + c2" with isConversion := true }])
let convTactic := "lhs"
let state3L ← match ← state2.tacticOn (goalId := 0) convTactic with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check s!" {convTactic}" ((← state3L.serializeGoals (options := ← read)).map (·.devolatilize) =
#[{ interiorGoal [] "a + b + c1" with isConversion := true }])
let convTactic := "congr"
let state4 ← match ← state3L.tacticOn (goalId := 0) convTactic with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check s!" {convTactic}" ((← state4.serializeGoals (options := ← read)).map (·.devolatilize) =
#[
{ interiorGoal [] "a + b" with isConversion := true, userName? := .some "a" },
{ interiorGoal [] "c1" with isConversion := true, userName? := .some "a" }
])
let convTactic := "rw [Nat.add_comm]"
let state5_1 ← match ← state4.tacticOn (goalId := 0) convTactic with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check s!" · {convTactic}" ((← state5_1.serializeGoals (options := ← read)).map (·.devolatilize) =
#[{ interiorGoal [] "b + a" with isConversion := true, userName? := .some "a" }])
let convTactic := "rfl"
let state6_1 ← match ← state5_1.tacticOn (goalId := 0) convTactic with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check s!" {convTactic}" ((← state6_1.serializeGoals (options := ← read)).map (·.devolatilize) =
#[])
let state4_1 ← match state6_1.continue state4 with
| .ok state => pure state
| .error e => do
addTest $ expectationFailure "continue" e
return ()
let convTactic := "rfl"
let state6 ← match ← state4_1.tacticOn (goalId := 0) convTactic with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check s!" · {convTactic}" ((← state6.serializeGoals (options := ← read)).map (·.devolatilize) =
#[])
let state1_1 ← match ← state6.convExit with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
let tactic := "exact h"
let stateF ← match ← state1_1.tacticOn (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check tactic ((← stateF.serializeGoals (options := ← read)).map (·.devolatilize) =
#[])
where
h := "b + a + c1 = b + a + c2"
interiorGoal (free: List (String × String)) (target: String) :=
let free := [("a", "Nat"), ("b", "Nat"), ("c1", "Nat"), ("c2", "Nat"), ("h", h)] ++ free
buildGoal free target
example : ∀ (a b c d: Nat), a + b = b + c → b + c = c + d → a + b = c + d := by
intro a b c d h1 h2
calc a + b = b + c := by apply h1
_ = c + d := by apply h2
def test_calc: TestM Unit := do
let state? ← startProof (.expr "∀ (a b c d: Nat), a + b = b + c → b + c = c + d → a + b = c + d")
let state0 ← match state? with
| .some state => pure state
| .none => do
addTest $ assertUnreachable "Goal could not parse"
return ()
let tactic := "intro a b c d h1 h2"
let state1 ← match ← state0.tacticOn (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check tactic ((← state1.serializeGoals (options := ← read)).map (·.devolatilize) =
#[interiorGoal [] "a + b = c + d"])
let pred := "a + b = b + c"
let state2 ← match ← state1.tryCalc (state1.get! 0) (pred := pred) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check s!"calc {pred} := _" ((← state2.serializeGoals (options := ← read)).map (·.devolatilize) =
#[
interiorGoal [] "a + b = b + c" (.some "calc"),
interiorGoal [] "b + c = c + d"
])
addTest $ LSpec.test "(2.0 prev rhs)" (state2.calcPrevRhsOf? (state2.get! 0) |>.isNone)
addTest $ LSpec.test "(2.1 prev rhs)" (state2.calcPrevRhsOf? (state2.get! 1) |>.isSome)
let tactic := "apply h1"
let state2m ← match ← state2.tacticOn (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
let state3 ← match state2m.continue state2 with
| .ok state => pure state
| .error e => do
addTest $ expectationFailure "continue" e
return ()
let pred := "_ = c + d"
let state4 ← match ← state3.tryCalc (state3.get! 0) (pred := pred) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check s!"calc {pred} := _" ((← state4.serializeGoals (options := ← read)).map (·.devolatilize) =
#[
interiorGoal [] "b + c = c + d" (.some "calc")
])
addTest $ LSpec.test "(4.0 prev rhs)" (state4.calcPrevRhsOf? (state4.get! 0) |>.isNone)
let tactic := "apply h2"
let state4m ← match ← state4.tacticOn (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.test "(4m root)" state4m.rootExpr?.isSome
where
interiorGoal (free: List (String × String)) (target: String) (userName?: Option String := .none) :=
let free := [("a", "Nat"), ("b", "Nat"), ("c", "Nat"), ("d", "Nat"),
("h1", "a + b = b + c"), ("h2", "b + c = c + d")] ++ free
buildGoal free target userName?
def test_nat_zero_add: TestM Unit := do
let state? ← startProof (.expr "∀ (n: Nat), n + 0 = n")
let state0 ← match state? with
| .some state => pure state
| .none => do
addTest $ assertUnreachable "Goal could not parse"
return ()
let tactic := "intro n"
let state1 ← match ← state0.tacticOn (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check tactic ((← state1.serializeGoals (options := ← read)).map (·.devolatilize) =
#[buildGoal [("n", "Nat")] "n + 0 = n"])
let recursor := "@Nat.brecOn"
let state2 ← match ← state1.tryMotivatedApply (state1.get! 0) (recursor := recursor) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check s!"mapply {recursor}" ((← state2.serializeGoals (options := ← read)).map (·.devolatilizeVars) =
#[
buildNamedGoal "_uniq.67" [("n", "Nat")] "Nat → Prop" (.some "motive"),
buildNamedGoal "_uniq.68" [("n", "Nat")] "Nat",
buildNamedGoal "_uniq.69" [("n", "Nat")] "∀ (t : Nat), Nat.below t → ?motive t",
buildNamedGoal "_uniq.70" [("n", "Nat")] "?motive ?m.68 = (n + 0 = n)" (.some "conduit")
])
let tactic := "exact n"
let state3b ← match ← state2.tacticOn (goalId := 1) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check tactic ((← state3b.serializeGoals (options := ← read)).map (·.devolatilize) =
#[])
let state2b ← match state3b.continue state2 with
| .ok state => pure state
| .error e => do
addTest $ assertUnreachable e
return ()
let tactic := "exact (λ x => x + 0 = x)"
let state3c ← match ← state2b.tacticOn (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check tactic ((← state3c.serializeGoals (options := ← read)).map (·.devolatilize) =
#[])
let state2c ← match state3c.continue state2b with
| .ok state => pure state
| .error e => do
addTest $ assertUnreachable e
return ()
let tactic := "intro t h"
let state3 ← match ← state2c.tacticOn (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check tactic ((← state3.serializeGoals (options := ← read)).map (·.devolatilize) =
#[buildGoal [("n", "Nat"), ("t", "Nat"), ("h", "Nat.below t")] "t + 0 = t"])
let tactic := "simp"
let state3d ← match ← state3.tacticOn (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
let state2d ← match state3d.continue state2c with
| .ok state => pure state
| .error e => do
addTest $ assertUnreachable e
return ()
let tactic := "rfl"
let stateF ← match ← state2d.tacticOn (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check tactic ((← stateF.serializeGoals (options := ← read)) =
#[])
let expr := stateF.mctx.eAssignment.find! stateF.root
let (expr, _) := instantiateMVarsCore (mctx := stateF.mctx) (e := expr)
addTest $ LSpec.check "(F root)" stateF.rootExpr?.isSome
def test_nat_zero_add_alt: TestM Unit := do
let state? ← startProof (.expr "∀ (n: Nat), n + 0 = n")
let state0 ← match state? with
| .some state => pure state
| .none => do
addTest $ assertUnreachable "Goal could not parse"
return ()
let tactic := "intro n"
let state1 ← match ← state0.tacticOn (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check tactic ((← state1.serializeGoals (options := ← read)).map (·.devolatilize) =
#[buildGoal [("n", "Nat")] "n + 0 = n"])
let recursor := "@Nat.brecOn"
let state2 ← match ← state1.tryMotivatedApply (state1.get! 0) (recursor := recursor) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
let major := "_uniq.68"
addTest $ LSpec.check s!"mapply {recursor}" ((← state2.serializeGoals (options := ← read)).map (·.devolatilizeVars) =
#[
buildNamedGoal "_uniq.67" [("n", "Nat")] "Nat → Prop" (.some "motive"),
buildNamedGoal major [("n", "Nat")] "Nat",
buildNamedGoal "_uniq.69" [("n", "Nat")] "∀ (t : Nat), Nat.below t → ?motive t",
buildNamedGoal "_uniq.70" [("n", "Nat")] "?motive ?m.68 = (n + 0 = n)" (.some "conduit")
])
let tactic := "intro x"
let state3m ← match ← state2.tacticOn (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check tactic ((← state3m.serializeGoals (options := ← read)).map (·.devolatilize) =
#[buildGoal [("n", "Nat"), ("x", "Nat")] "Prop" (.some "motive")])
let tactic := "apply Eq"
let state3m2 ← match ← state3m.tacticOn (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
let (eqL, eqR, eqT) := ("_uniq.88", "_uniq.89", "_uniq.87")
addTest $ LSpec.check tactic $ state3m2.goals.map (·.name.toString) = [eqL, eqR, eqT]
let [_motive, _major, _step, conduit] := state2.goals | panic! "Goals conflict"
let state2b ← match state3m2.resume [conduit] with
| .ok state => pure state
| .error e => do
addTest $ assertUnreachable e
return ()
let cNatAdd := "(:c HAdd.hAdd) (:c Nat) (:c Nat) (:c Nat) ((:c instHAdd) (:c Nat) (:c instAddNat))"
let cNat0 := "((:c OfNat.ofNat) (:c Nat) (:lit 0) ((:c instOfNatNat) (:lit 0)))"
let fvN := "_uniq.63"
let conduitRight := s!"((:c Eq) (:c Nat) ({cNatAdd} (:fv {fvN}) {cNat0}) (:fv {fvN}))"
let substOf (mv: String) := s!"(:subst (:mv {mv}) (:fv {fvN}) (:mv {major}))"
addTest $ LSpec.check "resume" ((← state2b.serializeGoals (options := { ← read with printExprAST := true })) =
#[
{
name := "_uniq.70",
userName? := .some "conduit",
target := {
pp? := .some "(?m.92 ?m.68 = ?m.94 ?m.68) = (n + 0 = n)",
sexp? := .some s!"((:c Eq) (:sort 0) ((:c Eq) {substOf eqT} {substOf eqL} {substOf eqR}) {conduitRight})",
},
vars := #[{
name := fvN,
userName := "n",
type? := .some { pp? := .some "Nat", sexp? := .some "(:c Nat)" },
}],
}
])
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
let tests := [
("identity", test_identity),
("Nat.add_comm", test_nat_add_comm false),
("Nat.add_comm manual", test_nat_add_comm true),
("Nat.add_comm delta", test_delta_variable),
("arithmetic", test_arith),
("Or.comm", test_or_comm),
("conv", test_conv),
("calc", test_calc),
("Nat.zero_add", test_nat_zero_add),
("Nat.zero_add alt", test_nat_zero_add_alt),
]
tests.map (fun (name, test) => (name, proofRunner env test))
end Pantograph.Test.Proofs

109
Test/Serial.lean Normal file
View File

@ -0,0 +1,109 @@
import LSpec
import Pantograph.Serial
import Test.Common
import Lean
open Lean
namespace Pantograph.Test.Serial
open Pantograph
deriving instance Repr, DecidableEq for Protocol.BoundExpression
def test_serializeName: LSpec.TestSeq :=
let quote := "\""
let escape := "\\"
LSpec.test "a.b.1" (serializeName (Name.num (.str (.str .anonymous "a") "b") 1) = "a.b.1") ++
LSpec.test "seg.«a.b»" (serializeName (Name.str (.str .anonymous "seg") "a.b") = s!"{quote}seg.«a.b»{quote}") ++
-- Pathological test case
LSpec.test s!"«̈{escape}{quote}»" (serializeName (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 (Name × Protocol.BoundExpression) := [
("Nat.add_comm".toName, { binders := #[("n", "Nat"), ("m", "Nat")], target := "n + m = m + n" }),
("Nat.le_of_succ_le".toName, { binders := #[("n", "Nat"), ("m", "Nat"), ("h", "n.succ ≤ m")], target := "n ≤ m" })
]
runCoreMSeq env $ entries.foldlM (λ suites (symbol, target) => do
let env ← MonadEnv.getEnv
let expr := env.find? symbol |>.get! |>.type
let test := LSpec.check symbol.toString ((← typeExprToBound expr) = target)
return LSpec.TestSeq.append suites test) LSpec.TestSeq.done |>.run'
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 _ (: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)"),
-- Handling of higher order types
("Or", "(:forall a (:sort 0) (:forall b (:sort 0) (:sort 0)))"),
("List", "(:forall α (:sort (+ u 1)) (:sort (+ u 1)))")
]
runMetaMSeq env $ entries.foldlM (λ suites (symbol, target) => do
let env ← MonadEnv.getEnv
let expr := env.find? symbol.toName |>.get! |>.type
let test := LSpec.check symbol ((← serializeExpressionSexp expr) = target)
return LSpec.TestSeq.append suites test) LSpec.TestSeq.done
def test_sexp_of_elab (env: Environment): IO LSpec.TestSeq := do
let entries: List (String × (List Name) × String) := [
("λ x: Nat × Bool => x.1", [], "(:lambda x ((:c Prod) (:c Nat) (:c Bool)) ((:c Prod.fst) (:c Nat) (:c Bool) 0))"),
("λ x: Array Nat => x.data", [], "(:lambda x ((:c Array) (:c Nat)) ((:c Array.data) (:c Nat) 0))"),
("λ {α: Sort (u + 1)} => List α", [`u], "(:lambda α (:sort (+ u 1)) ((:c List) 0) :implicit)"),
("λ {α} => List α", [], "(:lambda α (:sort (+ (:mv _uniq.4) 1)) ((:c List) 0) :implicit)"),
("(2: Nat) <= (5: Nat)", [], "((:c LE.le) (:mv _uniq.18) (:mv _uniq.19) ((:c OfNat.ofNat) (:mv _uniq.4) (:lit 2) (:mv _uniq.5)) ((:c OfNat.ofNat) (:mv _uniq.14) (:lit 5) (:mv _uniq.15)))"),
]
entries.foldlM (λ suites (source, levels, target) =>
let termElabM := do
let env ← MonadEnv.getEnv
let s ← match parseTerm env source with
| .ok s => pure s
| .error e => return parseFailure e
let expr ← match (← elabTerm s) with
| .ok expr => pure expr
| .error e => return elabFailure e
return LSpec.check source ((← serializeExpressionSexp expr) = target)
let metaM := (Elab.Term.withLevelNames levels termElabM).run' (ctx := Condensed.elabContext)
return LSpec.TestSeq.append suites (← runMetaMSeq env metaM))
LSpec.TestSeq.done
def test_sexp_of_expr (env: Environment): IO LSpec.TestSeq := do
let entries: List (Expr × String) := [
(.lam `p (.sort .zero)
(.lam `q (.sort .zero)
(.lam `k (mkApp2 (.const `And []) (.bvar 1) (.bvar 0))
(.proj `And 1 (.bvar 0))
.default)
.implicit)
.implicit,
"(:lambda p (:sort 0) (:lambda q (:sort 0) (:lambda k ((:c And) 1 0) ((:c And.right) _ _ 0)) :implicit) :implicit)"
),
]
let termElabM: Elab.TermElabM LSpec.TestSeq := entries.foldlM (λ suites (expr, target) => do
let env ← MonadEnv.getEnv
let testCaseName := target.take 10
let test := LSpec.check testCaseName ((← serializeExpressionSexp expr) = target)
return LSpec.TestSeq.append suites test) LSpec.TestSeq.done
runMetaMSeq env $ termElabM.run' (ctx := Condensed.elabContext)
-- Instance parsing
def test_instance (env: Environment): IO LSpec.TestSeq :=
runMetaMSeq env do
let env ← MonadEnv.getEnv
let source := "λ x y: Nat => HAdd.hAdd Nat Nat Nat (instHAdd Nat instAddNat) x y"
let s := parseTerm env source |>.toOption |>.get!
let _expr := (← runTermElabMInMeta <| elabTerm s) |>.toOption |>.get!
return LSpec.TestSeq.done
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
[
("serializeName", do pure test_serializeName),
("Expression binder", test_expr_to_binder env),
("Sexp from symbol", test_sexp_of_symbol env),
("Sexp from elaborated expr", test_sexp_of_elab env),
("Sexp from expr", test_sexp_of_expr env),
("Instance", test_instance env),
]
end Pantograph.Test.Serial

4
Test/Tactic.lean Normal file
View File

@ -0,0 +1,4 @@
import Test.Tactic.Congruence
import Test.Tactic.MotivatedApply
import Test.Tactic.NoConfuse
import Test.Tactic.Prograde

View File

@ -0,0 +1,88 @@
import LSpec
import Lean
import Test.Common
open Lean
open Pantograph
namespace Pantograph.Test.Tactic.Congruence
def test_congr_arg_list : TestT Elab.TermElabM Unit := do
let expr := "λ {α} (l1 l2 : List α) (h: l1 = l2) => l1.reverse = l2.reverse"
let expr ← parseSentence expr
Meta.lambdaTelescope expr $ λ _ body => do
let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
let newGoals ← runTacticOnMVar Tactic.evalCongruenceArg target.mvarId!
addTest $ LSpec.check "goals" ((← newGoals.mapM (λ x => mvarUserNameAndType x)) =
[
(`α, "Sort ?u.30"),
(`a₁, "?α"),
(`a₂, "?α"),
(`f, "?α → List α"),
(`h, "?a₁ = ?a₂"),
(`conduit, "(?f ?a₁ = ?f ?a₂) = (l1.reverse = l2.reverse)"),
])
let f := newGoals.get! 3
let h := newGoals.get! 4
let c := newGoals.get! 5
let results ← Meta.withAssignableSyntheticOpaque do f.apply (← parseSentence "List.reverse")
addTest $ LSpec.check "apply" (results.length = 0)
addTest $ LSpec.check "h" ((← exprToStr $ ← h.getType) = "?a₁ = ?a₂")
addTest $ LSpec.check "conduit" ((← exprToStr $ ← c.getType) = "(?a₁.reverse = ?a₂.reverse) = (l1.reverse = l2.reverse)")
def test_congr_arg : TestT Elab.TermElabM Unit := do
let expr := "λ (n m: Nat) (h: n = m) => n * n = m * m"
let expr ← parseSentence expr
Meta.lambdaTelescope expr $ λ _ body => do
let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
let newGoals ← runTacticOnMVar Tactic.evalCongruenceArg target.mvarId!
addTest $ LSpec.check "goals" ((← newGoals.mapM (λ x => mvarUserNameAndType x)) =
[
(`α, "Sort ?u.70"),
(`a₁, "?α"),
(`a₂, "?α"),
(`f, "?α → Nat"),
(`h, "?a₁ = ?a₂"),
(`conduit, "(?f ?a₁ = ?f ?a₂) = (n * n = m * m)"),
])
def test_congr_fun : TestT Elab.TermElabM Unit := do
let expr := "λ (n m: Nat) => (n + m) + (n + m) = (n + m) * 2"
let expr ← parseSentence expr
Meta.lambdaTelescope expr $ λ _ body => do
let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
let newGoals ← runTacticOnMVar Tactic.evalCongruenceFun target.mvarId!
addTest $ LSpec.check "goals" ((← newGoals.mapM (λ x => mvarUserNameAndType x)) =
[
(`α, "Sort ?u.159"),
(`f₁, "?α → Nat"),
(`f₂, "?α → Nat"),
(`h, "?f₁ = ?f₂"),
(`a, "?α"),
(`conduit, "(?f₁ ?a = ?f₂ ?a) = (n + m + (n + m) = (n + m) * 2)"),
])
def test_congr : TestT Elab.TermElabM Unit := do
let expr := "λ (a b: Nat) => a = b"
let expr ← parseSentence expr
Meta.lambdaTelescope expr $ λ _ body => do
let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
let newGoals ← runTacticOnMVar Tactic.evalCongruence target.mvarId!
addTest $ LSpec.check "goals" ((← newGoals.mapM (λ x => mvarUserNameAndType x)) =
[
(`α, "Sort ?u.10"),
(`f₁, "?α → Nat"),
(`f₂, "?α → Nat"),
(`a₁, "?α"),
(`a₂, "?α"),
(`h₁, "?f₁ = ?f₂"),
(`h₂, "?a₁ = ?a₂"),
(`conduit, "(?f₁ ?a₁ = ?f₂ ?a₂) = (a = b)"),
])
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
[
("congrArg List.reverse", test_congr_arg_list),
("congrArg", test_congr_arg),
("congrFun", test_congr_fun),
("congr", test_congr),
] |>.map (λ (name, t) => (name, runTestTermElabM env t))
end Pantograph.Test.Tactic.Congruence

View File

@ -0,0 +1,113 @@
import LSpec
import Lean
import Test.Common
open Lean
open Pantograph
namespace Pantograph.Test.Tactic.MotivatedApply
def test_type_extract : TestT Elab.TermElabM Unit := do
let recursor ← parseSentence "@Nat.brecOn"
let recursorType ← Meta.inferType recursor
addTest $ LSpec.check "recursorType" ("{motive : Nat → Sort ?u.1} → (t : Nat) → ((t : Nat) → Nat.below t → motive t) → motive t" =
(← exprToStr recursorType))
let info ← match Tactic.getRecursorInformation recursorType with
| .some info => pure info
| .none => throwError "Failed to extract recursor info"
addTest $ LSpec.check "iMotive" (info.iMotive = 2)
let motiveType := info.getMotiveType
addTest $ LSpec.check "motiveType" ("Nat → Sort ?u.1" =
(← exprToStr motiveType))
def test_nat_brec_on : TestT Elab.TermElabM Unit := do
let expr := "λ (n t: Nat) => n + 0 = n"
let expr ← parseSentence expr
Meta.lambdaTelescope expr $ λ _ body => do
let recursor ← match Parser.runParserCategory
(env := ← MonadEnv.getEnv)
(catName := `term)
(input := "@Nat.brecOn")
(fileName := filename) with
| .ok syn => pure syn
| .error error => throwError "Failed to parse: {error}"
-- Apply the tactic
let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
let tactic := Tactic.evalMotivatedApply recursor
let newGoals ← runTacticOnMVar tactic target.mvarId!
let test := LSpec.check "goals" ((← newGoals.mapM (λ g => do exprToStr (← g.getType))) =
[
"Nat → Prop",
"Nat",
"∀ (t : Nat), Nat.below t → ?motive t",
"?motive ?m.67 = (n + 0 = n)",
])
addTest test
def test_list_brec_on : TestT Elab.TermElabM Unit := do
let expr := "λ {α : Type} (l: List α) => l ++ [] = [] ++ l"
let expr ← parseSentence expr
Meta.lambdaTelescope expr $ λ _ body => do
let recursor ← match Parser.runParserCategory
(env := ← MonadEnv.getEnv)
(catName := `term)
(input := "@List.brecOn")
(fileName := filename) with
| .ok syn => pure syn
| .error error => throwError "Failed to parse: {error}"
-- Apply the tactic
let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
let tactic := Tactic.evalMotivatedApply recursor
let newGoals ← runTacticOnMVar tactic target.mvarId!
addTest $ LSpec.check "goals" ((← newGoals.mapM (λ g => do exprToStr (← g.getType))) =
[
"Type ?u.90",
"List ?m.92 → Prop",
"List ?m.92",
"∀ (t : List ?m.92), List.below t → ?motive t",
"?motive ?m.94 = (l ++ [] = [] ++ l)",
])
def test_partial_motive_instantiation : TestT Elab.TermElabM Unit := do
let expr := "λ (n t: Nat) => n + 0 = n"
let recursor ← match Parser.runParserCategory
(env := ← MonadEnv.getEnv)
(catName := `term)
(input := "@Nat.brecOn")
(fileName := filename) with
| .ok syn => pure syn
| .error error => throwError "Failed to parse: {error}"
let expr ← parseSentence expr
Meta.lambdaTelescope expr $ λ _ body => do
-- Apply the tactic
let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
let tactic := Tactic.evalMotivatedApply recursor
let newGoals ← runTacticOnMVar tactic target.mvarId!
let majorId := 67
addTest $ (LSpec.check "goals" ((← newGoals.mapM (λ g => do exprToStr (← g.getType))) =
[
"Nat → Prop",
"Nat",
"∀ (t : Nat), Nat.below t → ?motive t",
s!"?motive ?m.{majorId} = (n + 0 = n)",
]))
let [motive, major, step, conduit] := newGoals | panic! "Incorrect goal number"
addTest $ (LSpec.check "goal name" (major.name.toString = s!"_uniq.{majorId}"))
-- Assign motive to `λ x => x + _`
let motive_assign ← parseSentence "λ (x: Nat) => @Nat.add x + 0 = _"
motive.assign motive_assign
addTest $ ← conduit.withContext do
let t := toString (← Meta.ppExpr $ ← conduit.getType)
return LSpec.check "conduit" (t = s!"(?m.{majorId}.add + 0 = ?m.138 ?m.{majorId}) = (n + 0 = n)")
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
[
("type_extract", test_type_extract),
("Nat.brecOn", test_nat_brec_on),
("List.brecOn", test_list_brec_on),
("Nat.brecOn partial motive instantiation", test_partial_motive_instantiation),
] |>.map (λ (name, t) => (name, runTestTermElabM env t))
end Pantograph.Test.Tactic.MotivatedApply

View File

@ -0,0 +1,72 @@
import LSpec
import Lean
import Test.Common
open Lean
open Pantograph
namespace Pantograph.Test.Tactic.NoConfuse
def test_nat : TestT Elab.TermElabM Unit := do
let expr := "λ (n: Nat) (h: 0 = n + 1) => False"
let expr ← parseSentence expr
Meta.lambdaTelescope expr $ λ _ body => do
let recursor ← match Parser.runParserCategory
(env := ← MonadEnv.getEnv)
(catName := `term)
(input := "h")
(fileName := filename) with
| .ok syn => pure syn
| .error error => throwError "Failed to parse: {error}"
-- Apply the tactic
let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
let tactic := Tactic.evalNoConfuse recursor
let newGoals ← runTacticOnMVar tactic target.mvarId!
addTest $ LSpec.check "goals" ((← newGoals.mapM (λ g => do exprToStr (← g.getType))) = [])
def test_nat_fail : TestT Elab.TermElabM Unit := do
let expr := "λ (n: Nat) (h: n = n) => False"
let expr ← parseSentence expr
Meta.lambdaTelescope expr $ λ _ body => do
let recursor ← match Parser.runParserCategory
(env := ← MonadEnv.getEnv)
(catName := `term)
(input := "h")
(fileName := filename) with
| .ok syn => pure syn
| .error error => throwError "Failed to parse: {error}"
-- Apply the tactic
let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
try
let tactic := Tactic.evalNoConfuse recursor
let _ ← runTacticOnMVar tactic target.mvarId!
addTest $ assertUnreachable "Tactic should fail"
catch _ =>
addTest $ LSpec.check "Tactic should fail" true
def test_list : TestT Elab.TermElabM Unit := do
let expr := "λ (l: List Nat) (h: [] = 1 :: l) => False"
let expr ← parseSentence expr
Meta.lambdaTelescope expr $ λ _ body => do
let recursor ← match Parser.runParserCategory
(env := ← MonadEnv.getEnv)
(catName := `term)
(input := "h")
(fileName := filename) with
| .ok syn => pure syn
| .error error => throwError "Failed to parse: {error}"
-- Apply the tactic
let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
let tactic := Tactic.evalNoConfuse recursor
let newGoals ← runTacticOnMVar tactic target.mvarId!
addTest $ LSpec.check "goals"
((← newGoals.mapM (λ g => do exprToStr (← g.getType))) = [])
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
[
("Nat", test_nat),
("Nat fail", test_nat_fail),
("List", test_list),
] |>.map (λ (name, t) => (name, runTestTermElabM env t))
end Pantograph.Test.Tactic.NoConfuse

300
Test/Tactic/Prograde.lean Normal file
View File

@ -0,0 +1,300 @@
import LSpec
import Lean
import Test.Common
open Lean
open Pantograph
namespace Pantograph.Test.Tactic.Prograde
def test_define : TestT Elab.TermElabM Unit := do
let expr := "forall (p q : Prop) (h: p), And (Or p q) (Or p q)"
let expr ← parseSentence expr
Meta.forallTelescope expr $ λ _ body => do
let e ← match Parser.runParserCategory
(env := ← MonadEnv.getEnv)
(catName := `term)
(input := "Or.inl h")
(fileName := filename) with
| .ok syn => pure syn
| .error error => throwError "Failed to parse: {error}"
-- Apply the tactic
let goal ← Meta.mkFreshExprSyntheticOpaqueMVar body
let target: Expr := mkAnd
(mkOr (.fvar ⟨uniq 8⟩) (.fvar ⟨uniq 9⟩))
(mkOr (.fvar ⟨uniq 8⟩) (.fvar ⟨uniq 9⟩))
let h := .fvar ⟨uniq 8⟩
addTest $ LSpec.test "goals before" ((← toCondensedGoal goal.mvarId!).devolatilize == {
context := #[
cdeclOf `p (.sort 0),
cdeclOf `q (.sort 0),
cdeclOf `h h
],
target,
})
let tactic := Tactic.evalDefine `h2 e
let m := .mvar ⟨uniq 13⟩
let [newGoal] ← runTacticOnMVar tactic goal.mvarId! | panic! "Incorrect goal number"
addTest $ LSpec.test "goals after" ((← toCondensedGoal newGoal).devolatilize == {
context := #[
cdeclOf `p (.sort 0),
cdeclOf `q (.sort 0),
cdeclOf `h h,
{
userName := `h2,
type := mkOr h m,
value? := .some $ mkApp3 (mkConst `Or.inl) h m (.fvar ⟨uniq 10⟩)
}
],
target,
})
let .some e ← getExprMVarAssignment? goal.mvarId! | panic! "Tactic must assign"
addTest $ LSpec.test "assign" e.isLet
def test_define_proof : TestT Elab.TermElabM Unit := do
let rootExpr ← parseSentence "∀ (p q: Prop), p → ((p q) (p q))"
let state0 ← GoalState.create rootExpr
let tactic := "intro p q h"
let state1 ← match ← state0.tacticOn (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check tactic ((← state1.serializeGoals).map (·.devolatilize) =
#[buildGoal [("p", "Prop"), ("q", "Prop"), ("h", "p")] "(p q) p q"])
let expr := "Or.inl (Or.inl h)"
let state2 ← match ← state1.tryAssign (state1.get! 0) (expr := expr) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check s!":= {expr}" ((← state2.serializeGoals).map (·.devolatilize) =
#[])
let evalBind := "y"
let evalExpr := "Or.inl h"
let state2 ← match ← state1.tryDefine (state1.get! 0) (binderName := evalBind) (expr := evalExpr) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check s!"eval {evalBind} := {evalExpr}" ((← state2.serializeGoals).map (·.devolatilize) =
#[{
target := { pp? := .some "(p q) p q"},
vars := #[
{ userName := "p", type? := .some { pp? := .some "Prop" } },
{ userName := "q", type? := .some { pp? := .some "Prop" } },
{ userName := "h", type? := .some { pp? := .some "p" } },
{ userName := "y",
type? := .some { pp? := .some "p ?m.25" },
value? := .some { pp? := .some "Or.inl h" },
}
]
}])
let expr := "Or.inl y"
let state3 ← match ← state2.tryAssign (state2.get! 0) (expr := expr) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check s!":= {expr}" ((← state3.serializeGoals).map (·.devolatilize) =
#[])
addTest $ LSpec.check "(3 root)" state3.rootExpr?.isSome
def fun_define_root_expr: ∀ (p: Prop), PProd (Nat → p) Unit → p := by
intro p x
apply x.fst
exact 5
def test_define_root_expr : TestT Elab.TermElabM Unit := do
--let rootExpr ← parseSentence "Nat"
--let state0 ← GoalState.create rootExpr
--let .success state1 ← state0.tacticOn (goalId := 0) "exact 5" | addTest $ assertUnreachable "exact 5"
--let .some rootExpr := state1.rootExpr? | addTest $ assertUnreachable "Root expr"
--addTest $ LSpec.check "root" ((toString $ ← Meta.ppExpr rootExpr) = "5")
let rootExpr ← parseSentence "∀ (p: Prop), PProd (Nat → p) Unit → p"
let state0 ← GoalState.create rootExpr
let tactic := "intro p x"
let .success state1 ← state0.tacticOn (goalId := 0) tactic | addTest $ assertUnreachable tactic
let binderName := `binder
let value := "x.fst"
let expr ← state1.goals[0]!.withContext $ strToTermSyntax value
let tacticM := Tactic.evalDefine binderName expr
let .success state2 ← state1.tryTacticM (state1.get! 0) tacticM | addTest $ assertUnreachable s!"define {binderName} := {value}"
let tactic := s!"apply {binderName}"
let .success state3 ← state2.tacticOn (goalId := 0) tactic | addTest $ assertUnreachable tactic
let tactic := s!"exact 5"
let .success state4 ← state3.tacticOn (goalId := 0) tactic | addTest $ assertUnreachable tactic
let .some rootExpr := state4.rootExpr? | addTest $ assertUnreachable "Root expr"
addTest $ LSpec.check "root" ((toString $ ← Meta.ppExpr rootExpr) = "fun p x =>\n let binder := x.fst;\n binder 5")
--set_option pp.all true
--#check @PSigma (α := Prop) (β := λ (p: Prop) => p)
--def test_define_root_expr : TestT Elab.TermElabM Unit := do
def test_have_proof : TestT Elab.TermElabM Unit := do
let rootExpr ← parseSentence "∀ (p q: Prop), p → ((p q) (p q))"
let state0 ← GoalState.create rootExpr
let tactic := "intro p q h"
let state1 ← match ← state0.tacticOn (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check tactic ((← state1.serializeGoals).map (·.devolatilize) =
#[buildGoal [("p", "Prop"), ("q", "Prop"), ("h", "p")] "(p q) p q"])
let expr := "Or.inl (Or.inl h)"
let state2 ← match ← state1.tryAssign (state1.get! 0) (expr := expr) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check s!":= {expr}" ((← state2.serializeGoals).map (·.devolatilize) =
#[])
let haveBind := "y"
let haveType := "p q"
let state2 ← match ← state1.tryHave (state1.get! 0) (binderName := haveBind) (type := haveType) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check s!"have {haveBind}: {haveType}" ((← state2.serializeGoals).map (·.devolatilize) =
#[
buildGoal [("p", "Prop"), ("q", "Prop"), ("h", "p")] "p q",
buildGoal [("p", "Prop"), ("q", "Prop"), ("h", "p"), ("y", "p q")] "(p q) p q"
])
let expr := "Or.inl h"
let state3 ← match ← state2.tryAssign (state2.get! 0) (expr := expr) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check s!":= {expr}" ((← state3.serializeGoals).map (·.devolatilize) =
#[])
let state2b ← match state3.continue state2 with
| .ok state => pure state
| .error e => do
addTest $ assertUnreachable e
return ()
let expr := "Or.inl y"
let state4 ← match ← state2b.tryAssign (state2b.get! 0) (expr := expr) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check s!":= {expr}" ((← state4.serializeGoals).map (·.devolatilize) =
#[])
let .some rootExpr := state4.rootExpr? | addTest $ assertUnreachable "Root expr"
addTest $ LSpec.check "root" ((toString $ ← Meta.ppExpr rootExpr) = "fun p q h y => Or.inl y")
def test_let (specialized: Bool): TestT Elab.TermElabM Unit := do
let rootExpr ← parseSentence "∀ (p q: Prop), p → ((p q) (p q))"
let state0 ← GoalState.create rootExpr
let tactic := "intro a p h"
let state1 ← match ← state0.tacticOn (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check tactic ((← state1.serializeGoals).map (·.devolatilize) =
#[{
target := { pp? := .some mainTarget },
vars := interiorVars,
}])
let letType := "Nat"
let expr := s!"let b: {letType} := _; _"
let result2 ← match specialized with
| true => state1.tryLet (state1.get! 0) (binderName := "b") (type := letType)
| false => state1.tryAssign (state1.get! 0) (expr := expr)
let state2 ← match result2 with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
let serializedState2 ← state2.serializeGoals
let letBindName := if specialized then "b" else "_1"
addTest $ LSpec.check expr (serializedState2.map (·.devolatilize) =
#[{
target := { pp? := .some letType },
vars := interiorVars,
userName? := .some letBindName
},
{
target := { pp? := .some mainTarget },
vars := interiorVars ++ #[{
userName := "b",
type? := .some { pp? := .some letType },
value? := .some { pp? := .some s!"?{letBindName}" },
}],
userName? := if specialized then .none else .some "_2",
}
])
let tactic := "exact 1"
let state3 ← match ← state2.tacticOn (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check tactic ((← state3.serializeGoals).map (·.devolatilize) = #[])
let state3r ← match state3.continue state2 with
| .error msg => do
addTest $ assertUnreachable $ msg
return ()
| .ok state => pure state
addTest $ LSpec.check "(continue)" ((← state3r.serializeGoals).map (·.devolatilize) =
#[
{
target := { pp? := .some mainTarget },
vars := interiorVars ++ #[{
userName := "b",
type? := .some { pp? := .some "Nat" },
value? := .some { pp? := .some "1" },
}],
userName? := if specialized then .none else .some "_2",
}
])
let tactic := "exact h"
match ← state3r.tacticOn (goalId := 0) (tactic := tactic) with
| .failure #[message] =>
addTest $ LSpec.check tactic (message = s!"type mismatch\n h\nhas type\n a : Prop\nbut is expected to have type\n {mainTarget} : Prop")
| other => do
addTest $ assertUnreachable $ other.toString
let tactic := "exact Or.inl (Or.inl h)"
let state4 ← match ← state3r.tacticOn (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.test "(4 root)" state4.rootExpr?.isSome
where
mainTarget := "(a p) a p"
interiorVars: Array Protocol.Variable := #[
{ userName := "a", type? := .some { pp? := .some "Prop" }, },
{ userName := "p", type? := .some { pp? := .some "Prop" }, },
{ userName := "h", type? := .some { pp? := .some "a" }, }
]
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
[
("define", test_define),
("define proof", test_define_proof),
("define root expr", test_define_root_expr),
("have proof", test_have_proof),
("let via assign", test_let false),
("let via tryLet", test_let true),
] |>.map (λ (name, t) => (name, runTestTermElabM env t))
end Pantograph.Test.Tactic.Prograde

73
doc/icon.svg Normal file
View File

@ -0,0 +1,73 @@
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
<!-- Created with Inkscape (http://www.inkscape.org/) -->
<svg
width="256"
height="256"
viewBox="0 0 55.900957 55.900957"
version="1.1"
id="svg21534"
xml:space="preserve"
inkscape:version="1.2.2 (b0a8486541, 2022-12-01)"
sodipodi:docname="icon.svg"
xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"
xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"
xmlns="http://www.w3.org/2000/svg"
xmlns:svg="http://www.w3.org/2000/svg"><sodipodi:namedview
id="namedview21536"
pagecolor="#ffffff"
bordercolor="#111111"
borderopacity="1"
inkscape:showpageshadow="0"
inkscape:pageopacity="0"
inkscape:pagecheckerboard="1"
inkscape:deskcolor="#d1d1d1"
inkscape:document-units="px"
showgrid="true"
inkscape:zoom="5.1754899"
inkscape:cx="158.82554"
inkscape:cy="91.682142"
inkscape:window-width="3777"
inkscape:window-height="2093"
inkscape:window-x="0"
inkscape:window-y="0"
inkscape:window-maximized="1"
inkscape:current-layer="layer1"><inkscape:grid
type="xygrid"
id="grid23833"
spacingx="3.4938098"
spacingy="3.4938098"
empspacing="4" /></sodipodi:namedview><defs
id="defs21531" /><g
inkscape:label="Layer 1"
inkscape:groupmode="layer"
id="layer1"><rect
style="fill:#3e3e3e;fill-opacity:1;fill-rule:evenodd;stroke:none;stroke-width:1.78013;stroke-miterlimit:3.4;stroke-dasharray:none"
id="rect26805"
width="11.502316"
height="2.2512667"
x="33.344425"
y="7.6690259"
ry="0.28140834"
rx="0.47926313" /><path
style="fill:#3e3e3e;stroke:none;stroke-width:0.218363px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1;fill-opacity:1"
d="m 35.764667,9.9513013 c 0,0 -26.8581417,13.7987337 -28.0863506,14.9501437 -1.250042,1.171878 3.2347846,3.945325 3.2347846,3.945325 l 21.34979,14.934062 6.624567,0.453105 -27.599216,-17.304358 c 0,0 -0.603209,-0.08927 -0.600411,-0.762283 0.0028,-0.673015 27.32022,-16.4227356 27.32022,-16.4227356 z"
id="path27381"
sodipodi:nodetypes="csccccscc" /><path
style="fill:#3e3e3e;stroke:none;stroke-width:0.218363px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1;fill-opacity:1"
d="M 10.97848,26.985751 40.537772,9.7943227 41.921795,9.7005084 11.210626,27.421377 Z"
id="path27479" /><path
style="fill:#3e3e3e;stroke:none;stroke-width:0.218363px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1;fill-opacity:1"
d="m 7.0509847,25.522367 c -0.8266141,1.386819 -2.4011783,4.48805 -2.4706357,4.90223 -0.069458,0.414182 0.4434324,0.513474 0.8491061,0.757041 C 5.835129,31.425204 19.33424,43.917182 19.33424,43.917182 l 0.324562,-0.539228 c 0,0 -14.2055729,-12.369493 -14.0644435,-12.868167 0.1411292,-0.498672 3.544896,-3.777392 3.544896,-3.777392 L 7.4596884,25.117508 Z"
id="path27481" /><rect
style="fill:#3e3e3e;fill-opacity:1;fill-rule:evenodd;stroke:none;stroke-width:2.11692;stroke-miterlimit:3.4;stroke-dasharray:none;stroke-opacity:1"
id="rect27483"
width="36.38942"
height="3.6217353"
x="13.953447"
y="43.009739"
rx="0.43672624"
ry="0.43672624" /><path
style="fill:none;stroke:#000000;stroke-width:0.218363px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"
d="M -2.1119274,7.666599 H 64.179192"
id="path27487" /></g></svg>

After

Width:  |  Height:  |  Size: 3.5 KiB

169
flake.lock Normal file
View File

@ -0,0 +1,169 @@
{
"nodes": {
"flake-parts": {
"inputs": {
"nixpkgs-lib": "nixpkgs-lib"
},
"locked": {
"lastModified": 1709336216,
"narHash": "sha256-Dt/wOWeW6Sqm11Yh+2+t0dfEWxoMxGBvv3JpIocFl9E=",
"owner": "hercules-ci",
"repo": "flake-parts",
"rev": "f7b3c975cf067e56e7cda6cb098ebe3fb4d74ca2",
"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",
"nixpkgs": "nixpkgs",
"nixpkgs-cadical": "nixpkgs-cadical",
"nixpkgs-old": "nixpkgs-old"
},
"locked": {
"lastModified": 1727749878,
"narHash": "sha256-O2Egyh2D0TfQWzQKfHUeAh7qAjMfeLVwXwGUw5QqcvE=",
"owner": "leanprover",
"repo": "lean4",
"rev": "dc2533473114eb8656439ff2b9335209784aa640",
"type": "github"
},
"original": {
"owner": "leanprover",
"ref": "v4.12.0",
"repo": "lean4",
"type": "github"
}
},
"lspec": {
"flake": false,
"locked": {
"lastModified": 1728279187,
"narHash": "sha256-ZMqbvCqR/gHXRuIkuo7b0Yp9N1vOQR7xnrcy/SeIBoQ=",
"owner": "argumentcomputer",
"repo": "LSpec",
"rev": "504a8cecf8da601b9466ac727aebb6b511aae4ab",
"type": "github"
},
"original": {
"owner": "argumentcomputer",
"ref": "504a8cecf8da601b9466ac727aebb6b511aae4ab",
"repo": "LSpec",
"type": "github"
}
},
"nixpkgs": {
"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-cadical": {
"locked": {
"lastModified": 1722221733,
"narHash": "sha256-sga9SrrPb+pQJxG1ttJfMPheZvDOxApFfwXCFO0H9xw=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "12bf09802d77264e441f48e25459c10c93eada2e",
"type": "github"
},
"original": {
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "12bf09802d77264e441f48e25459c10c93eada2e",
"type": "github"
}
},
"nixpkgs-lib": {
"locked": {
"dir": "lib",
"lastModified": 1709237383,
"narHash": "sha256-cy6ArO4k5qTx+l5o+0mL9f5fa86tYUX3ozE1S+Txlds=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "1536926ef5621b09bba54035ae2bb6d806d72ac8",
"type": "github"
},
"original": {
"dir": "lib",
"owner": "NixOS",
"ref": "nixos-unstable",
"repo": "nixpkgs",
"type": "github"
}
},
"nixpkgs-old": {
"flake": false,
"locked": {
"lastModified": 1581379743,
"narHash": "sha256-i1XCn9rKuLjvCdu2UeXKzGLF6IuQePQKFt4hEKRU5oc=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "34c7eb7545d155cc5b6f499b23a7cb1c96ab4d59",
"type": "github"
},
"original": {
"owner": "NixOS",
"ref": "nixos-19.03",
"repo": "nixpkgs",
"type": "github"
}
},
"nixpkgs_2": {
"locked": {
"lastModified": 1711703276,
"narHash": "sha256-iMUFArF0WCatKK6RzfUJknjem0H9m4KgorO/p3Dopkk=",
"owner": "nixos",
"repo": "nixpkgs",
"rev": "d8fe5e6c92d0d190646fb9f1056741a229980089",
"type": "github"
},
"original": {
"owner": "nixos",
"ref": "nixos-unstable",
"repo": "nixpkgs",
"type": "github"
}
},
"root": {
"inputs": {
"flake-parts": "flake-parts",
"lean": "lean",
"lspec": "lspec",
"nixpkgs": "nixpkgs_2"
}
}
},
"root": "root",
"version": 7
}

96
flake.nix Normal file
View File

@ -0,0 +1,96 @@
{
description = "Pantograph";
inputs = {
nixpkgs.url = "github:nixos/nixpkgs/nixos-unstable";
flake-parts.url = "github:hercules-ci/flake-parts";
lean = {
# Do not follow input's nixpkgs since it could cause build failures
url = "github:leanprover/lean4?ref=v4.12.0";
};
lspec = {
url = "github:argumentcomputer/LSpec?ref=504a8cecf8da601b9466ac727aebb6b511aae4ab";
flake = false;
};
};
outputs = inputs @ {
self,
nixpkgs,
flake-parts,
lean,
lspec,
...
} : flake-parts.lib.mkFlake { inherit inputs; } {
flake = {
};
systems = [
"x86_64-linux"
"x86_64-darwin"
];
perSystem = { system, pkgs, ... }: let
leanPkgs = lean.packages.${system}.deprecated;
lspecLib = leanPkgs.buildLeanPackage {
name = "LSpec";
roots = [ "Main" "LSpec" ];
src = "${lspec}";
};
project = leanPkgs.buildLeanPackage {
name = "Pantograph";
roots = [ "Pantograph" ];
src = pkgs.lib.cleanSource (pkgs.lib.cleanSourceWith {
src = ./.;
filter = path: type:
!(pkgs.lib.hasInfix "/Test/" path) &&
!(pkgs.lib.hasSuffix ".md" path) &&
!(pkgs.lib.hasSuffix "Repl.lean" path);
});
};
repl = leanPkgs.buildLeanPackage {
name = "Repl";
roots = [ "Main" "Repl" ];
deps = [ project ];
src = pkgs.lib.cleanSource (pkgs.lib.cleanSourceWith {
src = ./.;
filter = path: type:
!(pkgs.lib.hasInfix "/Test/" path) &&
!(pkgs.lib.hasSuffix ".md" path);
});
};
test = leanPkgs.buildLeanPackage {
name = "Test";
# NOTE: The src directory must be ./. since that is where the import
# root begins (e.g. `import Test.Environment` and not `import
# Environment`) and thats where `lakefile.lean` resides.
roots = [ "Test.Main" ];
deps = [ lspecLib repl ];
src = pkgs.lib.cleanSource (pkgs.lib.cleanSourceWith {
src = ./.;
filter = path: type:
!(pkgs.lib.hasInfix "Pantograph" path);
});
};
in rec {
packages = {
inherit (leanPkgs) lean lean-all;
inherit (project) sharedLib;
inherit (repl) executable;
default = repl.executable;
};
legacyPackages = {
inherit project leanPkgs;
};
checks = {
test = pkgs.runCommand "test" {
buildInputs = [ test.executable leanPkgs.lean-all ];
} ''
#export LEAN_SRC_PATH="${./.}"
${test.executable}/bin/test > $out
'';
};
devShells.default = pkgs.mkShell {
buildInputs = [ leanPkgs.lean-all leanPkgs.lean ];
};
};
};
}

15
lake-manifest.json Normal file
View File

@ -0,0 +1,15 @@
{"version": "1.1.0",
"packagesDir": ".lake/packages",
"packages":
[{"url": "https://github.com/lenianiva/LSpec.git",
"type": "git",
"subDir": null,
"scope": "",
"rev": "c492cecd0bc473e2f9c8b94d545d02cc0056034f",
"name": "LSpec",
"manifestFile": "lake-manifest.json",
"inputRev": "c492cecd0bc473e2f9c8b94d545d02cc0056034f",
"inherited": false,
"configFile": "lakefile.lean"}],
"name": "pantograph",
"lakeDir": ".lake"}

View File

@ -1,19 +1,29 @@
import Lake
open Lake DSL
package pantograph {
-- add package configuration options here
}
require mathlib from git
"https://github.com/leanprover-community/mathlib4.git" @ "8e5a00a8afc8913c0584cb85f37951995275fd87"
package pantograph
lean_lib Pantograph {
-- add library configuration options here
roots := #[`Pantograph]
defaultFacets := #[LeanLib.sharedFacet]
}
@[default_target]
lean_exe pantograph {
root := `Main
lean_lib Repl {
}
@[default_target]
lean_exe repl {
root := `Main
-- Solves the native symbol not found problem
supportInterpreter := true
}
require LSpec from git
"https://github.com/lenianiva/LSpec.git" @ "c492cecd0bc473e2f9c8b94d545d02cc0056034f"
lean_lib Test {
}
@[test_driver]
lean_exe test {
root := `Test.Main
-- Solves the native symbol not found problem
supportInterpreter := true
}

View File

@ -1 +1 @@
leanprover/lean4:nightly-2023-05-06
leanprover/lean4:v4.12.0