lean4-htt/src/Lean/Meta/Sorry.lean

/-
Copyright (c) 2024 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kyle Miller
-/
module

prelude
public import Lean.Data.Lsp.Utf16
public import Lean.Meta.ForEachExpr
public import Lean.Meta.InferType
public import Lean.Util.Recognizers

public section

/-!
# Utilities for creating and recognizing `sorry`

This module develops material for creating and recognizing `sorryAx` terms that encode originating source positions.
There are three orthogonal configurations for sorries:

- The sorry could be *synthetic*. When elaboration fails on some subterm, then we can use a sorry to fill in the missing subterm.
  In this case elaboration marks the sorry as being "synthetic" while logging an error.
  The presence of synthetic sorries tends to suppress further errors. For example, the "this declaration contains sorry" error
  is not triggered for synthetic sorries as we assume there is already an error message logged.

- The sorry could be *unique*. A unique sorry is not definitionally equal to any other sorry, even if they have the same type.
  Normally `sorryAx α s = sorryAx α s` is a definitional equality. Unique sorries insert a unique tag `t` using the encoding `sorryAx (τ → α) s t`.

- The sorry could be *labeled*. A labeled sorry contains source position information, supporting the LSP "go to definition" feature in the Infoview,
  and also supporting pretty printing the sorry with an indication of source position when the option `pp.sorrySource` is true.
-/

namespace Lean.Meta

/--
Returns `sorryAx type synthetic`. Recall that `synthetic` is true if this sorry is from an error.

See also `Lean.Meta.mkLabeledSorry`, for creating a `sorry` that is labeled or unique.
-/
def mkSorry (type : Expr) (synthetic : Bool) : MetaM Expr := do
  if !(← hasConst ``sorryAx) then
    -- Abort if we are not ready yet to generate `sorry`s in bootstrapping contexts.
    Elab.throwAbortCommand
  let u ← getLevel type
  return mkApp2 (mkConst ``sorryAx [u]) type (toExpr synthetic)

structure SorryLabelView where
  /--
  Records the origin module name, logical source position, and LSP range for the `sorry`.
  The logical source position is used when displaying the sorry when the `pp.sorrySource` option is true,
  and the LSP range is used for "go to definition" in the Infoview.
  -/
  module? : Option DeclarationLocation := none

def SorryLabelView.encode (view : SorryLabelView) : CoreM Name :=
  let name :=
    if let some { module, range := { pos, endPos, charUtf16, endCharUtf16 } } := view.module? then
      module
        |>.num pos.line |>.num pos.column
        |>.num endPos.line |>.num endPos.column
        |>.num charUtf16 |>.num endCharUtf16
    else
      .anonymous
  mkFreshUserName (name.str "_sorry")

def SorryLabelView.decode? (name : Name) : Option SorryLabelView := do
  guard <| name.hasMacroScopes
  let .str name "_sorry" := name.eraseMacroScopes | failure
  if let .num (.num (.num (.num (.num (.num module posLine) posCol) endLine) endCol) charUtf16) endCharUtf16 := name then
    return { module? := some { module, range := { pos := ⟨posLine, posCol⟩, endPos := ⟨endLine, endCol⟩, charUtf16, endCharUtf16 } } }
  else
    failure

/--
Constructs a `sorryAx`.
* If the current ref has a source position, then creates a labeled sorry.
  This supports "go to definition" in the InfoView and pretty printing a source position when the `pp.sorrySource` option is true.
* If `synthetic` is true, then the `sorry` is regarded as being generated by the elaborator.
  The caller should ensure that there is an associated error logged.
* If `unique` is true, the `sorry` is unique, in the sense that it is not defeq to any other `sorry` created by `mkLabeledSorry`.
-/
def mkLabeledSorry (type : Expr) (synthetic : Bool) (unique : Bool) : MetaM Expr := do
  if !(← hasConst ``Lean.Name) then
    -- Abort if we are not ready yet to generate `sorry`s in bootstrapping contexts.
    Elab.throwAbortCommand
  let tag ←
    if let (some startSPos, some endSPos) := ((← getRef).getPos?, (← getRef).getTailPos?) then
      let fileMap ← getFileMap
      SorryLabelView.encode {
        module? := some {
          module := (← getMainModule)
          range := {
            pos := fileMap.toPosition startSPos
            endPos := fileMap.toPosition endSPos
            charUtf16 := (fileMap.utf8PosToLspPos startSPos).character
            endCharUtf16 := (fileMap.utf8PosToLspPos endSPos).character
          }
        }
      }
    else
      SorryLabelView.encode {}
  if unique then
    let e ← mkSorry (mkForall `tag .default (mkConst ``Lean.Name) type) synthetic
    return .app e (toExpr tag)
  else
    let e ← mkSorry (mkForall `tag .default (mkConst ``Unit) type) synthetic
    let tag' := mkApp4 (mkConst ``Function.const [levelOne, levelOne]) (mkConst ``Unit) (mkConst ``Lean.Name) (mkConst ``Unit.unit) (toExpr tag)
    return .app e tag'

/--
Returns a `SorryLabelView` if `e` is an application of an expression returned by `mkLabeledSorry`.
If it is, then the `sorry` takes the first three arguments, and the tag is at argument 3.
-/
def isLabeledSorry? (e : Expr) : Option SorryLabelView := do
  guard <| e.isAppOf ``sorryAx
  let numArgs := e.getAppNumArgs
  guard <| numArgs ≥ 3
  let arg := e.getArg! 2
  if let some tag := arg.name? then
    SorryLabelView.decode? tag
  else
    guard <| arg.isAppOfArity ``Function.const 4
    guard <| arg.appFn!.appArg!.isAppOfArity ``Unit.unit 0
    let tag ← arg.appArg!.name?
    SorryLabelView.decode? tag

end Meta

/--
If `e` is a sorry application, returns the sorry itself,
stripping off any arguments in case the `sorry` is standing in for a function.

For labeled sorries, includes the label information.
-/
def Expr.getSorry? (e : Expr) : Option Expr :=
  if e.isSorry then
    if (Meta.isLabeledSorry? e).isSome then
      e.getBoundedAppFn (e.getAppNumArgs - 3)
    else
      e.getBoundedAppFn (e.getAppNumArgs - 2)
  else
    none

/--
Evaluates `fn` on each `sorry` in the expression.
Instantiates bound variables with free variables.
-/
def Meta.forEachSorryM {m : Type → Type} [Monad m] [MonadLiftT MetaM m] [MonadControlT MetaM m] (input : Expr)
    (fn : Expr → m Unit) : m Unit := do
  Meta.forEachExpr' input fun e => do
    if let some e' := e.getSorry? then
      fn e'
      return false
    else
      return true

/--
Evaluates `fn` on each `sorry` in the declaration.
-/
def Declaration.forEachSorryM {m : Type → Type} [Monad m] [MonadLiftT MetaM m] [MonadControlT MetaM m] (decl : Declaration)
    (fn : Expr → m Unit) : m Unit := do
  decl.forExprM (Meta.forEachSorryM · fn)

end Lean