966fa800f8
This coercion caused difficult-to-diagnose bugs sometimes. Because there are some situations where converting a string to a name should be done by parsing the string, and others where it should not, an explicit choice seems better here. --------- Co-authored-by: Mac Malone <tydeu@hatpress.net>
281 lines
13 KiB
Text
281 lines
13 KiB
Text
/-
|
||
Copyright (c) 2022 E.W.Ayers. All rights reserved.
|
||
Released under Apache 2.0 license as described in the file LICENSE.
|
||
|
||
Authors: E.W.Ayers
|
||
-/
|
||
prelude
|
||
import Lean.Meta.PPGoal
|
||
import Lean.Widget.InteractiveCode
|
||
import Lean.Widget.InteractiveGoal
|
||
import Lean.Data.Lsp.Extra
|
||
import Lean.Elab.InfoTree
|
||
|
||
namespace Lean.Widget
|
||
|
||
register_builtin_option showTacticDiff : Bool := {
|
||
defValue := true
|
||
descr := "When true, interactive goals for tactics will be decorated with diffing information. "
|
||
}
|
||
|
||
open Server Std Lean SubExpr
|
||
|
||
/-- A marker for a point in the expression where a subexpression has been inserted.
|
||
|
||
NOTE: in the future we may add other tags.
|
||
-/
|
||
private inductive ExprDiffTag where
|
||
| change
|
||
| delete
|
||
| insert
|
||
|
||
def ExprDiffTag.toDiffTag : (useAfter : Bool) → ExprDiffTag → Lean.Widget.DiffTag
|
||
| true, .change => .wasChanged
|
||
| false, .change => .willChange
|
||
| true, .delete => .wasDeleted
|
||
| false, .delete => .willDelete
|
||
| true, .insert => .wasInserted
|
||
| false, .insert => .willInsert
|
||
|
||
def ExprDiffTag.toString : ExprDiffTag → String
|
||
| .change => "change"
|
||
| .delete => "delete"
|
||
| .insert => "insert"
|
||
|
||
instance : ToString ExprDiffTag := ⟨ExprDiffTag.toString⟩
|
||
|
||
/-- A description of the differences between a pair of expressions `before`, `after : Expr`.
|
||
The information can be used to display a 'visual diff' for
|
||
either `before`, showing the parts of the expression that are about to change,
|
||
or `after` showing which parts of the expression have changed. -/
|
||
structure ExprDiff where
|
||
/-- Map from subexpr positions in `e₀` to diff points.-/
|
||
changesBefore : PosMap ExprDiffTag := ∅
|
||
/-- A map from subexpr positions in `e₁` to 'diff points' which are tags
|
||
describing how the expression has changed relative to `before` at the given position.-/
|
||
changesAfter : PosMap ExprDiffTag := ∅
|
||
|
||
instance : EmptyCollection ExprDiff := ⟨{}⟩
|
||
instance : Append ExprDiff where
|
||
append a b := {
|
||
changesBefore := RBMap.mergeBy (fun _ _ b => b) a.changesBefore b.changesBefore,
|
||
changesAfter := RBMap.mergeBy (fun _ _ b => b) a.changesAfter b.changesAfter
|
||
}
|
||
instance : ToString ExprDiff where
|
||
toString x :=
|
||
let f := fun (p : PosMap ExprDiffTag) =>
|
||
RBMap.toList p |>.map (fun (k,v) => s!"({toString k}:{toString v})")
|
||
s!"before: {f x.changesBefore}\nafter: {f x.changesAfter}"
|
||
|
||
/-- Add a tag at the given position to the `changesBefore` dict. -/
|
||
def ExprDiff.insertBeforeChange (p : Pos) (d : ExprDiffTag := .change) (δ : ExprDiff) : ExprDiff :=
|
||
{δ with changesBefore := δ.changesBefore.insert p d}
|
||
|
||
/-- Add a tag at the given position to the `changesAfter` dict. -/
|
||
def ExprDiff.insertAfterChange (p : Pos) (d : ExprDiffTag := .change) (δ : ExprDiff) : ExprDiff :=
|
||
{δ with changesAfter := δ.changesAfter.insert p d}
|
||
|
||
def ExprDiff.withChangePos (before after : Pos) (d : ExprDiffTag := .change) : ExprDiff :=
|
||
{ changesAfter := RBMap.empty.insert after d
|
||
changesBefore := RBMap.empty.insert before d
|
||
}
|
||
|
||
/-- Add a tag to the diff at the positions given by `before` and `after`. -/
|
||
def ExprDiff.withChange (before after : SubExpr) (d : ExprDiffTag := .change) : ExprDiff :=
|
||
ExprDiff.withChangePos before.pos after.pos d
|
||
|
||
/-- If true, the expression before and the expression after are identical. -/
|
||
def ExprDiff.isEmpty (d : ExprDiff) : Bool :=
|
||
d.changesAfter.isEmpty ∧ d.changesBefore.isEmpty
|
||
|
||
/-- Computes a diff between `before` and `after` expressions.
|
||
|
||
This works by recursively comparing function arguments.
|
||
|
||
TODO(ed): experiment with a 'greatest common subexpression' design where
|
||
given `e₀`, `e₁`, find the greatest common subexpressions `Xs : Array Expr` and a congruence `F` such that
|
||
`e₀ = F[A₀[..Xs]]` and `e₀ = F[A₁[..Xs]]`. Then, we can have fancy diff highlighting where common subexpressions are not highlighted.
|
||
|
||
## Diffing binders
|
||
|
||
Two binding domains are identified if they have the same user name and the same type.
|
||
The most common tactic that modifies binders is after an `intros`.
|
||
To deal with this case, if `before = (a : α) → β` and `after`, is not a matching binder (ie: not `(a : α) → _`)
|
||
then we instantiate the `before` variable in a new context and continue diffing `β` against `after`.
|
||
|
||
-/
|
||
partial def exprDiffCore (before after : SubExpr) : MetaM ExprDiff := do
|
||
if before.expr == after.expr then
|
||
return ∅
|
||
match before.expr, after.expr with
|
||
| .mdata _ e₀, _ => exprDiffCore {before with expr := e₀} after
|
||
| _, .mdata _ e₁ => exprDiffCore before {after with expr := e₁}
|
||
| .app .., .app .. =>
|
||
let (fn₀, args₀) := after.expr.withApp Prod.mk
|
||
let (fn₁, args₁) := before.expr.withApp Prod.mk
|
||
if fn₀ != fn₁ || args₀.size != args₁.size then
|
||
return ExprDiff.withChange before after
|
||
let args := Array.zip args₀ args₁
|
||
let args ← args.mapIdxM (fun i (beforeArg, afterArg) =>
|
||
exprDiffCore
|
||
⟨beforeArg, before.pos.pushNaryArg args₀.size i⟩
|
||
⟨afterArg, after.pos.pushNaryArg args₀.size i⟩
|
||
)
|
||
return args.foldl (init := ∅) (· ++ ·)
|
||
| .forallE .., _ => piDiff before after
|
||
| .lam n₀ d₀ b₀ i₀, .lam n₁ d₁ b₁ i₁=>
|
||
if n₀ != n₁ || i₀ != i₁ then
|
||
return ExprDiff.withChange before after
|
||
let δd ← exprDiffCore ⟨d₀, before.pos.pushBindingDomain⟩ ⟨d₁, after.pos.pushBindingDomain⟩
|
||
if δd.isEmpty then
|
||
return ← exprDiffCore ⟨b₀, before.pos.pushBindingBody⟩ ⟨b₁, after.pos.pushBindingBody⟩
|
||
else
|
||
return δd ++ ExprDiff.withChangePos before.pos.pushBindingBody after.pos.pushBindingBody
|
||
| .proj n₀ i₀ e₀, .proj n₁ i₁ e₁ =>
|
||
if n₀ != n₁ || i₀ != i₁ then
|
||
return ExprDiff.withChange before after
|
||
else
|
||
exprDiffCore ⟨e₀, before.pos.pushProj⟩ ⟨e₁, after.pos.pushProj⟩
|
||
| _, _ => return ExprDiff.withChange before after
|
||
where
|
||
piDiff (before after : SubExpr) : MetaM ExprDiff := do
|
||
let .forallE n₀ d₀ b₀ i₀ := before.expr
|
||
| return ∅
|
||
if let .forallE n₁ d₁ b₁ i₁ := after.expr then
|
||
if n₀ == n₁ && i₀ == i₁ then
|
||
-- assume that these are the same binders
|
||
let δd ← exprDiffCore
|
||
⟨d₀, before.pos.pushBindingDomain⟩
|
||
⟨d₁, after.pos.pushBindingDomain⟩
|
||
if δd.isEmpty then
|
||
-- the types have changed, so we can no longer meaningfully compare the targets
|
||
let δt ← Lean.Meta.withLocalDecl n₀ i₀ d₀ fun x =>
|
||
exprDiffCore
|
||
⟨b₀.instantiate1 x, before.pos.pushBindingBody⟩
|
||
⟨b₁.instantiate1 x, after.pos.pushBindingBody⟩
|
||
return δt
|
||
else
|
||
return δd ++ ExprDiff.withChangePos before.pos.pushBindingBody after.pos.pushBindingBody
|
||
-- in this case, the after expression does not match the before expression.
|
||
-- however, a special case is intros:
|
||
if let some s := List.isSuffixOf? after.expr.getForallBinderNames before.expr.getForallBinderNames then
|
||
-- s ++ namesAfter = namesBefore
|
||
if s.length == 0 then
|
||
throwError "should not happen"
|
||
let body₀ := before.expr.getForallBodyMaxDepth s.length
|
||
let mut δ : ExprDiff ← (do
|
||
-- this line can fail if we are using `before`'s mvar context, in which case
|
||
-- we can skip giving a diff.
|
||
let fvars ← s.mapM Lean.Meta.getFVarFromUserName
|
||
return ← exprDiffCore
|
||
⟨body₀.instantiateRev fvars.toArray, before.pos.pushNthBindingBody s.length⟩
|
||
after
|
||
) <|> (pure ∅)
|
||
for i in [0:s.length] do
|
||
δ := δ.insertBeforeChange (before.pos.pushNthBindingDomain i) .delete
|
||
-- [todo] maybe here insert a tag on the after case indicating an expression was deleted above the expression?
|
||
return δ
|
||
return ExprDiff.withChange before after
|
||
|
||
/-- Computes the diff for `e₀` and `e₁`. If `useAfter` is `false`, `e₀, e₁` are interpreted as `after, before` instead of `before, after`.-/
|
||
def exprDiff (e₀ e₁ : Expr) (useAfter := true) : MetaM ExprDiff := do
|
||
let s₀ := ⟨e₀, Pos.root⟩
|
||
let s₁ := ⟨e₁, Pos.root⟩
|
||
if useAfter then
|
||
exprDiffCore s₀ s₁
|
||
else
|
||
exprDiffCore s₁ s₀
|
||
|
||
/-- Given a `diff` between `before` and `after : Expr`, and the rendered `infoAfter : CodeWithInfos` for `after`,
|
||
this function decorates `infoAfter` with tags indicating where the expression has changed.
|
||
|
||
If `useAfter == false` before and after are swapped. -/
|
||
def addDiffTags (useAfter : Bool) (diff : ExprDiff) (info₁ : CodeWithInfos) : MetaM CodeWithInfos := do
|
||
let cs := if useAfter then diff.changesAfter else diff.changesBefore
|
||
info₁.mergePosMap (fun info d => pure <| info.withDiffTag <| ExprDiffTag.toDiffTag useAfter d) cs
|
||
|
||
open Meta
|
||
|
||
/-- Diffs the given hypothesis bundle against the given local context.
|
||
|
||
If `useAfter == true`, `ctx₀` is the context _before_ and `h₁` is the bundle _after_.
|
||
If `useAfter == false`, these are swapped.
|
||
-/
|
||
def diffHypothesesBundle (useAfter : Bool) (ctx₀ : LocalContext) (h₁ : InteractiveHypothesisBundle) : MetaM InteractiveHypothesisBundle := do
|
||
/- Strategy: we say a hypothesis has mutated if the ppName is the same but the fvarid has changed.
|
||
this indicates that something like `rewrite at` has hit it. -/
|
||
for (ppName, fvid) in Array.zip h₁.names h₁.fvarIds do
|
||
if !(ctx₀.contains fvid) then
|
||
if let some decl₀ := ctx₀.findFromUserName? (.mkSimple ppName) then
|
||
-- on ctx₀ there is an fvar with the same name as this one.
|
||
let t₀ := decl₀.type
|
||
return ← withTypeDiff t₀ h₁
|
||
else
|
||
if useAfter then
|
||
return {h₁ with isInserted? := true }
|
||
else
|
||
return {h₁ with isRemoved? := true }
|
||
-- all fvids are present on original so we can assume no change.
|
||
return h₁
|
||
where
|
||
withTypeDiff (t₀ : Expr) (h₁ : InteractiveHypothesisBundle) : MetaM InteractiveHypothesisBundle := do
|
||
let some x₁ := h₁.fvarIds[0]?
|
||
| throwError "internal error: empty fvar list!"
|
||
let t₁ ← inferType <| Expr.fvar x₁
|
||
let tδ ← exprDiff t₀ t₁ useAfter
|
||
let c₁ ← addDiffTags useAfter tδ h₁.type
|
||
return {h₁ with type := c₁}
|
||
|
||
def diffHypotheses (useAfter : Bool) (lctx₀ : LocalContext) (hs₁ : Array InteractiveHypothesisBundle) : MetaM (Array InteractiveHypothesisBundle) := do
|
||
-- [todo] also show when hypotheses (user-names present in lctx₀ but not in hs₁) are deleted
|
||
hs₁.mapM (diffHypothesesBundle useAfter lctx₀)
|
||
|
||
/-- Decorates the given goal `i₁` with a diff by comparing with goal `g₀`.
|
||
If `useAfter` is true then `i₁` is _after_ and `g₀` is _before_. Otherwise they are swapped. -/
|
||
def diffInteractiveGoal (useAfter : Bool) (g₀ : MVarId) (i₁ : InteractiveGoal) : MetaM InteractiveGoal := do
|
||
let mctx ← getMCtx
|
||
let some md₀ := mctx.findDecl? g₀
|
||
| throwError "Failed to find decl for {g₀}."
|
||
let lctx₀ := md₀.lctx |>.sanitizeNames.run' {options := (← getOptions)}
|
||
let hs₁ ← diffHypotheses useAfter lctx₀ i₁.hyps
|
||
let i₁ := {i₁ with hyps := hs₁}
|
||
let g₁ := i₁.mvarId
|
||
let t₀ ← instantiateMVars <|← inferType (Expr.mvar g₀)
|
||
let some md₁ := (← getMCtx).findDecl? g₁
|
||
| throwError "Unknown goal {g₁}"
|
||
let t₁ ← instantiateMVars md₁.type
|
||
let tδ ← exprDiff t₀ t₁ useAfter
|
||
let c₁ ← addDiffTags useAfter tδ i₁.type
|
||
let i₁ := {i₁ with type := c₁, isInserted? := false}
|
||
return i₁
|
||
|
||
/-- Modifies `goalsAfter` with additional information about how it is different to `goalsBefore`.
|
||
If `useAfter` is `true` then `igs₁` is the set of interactive goals _after_ the tactic has been applied.
|
||
Otherwise `igs₁` is the set of interactive goals _before_. -/
|
||
def diffInteractiveGoals (useAfter : Bool) (info : Elab.TacticInfo) (igs₁ : InteractiveGoals) : MetaM InteractiveGoals := do
|
||
if ! showTacticDiff.get (← getOptions) then return igs₁ else
|
||
let goals₀ := if useAfter then info.goalsBefore else info.goalsAfter
|
||
let parentMap : MVarIdMap MVarIdSet ← info.goalsBefore.foldlM (init := ∅) (fun s g => do
|
||
let ms ← Expr.mvar g |> Lean.Meta.getMVars
|
||
let ms : MVarIdSet := RBTree.fromArray ms _
|
||
return s.insert g ms
|
||
)
|
||
let isParent (before after : MVarId) : Bool :=
|
||
match parentMap.find? before with
|
||
| some xs => xs.contains after
|
||
| none => false
|
||
let goals ← igs₁.goals.mapM (fun ig₁ => do
|
||
let g₁ := ig₁.mvarId
|
||
withGoalCtx (g₁ : MVarId) (fun _lctx₁ _md₁ => do
|
||
-- if the goal is present on the previous version then continue
|
||
if goals₀.any (fun g₀ => g₀ == g₁) then
|
||
return {ig₁ with isInserted? := none}
|
||
let some g₀ := goals₀.find? (fun g₀ => if useAfter then isParent g₀ g₁ else isParent g₁ g₀)
|
||
| return if useAfter then {ig₁ with isInserted? := true } else {ig₁ with isRemoved? := true}
|
||
let ig₁ ← diffInteractiveGoal useAfter g₀ ig₁
|
||
return ig₁
|
||
)
|
||
)
|
||
return {igs₁ with goals := goals}
|
||
|
||
end Lean.Widget
|