-
Notifications
You must be signed in to change notification settings - Fork 957
Expand file tree
/
Copy pathTermElabM.lean
More file actions
2270 lines (2008 loc) · 100 KB
/
Copy pathTermElabM.lean
File metadata and controls
2270 lines (2008 loc) · 100 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
/-
Copyright (c) 2019-2025 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Sebastian Ullrich
-/
module
prelude
public import Lean.Meta.Coe
public import Lean.Util.CollectLevelMVars
public import Lean.Linter.Deprecated
import Lean.Elab.DeprecatedSyntax
public import Lean.Elab.Attributes
public import Lean.Elab.Level
public import Lean.Elab.PreDefinition.TerminationHint
public import Lean.Elab.DeclarationRange
public import Lean.Elab.WhereFinally
public import Lean.Elab.InfoTree.InlayHints
public meta import Lean.Parser.Term
public section
namespace Lean.Elab
namespace Term
-- Same pattern as for `Methods`/`MethodsRef` in `SimpM`. See `FixedTermElabRef`.
private opaque FixedTermElabRefPointed : NonemptyType.{0}
/--
This type is an abbreviation for `Option Expr → TermElabM Expr`, but avoids a circular dependency
with `TermElabM`.
We store `FixedTermElabRef` in the `Context` of the `TermElabM` monad, inducing the circular
dependency. This mechanism allows us to register semantic term elaborators in
`el : Option Expr → TermElabM Expr` as scoped `s : Syntax`, such that `elabTerm s = el`.
-/
def FixedTermElabRef : Type := FixedTermElabRefPointed.type
instance : Nonempty FixedTermElabRef :=
by exact FixedTermElabRefPointed.property
/-- Saved context for postponed terms and tactics to be executed. -/
structure SavedContext where
declName? : Option Name
options : Options
openDecls : List OpenDecl
macroStack : MacroStack
errToSorry : Bool
levelNames : List Name
fixedTermElabs : Array FixedTermElabRef
/-- The kind of a tactic metavariable, used for additional error reporting. -/
inductive TacticMVarKind
/-- Standard tactic metavariable, arising from `by ...` syntax. -/
| term
/-- Tactic metavariable arising from an autoparam for a function application. -/
| autoParam (argName : Name)
/-- Tactic metavariable arising from an autoparam for a structure field. -/
| fieldAutoParam (fieldName structName : Name)
/-- We use synthetic metavariables as placeholders for pending elaboration steps. -/
inductive SyntheticMVarKind where
/--
Use typeclass resolution to synthesize value for metavariable.
If `extraErrorMsg?` is `some msg`, `msg` contains additional information to include in error messages
regarding type class synthesis failure.
-/
| typeClass (extraErrorMsg? : Option MessageData)
/--
Use coercion to synthesize value for the metavariable.
If synthesis fails, then throws an error.
- If `mkErrorMsg?` is provided, then the error `mkErrorMsg expectedType e` is thrown.
The `mkErrorMsg` function is allowed to throw an error itself.
- Otherwise, throws a default type mismatch error message.
If `header?` is not provided, the default header is "type mismatch".
If `f?` is provided, then throws an application type mismatch error.
-/
| coe (header? : Option String) (expectedType : Expr) (e : Expr) (f? : Option Expr)
(mkErrorMsg? : Option (MVarId → Expr → Expr → MetaM MessageData))
/--
Use tactic to synthesize value for metavariable.
If `delayOnMVars` is true, the tactic will not be executed until the goal is free of unassigned
expr metavariables.
-/
| tactic (tacticCode : Syntax) (ctx : SavedContext) (kind : TacticMVarKind) (delayOnMVars := false)
/-- Metavariable represents a hole whose elaboration has been postponed. -/
| postponed (ctx : SavedContext)
deriving Inhabited
/--
Convert an "extra" optional error message into a message `"\n{msg}"` (if `some msg`) and `MessageData.nil` (if `none`)
-/
def extraMsgToMsg (extraErrorMsg? : Option MessageData) : MessageData :=
if let some msg := extraErrorMsg? then m!"\n{msg}" else .nil
instance : ToString SyntheticMVarKind where
toString
| .typeClass .. => "typeclass"
| .coe .. => "coe"
| .tactic .. => "tactic"
| .postponed .. => "postponed"
structure SyntheticMVarDecl where
stx : Syntax
kind : SyntheticMVarKind
deriving Inhabited
/--
We can optionally associate an error context with a metavariable (see `MVarErrorInfo`).
We have three different kinds of error context.
-/
inductive MVarErrorKind where
/-- Metavariable for implicit arguments. `ctx` is the parent application,
`lctx` is a local context where it is valid (necessary for eta feature for named arguments). -/
| implicitArg (lctx : LocalContext) (ctx : Expr)
/-- Metavariable for explicit holes provided by the user (e.g., `_` and `?m`) -/
| hole
/-- "Custom", `msgData` stores the additional error messages. -/
| custom (msgData : MessageData)
deriving Inhabited
instance : ToString MVarErrorKind where
toString
| .implicitArg _ _ => "implicitArg"
| .hole => "hole"
| .custom _ => "custom"
/--
We can optionally associate an error context with metavariables.
-/
structure MVarErrorInfo where
mvarId : MVarId
ref : Syntax
kind : MVarErrorKind
deriving Inhabited
/--
When reporting unexpected universe level metavariables, it is useful to localize the errors
to particular terms, especially at `let` bindings and function binders,
where universe polymorphism is not permitted.
-/
structure LevelMVarErrorInfo where
lctx : LocalContext
expr : Expr
ref : Syntax
msgData? : Option MessageData := none
deriving Inhabited
/--
Nested `let rec` expressions are eagerly lifted by the elaborator.
We store the information necessary for performing the lifting here.
-/
structure LetRecToLift where
ref : Syntax
fvarId : FVarId
attrs : Array Attribute
shortDeclName : Name
declName : Name
parentName? : Option Name
lctx : LocalContext
localInstances : LocalInstances
type : Expr
val : Expr
mvarId : MVarId
termination : TerminationHints
/-- The binders syntax for the declaration, used for docstring elaboration. -/
binders : Syntax := .missing
/-- The docstring, if present, and whether it's Verso. Docstring processing is deferred until the
declaration is added to the environment (needed for Verso docstrings to work). -/
docString? : Option (TSyntax ``Lean.Parser.Command.docComment × Bool) := none
deriving Inhabited
/--
State of the `TermElabM` monad.
-/
structure State where
levelNames : List Name := []
syntheticMVars : MVarIdMap SyntheticMVarDecl := {}
pendingMVars : List MVarId := {}
/-- List of errors associated to a metavariable that are shown to the user if the metavariable could not be fully instantiated -/
mvarErrorInfos : List MVarErrorInfo := []
/-- List of data to be able to localize universe level metavariable errors to particular expressions. -/
levelMVarErrorInfos : List LevelMVarErrorInfo := []
/--
`mvarArgNames` stores the argument names associated to metavariables.
These are used in combination with `mvarErrorInfos` for throwing errors about metavariables that could not be fully instantiated.
For example when elaborating `List _`, the argument name of the placeholder will be `α`.
While elaborating an application, `mvarArgNames` is set for each metavariable argument, using the available argument name.
This may happen before or after the `mvarErrorInfos` is set for the same metavariable.
We used to store the argument names in `mvarErrorInfos`, updating the `MVarErrorInfos` to add the argument name when it is available,
but this doesn't work if the argument name is available _before_ the `mvarErrorInfos` is set for that metavariable.
-/
mvarArgNames : MVarIdMap Name := {}
letRecsToLift : List LetRecToLift := []
deriving Inhabited
/--
Backtrackable state for the `TermElabM` monad.
-/
structure SavedState where
«meta» : Meta.SavedState
«elab» : State
deriving Nonempty
end Term
namespace Tactic
/--
State of the `TacticM` monad.
-/
structure State where
goals : List MVarId
deriving Inhabited
section Snapshot
open Language
structure SavedState where
term : Term.SavedState
tactic : State
/-- Snapshot after finishing execution of a tactic. -/
structure TacticFinishedSnapshot extends Language.Snapshot where
/-- State saved for reuse, if no fatal exception occurred. -/
state? : Option SavedState
/-- Untyped snapshots from `logSnapshotTask`, saved at this level for cancellation. -/
moreSnaps : Array (SnapshotTask SnapshotTree)
instance : Inhabited TacticFinishedSnapshot where
default := { toSnapshot := default, state? := default, moreSnaps := default }
instance : ToSnapshotTree TacticFinishedSnapshot where
toSnapshotTree s := ⟨s.toSnapshot, s.moreSnaps⟩
/-- Snapshot just before execution of a tactic. -/
structure TacticParsedSnapshot extends Language.Snapshot where
/-- Syntax tree of the tactic, stored and compared for incremental reuse. -/
stx : Syntax
/-- Task for nested incrementality, if enabled for tactic. -/
inner? : Option (SnapshotTask TacticParsedSnapshot) := none
/-- Task for state after tactic execution. -/
finished : SnapshotTask TacticFinishedSnapshot
/-- Tasks for subsequent, potentially parallel, tactic steps. -/
next : Array (SnapshotTask TacticParsedSnapshot) := #[]
instance : Inhabited TacticParsedSnapshot where
default := { toSnapshot := default, stx := default, finished := default }
partial instance : ToSnapshotTree TacticParsedSnapshot where
toSnapshotTree := go where
go := fun s => ⟨s.toSnapshot,
s.inner?.toArray.map (·.map (sync := true) go) ++
#[s.finished.map (sync := true) toSnapshotTree] ++
s.next.map (·.map (sync := true) go)⟩
end Snapshot
end Tactic
namespace Term
structure Context where
declName? : Option Name := none
macroStack : MacroStack := []
/--
When `mayPostpone == true`, an elaboration function may interrupt its execution by throwing `Exception.postpone`.
The function `elabTerm` catches this exception and creates fresh synthetic metavariable `?m`, stores `?m` in
the list of pending synthetic metavariables, and returns `?m`.
-/
mayPostpone : Bool := true
/--
When `errToSorry` is set to true, the method `elabTerm` catches
exceptions and converts them into synthetic `sorry`s.
The implementation of choice nodes and overloaded symbols rely on the fact
that when `errToSorry` is set to false for an elaboration function `F`, then
`errToSorry` remains `false` for all elaboration functions invoked by `F`.
That is, it is safe to transition `errToSorry` from `true` to `false`, but
we must not set `errToSorry` to `true` when it is currently set to `false`.
-/
errToSorry : Bool := true
/--
During elaboration we track the current context for adding auto-bound
implicit variables. (We mark the entry to such a region with
`withAutoBoundImplicit` and leave it with `withoutAutoBoundImplicit`.)
When the `autoImplicit` option is `false`, this context is only used to
affect error messages. When `autoImplicit` is `true` and an identifier is
unbound and potentially an auto-bound implicit, an internal exception is
thrown and caught at the closest surrounding `withAutoBoundImplicit`,
which adds an implicit declaration for the unbound variable and tries
again.
-/
autoBoundImplicitContext : Option AutoBoundImplicitContext := .none
/--
A name `n` is only eligible to be an auto implicit name if `autoBoundImplicitForbidden n = false`.
We use this predicate to disallow `f` to be considered an auto implicit name in a definition such
as
```
def f : f → Bool := fun _ => true
```
-/
autoBoundImplicitForbidden : Name → Bool := fun _ => false
/-- Map from user name to internal unique name -/
sectionVars : NameMap Name := {}
/-- Map from internal name to fvar -/
sectionFVars : NameMap Expr := {}
/-- Enable/disable implicit lambdas feature. -/
implicitLambda : Bool := true
/-- Heed `elab_as_elim` attribute. -/
heedElabAsElim : Bool := true
/-- Noncomputable sections automatically add the `noncomputable` modifier to any declaration we cannot generate code for. -/
isNoncomputableSection : Bool := false
/-- `true` when inside a `meta section`. -/
isMetaSection : Bool := false
/-- When `true` we skip TC failures. We use this option when processing patterns. -/
ignoreTCFailures : Bool := false
/-- `true` when elaborating patterns. It affects how we elaborate named holes. -/
inPattern : Bool := false
/--
Snapshot for incremental processing of current tactic, if any.
Invariant: if the bundle's `old?` is set, then the state *up to the start* of the tactic is
unchanged, i.e. reuse is possible.
-/
tacSnap? : Option (Language.SnapshotBundle Tactic.TacticParsedSnapshot) := none
/--
If `true`, we store in the `Expr` the `Syntax` for recursive applications (i.e., applications
of free variables tagged with `isAuxDecl`). We store the `Syntax` using `mkRecAppWithSyntax`.
We use the `Syntax` object to produce better error messages at `Structural.lean` and `WF.lean`. -/
saveRecAppSyntax : Bool := true
/--
If `holesAsSyntheticOpaque` is `true`, then we mark metavariables associated
with `_`s as `syntheticOpaque` if they do not occur in patterns.
This option is useful when elaborating terms in tactics such as `refine'` where
we want holes there to become new goals. See issue #1681, we have
`refine' (fun x => _)
-/
holesAsSyntheticOpaque : Bool := false
/--
If `checkDeprecated := true`, then `Linter.checkDeprecated` when creating constants.
-/
checkDeprecated : Bool := true
/--
Fixed term elaborators for supporting `elabToSyntax`.
-/
fixedTermElabs : Array FixedTermElabRef := #[]
abbrev TermElabM := ReaderT Context $ StateRefT State MetaM
abbrev TermElab := Syntax → Option Expr → TermElabM Expr
@[deprecated "replace with a check of autoBoundImplicitContext" (since := "2025-11-11")]
def Context.autoBoundImplicit (ctx : Context) : Bool :=
match ctx.autoBoundImplicitContext with
| .none => false
| .some subCtx => subCtx.autoImplicitEnabled
abbrev FixedTermElab := Option Expr → TermElabM Expr
unsafe def FixedTermElab.toFixedTermElabRefImpl (m : FixedTermElab) : FixedTermElabRef :=
unsafeCast m
@[implemented_by FixedTermElab.toFixedTermElabRefImpl]
opaque FixedTermElab.toFixedTermElabRef (m : FixedTermElab) : FixedTermElabRef
unsafe def FixedTermElabRef.toFixedTermElabImpl (m : FixedTermElabRef) : FixedTermElab :=
unsafeCast m
@[implemented_by FixedTermElabRef.toFixedTermElabImpl]
opaque FixedTermElabRef.toFixedTermElab (m : FixedTermElabRef) : FixedTermElab
/-
Make the compiler generate specialized `pure`/`bind` so we do not have to optimize through the
whole monad stack at every use site. May eventually be covered by `deriving`.
-/
@[always_inline]
instance : Monad TermElabM :=
let i : Monad TermElabM := inferInstance
{ pure := i.pure, bind := i.bind }
open Meta
instance : Inhabited (TermElabM α) where
default := throw default
protected def saveState : TermElabM SavedState :=
return { «meta» := (← Meta.saveState), «elab» := (← get) }
def SavedState.restore (s : SavedState) (restoreInfo : Bool := false) : TermElabM Unit := do
let traceState ← getTraceState -- We never backtrack trace message
let infoState ← getInfoState -- We also do not backtrack the info nodes when `restoreInfo == false`
s.meta.restore
set s.elab
setTraceState traceState
unless restoreInfo do
setInfoState infoState
/--
Like `Meta.withRestoreOrSaveFull` for `TermElabM`, but also takes a `tacSnap?` that
* when running `act`, is set as `Context.tacSnap?`
* otherwise (i.e. on restore) is used to update the new snapshot promise to the old task's
value.
This extra restore step is necessary because while `reusableResult?` can be used to replay any
effects on `State`, `Context.tacSnap?` is not part of it but changed via an `IO` side effect, so
it needs to be replayed separately.
We use an explicit parameter instead of accessing `Context.tacSnap?` directly because this prevents
`withRestoreOrSaveFull` and `withReader` from being used in the wrong order.
-/
@[specialize]
def withRestoreOrSaveFull (reusableResult? : Option (α × SavedState))
(tacSnap? : Option (Language.SnapshotBundle Tactic.TacticParsedSnapshot)) (act : TermElabM α) :
TermElabM (α × SavedState) := do
if let some (_, state) := reusableResult? then
set state.elab
if let some snap := tacSnap? then
let some old := snap.old?
| throwError "withRestoreOrSaveFull: expected old snapshot in `tacSnap?`"
snap.new.resolve old.val.get
let reusableResult? := reusableResult?.map (fun (val, state) => (val, state.meta))
let (a, «meta») ← withReader ({ · with tacSnap? }) do
controlAt MetaM fun runInBase => do
Meta.withRestoreOrSaveFull reusableResult? <| runInBase act
return (a, { «meta», «elab» := (← get) })
instance : MonadBacktrack SavedState TermElabM where
saveState := Term.saveState
restoreState b := b.restore
/--
Incremental elaboration helper. Avoids leakage of data from outside syntax via the monadic context
when running `act` on `stx` by
* setting `stx` as the `ref` and
* deactivating `suppressElabErrors` if `stx` is `missing`-free, which also helps with not hiding
useful errors in this part of the input. Note that if `stx` has `missing`, this should always be
true for the outer syntax as well, so taking the old value of `suppressElabErrors` into account
should not introduce data leakage.
This combinator should always be used when narrowing reuse to a syntax subtree, usually (in the case
of tactics, to be generalized) via `withNarrowed(Arg)TacticReuse`.
-/
def withReuseContext [Monad m] [MonadWithReaderOf Core.Context m] (stx : Syntax) (act : m α) :
m α := do
withTheReader Core.Context (fun ctx => { ctx with
ref := stx
suppressElabErrors := ctx.suppressElabErrors && stx.hasMissing }) act
/--
Manages reuse information for nested tactics by `split`ting given syntax into an outer and inner
part. `act` is then run on the inner part but with reuse information adjusted as following:
* If the old (from `tacSnap?`'s `SyntaxGuarded.stx`) and new (from `stx`) outer syntax are not
identical according to `Syntax.eqWithInfo`, reuse is disabled.
* Otherwise, the old syntax as stored in `tacSnap?` is updated to the old *inner* syntax.
* In any case, `withReuseContext` is used on the new inner syntax to further prepare the monadic
context.
For any tactic that participates in reuse, `withNarrowedTacticReuse` should be applied to the
tactic's syntax and `act` should be used to do recursive tactic evaluation of nested parts. Also,
after this function, `getAndEmptySnapshotTasks` should be called and the result stored in a snapshot
so that the tasks don't end up in a snapshot further up and are cancelled together with it; see
note [Incremental Cancellation].
-/
def withNarrowedTacticReuse [Monad m] [MonadReaderOf Context m] [MonadLiftT BaseIO m]
[MonadWithReaderOf Core.Context m] [MonadWithReaderOf Context m] [MonadOptions m]
(split : Syntax → Syntax × Syntax) (act : Syntax → m α) (stx : Syntax) : m α := do
let (outer, inner) := split stx
let opts ← getOptions
let ctx ← readThe Term.Context
withTheReader Term.Context (fun ctx => { ctx with tacSnap? := ctx.tacSnap?.map fun tacSnap =>
{ tacSnap with old? := tacSnap.old?.bind fun old => do
let (oldOuter, oldInner) := split old.stx
guard <| outer.eqWithInfoAndTraceReuse opts oldOuter
return { old with stx := oldInner }
}
}) do
if let some oldOuter := ctx.tacSnap?.bind (·.old?) then
if (← read).tacSnap?.bind (·.old?) |>.isNone then
oldOuter.val.cancelRec
withReuseContext inner (act inner)
/--
A variant of `withNarrowedTacticReuse` that uses `stx[argIdx]` as the inner syntax and all `stx`
child nodes before that as the outer syntax, i.e. reuse is disabled if there was any change before
`argIdx`.
NOTE: child nodes after `argIdx` are not tested (which would almost always disable reuse as they are
necessarily shifted by changes at `argIdx`) so it must be ensured that the result of `arg` does not
depend on them (i.e. they should not be inspected beforehand).
-/
def withNarrowedArgTacticReuse [Monad m] [MonadReaderOf Context m] [MonadLiftT BaseIO m]
[MonadWithReaderOf Core.Context m] [MonadWithReaderOf Context m] [MonadOptions m]
(argIdx : Nat) (act : Syntax → m α) (stx : Syntax) : m α :=
withNarrowedTacticReuse (fun stx => (mkNullNode stx.getArgs[*...argIdx], stx[argIdx])) act stx
/--
Disables incremental tactic reuse *and* reporting for `act` if `cond` is true by setting `tacSnap?`
to `none`. This should be done for tactic blocks that are run multiple times as otherwise the
reported progress will jump back and forth (and partial reuse for these kinds of tact blocks is
similarly questionable).
-/
def withoutTacticIncrementality [Monad m] [MonadWithReaderOf Context m] [MonadOptions m]
(cond : Bool) (act : m α) : m α := do
let opts ← getOptions
withTheReader Term.Context (fun ctx => { ctx with tacSnap? := ctx.tacSnap?.filter fun tacSnap => Id.run do
if let some old := tacSnap.old? then
if cond && opts.getBool `trace.Elab.reuse then
dbg_trace "reuse stopped: guard failed at {old.stx}"
return !cond
}) act
/-- Disables incremental tactic reuse for `act` if `cond` is true. -/
def withoutTacticReuse [Monad m] [MonadWithReaderOf Context m] [MonadOptions m]
(cond : Bool) (act : m α) : m α := do
let opts ← getOptions
withTheReader Term.Context (fun ctx => { ctx with tacSnap? := ctx.tacSnap?.map fun tacSnap =>
{ tacSnap with old? := tacSnap.old?.filter fun old => Id.run do
if cond && opts.getBool `trace.Elab.reuse then
dbg_trace "reuse stopped: guard failed at {old.stx}"
return !cond }
}) act
@[inherit_doc Core.wrapAsyncAsSnapshot]
def wrapAsyncAsSnapshot {α : Type} (act : α → TermElabM Unit) (cancelTk? : Option IO.CancelToken)
(desc : String := by exact decl_name%.toString) :
TermElabM (α → BaseIO Language.SnapshotTree) := do
let ctx ← read
let st ← get
let metaCtx ← readThe Meta.Context
let metaSt ← getThe Meta.State
Core.wrapAsyncAsSnapshot (cancelTk? := cancelTk?) (desc := desc) fun a =>
act a |>.run ctx |>.run' st |>.run' metaCtx metaSt
abbrev TermElabResult (α : Type) := EStateM.Result Exception SavedState α
/--
Execute `x`, save resulting expression and new state.
We remove any `Info` created by `x`.
The info nodes are committed when we execute `applyResult`.
We use `observing` to implement overloaded notation and decls.
We want to save `Info` nodes for the chosen alternative.
-/
def observing (x : TermElabM α) : TermElabM (TermElabResult α) := do
let s ← saveState
try
let e ← x
let sNew ← saveState
s.restore (restoreInfo := true)
return EStateM.Result.ok e sNew
catch
| ex@(.error ..) =>
let sNew ← saveState
s.restore (restoreInfo := true)
return .error ex sNew
| ex@(.internal id _) =>
if id == postponeExceptionId then
s.restore (restoreInfo := true)
throw ex
/--
Apply the result/exception and state captured with `observing`.
We use this method to implement overloaded notation and symbols. -/
def applyResult (result : TermElabResult α) : TermElabM α := do
match result with
| .ok a r => r.restore (restoreInfo := true); return a
| .error ex r => r.restore (restoreInfo := true); throw ex
/--
Execute `x`, but keep state modifications only if `x` did not postpone.
This method is useful to implement elaboration functions that cannot decide whether
they need to postpone or not without updating the state. -/
def commitIfDidNotPostpone (x : TermElabM α) : TermElabM α := do
-- We just reuse the implementation of `observing` and `applyResult`.
let r ← observing x
applyResult r
/--
Return the universe level names explicitly provided by the user.
-/
def getLevelNames : TermElabM (List Name) :=
return (← get).levelNames
/--
Given a free variable `fvar`, return its declaration.
This function panics if `fvar` is not a free variable.
-/
def getFVarLocalDecl! (fvar : Expr) : TermElabM LocalDecl := do
match (← getLCtx).find? fvar.fvarId! with
| some d => pure d
| none => unreachable!
instance : AddErrorMessageContext TermElabM where
add ref msg := do
let ctx ← read
let ref := getBetterRef ref ctx.macroStack
let msg ← addMessageContext msg
let msg ← addMacroStack msg ctx.macroStack
pure (ref, msg)
/--
Execute `x` without storing `Syntax` for recursive applications. See `saveRecAppSyntax` field at `Context`.
-/
def withoutSavingRecAppSyntax (x : TermElabM α) : TermElabM α :=
withReader (fun ctx => { ctx with saveRecAppSyntax := false }) x
unsafe def mkTermElabAttributeUnsafe (ref : Name) : IO (KeyedDeclsAttribute TermElab) :=
mkElabAttribute TermElab `builtin_term_elab `term_elab `Lean.Parser.Term `Lean.Elab.Term.TermElab "term" ref
@[implemented_by mkTermElabAttributeUnsafe]
opaque mkTermElabAttribute (ref : Name) : IO (KeyedDeclsAttribute TermElab)
/--
Registers a term elaborator for the given syntax node kind.
A term elaborator should have type `Lean.Elab.Term.TermElab` (which is
`Lean.Syntax → Option Lean.Expr → Lean.Elab.Term.TermElabM Lean.Expr`), i.e. should take syntax of
the given syntax node kind and an optional expected type as parameters and produce an expression.
The `elab_rules` and `elab` commands should usually be preferred over using this attribute
directly.
-/
@[builtin_doc]
builtin_initialize termElabAttribute : KeyedDeclsAttribute TermElab ← mkTermElabAttribute decl_name%
/--
Auxiliary datatype for presenting a Lean lvalue modifier.
We represent an unelaborated lvalue as a `Syntax` (or `Expr`) and `List LVal`.
Example: `a.foo.1` is represented as the `Syntax` `a` and the list
`[LVal.fieldName "foo", LVal.fieldIdx 1]`.
-/
inductive LVal where
| fieldIdx (ref : Syntax) (i : Nat) (levels : List Level)
/-- Field `suffix?` is for producing better error messages because `x.y` may be a field access or a hierarchical/composite name.
`ref` is the syntax object representing the field. `fullRef` includes the LHS. -/
| fieldName (ref : Syntax) (name : String) (levels : List Level) (suffix? : Option Name) (fullRef : Syntax)
def LVal.getRef : LVal → Syntax
| .fieldIdx ref .. => ref
| .fieldName ref .. => ref
def LVal.isFieldName : LVal → Bool
| .fieldName .. => true
| _ => false
instance : ToString LVal where
toString
| .fieldIdx _ i levels .. => toString i ++ levelsToString levels
| .fieldName _ n levels .. => n ++ levelsToString levels
where
levelsToString levels :=
if levels.isEmpty then "" else ".{" ++ String.intercalate "," (levels.map toString) ++ "}"
/-- Return the name of the declaration being elaborated if available. -/
def getDeclName? : TermElabM (Option Name) := return (← read).declName?
/-- Return the list of nested `let rec` declarations that need to be lifted. -/
def getLetRecsToLift : TermElabM (List LetRecToLift) := return (← get).letRecsToLift
/-- Return the declaration of the given metavariable -/
def getMVarDecl (mvarId : MVarId) : TermElabM MetavarDecl := return (← getMCtx).getDecl mvarId
instance : MonadParentDecl TermElabM where
getParentDeclName? := getDeclName?
instance : MonadAutoImplicits TermElabM where
getAutoImplicits := do
if let .some implicits := (← read).autoBoundImplicitContext then
pure implicits.boundVariables.toArray
else
pure #[]
/--
Executes `x` in the context of the given declaration name. Ensures that the info tree is set up
correctly and adjusts the declaration name generator to generate names below this name, resetting
the nested counter.
-/
def withDeclName (name : Name) (x : TermElabM α) : TermElabM α :=
withReader (fun ctx => { ctx with declName? := name }) do
withSaveParentDeclInfoContext do
withDeclNameForAuxNaming name do
x
/-- Update the universe level parameter names. -/
def setLevelNames (levelNames : List Name) : TermElabM Unit :=
modify fun s => { s with levelNames := levelNames }
/-- Execute `x` using `levelNames` as the universe level parameter names. See `getLevelNames`. -/
def withLevelNames (levelNames : List Name) (x : TermElabM α) : TermElabM α := do
let levelNamesSaved ← getLevelNames
setLevelNames levelNames
try x finally setLevelNames levelNamesSaved
def withoutErrToSorryImp (x : TermElabM α) : TermElabM α :=
withReader (fun ctx => { ctx with errToSorry := false }) x
/--
Execute `x` without converting errors (i.e., exceptions) to `sorry` applications.
Recall that when `errToSorry = true`, the method `elabTerm` catches exceptions and converts them into `sorry` applications.
-/
def withoutErrToSorry [MonadFunctorT TermElabM m] : m α → m α :=
monadMap (m := TermElabM) withoutErrToSorryImp
def withoutHeedElabAsElimImp (x : TermElabM α) : TermElabM α :=
withReader (fun ctx => { ctx with heedElabAsElim := false }) x
/--
Execute `x` without heeding the `elab_as_elim` attribute. Useful when there is
no expected type (so `elabAppArgs` would fail), but expect that the user wants
to use such constants.
-/
def withoutHeedElabAsElim [MonadFunctorT TermElabM m] : m α → m α :=
monadMap (m := TermElabM) withoutHeedElabAsElimImp
/--
Execute `x` but discard changes performed at `Term.State` and `Meta.State`.
Recall that the `Environment`, `InfoState` and messages are at `Core.State`. Thus, any updates to
it will be preserved.
This method is useful for performing computations where all metavariable must be resolved or
discarded.
The `InfoTree`s are not discarded, however, and wrapped in `InfoTree.Context`
to store their metavariable context.
-/
def withoutModifyingElabMetaStateWithInfo (x : TermElabM α) : TermElabM α := do
let s ← get
let sMeta ← getThe Meta.State
try
withSaveInfoContext x
finally
set s
set sMeta
/--
Execute `x` but discard changes performed to the state.
However, the info trees and messages are not discarded. -/
private def withoutModifyingStateWithInfoAndMessagesImpl (x : TermElabM α) : TermElabM α := do
let saved ← saveState
try
withSaveInfoContext x
finally
let saved := { saved with meta.core.infoState := (← getInfoState), meta.core.messages := (← getThe Core.State).messages }
restoreState saved
/--
Wraps the trees returned from `getInfoTrees`, if any, in an `InfoTree.context` node based on the
current monadic context and state. This is mainly used to report info trees early via
`Snapshot.infoTree?`. The trees are not removed from the `getInfoTrees` state as the final info tree
of the elaborated command should be complete and not depend on whether parts have been reported
early.
As `InfoTree.context` can have only one child, this function panics if `trees` contains more than 1
tree. Also, `PartialContextInfo.parentDeclCtx` is not currently generated as that information is not
available in the monadic context and only needed for the final info tree.
-/
def getInfoTreeWithContext? : TermElabM (Option InfoTree) := do
let st ← getInfoState
if st.trees.size > 1 then
return panic! "getInfoTreeWithContext: overfull tree"
let some t := st.trees[0]? |
return none
let t := t.substitute st.assignment
let ctx ← readThe Core.Context
let s ← getThe Core.State
let ctx := PartialContextInfo.commandCtx {
env := s.env, fileMap := ctx.fileMap, mctx := {}, currNamespace := ctx.currNamespace,
openDecls := ctx.openDecls, options := ctx.options, ngen := s.ngen
}
return InfoTree.context ctx t
/-- For testing `TermElabM` methods. The #eval command will sign the error. -/
def throwErrorIfErrors : TermElabM Unit := do
if (← MonadLog.hasErrors) then
throwError "Error(s)"
def traceAtCmdPos (cls : Name) (msg : Unit → MessageData) : TermElabM Unit :=
withRef Syntax.missing <| trace cls msg
def ppGoal (mvarId : MVarId) : TermElabM Format :=
Meta.ppGoal mvarId
open Level (LevelElabM)
def liftLevelM (x : LevelElabM α) : TermElabM α := do
let ctx ← read
let mctx ← getMCtx
let ngen ← getNGen
let lvlCtx : Level.Context := {
options := (← getOptions),
ref := (← getRef),
autoBoundImplicit := ctx.autoBoundImplicitContext.map (·.autoImplicitEnabled) |>.getD false
}
match (x lvlCtx).run { ngen := ngen, mctx := mctx, levelNames := (← getLevelNames) } with
| .ok a newS => setMCtx newS.mctx; setNGen newS.ngen; setLevelNames newS.levelNames; pure a
| .error ex _ => throw ex
def elabLevel (stx : Syntax) : TermElabM Level :=
liftLevelM <| Level.elabLevel stx
/-- Elaborate `x` with `stx` on the macro stack -/
def withPushMacroExpansionStack (beforeStx afterStx : Syntax) (x : TermElabM α) : TermElabM α :=
withReader (fun ctx => { ctx with macroStack := { before := beforeStx, after := afterStx } :: ctx.macroStack }) x
/-- Elaborate `x` with `stx` on the macro stack and produce macro expansion info -/
@[specialize]
def withMacroExpansion [Monad n] [MonadControlT TermElabM n] (beforeStx afterStx : Syntax) (x : n α) : n α :=
controlAt TermElabM fun runInBase => do
withMacroExpansionInfo beforeStx afterStx do
withPushMacroExpansionStack beforeStx afterStx <| runInBase x
/--
Node kind for the `Lean.Elab.Term.elabToSyntax` functionality.
It is an implementation detail of `Lean.Elab.Term.elabToSyntax`.
-/
@[builtin_term_parser] protected def _root_.Lean.Parser.Term.elabToSyntax : Lean.Parser.Parser := leading_parser
"elabToSyntax% " >> Parser.numLit
/-- Refer to the given term elaborator by a scoped `Syntax` object. -/
def elabToSyntax (fixedTermElab : FixedTermElab) (k : Term → TermElabM α) (hint? : Option MessageData := none) (ref : Syntax := .missing) : TermElabM α := do
let ctx ← read
let fixedTermElab : FixedTermElab := fun ty? => do
if let some hint := hint? then
trace[Elab.step] "elabToSyntax hint: {hint}"
fixedTermElab ty?
withReader (fun ctx => { ctx with fixedTermElabs := ctx.fixedTermElabs.push fixedTermElab.toFixedTermElabRef }) do
k ⟨Syntax.node (.fromRef ref) ``Lean.Parser.Term.elabToSyntax #[mkAtom "elabToSyntax% ", Syntax.mkNatLit ctx.fixedTermElabs.size]⟩
@[builtin_term_elab Lean.Parser.Term.elabToSyntax] def elabFixedTermElab : TermElab := fun stx expectedType? => do
let some idx := stx[1].isNatLit? | throwUnsupportedSyntax
let some fixedTermElab := (← read).fixedTermElabs[idx]?
| throwError "Fixed term elaborator {idx} not found. There were only {(← read).fixedTermElabs.size} fixed term elaborators registered."
fixedTermElab.toFixedTermElab expectedType?
/--
Add the given metavariable to the list of pending synthetic metavariables.
The method `synthesizeSyntheticMVars` is used to process the metavariables on this list. -/
def registerSyntheticMVar (stx : Syntax) (mvarId : MVarId) (kind : SyntheticMVarKind) : TermElabM Unit := do
modify fun s => { s with syntheticMVars := s.syntheticMVars.insert mvarId { stx, kind }, pendingMVars := mvarId :: s.pendingMVars }
def registerSyntheticMVarWithCurrRef (mvarId : MVarId) (kind : SyntheticMVarKind) : TermElabM Unit := do
registerSyntheticMVar (← getRef) mvarId kind
def registerMVarErrorInfo (mvarErrorInfo : MVarErrorInfo) : TermElabM Unit :=
modify fun s => { s with mvarErrorInfos := mvarErrorInfo :: s.mvarErrorInfos }
def registerMVarErrorHoleInfo (mvarId : MVarId) (ref : Syntax) : TermElabM Unit :=
registerMVarErrorInfo { mvarId, ref, kind := .hole }
def registerMVarErrorImplicitArgInfo (mvarId : MVarId) (ref : Syntax) (app : Expr) : TermElabM Unit := do
registerMVarErrorInfo { mvarId, ref, kind := .implicitArg (← getLCtx) app }
def registerMVarErrorCustomInfo (mvarId : MVarId) (ref : Syntax) (msgData : MessageData) : TermElabM Unit := do
registerMVarErrorInfo { mvarId, ref, kind := .custom msgData }
def registerCustomErrorIfMVar (e : Expr) (ref : Syntax) (msgData : MessageData) : TermElabM Unit :=
match e.getAppFn with
| Expr.mvar mvarId => registerMVarErrorCustomInfo mvarId ref msgData
| _ => pure ()
def registerMVarArgName (mvarId : MVarId) (argName : Name) : TermElabM Unit :=
modify fun s => { s with mvarArgNames := s.mvarArgNames.insert mvarId argName }
/--
Auxiliary method for reporting errors of the form "... contains metavariables ...".
This kind of error is thrown, for example, at `Match.lean` where elaboration
cannot continue if there are metavariables in patterns.
We only want to log it if we haven't logged any errors so far. -/
def throwMVarError (m : MessageData) : TermElabM α := do
if (← MonadLog.hasErrors) then
throwAbortTerm
else
throwError m
def MVarErrorInfo.logError (mvarErrorInfo : MVarErrorInfo) (extraMsg? : Option MessageData) : TermElabM Unit := do
match mvarErrorInfo.kind with
| MVarErrorKind.implicitArg lctx app => withLCtx lctx {} do
let app ← instantiateMVars app
let msg ← addArgName "don't know how to synthesize implicit argument"
let msg := msg ++ m!"{indentExpr app.setAppPPExplicitForExposingMVars}" ++ Format.line ++ "context:" ++ Format.line ++ MessageData.ofGoal mvarErrorInfo.mvarId
logErrorAt mvarErrorInfo.ref (appendExtra msg)
| MVarErrorKind.hole => do
let msg ← addArgName "don't know how to synthesize placeholder" " for argument"
let msg := msg ++ Format.line ++ "context:" ++ Format.line ++ MessageData.ofGoal mvarErrorInfo.mvarId
logErrorAt mvarErrorInfo.ref (MessageData.tagged `Elab.synthPlaceholder <| appendExtra msg)
| MVarErrorKind.custom msg =>
logErrorAt mvarErrorInfo.ref (appendExtra msg)
where
/-- Append the argument name (if available) to the message.
Remark: if the argument name contains macro scopes we do not append it. -/
addArgName (msg : MessageData) (extra : String := "") : TermElabM MessageData := do
match (← get).mvarArgNames.get? mvarErrorInfo.mvarId with
| none => return msg
| some argName => return if argName.hasMacroScopes then msg else msg ++ extra ++ m!" `{argName}`"
appendExtra (msg : MessageData) : MessageData :=
match extraMsg? with
| none => msg
| some extraMsg => msg.composePreservingKind extraMsg
/--
Try to log errors for the unassigned metavariables `pendingMVarIds`.
Return `true` if there were "unfilled holes", and we should "abort" declaration.
TODO: try to fill "all" holes using synthetic "sorry's"
Remark: We only log the "unfilled holes" as new errors if no error has been logged so far. -/
def logUnassignedUsingErrorInfos (pendingMVarIds : Array MVarId) (extraMsg? : Option MessageData := none) : TermElabM Bool := do
if pendingMVarIds.isEmpty then
return false
else
let hasOtherErrors ← MonadLog.hasErrors
let mut hasNewErrors := false
let mut alreadyVisited : MVarIdSet := {}
let mut errors : Array MVarErrorInfo := #[]
for mvarErrorInfo in (← get).mvarErrorInfos do
let mvarId := mvarErrorInfo.mvarId
unless alreadyVisited.contains mvarId do
alreadyVisited := alreadyVisited.insert mvarId
/- The metavariable `mvarErrorInfo.mvarId` may have been assigned or
delayed assigned to another metavariable that is unassigned. -/
let mvarDeps ← getMVars (mkMVar mvarId)
if mvarDeps.any pendingMVarIds.contains then do
unless hasOtherErrors do
errors := errors.push mvarErrorInfo
hasNewErrors := true
-- To sort the errors by position use
-- let sortedErrors := errors.qsort fun e₁ e₂ => e₁.ref.getPos?.getD 0 < e₂.ref.getPos?.getD 0
for error in errors do
error.mvarId.withContext do
error.logError extraMsg?
return hasNewErrors
def registerLevelMVarErrorInfo (levelMVarErrorInfo : LevelMVarErrorInfo) : TermElabM Unit :=
modify fun s => { s with levelMVarErrorInfos := levelMVarErrorInfo :: s.levelMVarErrorInfos }
def registerLevelMVarErrorExprInfo (expr : Expr) (ref : Syntax) (msgData? : Option MessageData := none) : TermElabM Unit := do
registerLevelMVarErrorInfo { lctx := (← getLCtx), expr, ref, msgData? }
def exposeLevelMVars (e : Expr) : MetaM Expr :=
Core.transform e
(pre := fun e => do
if e.isSorry then
-- (kmill) Exposing metavariables in a `sorry` exposes its encoding.
-- On balance, for now it seems better to see `sorry` than ``sorryAx.{?u + 1} (Name → Sort ?u) false `external...hygCtx._hyg.6``
return .done e
else
return .continue)
(post := fun e => do
match e with
| .const _ us => return .done <| if us.any (·.hasMVar) then e.setPPUniverses true else e
| .sort u => return .done <| if u.hasMVar then e.setPPUniverses true else e
| .lam _ t _ _ => return .done <| if t.hasLevelMVar then e.setOption `pp.funBinderTypes true else e
| .letE _ t _ _ _ => return .done <| if t.hasLevelMVar then e.setOption `pp.letVarTypes true else e
| _ => return .done e)
def LevelMVarErrorInfo.logError (levelMVarErrorInfo : LevelMVarErrorInfo) : TermElabM Unit :=
Meta.withLCtx levelMVarErrorInfo.lctx {} do
let e' ← exposeLevelMVars (← instantiateMVars levelMVarErrorInfo.expr)
let msg := levelMVarErrorInfo.msgData?.getD m!"don't know how to synthesize universe level metavariables"
let msg := m!"{msg}{indentExpr e'}"
logErrorAt levelMVarErrorInfo.ref msg
/--
Try to log errors for unassigned level metavariables `pendingLevelMVarIds`.
Returns `true` if there are any relevant `LevelMVarErrorInfo`s and we should "abort" the declaration.
Remark: we only log unassigned level metavariables as new errors if no error has been logged so far.
-/
def logUnassignedLevelMVarsUsingErrorInfos (pendingLevelMVarIds : Array LMVarId) : TermElabM Bool := do
if pendingLevelMVarIds.isEmpty then
return false
else
let hasOtherErrors ← MonadLog.hasErrors
let mut hasNewErrors := false
let mut errors : Array LevelMVarErrorInfo := #[]
for levelMVarErrorInfo in (← get).levelMVarErrorInfos do
let e ← instantiateMVars levelMVarErrorInfo.expr
let lmvars := (collectLevelMVars {} e).result
if lmvars.any pendingLevelMVarIds.contains then do
unless hasOtherErrors do
errors := errors.push levelMVarErrorInfo
hasNewErrors := true
for error in errors do
error.logError
return hasNewErrors
/--
Locates expressions that have level metavariables, calling `f` with the level metavariables exposed.
Gives entire applications to `f`.
-/
partial def forEachExprWithExposedLevelMVars (e : Expr) (f : Expr → TermElabM Unit) : TermElabM Unit := do
let rec visitLevel (u : Level) (e : Expr) : TermElabM Unit := do
if u.hasMVar then
let e' ← exposeLevelMVars e
f e'
let withExpr (e : Expr) (m : ReaderT Expr (MonadCacheT ExprStructEq Unit TermElabM) Unit) :=
withReader (fun _ => e) m
let rec visit (e : Expr) (head := false) : ReaderT Expr (MonadCacheT ExprStructEq Unit TermElabM) Unit := do
if e.hasLevelMVar then