/-
Copyright (c) 2019 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura and Sebastian Ullrich

Additional goodies for writing macros
-/
module

prelude
import all Init.Prelude -- for unfolding `Name.beq`
public import Init.Syntax
public import Init.Data.Array.GetLit
public import Init.Data.Option.BasicAux
public meta import Init.Data.Array.Basic
public meta import Init.Syntax

public section

namespace Lean

@[extern "lean_version_get_major"]
private opaque version.getMajor (u : Unit) : Nat
def version.major : Nat := version.getMajor ()

@[extern "lean_version_get_minor"]
private opaque version.getMinor (u : Unit) : Nat
def version.minor : Nat := version.getMinor ()

@[extern "lean_version_get_patch"]
private opaque version.getPatch (u : Unit) : Nat
def version.patch : Nat := version.getPatch ()

@[extern "lean_get_githash"]
opaque getGithash (u : Unit) : String
def githash : String := getGithash ()

@[extern "lean_version_get_is_release"]
opaque version.getIsRelease (u : Unit) : Bool
def version.isRelease : Bool := version.getIsRelease ()

/-- Additional version description like "nightly-2018-03-11" -/
@[extern "lean_version_get_special_desc"]
opaque version.getSpecialDesc (u : Unit) : String
def version.specialDesc : String := version.getSpecialDesc ()

def versionStringCore :=
  String.Internal.append
    (String.Internal.append
      (String.Internal.append
        (String.Internal.append (toString version.major) ".")
        (toString version.minor))
      ".")
    (toString version.patch)

def versionString :=
  if version.specialDesc ≠ "" then
    String.Internal.append (String.Internal.append versionStringCore "-") version.specialDesc
  else if version.isRelease then
    versionStringCore
  else
    (String.Internal.append (String.Internal.append versionStringCore ", commit ") githash)

def origin :=
  "leanprover/lean4"

def toolchain :=
  if version.specialDesc ≠ ""  then
    if version.isRelease then
      String.Internal.append
        (String.Internal.append
          (String.Internal.append
            (String.Internal.append origin ":")
            versionStringCore)
          "-")
        version.specialDesc
    else
      String.Internal.append (String.Internal.append origin ":") version.specialDesc
  else if version.isRelease then
    String.Internal.append (String.Internal.append origin ":") versionStringCore
  else
    ""

@[extern "lean_internal_is_stage0"]
opaque Internal.isStage0 (u : Unit) : Bool

/--
This function can be used to detect whether the compiler has support for
generating LLVM instead of C. It is used by lake instead of the --features
flag in order to avoid having to run a compiler for this every time on startup.
See #2572.
-/
@[extern "lean_internal_has_llvm_backend"]
opaque Internal.hasLLVMBackend (u : Unit) : Bool

/-- Valid identifier names -/
@[inline] def isGreek (c : Char) : Bool :=
  0x391 ≤ c.val && c.val ≤ 0x3dd

def isLetterLike (c : Char) : Bool :=
  (0x3b1  ≤ c.val && c.val ≤ 0x3c9 && c.val ≠ 0x3bb) ||                     -- Lower greek, but lambda
  (0x391  ≤ c.val && c.val ≤ 0x3A9 && c.val ≠ 0x3A0 && c.val ≠ 0x3A3) ||    -- Upper greek, but Pi and Sigma
  (0x3ca  ≤ c.val && c.val ≤ 0x3fb) ||                                      -- Coptic letters
  (0x1f00 ≤ c.val && c.val ≤ 0x1ffe) ||                                     -- Polytonic Greek Extended Character Set
  (0x2100 ≤ c.val && c.val ≤ 0x214f) ||                                     -- Letter like block
  (0x1d49c ≤ c.val && c.val ≤ 0x1d59f) ||                                   -- Latin letters, Script, Double-struck, Fractur
  (0x00c0 ≤ c.val && c.val ≤ 0x00ff && c.val ≠ 0x00d7 && c.val ≠ 0x00f7) || -- Latin-1 supplement letters but × and ÷
  (0x0100 ≤ c.val && c.val ≤ 0x017f)                                        -- Latin Extended-A

@[inline] def isNumericSubscript (c : Char) : Bool :=
  0x2080 ≤ c.val && c.val ≤ 0x2089

def isSubScriptAlnum (c : Char) : Bool :=
  isNumericSubscript c ||
  (0x2090 ≤ c.val && c.val ≤ 0x209c) ||
  (0x1d62 ≤ c.val && c.val ≤ 0x1d6a) ||
  c.val == 0x2c7c

@[inline] def isIdFirst (c : Char) : Bool :=
  c.isAlpha || c = '_' || isLetterLike c

@[inline] private def isAlphaAscii (c : UInt8) : Bool :=
  'a'.toUInt8 ≤ c && c ≤ 'z'.toUInt8
    || 'A'.toUInt8 ≤ c && c ≤ 'Z'.toUInt8

@[inline] def isIdFirstAscii (c : UInt8) : Bool :=
  isAlphaAscii c || c = '_'.toUInt8

@[inline] private def isAlphanumAscii (c : UInt8) : Bool :=
  isAlphaAscii c || '0'.toUInt8 ≤ c && c ≤ '9'.toUInt8

@[inline] def isIdRest (c : Char) : Bool :=
  c.isAlphanum || c = '_' || c = '\'' || c == '!' || c == '?' || isLetterLike c || isSubScriptAlnum c

@[inline] def isIdRestAscii (c : UInt8) : Bool :=
  isAlphanumAscii c || c = '_'.toUInt8 || c = '\''.toUInt8 || c == '!'.toUInt8 || c == '?'.toUInt8

def idBeginEscape := '«'
def idEndEscape   := '»'
@[inline] def isIdBeginEscape (c : Char) : Bool := c = idBeginEscape
@[inline] def isIdEndEscape (c : Char) : Bool := c = idEndEscape
namespace Name

def getRoot : Name → Name
  | anonymous             => anonymous
  | n@(str anonymous _) => n
  | n@(num anonymous _) => n
  | str n _             => getRoot n
  | num n _             => getRoot n

@[export lean_is_inaccessible_user_name]
def isInaccessibleUserName : Name → Bool
  | Name.str _ s   => (String.Internal.contains s '✝') || s == "_inaccessible"
  | Name.num p _   => isInaccessibleUserName p
  | _              => false

section ToString

/-!
Here we give a private implementation of `Name.toString`. The real implementation is in
`Init.Data.ToString.Name`, which we cannot import here due to import hierarchy limitations.

The difference between the two versions is that this one uses the `String.Internal.*` functions,
while the one in `Init.Data.ToString.Name` uses the public String functions. These differ in
that the latter versions have better inferred borrowing annotations, which is significant for an
inner-loop function like `Name.toString`.
-/

-- If you change this, also change the corresponding function in `Init.Data.ToString.Name`.
private partial def needsNoEscapeAsciiRest (s : String) (i : Nat) : Bool :=
  if h : i < s.utf8ByteSize then
    let c := String.Internal.getUTF8Byte s i h
    isIdRestAscii c && needsNoEscapeAsciiRest s (i + 1)
  else
    true

-- If you change this, also change the corresponding function in `Init.Data.ToString.Name`.
@[inline] private def needsNoEscapeAscii (s : String) (h : s.utf8ByteSize > 0) : Bool :=
  let c := String.Internal.getUTF8Byte s 0 h
  isIdFirstAscii c && needsNoEscapeAsciiRest s 1

-- If you change this, also change the corresponding function in `Init.Data.ToString.Name`.
@[inline] private def needsNoEscape (s : String) (h : s.utf8ByteSize > 0) : Bool :=
  needsNoEscapeAscii s h || isIdFirst (String.Internal.get s 0) && Substring.Raw.Internal.all (Substring.Raw.Internal.drop s.toRawSubstring 1) isIdRest

-- If you change this, also change the corresponding function in `Init.Data.ToString.Name`.
@[inline] private def escape (s : String) : String :=
  String.Internal.append (String.Internal.append idBeginEscape.toString s) idEndEscape.toString

/--
Creates a round-trippable string name component if possible, otherwise returns `none`.
Names that are valid identifiers are not escaped, and otherwise, if they do not contain `»`, they are escaped.
- If `force` is `true`, then even valid identifiers are escaped.
-/
-- If you change this, also change the corresponding function in `Init.Data.ToString.Name`.
@[inline]
private def Internal.Meta.escapePart (s : String) (force : Bool := false) : Option String :=
  if h : s.utf8ByteSize > 0 then
    if !force && needsNoEscape s h then
      some s
    else if String.Internal.any s isIdEndEscape then
      none
    else
      some <| escape s
  else
    some <| escape s

variable (sep : String) (escape : Bool) in
/--
Uses the separator `sep` (usually `"."`) to combine the components of the `Name` into a string.
See the documentation for `Name.toStringWithToken` for an explanation of `escape` and `isToken`.
-/
-- If you change this, also change the corresponding function in `Init.Data.ToString.Name`.
@[specialize isToken] -- explicit annotation because isToken is overridden in recursive call
private def Internal.Meta.toStringWithSep (n : Name) (isToken : String → Bool := fun _ => false) : String :=
  match n with
  | anonymous       => "[anonymous]"
  | str anonymous s => maybeEscape s (isToken s)
  | num anonymous v => toString v
  | str n s         =>
    -- Escape the last component if the identifier would otherwise be a token
    let r := toStringWithSep n isToken
    let r' := String.Internal.append (String.Internal.append r sep) (maybeEscape s false)
    if escape && isToken r' then String.Internal.append (String.Internal.append r sep) (maybeEscape s true) else r'
  | num n v         => String.Internal.append (String.Internal.append (toStringWithSep n (isToken := fun _ => false)) sep) (Nat.repr v)
where
  maybeEscape s force := if escape then escapePart s force |>.getD s else s

/--
Converts a name to a string.

- If `escape` is `true`, then escapes name components using `«` and `»` to ensure that
  those names that can appear in source files round trip.
  Names with number components, anonymous names, and names containing `»` might not round trip.
  Furthermore, "pseudo-syntax" produced by the delaborator, such as `_`, `#0` or `?u`, is not escaped.
- The optional `isToken` function is used when `escape` is `true` to determine whether more
  escaping is necessary to avoid parser tokens.
  The insertion algorithm works so long as parser tokens do not themselves contain `«` or `»`.
-/
@[specialize]
-- If you change this, also change the corresponding function in `Init.Data.ToString.Name`.
private def Internal.Meta.toStringWithToken (n : Name) (escape := true) (isToken : String → Bool) : String :=
  -- never escape "prettified" inaccessible names or macro scopes or pseudo-syntax introduced by the delaborator
  toStringWithSep "." (escape && !n.isInaccessibleUserName && !n.hasMacroScopes && !maybePseudoSyntax) n isToken
where
  maybePseudoSyntax :=
    if n == `_ then
      -- output hole as is
      true
    else if let .str _ s := n.getRoot then
      -- could be pseudo-syntax for loose bvar or universe mvar, output as is
      String.Internal.isPrefixOf "#" s || String.Internal.isPrefixOf "?" s
    else
      false

/--
Converts a name to a string.

- If `escape` is `true`, then escapes name components using `«` and `»` to ensure that
  those names that can appear in source files round trip.
  Names with number components, anonymous names, and names containing `»` might not round trip.
  Furthermore, "pseudo-syntax" produced by the delaborator, such as `_`, `#0` or `?u`, is not escaped.
-/
-- If you change this, also change the corresponding function in `Init.Data.ToString.Name`.
private def Internal.Meta.toString (n : Name) (escape := true) : String :=
  toStringWithToken n escape (fun _ => false)

end ToString

private def hasNum : Name → Bool
  | anonymous => false
  | num ..    => true
  | str p ..  => hasNum p

protected def reprPrec (n : Name) (prec : Nat) : Std.Format :=
  match n with
  | anonymous => Std.Format.text "Lean.Name.anonymous"
  | num p i => Repr.addAppParen ("Lean.Name.mkNum " ++ Name.reprPrec p max_prec ++ " " ++ repr i) prec
  | str p s =>
    if p.hasNum then
      Repr.addAppParen ("Lean.Name.mkStr " ++ Name.reprPrec p max_prec ++ " " ++ repr s) prec
    else
      Std.Format.text "`" ++ Internal.Meta.toString n

instance : Repr Name where
  reprPrec := Name.reprPrec

def capitalize : Name → Name
  | .str p s => .str p (String.Internal.capitalize s)
  | n        => n

def replacePrefix : Name → Name → Name → Name
  | anonymous,   anonymous, newP => newP
  | anonymous,   _,         _    => anonymous
  | n@(str p s), queryP,    newP => if n == queryP then newP else Name.mkStr (p.replacePrefix queryP newP) s
  | n@(num p s), queryP,    newP => if n == queryP then newP else Name.mkNum (p.replacePrefix queryP newP) s

/--
  `eraseSuffix? n s` return `n'` if `n` is of the form `n == n' ++ s`.
-/
def eraseSuffix? : Name → Name → Option Name
  | n,       anonymous => some n
  | str p s, str p' s' => if s == s' then eraseSuffix? p p' else none
  | num p s, num p' s' => if s == s' then eraseSuffix? p p' else none
  | _,       _         => none

/-- Remove macros scopes, apply `f`, and put them back -/
@[inline] def modifyBase (n : Name) (f : Name → Name) : Name :=
  if n.hasMacroScopes then
    let view := extractMacroScopes n
    { view with name := f view.name }.review
  else
    f n

@[export lean_name_append_after]
def appendAfter (n : Name) (suffix : String) : Name :=
  n.modifyBase fun
    | str p s => Name.mkStr p (String.Internal.append s suffix)
    | n       => Name.mkStr n suffix

@[export lean_name_append_index_after]
def appendIndexAfter (n : Name) (idx : Nat) : Name :=
  n.modifyBase fun
    | str p s => Name.mkStr p (String.Internal.append (String.Internal.append s "_") (toString idx))
    | n       => Name.mkStr n (String.Internal.append "_" (toString idx))

@[export lean_name_append_before]
def appendBefore (n : Name) (pre : String) : Name :=
  n.modifyBase fun
    | anonymous => Name.mkStr anonymous pre
    | str p s => Name.mkStr p (String.Internal.append pre s)
    | num p n => Name.mkNum (Name.mkStr p pre) n

protected theorem beq_iff_eq {m n : Name} : m == n ↔ m = n := by
  change m.beq n ↔ _
  induction m generalizing n <;> cases n <;> simp_all [Name.beq, And.comm]

instance : LawfulBEq Name where
  eq_of_beq := Name.beq_iff_eq.1
  rfl := Name.beq_iff_eq.2 rfl

instance : DecidableEq Name :=
  fun a b => if h : a == b then .isTrue (by simp_all) else .isFalse (by simp_all)

end Name

namespace NameGenerator

@[inline] def curr (g : NameGenerator) : Name :=
  Name.mkNum g.namePrefix g.idx

@[inline] def next (g : NameGenerator) : NameGenerator :=
  { g with idx := g.idx + 1 }

@[inline] def mkChild (g : NameGenerator) : NameGenerator × NameGenerator :=
  ({ namePrefix := Name.mkNum g.namePrefix g.idx, idx := 1 },
   { g with idx := g.idx + 1 })

end NameGenerator

class MonadNameGenerator (m : Type → Type) where
  getNGen : m NameGenerator
  setNGen : NameGenerator → m Unit

export MonadNameGenerator (getNGen setNGen)

/--
Creates a globally unique `Name`, without any semantic interpretation.
The names are not intended to be user-visible.
With the default name generator, names use `_uniq` as a base and have a numeric suffix.

This is used for example by `Lean.mkFreshFVarId`, `Lean.mkFreshMVarId`, and `Lean.mkFreshLMVarId`.
To create fresh user-visible identifiers, use functions such as `Lean.Core.mkFreshUserName` instead.
-/
def mkFreshId {m : Type → Type} [Monad m] [MonadNameGenerator m] : m Name := do
  let ngen ← getNGen
  let r := ngen.curr
  setNGen ngen.next
  pure r

instance monadNameGeneratorLift (m n : Type → Type) [MonadLift m n] [MonadNameGenerator m] : MonadNameGenerator n := {
  getNGen := liftM (getNGen : m _),
  setNGen := fun ngen => liftM (setNGen ngen : m _)
}

namespace Syntax

deriving instance Repr for Syntax.Preresolved
deriving instance Repr for Syntax
deriving instance Repr for TSyntax

/--
Syntax that represents a Lean term.
-/
abbrev Term := TSyntax `term
/--
Syntax that represents a command.
-/
abbrev Command := TSyntax `command
/--
Syntax that represents a universe level.
-/
protected abbrev Level := TSyntax `level
/--
Syntax that represents a tactic.
-/
protected abbrev Tactic := TSyntax `tactic
/--
Syntax that represents a precedence (e.g. for an operator).
-/
abbrev Prec := TSyntax `prec
/--
Syntax that represents a priority (e.g. for an instance declaration).
-/
abbrev Prio := TSyntax `prio
/--
Syntax that represents an identifier.
-/
abbrev Ident := TSyntax identKind
/--
Syntax that represents a string literal.
-/
abbrev StrLit := TSyntax strLitKind
/--
Syntax that represents a character literal.
-/
abbrev CharLit := TSyntax charLitKind
/--
Syntax that represents a quoted name literal that begins with a back-tick.
-/
abbrev NameLit := TSyntax nameLitKind
/--
Syntax that represents a scientific numeric literal that may have decimal and exponential parts.
-/
abbrev ScientificLit := TSyntax scientificLitKind
/--
Syntax that represents a numeric literal.
-/
abbrev NumLit := TSyntax numLitKind
/--
Syntax that represents macro hygiene info.
-/
abbrev HygieneInfo := TSyntax hygieneInfoKind
/--
Syntax that represent a hexadecimal number without the `0x` prefix.
-/
abbrev HexNum := TSyntax hexnumKind

end Syntax

export Syntax (Term Command Prec Prio Ident StrLit CharLit NameLit ScientificLit NumLit HygieneInfo)

namespace TSyntax

instance : Coe (TSyntax [k]) (TSyntax (k :: ks)) where
  coe stx := ⟨stx⟩

instance : Coe (TSyntax ks) (TSyntax (k' :: ks)) where
  coe stx := ⟨stx⟩

instance : Coe Ident Term where
  coe s := ⟨s.raw⟩

instance : CoeDep Term ⟨Syntax.ident info ss n res⟩ Ident where
  coe := ⟨Syntax.ident info ss n res⟩

instance : Coe StrLit Term where
  coe s := ⟨s.raw⟩

instance : Coe NameLit Term where
  coe s := ⟨s.raw⟩

instance : Coe ScientificLit Term where
  coe s := ⟨s.raw⟩

instance : Coe NumLit Term where
  coe s := ⟨s.raw⟩

instance : Coe CharLit Term where
  coe s := ⟨s.raw⟩

instance : Coe Ident Syntax.Level where
  coe s := ⟨s.raw⟩

instance : Coe NumLit Prio where
  coe s := ⟨s.raw⟩

instance : Coe NumLit Prec where
  coe s := ⟨s.raw⟩

namespace Compat

scoped instance : CoeTail Syntax (TSyntax k) where
  coe s := ⟨s⟩

scoped instance : CoeTail (Array Syntax) (TSyntaxArray k) where
  coe := .mk

end Compat

end TSyntax

namespace Syntax

deriving instance BEq for Syntax.Preresolved

/-- Compare syntax structures modulo source info. -/
partial def structEq : Syntax → Syntax → Bool
  | Syntax.missing, Syntax.missing => true
  | Syntax.node _ k args, Syntax.node _ k' args' => k == k' && args.isEqv args' structEq
  | Syntax.atom _ val, Syntax.atom _ val' => val == val'
  | Syntax.ident _ rawVal val preresolved, Syntax.ident _ rawVal' val' preresolved' => Substring.Raw.Internal.beq rawVal rawVal' && val == val' && preresolved == preresolved'
  | _, _ => false

instance : BEq Lean.Syntax := ⟨structEq⟩
instance : BEq (Lean.TSyntax k) := ⟨(·.raw == ·.raw)⟩

/--
Finds the first `SourceInfo` from the back of `stx` or `none` if no `SourceInfo` can be found.
-/
partial def getTailInfo? : Syntax → Option SourceInfo
  | atom info _   => some info
  | ident info .. => some info
  | node SourceInfo.none _ args =>
      args.findSomeRev? getTailInfo?
  | node info _ _    => some info
  | _             => none

/--
Finds the first `SourceInfo` from the back of `stx` or `SourceInfo.none`
if no `SourceInfo` can be found.
-/
def getTailInfo (stx : Syntax) : SourceInfo :=
  stx.getTailInfo?.getD SourceInfo.none

/--
Finds the trailing size of the first `SourceInfo` from the back of `stx`.
If no `SourceInfo` can be found or the first `SourceInfo` from the back of `stx` contains no
trailing whitespace, the result is `0`.
-/
def getTrailingSize (stx : Syntax) : Nat :=
  match stx.getTailInfo? with
  | some (SourceInfo.original (trailing := trailing) ..) => trailing.bsize
  | _ => 0

/--
Finds the trailing whitespace substring of the first `SourceInfo` from the back of `stx`.
If no `SourceInfo` can be found or the first `SourceInfo` from the back of `stx` contains
no trailing whitespace, the result is `none`.
-/
def getTrailing? (stx : Syntax) : Option Substring.Raw :=
  stx.getTailInfo.getTrailing?

/--
Finds the tail position of the trailing whitespace of the first `SourceInfo` from the back of `stx`.
If no `SourceInfo` can be found or the first `SourceInfo` from the back of `stx` contains
no trailing whitespace and lacks a tail position, the result is `none`.
-/
def getTrailingTailPos? (stx : Syntax) (canonicalOnly := false) : Option String.Pos.Raw :=
  stx.getTailInfo.getTrailingTailPos? canonicalOnly

/--
  Return substring of original input covering `stx`.
  Result is meaningful only if all involved `SourceInfo.original`s refer to the same string (as is the case after parsing). -/
def getSubstring? (stx : Syntax) (withLeading := true) (withTrailing := true) : Option Substring.Raw :=
  match stx.getHeadInfo, stx.getTailInfo with
  | SourceInfo.original lead startPos _ _, SourceInfo.original _ _ trail stopPos =>
    some {
      str      := lead.str
      startPos := if withLeading then lead.startPos else startPos
      stopPos  := if withTrailing then trail.stopPos else stopPos
    }
  | _, _ => none

@[specialize] private partial def updateLast {α} (a : Array α) (f : α → Option α) (i : Fin (a.size + 1)) : Option (Array α) :=
  match i with
  | 0 => none
  | ⟨i + 1, h⟩ =>
    let v := a[i]'(Nat.succ_lt_succ_iff.mp h)
    match f v with
    | some v => some <| a.set i v (Nat.succ_lt_succ_iff.mp h)
    | none   => updateLast a f ⟨i, Nat.lt_of_succ_lt h⟩

partial def setTailInfoAux (info : SourceInfo) : Syntax → Option Syntax
  | atom _ val             => some <| atom info val
  | ident _ rawVal val pre => some <| ident info rawVal val pre
  | node info' k args      =>
    match updateLast args (setTailInfoAux info) ⟨args.size, by simp⟩ with
    | some args => some <| node info' k args
    | none      => none
  | _                      => none

def setTailInfo (stx : Syntax) (info : SourceInfo) : Syntax :=
  match setTailInfoAux info stx with
  | some stx => stx
  | none     => stx

/--
Replaces the trailing whitespace in `stx`, if any, with an empty substring.

The trailing substring's `startPos` and `str` are preserved in order to ensure that the result could
have been produced by the parser, in case any syntax consumers rely on such an assumption.
-/
def unsetTrailing (stx : Syntax) : Syntax :=
  match stx.getTailInfo with
  | SourceInfo.original lead pos trail endPos =>
    stx.setTailInfo (SourceInfo.original lead pos { trail with stopPos := trail.startPos } endPos)
  | _                                     => stx

@[specialize] private partial def updateFirst {α} [Inhabited α] (a : Array α) (f : α → Option α) (i : Nat) : Option (Array α) :=
  if h : i < a.size then
    let v := a[i]
    match f v with
    | some v => some <| a.set i v h
    | none   => updateFirst a f (i+1)
  else
    none

partial def setHeadInfoAux (info : SourceInfo) : Syntax → Option Syntax
  | atom _ val             => some <| atom info val
  | ident _ rawVal val pre => some <| ident info rawVal val pre
  | node i k args          =>
    match updateFirst args (setHeadInfoAux info) 0 with
    | some args => some <| node i k args
    | _         => none
  | _                      => none

def setHeadInfo (stx : Syntax) (info : SourceInfo) : Syntax :=
  match setHeadInfoAux info stx with
  | some stx => stx
  | none     => stx

def setInfo (info : SourceInfo) : Syntax → Syntax
  | atom _ val             => atom info val
  | ident _ rawVal val pre => ident info rawVal val pre
  | node _ kind args       => node info kind args
  | missing                => missing

/-- Return the first atom/identifier that has position information -/
partial def getHead? : Syntax → Option Syntax
  | stx@(atom info ..)  => info.getPos?.map fun _ => stx
  | stx@(ident info ..) => info.getPos?.map fun _ => stx
  | node SourceInfo.none _ args => args.findSome? getHead?
  | stx@(node ..) => some stx
  | _ => none

def copyHeadTailInfoFrom (target source : Syntax) : Syntax :=
  target.setHeadInfo source.getHeadInfo |>.setTailInfo source.getTailInfo

/-- Ensure head position is synthetic. The server regards syntax as "original" only if both head and tail info are `original`. -/
def mkSynthetic (stx : Syntax) : Syntax :=
  stx.setHeadInfo (SourceInfo.fromRef stx)

end Syntax

/-- Use the head atom/identifier of the current `ref` as the `ref` -/
@[inline] def withHeadRefOnly {m : Type → Type} [Monad m] [MonadRef m] {α} (x : m α) : m α := do
  match (← getRef).getHead? with
  | none => x
  | some ref => withRef ref x

/--
  Expand macros in the given syntax.
  A node with kind `k` is visited only if `p k` is true.

  Note that the default value for `p` returns false for `by ...` nodes.
  This is a "hack". The tactic framework abuses the macro system to implement extensible tactics.
  For example, one can define
  ```lean
  syntax "my_trivial" : tactic -- extensible tactic

  macro_rules | `(tactic| my_trivial) => `(tactic| decide)
  macro_rules | `(tactic| my_trivial) => `(tactic| assumption)
  ```
  When the tactic evaluator finds the tactic `my_trivial`, it tries to evaluate the `macro_rule` expansions
  until one "works", i.e., the macro expansion is evaluated without producing an exception.
  We say this solution is a bit hackish because the term elaborator may invoke `expandMacros` with `(p := fun _ => true)`,
  and expand the tactic macros as just macros. In the example above, `my_trivial` would be replaced with `assumption`,
  `decide` would not be tried if `assumption` fails at tactic evaluation time.

  We are considering two possible solutions for this issue:
  1- A proper extensible tactic feature that does not rely on the macro system.

  2- Typed macros that know the syntax categories they're working in. Then, we would be able to select which
     syntactic categories are expanded by `expandMacros`.
-/
partial def expandMacros (stx : Syntax) (p : SyntaxNodeKind → Bool := fun k => k != `Lean.Parser.Term.byTactic) : MacroM Syntax :=
  withRef stx do
    match stx with
    | .node info k args => do
      if p k then
        match (← expandMacro? stx) with
        | some stxNew => expandMacros stxNew
        | none        => do
          let args ← Macro.withIncRecDepth stx <| args.mapM expandMacros
          return .node info k args
      else
        return stx
    | stx => return stx

/-! # Helper functions for processing Syntax programmatically -/

/--
Creates an identifier with its position copied from `src`.

To refer to a specific constant without a risk of variable capture, use `mkCIdentFrom` instead.
-/
def mkIdentFrom (src : Syntax) (val : Name) (canonical := false) : Ident :=
  ⟨Syntax.ident (SourceInfo.fromRef src canonical) (Name.Internal.Meta.toString val).toRawSubstring val []⟩

/--
Creates an identifier with its position copied from the syntax returned by `getRef`.

To refer to a specific constant without a risk of variable capture, use `mkCIdentFromRef` instead.
-/
def mkIdentFromRef [Monad m] [MonadRef m] (val : Name) (canonical := false) : m Ident := do
  return mkIdentFrom (← getRef) val canonical

/--
Creates an identifier referring to a constant `c`. The identifier's position is copied from `src`.

This variant of `mkIdentFrom` makes sure that the identifier cannot accidentally be captured.
-/
def mkCIdentFrom (src : Syntax) (c : Name) (canonical := false) : Ident :=
  -- Remark: We use the reserved macro scope to make sure there are no accidental collision with our frontend
  let id   := addMacroScope `_internal c reservedMacroScope
  ⟨Syntax.ident (SourceInfo.fromRef src canonical) (Name.Internal.Meta.toString id).toRawSubstring id [.decl c []]⟩

/--
Creates an identifier referring to a constant `c`. The identifier's position is copied from the
syntax returned by `getRef`.

This variant of `mkIdentFrom` makes sure that the identifier cannot accidentally be captured.
-/
def mkCIdentFromRef [Monad m] [MonadRef m] (c : Name) (canonical := false) : m Syntax := do
  return mkCIdentFrom (← getRef) c canonical

/--
Creates an identifier that refers to a constant `c`. The identifier has no source position.

This variant of `mkIdent` makes sure that the identifier cannot accidentally be captured.
-/
def mkCIdent (c : Name) : Ident :=
  mkCIdentFrom Syntax.missing c

/--
Creates an identifier from a name. The resulting identifier has no source position.
-/
@[export lean_mk_syntax_ident]
def mkIdent (val : Name) : Ident :=
  ⟨Syntax.ident SourceInfo.none (Name.Internal.Meta.toString val).toRawSubstring val []⟩

/--
Creates a group node, as if it were parsed by `Lean.Parser.group`.
-/
@[inline] def mkGroupNode (args : Array Syntax := #[]) : Syntax :=
  mkNode groupKind args

/--
Creates an array of syntax, separated by `sep`.
-/
def mkSepArray (as : Array Syntax) (sep : Syntax) : Array Syntax := Id.run do
  let mut i := 0
  let mut r := #[]
  for a in as do
    if i > 0 then
      r := r.push sep |>.push a
    else
      r := r.push a
    i := i + 1
  return r

/--
Creates an optional node.

Optional nodes consist of null nodes that contain either zero or one element.
-/
def mkOptionalNode (arg : Option Syntax) : Syntax :=
  match arg with
  | some arg => mkNullNode #[arg]
  | none     => mkNullNode #[]

/--
Creates a hole (`_`). The hole's position is copied from `ref`.
-/
def mkHole (ref : Syntax) (canonical := false) : Syntax :=
  mkNode `Lean.Parser.Term.hole #[mkAtomFrom ref "_" canonical]

namespace Syntax

/--
Creates the syntax of a separated array of items. `sep` is inserted between each item from `a`, and
the result is wrapped in a null node.
-/
def mkSep (a : Array Syntax) (sep : Syntax) : Syntax :=
  mkNullNode <| mkSepArray a sep

/--
Constructs a typed separated array from elements by adding suitable separators.
The provided array should not include the separators.

Like `Syntax.TSepArray.ofElems` but for untyped syntax.
-/
def SepArray.ofElems {sep} (elems : Array Syntax) : SepArray sep :=
⟨mkSepArray elems (if String.Internal.isEmpty sep then mkNullNode else mkAtom sep)⟩

/--
Constructs a typed separated array from elements by adding suitable separators.
The provided array should not include the separators.
The generated separators' source location is that of the syntax returned by `getRef`.
-/
def SepArray.ofElemsUsingRef [Monad m] [MonadRef m] {sep} (elems : Array Syntax) : m (SepArray sep) := do
  let ref ← getRef;
  return ⟨mkSepArray elems (if String.Internal.isEmpty sep then mkNullNode else mkAtomFrom ref sep)⟩

instance : Coe (Array Syntax) (SepArray sep) where
  coe := SepArray.ofElems

/--
Constructs a typed separated array from elements by adding suitable separators.
The provided array should not include the separators.

Like `Syntax.SepArray.ofElems` but for typed syntax.
-/
def TSepArray.ofElems {sep} (elems : Array (TSyntax k)) : TSepArray k sep :=
  .mk (SepArray.ofElems (sep := sep) (TSyntaxArray.raw elems)).1

instance : Coe (TSyntaxArray k) (TSepArray k sep) where
  coe := TSepArray.ofElems

/--
Creates syntax representing a Lean term application, but avoids degenerate empty applications.
-/
def mkApp (fn : Term) : (args : TSyntaxArray `term) → Term
  | #[]  => fn
  | args => ⟨mkNode `Lean.Parser.Term.app #[fn, mkNullNode args.raw]⟩

/--
Creates syntax representing a Lean constant application, but avoids degenerate empty applications.
-/
def mkCApp (fn : Name) (args : TSyntaxArray `term) : Term :=
  mkApp (mkCIdent fn) args

/--
Creates a literal of the given kind. It is the caller's responsibility to ensure that the provided
literal is a valid atom for the provided kind.

If `info` is provided, then the literal's source information is copied from it.
-/
def mkLit (kind : SyntaxNodeKind) (val : String) (info := SourceInfo.none) : TSyntax kind :=
  let atom : Syntax := Syntax.atom info val
  mkNode kind #[atom]

/--
Creates literal syntax for the given character.

If `info` is provided, then the literal's source information is copied from it.
-/
def mkCharLit (val : Char) (info := SourceInfo.none) : CharLit :=
  mkLit charLitKind (Char.quote val) info

/--
Creates literal syntax for the given string.

If `info` is provided, then the literal's source information is copied from it.
-/
def mkStrLit (val : String) (info := SourceInfo.none) : StrLit :=
  mkLit strLitKind (String.quote val) info

/--
Creates literal syntax for a number, which is provided as a string. The caller must ensure that the
string is a valid token for the `num` token parser.

If `info` is provided, then the literal's source information is copied from it.
-/
def mkNumLit (val : String) (info := SourceInfo.none) : NumLit :=
  mkLit numLitKind val info

/--
Creates literal syntax for a natural number.

If `info` is provided, then the literal's source information is copied from it.
-/
def mkNatLit (val : Nat) (info := SourceInfo.none) : NumLit :=
  mkLit numLitKind (toString val) info

/--
Creates literal syntax for a number in scientific notation. The caller must ensure that the provided
string is a valid scientific notation literal.

If `info` is provided, then the literal's source information is copied from it.
-/
def mkScientificLit (val : String) (info := SourceInfo.none) : TSyntax scientificLitKind :=
  mkLit scientificLitKind val info

/--
Creates literal syntax for a name. The caller must ensure that the provided string is a valid name
literal.

If `info` is provided, then the literal's source information is copied from it.
-/
def mkNameLit (val : String) (info := SourceInfo.none) : NameLit :=
  mkLit nameLitKind val info

/-! Recall that we don't have special Syntax constructors for storing numeric and string atoms.
   The idea is to have an extensible approach where embedded DSLs may have new kind of atoms and/or
   different ways of representing them. So, our atoms contain just the parsed string.
   The main Lean parser uses the kind `numLitKind` for storing natural numbers that can be encoded
   in binary, octal, decimal and hexadecimal format. `isNatLit` implements a "decoder"
   for Syntax objects representing these numerals. -/

private partial def decodeBinLitAux (s : String) (i : String.Pos.Raw) (val : Nat) : Option Nat :=
  if String.Internal.atEnd s i then some val
  else
    let c := String.Internal.get s i
    if c == '0' then decodeBinLitAux s (String.Internal.next s i) (2*val)
    else if c == '1' then decodeBinLitAux s (String.Internal.next s i) (2*val + 1)
    else if c == '_' then decodeBinLitAux s (String.Internal.next s i) val
    else none

private partial def decodeOctalLitAux (s : String) (i : String.Pos.Raw) (val : Nat) : Option Nat :=
  if String.Internal.atEnd s i then some val
  else
    let c := String.Internal.get s i
    if '0' ≤ c && c ≤ '7' then decodeOctalLitAux s (String.Internal.next s i) (8*val + c.toNat - '0'.toNat)
    else if c == '_' then decodeOctalLitAux s (String.Internal.next s i) val
    else none

private def decodeHexDigit (s : String) (i : String.Pos.Raw) : Option (Nat × String.Pos.Raw) :=
  let c := String.Internal.get s i
  let i := String.Internal.next s i
  if '0' ≤ c && c ≤ '9' then some (c.toNat - '0'.toNat, i)
  else if 'a' ≤ c && c ≤ 'f' then some (10 + c.toNat - 'a'.toNat, i)
  else if 'A' ≤ c && c ≤ 'F' then some (10 + c.toNat - 'A'.toNat, i)
  else none

private partial def decodeHexLitAux (s : String) (i : String.Pos.Raw) (val : Nat) : Option Nat :=
  if String.Internal.atEnd s i then some val
  else match decodeHexDigit s i with
    | some (d, i) => decodeHexLitAux s i (16*val + d)
    | none        =>
      if String.Internal.get s i == '_' then decodeHexLitAux s (String.Internal.next s i) val
      else none

private partial def decodeDecimalLitAux (s : String) (i : String.Pos.Raw) (val : Nat) : Option Nat :=
  if String.Internal.atEnd s i then some val
  else
    let c := String.Internal.get s i
    if '0' ≤ c && c ≤ '9' then decodeDecimalLitAux s (String.Internal.next s i) (10*val + c.toNat - '0'.toNat)
    else if c == '_' then decodeDecimalLitAux s (String.Internal.next s i) val
    else none

def decodeNatLitVal? (s : String) : Option Nat :=
  let len := String.Internal.length s
  if len == 0 then none
  else
    let c := String.Internal.get s 0
    if c == '0' then
      if len == 1 then some 0
      else
        let c := String.Internal.get s ⟨1⟩
        if c == 'x' || c == 'X' then decodeHexLitAux s ⟨2⟩ 0
        else if c == 'b' || c == 'B' then decodeBinLitAux s ⟨2⟩ 0
        else if c == 'o' || c == 'O' then decodeOctalLitAux s ⟨2⟩ 0
        else if c.isDigit then decodeDecimalLitAux s 0 0
        else none
    else if c.isDigit then decodeDecimalLitAux s 0 0
    else none

def isLit? (litKind : SyntaxNodeKind) (stx : Syntax) : Option String :=
  match stx with
  | Syntax.node _ k args =>
    if h : k == litKind ∧ args.size = 1 then
      match args[0]'(Nat.lt_of_sub_eq_succ h.2) with
      | (Syntax.atom _ val) => some val
      | _ => none
    else
      none
  | _ => none

private def isNatLitAux (litKind : SyntaxNodeKind) (stx : Syntax) : Option Nat :=
  match isLit? litKind stx with
  | some val => decodeNatLitVal? val
  | _        => none

def isNatLit? (s : Syntax) : Option Nat :=
  isNatLitAux numLitKind s

def isFieldIdx? (s : Syntax) : Option Nat :=
  isNatLitAux fieldIdxKind s

/--
Decodes a 'scientific number' string which is consumed by the `OfScientific` class. Takes as input a
string such as `123`, `123.456e7` and returns a triple `(n, sign, e)` with value given by
`n * 10^-e` if `sign` else `n * 10^e`.
-/
partial def decodeScientificLitVal? (s : String) : Option (Nat × Bool × Nat) :=
  let len := String.Internal.length s
  if len == 0 then none
  else
    let c := String.Internal.get s 0
    if c.isDigit then
      decode 0 0
    else none
where
  decodeAfterExp (i : String.Pos.Raw) (val : Nat) (e : Nat) (sign : Bool) (exp : Nat) : Option (Nat × Bool × Nat) :=
    if String.Internal.atEnd s i then
      if sign then
        some (val, sign, exp + e)
      else if exp >= e then
        some (val, sign, exp - e)
      else
        some (val, true, e - exp)
    else
      let c := String.Internal.get s i
      if '0' ≤ c && c ≤ '9' then
        decodeAfterExp (String.Internal.next s i) val e sign (10*exp + c.toNat - '0'.toNat)
      else if c == '_' then
        decodeAfterExp (String.Internal.next s i) val e sign exp
      else
        none

  decodeExp (i : String.Pos.Raw) (val : Nat) (e : Nat) : Option (Nat × Bool × Nat) :=
    if String.Internal.atEnd s i then none else
    let c := String.Internal.get s i
    if c == '-' then
       decodeAfterExp (String.Internal.next s i) val e true 0
    else if c == '+' then
       decodeAfterExp (String.Internal.next s i) val e false 0
    else
       decodeAfterExp i val e false 0

  decodeAfterDot (i : String.Pos.Raw) (val : Nat) (e : Nat) : Option (Nat × Bool × Nat) :=
    if String.Internal.atEnd s i then
      some (val, true, e)
    else
      let c := String.Internal.get s i
      if '0' ≤ c && c ≤ '9' then
        decodeAfterDot (String.Internal.next s i) (10*val + c.toNat - '0'.toNat) (e+1)
      else if c == '_' then
        decodeAfterDot (String.Internal.next s i) val e
      else if c == 'e' || c == 'E' then
        decodeExp (String.Internal.next s i) val e
      else
        none

  decode (i : String.Pos.Raw) (val : Nat) : Option (Nat × Bool × Nat) :=
    if String.Internal.atEnd s i then
      none
    else
      let c := String.Internal.get s i
      if '0' ≤ c && c ≤ '9' then
        decode (String.Internal.next s i) (10*val + c.toNat - '0'.toNat)
      else if c == '_' then
        decode (String.Internal.next s i) val
      else if c == '.' then
        decodeAfterDot (String.Internal.next s i) val 0
      else if c == 'e' || c == 'E' then
        decodeExp (String.Internal.next s i) val 0
      else
        none

def isScientificLit? (stx : Syntax) : Option (Nat × Bool × Nat) :=
  match isLit? scientificLitKind stx with
  | some val => decodeScientificLitVal? val
  | _        => none

def isIdOrAtom? : Syntax → Option String
  | Syntax.atom _ val           => some val
  | Syntax.ident _ rawVal _ _   => some (Substring.Raw.Internal.toString rawVal)
  | _ => none

def toNat (stx : Syntax) : Nat :=
  match stx.isNatLit? with
  | some val => val
  | none     => 0

def decodeQuotedChar (s : String) (i : String.Pos.Raw) : Option (Char × String.Pos.Raw) := do
  let c := String.Internal.get s i
  let i := String.Internal.next s i
  if c == '\\' then pure ('\\', i)
  else if c = '\"' then pure ('\"', i)
  else if c = '\'' then pure ('\'', i)
  else if c = 'r'  then pure ('\r', i)
  else if c = 'n'  then pure ('\n', i)
  else if c = 't'  then pure ('\t', i)
  else if c = 'x'  then
    let (d₁, i) ← decodeHexDigit s i
    let (d₂, i) ← decodeHexDigit s i
    pure (Char.ofNat (16*d₁ + d₂), i)
  else if c = 'u'  then do
    let (d₁, i) ← decodeHexDigit s i
    let (d₂, i) ← decodeHexDigit s i
    let (d₃, i) ← decodeHexDigit s i
    let (d₄, i) ← decodeHexDigit s i
    pure (Char.ofNat (16*(16*(16*d₁ + d₂) + d₃) + d₄), i)
  else
    none

/--
Decodes a valid string gap after the `\`.
Note that this function matches `"\" whitespace+` rather than
the more restrictive `"\" newline whitespace*` since this simplifies the implementation.
Justification: this does not overlap with any other sequences beginning with `\`.
-/
def decodeStringGap (s : String) (i : String.Pos.Raw) : Option String.Pos.Raw := do
  guard <| (String.Internal.get s i).isWhitespace
  some <| String.Internal.nextWhile s Char.isWhitespace (String.Internal.next s i)

partial def decodeStrLitAux (s : String) (i : String.Pos.Raw) (acc : String) : Option String := do
  let c := String.Internal.get s i
  let i := String.Internal.next s i
  if c == '\"' then
    pure acc
  else if String.Internal.atEnd s i then
    none
  else if c == '\\' then do
    if let some (c, i) := decodeQuotedChar s i then
      decodeStrLitAux s i (String.push acc c)
    else if let some i := decodeStringGap s i then
      decodeStrLitAux s i acc
    else
      none
  else
    decodeStrLitAux s i (String.push acc c)

/--
Takes a raw string literal, counts the number of `#`'s after the `r`, and interprets it as a string.
The position `i` should start at `1`, which is the character after the leading `r`.
The algorithm is simple: we are given `r##...#"...string..."##...#` with zero or more `#`s.
By counting the number of leading `#`'s, we can extract the `...string...`.
-/
partial def decodeRawStrLitAux (s : String) (i : String.Pos.Raw) (num : Nat) : String :=
  let c := String.Internal.get s i
  let i := String.Internal.next s i
  if c == '#' then
    decodeRawStrLitAux s i (num + 1)
  else
    String.Internal.extract s i ⟨s.utf8ByteSize - (num + 1)⟩

/--
Takes the string literal lexical syntax parsed by the parser and interprets it as a string.
This is where escape sequences are processed for example.
The string `s` is either a plain string literal or a raw string literal.

If it returns `none` then the string literal is ill-formed, which indicates a bug in the parser.
The function is not required to return `none` if the string literal is ill-formed.
-/
def decodeStrLit (s : String) : Option String :=
  if String.Internal.get s 0 == 'r' then
    some <| decodeRawStrLitAux s ⟨1⟩ 0
  else
    decodeStrLitAux s ⟨1⟩ ""

/--
If the provided `Syntax` is a string literal, returns the string it represents.

Even if the `Syntax` is a `str` node, the function may return `none` if its internally ill-formed.
The parser should always create well-formed `str` nodes.
-/
def isStrLit? (stx : Syntax) : Option String :=
  match isLit? strLitKind stx with
  | some val => decodeStrLit val
  | _        => none

def decodeCharLit (s : String) : Option Char := do
  let c := String.Internal.get s ⟨1⟩
  if c == '\\' then do
    let (c, _) ← decodeQuotedChar s ⟨2⟩
    pure c
  else
    pure c

def isCharLit? (stx : Syntax) : Option Char :=
  match isLit? charLitKind stx with
  | some val => decodeCharLit val
  | _        => none

private partial def splitNameLitAux (ss : Substring.Raw) (acc : List Substring.Raw) : List Substring.Raw :=
  let splitRest (ss : Substring.Raw) (acc : List Substring.Raw) : List Substring.Raw :=
    if Substring.Raw.Internal.front ss == '.' then
      splitNameLitAux (Substring.Raw.Internal.drop ss 1) acc
    else if Substring.Raw.Internal.isEmpty ss then
      acc
    else
      []
  if Substring.Raw.Internal.isEmpty ss then []
  else
    let curr := Substring.Raw.Internal.front ss
    if isIdBeginEscape curr then
      let escapedPart := Substring.Raw.Internal.takeWhile ss (!isIdEndEscape ·)
      let escapedPart := { escapedPart with stopPos := String.Pos.Raw.Internal.min ss.stopPos (String.Internal.next escapedPart.str escapedPart.stopPos) }
      if !isIdEndEscape (Substring.Raw.Internal.get escapedPart <| Substring.Raw.Internal.prev escapedPart ⟨escapedPart.bsize⟩) then []
      else splitRest (Substring.Raw.Internal.extract ss ⟨escapedPart.bsize⟩ ⟨ss.bsize⟩) (escapedPart :: acc)
    else if isIdFirst curr then
      let idPart := Substring.Raw.Internal.takeWhile ss isIdRest
      splitRest (Substring.Raw.Internal.extract ss ⟨idPart.bsize⟩ ⟨ss.bsize⟩) (idPart :: acc)
    else if curr.isDigit then
      let idPart := Substring.Raw.Internal.takeWhile ss Char.isDigit
      splitRest (Substring.Raw.Internal.extract ss ⟨idPart.bsize⟩ ⟨ss.bsize⟩) (idPart :: acc)
    else
      []

/-- Split a name literal (without the backtick) into its dot-separated components. For example,
`foo.bla.«bo.o»` ↦ `["foo", "bla", "«bo.o»"]`. If the literal cannot be parsed, return `[]`. -/
def splitNameLit (ss : Substring.Raw) : List Substring.Raw :=
  splitNameLitAux ss [] |>.reverse

/--
Converts a substring to the Lean compiler's representation of names. The resulting name is
hierarchical, and the string is split at the dots (`'.'`).

`"a.b".toRawSubstring.toName` is the name `a.b`, not `«a.b»`. For the latter, use
`Name.mkSimple ∘ Substring.Raw.toString`.
-- TODO: deprecate old name
-/
def _root_.Substring.Raw.toName (s : Substring.Raw) : Name :=
  match splitNameLitAux s [] with
  | [] => .anonymous
  | comps => comps.foldr (init := Name.anonymous)
    fun comp n =>
      let comp := Substring.Raw.Internal.toString comp
      if isIdBeginEscape (String.Internal.front comp) then
        Name.mkStr n (String.Internal.dropRight (String.Internal.drop comp 1) 1)
      else if (String.Internal.front comp).isDigit then
        if let some k := decodeNatLitVal? comp then
          Name.mkNum n k
        else
          unreachable!
      else
        Name.mkStr n comp

/--
Converts a string to the Lean compiler's representation of names. The resulting name is
hierarchical, and the string is split at the dots (`'.'`).

`"a.b".toName` is the name `a.b`, not `«a.b»`. For the latter, use `Name.mkSimple`.
-/
def _root_.String.toName (s : String) : Name :=
  s.toRawSubstring.toName

def decodeNameLit (s : String) : Option Name :=
  if String.Internal.get s 0 == '`' then
    match (Substring.Raw.Internal.drop s.toRawSubstring 1).toName with
    | .anonymous => none
    | name => some name
  else
    none

def isNameLit? (stx : Syntax) : Option Name :=
  match isLit? nameLitKind stx with
  | some val => decodeNameLit val
  | _        => none

def hasArgs : Syntax → Bool
  | Syntax.node _ _ args => args.size > 0
  | _                    => false

def isAtom : Syntax → Bool
  | atom _ _ => true
  | _        => false

def isToken (token : String) : Syntax → Bool
  | atom _ val => String.Internal.trim val == String.Internal.trim token
  | _          => false

def isNone (stx : Syntax) : Bool :=
  match stx with
  | Syntax.node _ k args => k == nullKind && args.size == 0
  -- when elaborating partial syntax trees, it's reasonable to interpret missing parts as `none`
  | Syntax.missing     => true
  | _                  => false

def getOptionalIdent? (stx : Syntax) : Option Name :=
  match stx.getOptional? with
  | some stx => some stx.getId
  | none     => none

partial def findAux (p : Syntax → Bool) : Syntax → Option Syntax
  | stx@(Syntax.node _ _ args) => if p stx then some stx else args.findSome? (findAux p)
  | stx                        => if p stx then some stx else none

def find? (stx : Syntax) (p : Syntax → Bool) : Option Syntax :=
  findAux p stx

end Syntax

namespace TSyntax

/--
Interprets a numeric literal as a natural number.

Returns `0` if the syntax is malformed.
-/
def getNat (s : NumLit) : Nat :=
  s.raw.isNatLit?.getD 0

private def isHexNum? (stx : Syntax) : Option Nat :=
  match Syntax.isLit? hexnumKind stx with
  | some val => Syntax.decodeHexLitAux val 0 0
  | _        => none

/-- Returns the value of the hexadecimal numeral as a natural number. -/
def getHexNumVal (s : Syntax.HexNum) : Nat :=
  isHexNum? s.raw |>.getD 0

/-- Returns the number of hexadecimal digits. -/
partial def getHexNumSize (s : Syntax.HexNum) : Nat :=
  match Syntax.isLit? hexnumKind s.raw with
  | some val => go val 0 0
  | _        => 0
where
  go (s : String) (p : String.Pos.Raw) (n : Nat) : Nat :=
    if String.Internal.atEnd s p then
      n
    else
      go s (String.Internal.next s p) (if String.Internal.get s p = '_' then n else n + 1)

/--
Extracts the parsed name from the syntax of an identifier.

Returns `Name.anonymous` if the syntax is malformed.
-/
def getId (s : Ident) : Name :=
  s.raw.getId

/--
Extracts the components of a scientific numeric literal.

Returns a triple `(n, sign, e) : Nat × Bool × Nat`; the number's value is given by:

```
if sign then n * 10 ^ (-e) else n * 10 ^ e
```

Returns `(0, false, 0)` if the syntax is malformed.
-/
def getScientific (s : ScientificLit) : Nat × Bool × Nat :=
  s.raw.isScientificLit?.getD (0, false, 0)

/--
Decodes a string literal, removing quotation marks and unescaping escaped characters.

Returns `""` if the syntax is malformed.
-/
def getString (s : StrLit) : String :=
  s.raw.isStrLit?.getD ""

/--
Decodes a character literal.

Returns `(default : Char)` if the syntax is malformed.
-/
def getChar (s : CharLit) : Char :=
  s.raw.isCharLit?.getD default

/--
Decodes a quoted name literal, returning the name.

Returns `Lean.Name.anonymous` if the syntax is malformed.
-/
def getName (s : NameLit) : Name :=
  s.raw.isNameLit?.getD .anonymous

/--
Decodes macro hygiene information.
-/
def getHygieneInfo (s : HygieneInfo) : Name :=
  s.raw[0].getId

namespace Compat

scoped instance : CoeTail (Array Syntax) (Syntax.TSepArray k sep) where
  coe a := (a : TSyntaxArray k)

end Compat

end TSyntax

def HygieneInfo.mkIdent (s : HygieneInfo) (val : Name) (canonical := false) : Ident :=
  let src := s.raw[0]
  let id := { extractMacroScopes src.getId with name := val.eraseMacroScopes }.review
  ⟨Syntax.ident (SourceInfo.fromRef src canonical) (Name.Internal.Meta.toString val).toRawSubstring id []⟩

/--
Converts a runtime value into surface syntax that denotes it.

Instances do not need to guarantee that the resulting syntax will always re-elaborate into an
equivalent value. For example, the syntax may omit implicit arguments that can usually be found
automatically.
-/
class Quote (α : Type) (k : SyntaxNodeKind := `term) where
  /--
  Returns syntax for the given value.
  -/
  quote : α → TSyntax k

export Quote (quote)

set_option synthInstance.checkSynthOrder false in
instance [Quote α k] [CoeHTCT (TSyntax k) (TSyntax [k'])] : Quote α k' := ⟨fun a => quote (k := k) a⟩

instance : Quote Term := ⟨id⟩
instance : Quote Bool := ⟨fun | true => mkCIdent ``Bool.true | false => mkCIdent ``Bool.false⟩
instance : Quote Char charLitKind := ⟨Syntax.mkCharLit⟩
instance : Quote String strLitKind := ⟨Syntax.mkStrLit⟩
instance : Quote Nat numLitKind := ⟨fun n => Syntax.mkNumLit <| toString n⟩
instance : Quote Substring.Raw := ⟨fun s => Syntax.mkCApp ``String.toRawSubstring' #[quote (Substring.Raw.Internal.toString s)]⟩

-- in contrast to `Name.toString`, we can, and want to be, precise here
private def getEscapedNameParts? (acc : List String) : Name → Option (List String)
  | Name.anonymous => if acc.isEmpty then none else some acc
  | Name.str n s => do
    let s ← Name.Internal.Meta.escapePart s false
    getEscapedNameParts? (s::acc) n
  | Name.num _ _ => none

def quoteNameMk : Name → Term
  | .anonymous => mkCIdent ``Name.anonymous
  | .str n s => Syntax.mkCApp ``Name.mkStr #[quoteNameMk n, quote s]
  | .num n i => Syntax.mkCApp ``Name.mkNum #[quoteNameMk n, quote i]

instance : Quote Name `term where
  quote n := private
    match getEscapedNameParts? [] n with
    | some ss => ⟨mkNode `Lean.Parser.Term.quotedName #[Syntax.mkNameLit (String.Internal.append "`" (String.Internal.intercalate "." ss))]⟩
    | none    => ⟨quoteNameMk n⟩

instance [Quote α `term] [Quote β `term] : Quote (α × β) `term where
  quote
    | ⟨a, b⟩ => Syntax.mkCApp ``Prod.mk #[quote a, quote b]

private def quoteList [Quote α `term] : List α → Term
  | []      => mkCIdent ``List.nil
  | (x::xs) => Syntax.mkCApp ``List.cons #[quote x, quoteList xs]

instance [Quote α `term] : Quote (List α) `term where
  quote := private quoteList

private def quoteArray [Quote α `term] (xs : Array α) : Term :=
  if xs.size <= 8 then
    go 0 #[]
  else
    Syntax.mkCApp ``List.toArray #[quote xs.toList]
where
  go (i : Nat) (args : Array Term) : Term :=
    if h : i < xs.size then
      go (i+1) (args.push (quote xs[i]))
    else
      Syntax.mkCApp (Name.mkStr2 "Array" (String.Internal.append "mkArray" (toString xs.size))) args
  termination_by xs.size - i
  decreasing_by decreasing_trivial_pre_omega

instance [Quote α `term] : Quote (Array α) `term where
  quote := private quoteArray

instance Option.hasQuote {α : Type} [Quote α `term] : Quote (Option α) `term where
  quote
    | none     => mkIdent ``none
    | (some x) => Syntax.mkCApp ``some #[quote x]


/-- Evaluator for `prec` DSL -/
def evalPrec (stx : Syntax) : MacroM Nat :=
  Macro.withIncRecDepth stx do
    let stx ← expandMacros stx
    match stx with
    | `(prec| $num:num) => return num.getNat
    | _ => Macro.throwErrorAt stx "unexpected precedence"

/-- Evaluator for `prio` DSL -/
def evalPrio (stx : Syntax) : MacroM Nat :=
  Macro.withIncRecDepth stx do
    let stx ← expandMacros stx
    match stx with
    | `(prio| $num:num) => return num.getNat
    | _ => Macro.throwErrorAt stx "unexpected priority"

def evalOptPrio : Option (TSyntax `prio) → MacroM Nat
  | some prio => evalPrio prio
  | none      => return 1000 -- TODO: FIX back eval_prio default

end Lean

namespace Array

abbrev getSepElems := @getEvenElems

open Lean

private partial def filterSepElemsMAux {m : Type → Type} [Monad m] (a : Array Syntax) (p : Syntax → m Bool) (i : Nat) (acc : Array Syntax) : m (Array Syntax) := do
  if h : i < a.size then
    let stx := a[i]
    if (← p stx) then
      if acc.isEmpty then
        filterSepElemsMAux a p (i+2) (acc.push stx)
      else if hz : i ≠ 0 then
        have : i.pred < i := Nat.pred_lt hz
        have : i.pred < a.size := Nat.lt_trans this h
        let sepStx := a[i.pred]
        filterSepElemsMAux a p (i+2) ((acc.push sepStx).push stx)
      else
        filterSepElemsMAux a p (i+2) (acc.push stx)
    else
      filterSepElemsMAux a p (i+2) acc
  else
    pure acc

/--
Filters an array of syntax, treating every other element as a separator rather than an element to
test with the monadic predicate `p`. The resulting array contains the tested elements for which `p`
returns `true`, separated by the corresponding separator elements.
-/
def filterSepElemsM {m : Type → Type} [Monad m] (a : Array Syntax) (p : Syntax → m Bool) : m (Array Syntax) :=
  filterSepElemsMAux a p 0 #[]

/--
Filters an array of syntax, treating every other element as a separator rather than an element to
test with the predicate `p`. The resulting array contains the tested elements for which `p` returns
`true`, separated by the corresponding separator elements.
-/
def filterSepElems (a : Array Syntax) (p : Syntax → Bool) : Array Syntax :=
  Id.run <| a.filterSepElemsM (pure <| p ·)

private partial def mapSepElemsMAux {m : Type → Type} [Monad m] (a : Array Syntax) (f : Syntax → m Syntax) (i : Nat) (acc : Array Syntax) : m (Array Syntax) := do
  if h : i < a.size then
    let stx := a[i]
    if i % 2 == 0 then do
      let stx ← f stx
      mapSepElemsMAux a f (i+1) (acc.push stx)
    else
      mapSepElemsMAux a f (i+1) (acc.push stx)
  else
    pure acc

def mapSepElemsM {m : Type → Type} [Monad m] (a : Array Syntax) (f : Syntax → m Syntax) : m (Array Syntax) :=
  mapSepElemsMAux a f 0 #[]

def mapSepElems (a : Array Syntax) (f : Syntax → Syntax) : Array Syntax :=
  Id.run <| a.mapSepElemsM (pure <| f ·)

end Array

namespace Lean.Syntax

/--
Extracts the non-separator elements of a separated array.
-/
def SepArray.getElems (sa : SepArray sep) : Array Syntax :=
  sa.elemsAndSeps.getSepElems

@[inherit_doc SepArray.getElems]
def TSepArray.getElems (sa : TSepArray k sep) : TSyntaxArray k :=
  .mk sa.elemsAndSeps.getSepElems

/--
Adds an element to the end of a separated array, adding a separator as needed.
-/
def TSepArray.push (sa : TSepArray k sep) (e : TSyntax k) : TSepArray k sep :=
  if sa.elemsAndSeps.isEmpty then
    { elemsAndSeps := #[e] }
  else
    { elemsAndSeps := sa.elemsAndSeps.push (mkAtom sep) |>.push e }

instance : EmptyCollection (SepArray sep) where
  emptyCollection := ⟨∅⟩

instance : EmptyCollection (TSepArray sep k) where
  emptyCollection := ⟨∅⟩

instance : CoeOut (SepArray sep) (Array Syntax) where
  coe := SepArray.getElems

instance : CoeOut (TSepArray k sep) (TSyntaxArray k) where
  coe := TSepArray.getElems

instance [Coe (TSyntax k) (TSyntax k')] : Coe (TSyntaxArray k) (TSyntaxArray k') where
  coe a := a.map Coe.coe

instance : CoeOut (TSyntaxArray k) (Array Syntax) where
  coe a := a.raw

instance : Coe Ident (TSyntax `Lean.Parser.Command.declId) where
  coe id := mkNode _ #[id, mkNullNode #[]]

instance : Coe (Lean.Term) (Lean.TSyntax `Lean.Parser.Term.funBinder) where
  coe stx := ⟨stx⟩

end Lean.Syntax

/-! # Helper functions for manipulating interpolated strings -/

namespace Lean.Syntax

private def decodeInterpStrQuotedChar (s : String) (i : String.Pos.Raw) : Option (Char × String.Pos.Raw) := do
  match decodeQuotedChar s i with
  | some r => some r
  | none   =>
    let c := String.Internal.get s i
    let i := String.Internal.next s i
    if c == '{' then pure ('{', i)
    else none

private partial def decodeInterpStrLit (s : String) : Option String :=
  let rec loop (i : String.Pos.Raw) (acc : String) : Option String :=
    let c := String.Internal.get s i
    let i := String.Internal.next s i
    if c == '\"' || c == '{' then
      pure acc
    else if String.Internal.atEnd s i then
      none
    else if c == '\\' then do
      if let some (c, i) := decodeInterpStrQuotedChar s i then
        loop i (String.push acc c)
      else if let some i := decodeStringGap s i then
        loop i acc
      else
        none
    else
      loop i (String.push acc c)
  loop ⟨1⟩ ""

partial def isInterpolatedStrLit? (stx : Syntax) : Option String :=
  match isLit? interpolatedStrLitKind stx with
  | none     => none
  | some val => decodeInterpStrLit val

def getSepArgs (stx : Syntax) : Array Syntax :=
  stx.getArgs.getSepElems

end Syntax

namespace TSyntax

def expandInterpolatedStrChunks (chunks : Array Syntax) (mkAppend : Syntax → Syntax → MacroM Syntax)
  (mkElem : Syntax → MacroM Syntax) (mkLit : String → MacroM Syntax) : MacroM Syntax := do
  let mut result := Syntax.missing
  for elem in chunks do
    let elem ← match elem.isInterpolatedStrLit? with
      | none     => withRef elem <| mkElem elem
      | some str =>
        if String.Internal.isEmpty str then continue
        else withRef elem <| mkLit str
    if result.isMissing then
      result := elem
    else
      result ← mkAppend result elem
  if result.isMissing then
    mkLit ""
  else
    return result

open TSyntax.Compat in
/-- Expand `interpStr` into a term of type `type` (which supports ` ++ `),
calling `ofInterpFn` on terms within `{}`,
and `ofLitFn` on the literals between the interpolations. -/
def expandInterpolatedStr (interpStr : TSyntax interpolatedStrKind) (type : Term) (ofInterpFn : Term) (ofLitFn : Term := ofInterpFn) : MacroM Term := do
  let r ← expandInterpolatedStrChunks interpStr.raw.getArgs
    (fun a b => `($a ++ $b))
    (fun a => `($ofInterpFn $a))
    (fun s => `($ofLitFn $(Syntax.mkStrLit s)))
  `(($r : $type))

def getDocString (stx : TSyntax `Lean.Parser.Command.docComment) : String :=
  match stx.raw[1] with
  | Syntax.atom _ val => String.Internal.extract val 0 (String.Pos.Raw.Internal.sub val.rawEndPos ⟨2⟩)
  | _                 => ""

end TSyntax

namespace Meta

deriving instance Repr for TransparencyMode, EtaStructMode, DSimp.Config, Simp.Config

def Occurrences.contains : Occurrences → Nat → Bool
  | all,      _   => true
  | pos idxs, idx => idxs.contains idx
  | neg idxs, idx => !idxs.contains idx

def Occurrences.isAll : Occurrences → Bool
  | all => true
  | _   => false

/--
Controls which new mvars are turned in to goals by the `apply` tactic.
- `nonDependentFirst`  mvars that don't depend on other goals appear first in the goal list.
- `nonDependentOnly` only mvars that don't depend on other goals are added to goal list.
- `all` all unassigned mvars are added to the goal list.
-/
-- TODO: Consider renaming to `Apply.NewGoals`
inductive ApplyNewGoals where
  | nonDependentFirst | nonDependentOnly | all

/-- Configures the behaviour of the `apply` tactic. -/
-- TODO: Consider renaming to `Apply.Config`
structure ApplyConfig where
  newGoals := ApplyNewGoals.nonDependentFirst
  /--
  If `synthAssignedInstances` is `true`, then `apply` will synthesize instance implicit arguments
  even if they have assigned by `isDefEq`, and then check whether the synthesized value matches the
  one inferred. The `congr` tactic sets this flag to false.
  -/
  synthAssignedInstances := true
  /--
  If `allowSynthFailures` is `true`, then `apply` will return instance implicit arguments
  for which typeclass search failed as new goals.
  -/
  allowSynthFailures := false
  /--
  If `approx := true`, then we turn on `isDefEq` approximations. That is, we use
  the `approxDefEq` combinator.
  -/
  approx : Bool := true

namespace Rewrite

@[inherit_doc ApplyNewGoals]
abbrev NewGoals := ApplyNewGoals

/-- Configures the behavior of the `rewrite` and `rw` tactics. -/
structure Config where
  /-- The transparency mode to use for unfolding -/
  transparency : TransparencyMode := .reducible
  /-- Whether to support offset constraints such as `?x + 1 =?= e` -/
  offsetCnstrs : Bool := true
  /-- Which occurrences to rewrite-/
  occs : Occurrences := .all
  /-- How to convert the resulting metavariables into  new goals -/
  newGoals : NewGoals := .nonDependentFirst

end Rewrite

namespace Omega

/-- Configures the behaviour of the `omega` tactic. -/
structure OmegaConfig where
  /--
  Split disjunctions in the context.

  Note that with `splitDisjunctions := false` omega will not be able to solve `x = y` goals
  as these are usually handled by introducing `¬ x = y` as a hypothesis, then replacing this with
  `x < y ∨ x > y`.

  On the other hand, `omega` does not currently detect disjunctions which, when split,
  introduce no new useful information, so the presence of irrelevant disjunctions in the context
  can significantly increase run time.
  -/
  splitDisjunctions : Bool := true
  /--
  Whenever `((a - b : Nat) : Int)` is found, register the disjunction
  `b ≤ a ∧ ((a - b : Nat) : Int) = a - b ∨ a < b ∧ ((a - b : Nat) : Int) = 0`
  for later splitting.
  -/
  splitNatSub : Bool := true
  /--
  Whenever `Int.natAbs a` is found, register the disjunction
  `0 ≤ a ∧ Int.natAbs a = a ∨ a < 0 ∧ Int.natAbs a = - a` for later splitting.
  -/
  splitNatAbs : Bool := true
  /--
  Whenever `min a b` or `max a b` is found, rewrite in terms of the definition
  `if a ≤ b ...`, for later case splitting.
  -/
  splitMinMax : Bool := true

end Omega

namespace CheckTactic

/--
Type used to lift an arbitrary value into a type parameter so it can
appear in a proof goal.

It is used by the #check_tactic command.
-/
inductive CheckGoalType {α : Sort u} : (val : α) → Prop where
| intro : (val : α) → CheckGoalType val

end CheckTactic

end Meta

namespace Parser

namespace Tactic

/--
Extracts the items from a tactic configuration,
either a `Lean.Parser.Tactic.optConfig`, `Lean.Parser.Tactic.config`, or these wrapped in null nodes.
-/
partial def getConfigItems (c : Syntax) : TSyntaxArray ``configItem :=
  if c.isOfKind nullKind then
    c.getArgs.flatMap getConfigItems
  else
    match c with
    | `(optConfig| $items:configItem*) => items
    | `(config| (config := $_)) => #[⟨c⟩] -- handled by mkConfigItemViews
    | _ => #[]

def mkOptConfig (items : TSyntaxArray ``configItem) : TSyntax ``optConfig :=
  ⟨Syntax.node1 .none ``optConfig (mkNullNode items)⟩

/--
Appends two tactic configurations.
The configurations can be `Lean.Parser.Tactic.optConfig`, `Lean.Parser.Tactic.config`,
or these wrapped in null nodes (for example because the syntax is `(config)?`).
-/
def appendConfig (cfg cfg' : Syntax) : TSyntax ``optConfig :=
  mkOptConfig <| getConfigItems cfg ++ getConfigItems cfg'