684 lines
22 KiB
Text
684 lines
22 KiB
Text
/-
|
||
Copyright (c) 2018 Microsoft Corporation. All rights reserved.
|
||
Released under Apache 2.0 license as described in the file LICENSE.
|
||
Authors: Leonardo de Moura
|
||
-/
|
||
prelude
|
||
import Init.Lean.Level
|
||
import Init.Lean.KVMap
|
||
import Init.Data.HashMap
|
||
import Init.Data.HashSet
|
||
import Init.Data.PersistentHashMap
|
||
import Init.Data.PersistentHashSet
|
||
|
||
namespace Lean
|
||
|
||
inductive Literal
|
||
| natVal (val : Nat)
|
||
| strVal (val : String)
|
||
|
||
inductive BinderInfo
|
||
| default | implicit | strictImplicit | instImplicit | auxDecl
|
||
|
||
namespace BinderInfo
|
||
|
||
def isInstImplicit : BinderInfo → Bool
|
||
| instImplicit => true
|
||
| _ => false
|
||
|
||
def isAuxDecl : BinderInfo → Bool
|
||
| auxDecl => true
|
||
| _ => false
|
||
|
||
protected def beq : BinderInfo → BinderInfo → Bool
|
||
| default, default => true
|
||
| implicit, implicit => true
|
||
| strictImplicit, strictImplicit => true
|
||
| instImplicit, instImplicit => true
|
||
| auxDecl, auxDecl => true
|
||
| _, _ => false
|
||
|
||
instance : HasBeq BinderInfo := ⟨BinderInfo.beq⟩
|
||
|
||
end BinderInfo
|
||
|
||
abbrev MData := KVMap
|
||
namespace MData
|
||
abbrev empty : MData := {KVMap .}
|
||
instance : HasEmptyc MData := ⟨empty⟩
|
||
end MData
|
||
|
||
/--
|
||
Cached data for `Expr`.
|
||
hash : 32-bits
|
||
hasFVar : 1-bit
|
||
hasExprMVar : 1-bit
|
||
hasLevelMVar : 1-bit
|
||
hasLevelParam : 1-bit
|
||
nonDepLet : 1-bit
|
||
binderInfo : 3-bits
|
||
looseBVarRange : 24-bits -/
|
||
private def ExprCachedData := UInt64
|
||
|
||
instance ExprCachedData.inhabited : Inhabited ExprCachedData :=
|
||
inferInstanceAs (Inhabited UInt64)
|
||
|
||
def ExprCachedData.hash (c : ExprCachedData) : USize :=
|
||
c.toUInt32.toUSize
|
||
|
||
def ExprCachedData.looseBVarRange (c : ExprCachedData) : UInt32 :=
|
||
(c.shiftRight 40).toUInt32
|
||
|
||
def ExprCachedData.hasFVar (c : ExprCachedData) : Bool :=
|
||
((c.shiftRight 32).land 1) == 1
|
||
|
||
def ExprCachedData.hasExprMVar (c : ExprCachedData) : Bool :=
|
||
((c.shiftRight 33).land 1) == 1
|
||
|
||
def ExprCachedData.hasLevelMVar (c : ExprCachedData) : Bool :=
|
||
((c.shiftRight 34).land 1) == 1
|
||
|
||
def ExprCachedData.hasLevelParam (c : ExprCachedData) : Bool :=
|
||
((c.shiftRight 35).land 1) == 1
|
||
|
||
def ExprCachedData.nonDepLet (c : ExprCachedData) : Bool :=
|
||
((c.shiftRight 36).land 1) == 1
|
||
|
||
@[extern c inline "(uint8_t)((#1 << 24) >> 61)"]
|
||
def ExprCachedData.binderInfo (c : ExprCachedData) : BinderInfo :=
|
||
let bi := (c.shiftLeft 24).shiftRight 61;
|
||
if bi == 0 then BinderInfo.default
|
||
else if bi == 1 then BinderInfo.implicit
|
||
else if bi == 2 then BinderInfo.strictImplicit
|
||
else if bi == 3 then BinderInfo.instImplicit
|
||
else BinderInfo.auxDecl
|
||
|
||
@[extern c inline "(uint64_t)#1"]
|
||
def BinderInfo.toUInt64 : BinderInfo → UInt64
|
||
| BinderInfo.default => 0
|
||
| BinderInfo.implicit => 1
|
||
| BinderInfo.strictImplicit => 2
|
||
| BinderInfo.instImplicit => 3
|
||
| BinderInfo.auxDecl => 4
|
||
|
||
@[inline] private def mkExprCachedDataCore
|
||
(h : USize) (looseBVarRange : Nat)
|
||
(hasFVar hasExprMVar hasLevelMVar hasLevelParam nonDepLet : Bool) (bi : BinderInfo)
|
||
: ExprCachedData :=
|
||
if looseBVarRange > Nat.pow 2 24 - 1 then panic! "bound variable index is too big"
|
||
else
|
||
let r : UInt64 :=
|
||
h.toUInt32.toUInt64 +
|
||
hasFVar.toUInt64.shiftLeft 32 +
|
||
hasExprMVar.toUInt64.shiftLeft 33 +
|
||
hasLevelMVar.toUInt64.shiftLeft 34 +
|
||
hasLevelParam.toUInt64.shiftLeft 35 +
|
||
nonDepLet.toUInt64.shiftLeft 36 +
|
||
bi.toUInt64.shiftLeft 37 +
|
||
looseBVarRange.toUInt64.shiftLeft 40;
|
||
r
|
||
|
||
def mkExprCachedData (h : USize) (looseBVarRange : Nat) (hasFVar hasExprMVar hasLevelMVar hasLevelParam : Bool) : ExprCachedData :=
|
||
mkExprCachedDataCore h looseBVarRange hasFVar hasExprMVar hasLevelMVar hasLevelParam false BinderInfo.default
|
||
|
||
def mkExprCachedDataForBinder (h : USize) (looseBVarRange : Nat) (hasFVar hasExprMVar hasLevelMVar hasLevelParam : Bool) (bi : BinderInfo) : ExprCachedData :=
|
||
mkExprCachedDataCore h looseBVarRange hasFVar hasExprMVar hasLevelMVar hasLevelParam false bi
|
||
|
||
def mkExprCachedDataForLet (h : USize) (looseBVarRange : Nat) (hasFVar hasExprMVar hasLevelMVar hasLevelParam nonDepLet : Bool) : ExprCachedData :=
|
||
mkExprCachedDataCore h looseBVarRange hasFVar hasExprMVar hasLevelMVar hasLevelParam nonDepLet BinderInfo.default
|
||
|
||
/- We use the `E` suffix (short for `Expr`) to avoid collision with keywords.
|
||
We considered using «...», but it is too inconvenient to use. -/
|
||
inductive Expr
|
||
| bvar : Nat → Expr -- bound variables
|
||
| fvar : Name → Expr -- free variables
|
||
| mvar : Name → Expr -- meta variables
|
||
| sort : Level → Expr -- Sort
|
||
| const : Name → List Level → Expr -- constants
|
||
| app : Expr → Expr → Expr -- application
|
||
| lam : Name → BinderInfo → Expr → Expr → Expr -- lambda abstraction
|
||
| forallE : Name → BinderInfo → Expr → Expr → Expr -- (dependent) arrow
|
||
| letE : Name → Expr → Expr → Expr → Expr -- let expressions
|
||
| lit : Literal → Expr -- literals
|
||
| mdata : MData → Expr → Expr -- metadata
|
||
| proj : Name → Nat → Expr → Expr -- projection
|
||
|
||
instance Expr.inhabited : Inhabited Expr :=
|
||
⟨Expr.sort Level.zero⟩
|
||
|
||
attribute [extern "lean_expr_mk_bvar"] Expr.bvar
|
||
attribute [extern "lean_expr_mk_fvar"] Expr.fvar
|
||
attribute [extern "lean_expr_mk_mvar"] Expr.mvar
|
||
attribute [extern "lean_expr_mk_sort"] Expr.sort
|
||
attribute [extern "lean_expr_mk_const"] Expr.const
|
||
attribute [extern "lean_expr_mk_app"] Expr.app
|
||
attribute [extern "lean_expr_mk_lambda"] Expr.lam
|
||
attribute [extern "lean_expr_mk_forall"] Expr.forallE
|
||
attribute [extern "lean_expr_mk_let"] Expr.letE
|
||
attribute [extern "lean_expr_mk_lit"] Expr.lit
|
||
attribute [extern "lean_expr_mk_mdata"] Expr.mdata
|
||
attribute [extern "lean_expr_mk_proj"] Expr.proj
|
||
|
||
def mkLit (l : Literal) : Expr :=
|
||
Expr.lit l
|
||
|
||
def mkNatLit (n : Nat) : Expr :=
|
||
mkLit (Literal.natVal n)
|
||
|
||
def mkStrLit (s : String) : Expr :=
|
||
mkLit (Literal.strVal s)
|
||
|
||
def mkConst (n : Name) (ls : List Level := []) : Expr :=
|
||
Expr.const n ls
|
||
|
||
namespace Literal
|
||
instance : Inhabited Literal := ⟨natVal 0⟩
|
||
def type : Literal → Expr
|
||
| natVal _ => mkConst `Nat
|
||
| strVal _ => mkConst `String
|
||
end Literal
|
||
|
||
def mkBVar (idx : Nat) : Expr :=
|
||
Expr.bvar idx
|
||
|
||
def mkSort (lvl : Level) : Expr :=
|
||
Expr.sort lvl
|
||
|
||
def mkFVar (fvarId : Name) : Expr :=
|
||
Expr.fvar fvarId
|
||
|
||
def mkMVar (fvarId : Name) : Expr :=
|
||
Expr.mvar fvarId
|
||
|
||
def mkMData (d : MData) (e : Expr) : Expr :=
|
||
Expr.mdata d e
|
||
|
||
def mkProj (s : Name) (i : Nat) (e : Expr) : Expr :=
|
||
Expr.proj s i e
|
||
|
||
def mkApp (f a : Expr) : Expr :=
|
||
Expr.app f a
|
||
|
||
def mkAppN (f : Expr) (args : Array Expr) : Expr :=
|
||
args.foldl mkApp f
|
||
|
||
def mkLambda (x : Name) (bi : BinderInfo) (t : Expr) (b : Expr) : Expr :=
|
||
Expr.lam x bi t b
|
||
|
||
def mkForall (x : Name) (bi : BinderInfo) (t : Expr) (b : Expr) : Expr :=
|
||
Expr.forallE x bi t b
|
||
|
||
def mkLet (x : Name) (t : Expr) (v : Expr) (b : Expr) : Expr :=
|
||
Expr.letE x t v b
|
||
|
||
private partial def mkAppRangeAux (n : Nat) (args : Array Expr) : Nat → Expr → Expr
|
||
| i, e => if i < n then mkAppRangeAux (i+1) (mkApp e (args.get! i)) else e
|
||
|
||
/-- `mkAppRange f i j #[a_1, ..., a_i, ..., a_j, ... ]` ==> the expression `f a_i ... a_{j-1}` -/
|
||
def mkAppRange (f : Expr) (i j : Nat) (args : Array Expr) : Expr :=
|
||
mkAppRangeAux j args i f
|
||
|
||
def mkAppRev (fn : Expr) (revArgs : Array Expr) : Expr :=
|
||
revArgs.foldr (fun a r => mkApp r a) fn
|
||
|
||
namespace Expr
|
||
@[extern "lean_expr_hash"]
|
||
constant hash (n : @& Expr) : USize := arbitrary USize
|
||
|
||
instance : Hashable Expr := ⟨Expr.hash⟩
|
||
|
||
-- TODO: implement it in Lean
|
||
@[extern "lean_expr_dbg_to_string"]
|
||
constant dbgToString (e : @& Expr) : String := arbitrary String
|
||
|
||
@[extern "lean_expr_quick_lt"]
|
||
constant quickLt (a : @& Expr) (b : @& Expr) : Bool := arbitrary _
|
||
|
||
@[extern "lean_expr_lt"]
|
||
constant lt (a : @& Expr) (b : @& Expr) : Bool := arbitrary _
|
||
|
||
/- Return true iff `a` and `b` are alpha equivalent.
|
||
Binder annotations are ignored. -/
|
||
@[extern "lean_expr_eqv"]
|
||
constant eqv (a : @& Expr) (b : @& Expr) : Bool := arbitrary _
|
||
|
||
instance : HasBeq Expr := ⟨Expr.eqv⟩
|
||
|
||
/- Return true iff `a` and `b` are equal.
|
||
Binder names and annotations are taking into account. -/
|
||
@[extern "lean_expr_equal"]
|
||
constant equal (a : @& Expr) (b : @& Expr) : Bool := arbitrary _
|
||
|
||
@[extern "lean_expr_has_expr_mvar"]
|
||
constant hasExprMVar (a : @& Expr) : Bool := arbitrary _
|
||
|
||
@[extern "lean_expr_has_level_mvar"]
|
||
constant hasLevelMVar (a : @& Expr) : Bool := arbitrary _
|
||
|
||
@[inline] def hasMVar (a : Expr) : Bool :=
|
||
a.hasExprMVar || a.hasLevelMVar
|
||
|
||
@[extern "lean_expr_has_fvar"]
|
||
constant hasFVar (a : @& Expr) : Bool := arbitrary _
|
||
|
||
def isSort : Expr → Bool
|
||
| sort _ => true
|
||
| _ => false
|
||
|
||
def isBVar : Expr → Bool
|
||
| bvar _ => true
|
||
| _ => false
|
||
|
||
def isMVar : Expr → Bool
|
||
| mvar _ => true
|
||
| _ => false
|
||
|
||
def isFVar : Expr → Bool
|
||
| fvar _ => true
|
||
| _ => false
|
||
|
||
def isApp : Expr → Bool
|
||
| app _ _ => true
|
||
| _ => false
|
||
|
||
def isProj : Expr → Bool
|
||
| proj _ _ _ => true
|
||
| _ => false
|
||
|
||
def isConst : Expr → Bool
|
||
| const _ _ => true
|
||
| _ => false
|
||
|
||
def isConstOf : Expr → Name → Bool
|
||
| const n _, m => n == m
|
||
| _, _ => false
|
||
|
||
def isForall : Expr → Bool
|
||
| forallE _ _ _ _ => true
|
||
| _ => false
|
||
|
||
def isLambda : Expr → Bool
|
||
| lam _ _ _ _ => true
|
||
| _ => false
|
||
|
||
def isBinding : Expr → Bool
|
||
| lam _ _ _ _ => true
|
||
| forallE _ _ _ _ => true
|
||
| _ => false
|
||
|
||
def isLet : Expr → Bool
|
||
| letE _ _ _ _ => true
|
||
| _ => false
|
||
|
||
def isMData : Expr → Bool
|
||
| mdata _ _ => true
|
||
| _ => false
|
||
|
||
def getAppFn : Expr → Expr
|
||
| app f a => getAppFn f
|
||
| e => e
|
||
|
||
def getAppNumArgsAux : Expr → Nat → Nat
|
||
| app f a, n => getAppNumArgsAux f (n+1)
|
||
| e, n => n
|
||
|
||
def getAppNumArgs (e : Expr) : Nat :=
|
||
getAppNumArgsAux e 0
|
||
|
||
private def getAppArgsAux : Expr → Array Expr → Nat → Array Expr
|
||
| app f a, as, i => getAppArgsAux f (as.set! i a) (i-1)
|
||
| _, as, _ => as
|
||
|
||
@[inline] def getAppArgs (e : Expr) : Array Expr :=
|
||
let dummy := mkSort Level.zero;
|
||
let nargs := e.getAppNumArgs;
|
||
getAppArgsAux e (mkArray nargs dummy) (nargs-1)
|
||
|
||
private def getAppRevArgsAux : Expr → Array Expr → Array Expr
|
||
| app f a, as => getAppRevArgsAux f (as.push a)
|
||
| _, as => as
|
||
|
||
@[inline] def getAppRevArgs (e : Expr) : Array Expr :=
|
||
getAppRevArgsAux e (Array.mkEmpty e.getAppNumArgs)
|
||
|
||
@[specialize] def withAppAux {α} (k : Expr → Array Expr → α) : Expr → Array Expr → Nat → α
|
||
| app f a, as, i => withAppAux f (as.set! i a) (i-1)
|
||
| f, as, i => k f as
|
||
|
||
@[inline] def withApp {α} (e : Expr) (k : Expr → Array Expr → α) : α :=
|
||
let dummy := mkSort Level.zero;
|
||
let nargs := e.getAppNumArgs;
|
||
withAppAux k e (mkArray nargs dummy) (nargs-1)
|
||
|
||
@[specialize] private def withAppRevAux {α} (k : Expr → Array Expr → α) : Expr → Array Expr → α
|
||
| app f a, as => withAppRevAux f (as.push a)
|
||
| f, as => k f as
|
||
|
||
@[inline] def withAppRev {α} (e : Expr) (k : Expr → Array Expr → α) : α :=
|
||
withAppRevAux k e (Array.mkEmpty e.getAppNumArgs)
|
||
|
||
def getRevArgD : Expr → Nat → Expr → Expr
|
||
| app f a, 0, _ => a
|
||
| app f _, i+1, v => getRevArgD f i v
|
||
| _ , _, v => v
|
||
|
||
def getRevArg! : Expr → Nat → Expr
|
||
| app f a, 0 => a
|
||
| app f _, i+1 => getRevArg! f i
|
||
| _ , _ => panic! "invalid index"
|
||
|
||
@[inline] def getArg! (e : Expr) (i : Nat) (n := e.getAppNumArgs) : Expr :=
|
||
getRevArg! e (n - i - 1)
|
||
|
||
@[inline] def getArgD (e : Expr) (i : Nat) (v₀ : Expr) (n := e.getAppNumArgs) : Expr :=
|
||
getRevArgD e (n - i - 1) v₀
|
||
|
||
def isAppOf (e : Expr) (n : Name) : Bool :=
|
||
match e.getAppFn with
|
||
| const c _ => c == n
|
||
| _ => false
|
||
|
||
def isAppOfArity : Expr → Name → Nat → Bool
|
||
| const c _, n, 0 => c == n
|
||
| app f _, n, a+1 => isAppOfArity f n a
|
||
| _, _, _ => false
|
||
|
||
def appFn! : Expr → Expr
|
||
| app f _ => f
|
||
| _ => panic! "application expected"
|
||
|
||
def appArg! : Expr → Expr
|
||
| app _ a => a
|
||
| _ => panic! "application expected"
|
||
|
||
def constName! : Expr → Name
|
||
| const n _ => n
|
||
| _ => panic! "constant expected"
|
||
|
||
def constLevels! : Expr → List Level
|
||
| const _ ls => ls
|
||
| _ => panic! "constant expected"
|
||
|
||
def bvarIdx! : Expr → Nat
|
||
| bvar idx => idx
|
||
| _ => panic! "bvar expected"
|
||
|
||
def fvarId! : Expr → Name
|
||
| fvar n => n
|
||
| _ => panic! "fvar expected"
|
||
|
||
def mvarId! : Expr → Name
|
||
| mvar n => n
|
||
| _ => panic! "mvar expected"
|
||
|
||
def bindingName! : Expr → Name
|
||
| forallE n _ _ _ => n
|
||
| lam n _ _ _ => n
|
||
| _ => panic! "binding expected"
|
||
|
||
def bindingDomain! : Expr → Expr
|
||
| forallE _ _ d _ => d
|
||
| lam _ _ d _ => d
|
||
| _ => panic! "binding expected"
|
||
|
||
def bindingBody! : Expr → Expr
|
||
| forallE _ _ _ b => b
|
||
| lam _ _ _ b => b
|
||
| _ => panic! "binding expected"
|
||
|
||
def letName! : Expr → Name
|
||
| letE n _ _ _ => n
|
||
| _ => panic! "let expression expected"
|
||
|
||
@[extern "lean_expr_get_loose_bvar_range"]
|
||
constant getLooseBVarRange (e : @& Expr) : Nat := arbitrary _
|
||
|
||
def hasLooseBVars (e : Expr) : Bool :=
|
||
getLooseBVarRange e > 0
|
||
|
||
@[extern "lean_expr_has_loose_bvar"]
|
||
constant hasLooseBVar (e : @& Expr) (bvarIdx : @& Nat) : Bool := arbitrary _
|
||
|
||
/-- Instantiate the loose bound variables in `e` using `subst`.
|
||
That is, a loose `Expr.bvar i` is replaced with `subst[i]`. -/
|
||
@[extern "lean_expr_instantiate"]
|
||
constant instantiate (e : @& Expr) (subst : @& Array Expr) : Expr := arbitrary _
|
||
|
||
@[extern "lean_expr_instantiate1"]
|
||
constant instantiate1 (e : @& Expr) (subst : @& Expr) : Expr := arbitrary _
|
||
|
||
/-- Similar to instantiate, but `Expr.bvar i` is replaced with `subst[subst.size - i - 1]` -/
|
||
@[extern "lean_expr_instantiate_rev"]
|
||
constant instantiateRev (e : @& Expr) (subst : @& Array Expr) : Expr := arbitrary _
|
||
|
||
/-- Similar to `instantiate`, but consider only the variables `xs` in the range `[beginIdx, endIdx)`.
|
||
Function panics if `beginIdx <= endIdx <= xs.size` does not hold. -/
|
||
@[extern "lean_expr_instantiate_range"]
|
||
constant instantiateRange (e : @& Expr) (beginIdx endIdx : @& Nat) (xs : Array Expr) : Expr := arbitrary _
|
||
|
||
/-- Similar to `instantiateRev`, but consider only the variables `xs` in the range `[beginIdx, endIdx)`.
|
||
Function panics if `beginIdx <= endIdx <= xs.size` does not hold. -/
|
||
@[extern "lean_expr_instantiate_rev_range"]
|
||
constant instantiateRevRange (e : @& Expr) (beginIdx endIdx : @& Nat) (xs : Array Expr) : Expr := arbitrary _
|
||
|
||
/-- Replace free variables `xs` with loose bound variables. -/
|
||
@[extern "lean_expr_abstract"]
|
||
constant abstract (e : @& Expr) (xs : @& Array Expr) : Expr := arbitrary _
|
||
|
||
/-- Similar to `abstract`, but consider only the first `min n xs.size` entries in `xs`. -/
|
||
@[extern "lean_expr_abstract_range"]
|
||
constant abstractRange (e : @& Expr) (n : @& Nat) (xs : @& Array Expr) : Expr := arbitrary _
|
||
|
||
@[extern "lean_instantiate_lparams"]
|
||
constant instantiateLevelParams (e : Expr) (paramNames : List Name) (lvls : List Level) : Expr := arbitrary _
|
||
|
||
instance : HasToString Expr :=
|
||
⟨Expr.dbgToString⟩
|
||
|
||
-- TODO: should not use dbgToString, but constructors.
|
||
instance : HasRepr Expr :=
|
||
⟨Expr.dbgToString⟩
|
||
|
||
end Expr
|
||
|
||
def mkCAppN (n : Name) (args : Array Expr) : Expr :=
|
||
mkAppN (mkConst n) args
|
||
|
||
def mkAppB (f a b : Expr) :=
|
||
mkApp (mkApp f a) b
|
||
|
||
def mkCAppB (n : Name) (a b : Expr) :=
|
||
mkAppB (mkConst n) a b
|
||
|
||
def mkDecIsTrue (pred proof : Expr) :=
|
||
mkAppB (Expr.const `Decidable.isTrue []) pred proof
|
||
|
||
def mkDecIsFalse (pred proof : Expr) :=
|
||
mkAppB (Expr.const `Decidable.isFalse []) pred proof
|
||
|
||
abbrev ExprMap (α : Type) := HashMap Expr α
|
||
abbrev PersistentExprMap (α : Type) := PHashMap Expr α
|
||
abbrev ExprSet := HashSet Expr
|
||
abbrev PersistentExprSet := PHashSet Expr
|
||
abbrev PExprSet := PersistentExprSet
|
||
|
||
/- Auxiliary type for forcing `==` to be structural equality for `Expr` -/
|
||
structure ExprStructEq :=
|
||
(val : Expr)
|
||
|
||
instance exprToExprStructEq : HasCoe Expr ExprStructEq := ⟨ExprStructEq.mk⟩
|
||
|
||
namespace ExprStructEq
|
||
|
||
protected def beq : ExprStructEq → ExprStructEq → Bool
|
||
| ⟨e₁⟩, ⟨e₂⟩ => Expr.equal e₁ e₂
|
||
|
||
protected def hash : ExprStructEq → USize
|
||
| ⟨e⟩ => e.hash
|
||
|
||
instance : Inhabited ExprStructEq := ⟨{ val := arbitrary _ }⟩
|
||
instance : HasBeq ExprStructEq := ⟨ExprStructEq.beq⟩
|
||
instance : Hashable ExprStructEq := ⟨ExprStructEq.hash⟩
|
||
instance : HasToString ExprStructEq := ⟨fun e => toString e.val⟩
|
||
instance : HasRepr ExprStructEq := ⟨fun e => repr e.val⟩
|
||
|
||
end ExprStructEq
|
||
|
||
abbrev ExprStructMap (α : Type) := HashMap ExprStructEq α
|
||
abbrev PersistentExprStructMap (α : Type) := PHashMap ExprStructEq α
|
||
|
||
namespace Expr
|
||
|
||
private partial def mkAppRevRangeAux (revArgs : Array Expr) (start : Nat) : Expr → Nat → Expr
|
||
| b, i =>
|
||
if i == start then b
|
||
else
|
||
let i := i - 1;
|
||
mkAppRevRangeAux (mkApp b (revArgs.get! i)) i
|
||
|
||
/-- `mkAppRevRange f b e args == mkAppRev f (revArgs.extract b e)` -/
|
||
def mkAppRevRange (f : Expr) (beginIdx endIdx : Nat) (revArgs : Array Expr) : Expr :=
|
||
mkAppRevRangeAux revArgs beginIdx f endIdx
|
||
|
||
private def betaRevAux (revArgs : Array Expr) (sz : Nat) : Expr → Nat → Expr
|
||
| Expr.lam _ _ _ b, i =>
|
||
if i + 1 < sz then
|
||
betaRevAux b (i+1)
|
||
else
|
||
let n := sz - (i + 1);
|
||
mkAppRevRange (b.instantiateRange n sz revArgs) 0 n revArgs
|
||
| b, i =>
|
||
let n := sz - i;
|
||
mkAppRevRange (b.instantiateRange n sz revArgs) 0 n revArgs
|
||
|
||
/-- If `f` is a lambda expression, than "beta-reduce" it using `revArgs`.
|
||
This function is often used with `getAppRev` or `withAppRev`.
|
||
Examples:
|
||
- `betaRev (fun x y => t x y) #[]` ==> `fun x y => t x y`
|
||
- `betaRev (fun x y => t x y) #[a]` ==> `fun y => t a y`
|
||
- `betaRev (fun x y => t x y) #[a, b]` ==> t b a`
|
||
- `betaRev (fun x y => t x y) #[a, b, c, d]` ==> t d c b a`
|
||
Suppose `t` is `(fun x y => t x y) a b c d`, then
|
||
`args := t.getAppRev` is `#[d, c, b, a]`,
|
||
and `betaRev (fun x y => t x y) #[d, c, b, a]` is `t a b c d`. -/
|
||
def betaRev (f : Expr) (revArgs : Array Expr) : Expr :=
|
||
if revArgs.size == 0 then f
|
||
else betaRevAux revArgs revArgs.size f 0
|
||
|
||
private def etaExpandedBody : Expr → Nat → Nat → Option Expr
|
||
| app f (bvar j), n+1, i => if j == i then etaExpandedBody f n (i+1) else none
|
||
| _, n+1, _ => none
|
||
| f, 0, _ => if f.hasLooseBVars then none else some f
|
||
|
||
private def etaExpandedAux : Expr → Nat → Option Expr
|
||
| lam _ _ _ b, n => etaExpandedAux b (n+1)
|
||
| e, n => etaExpandedBody e n 0
|
||
|
||
/- If `e` is of the form `(fun x₁ ... xₙ => f x₁ ... xₙ)` and `f` does not contain `x₁`, ..., `xₙ`,
|
||
then return `some f`. Otherwise, return `none`.
|
||
|
||
It assumes `e` does not have loose bound variables. -/
|
||
def etaExpanded? (e : Expr) : Option Expr :=
|
||
etaExpandedAux e 0
|
||
|
||
/- The update functions here are defined using C code. They will try to avoid
|
||
allocating new values using pointer equality.
|
||
The hypotheses `(h : e.is... = true)` are used to ensure Lean will not crash
|
||
at runtime.
|
||
The `update*!` functions are inlined and provide a convenient way of using the
|
||
update proofs without providing proofs.
|
||
Note that if they are used under a match-expression, the compiler will eliminate
|
||
the double-match. -/
|
||
|
||
@[extern "lean_expr_update_app"]
|
||
def updateApp (e : Expr) (newFn : Expr) (newArg : Expr) (h : e.isApp = true) : Expr :=
|
||
app newFn newArg
|
||
|
||
@[inline] def updateApp! (e : Expr) (newFn : Expr) (newArg : Expr) : Expr :=
|
||
match e with
|
||
| app fn arg => updateApp (app fn arg) newFn newArg rfl
|
||
| _ => panic! "application expected"
|
||
|
||
@[extern "lean_expr_update_const"]
|
||
def updateConst (e : Expr) (newLevels : List Level) (h : e.isConst = true) : Expr :=
|
||
const e.constName! newLevels
|
||
|
||
@[inline] def updateConst! (e : Expr) (newLevels : List Level) : Expr :=
|
||
match e with
|
||
| const n ls => updateConst (const n ls) newLevels rfl
|
||
| _ => panic! "constant expected"
|
||
|
||
@[extern "lean_expr_update_sort"]
|
||
def updateSort (e : Expr) (newLevel : Level) (h : e.isSort = true) : Expr :=
|
||
sort newLevel
|
||
|
||
@[inline] def updateSort! (e : Expr) (newLevel : Level) : Expr :=
|
||
match e with
|
||
| sort l => updateSort (sort l) newLevel rfl
|
||
| _ => panic! "level expected"
|
||
|
||
@[extern "lean_expr_update_proj"]
|
||
def updateProj (e : Expr) (newExpr : Expr) (h : e.isProj = true) : Expr :=
|
||
match e with
|
||
| proj s i _ => proj s i newExpr
|
||
| _ => e -- unreachable because of `h`
|
||
|
||
@[extern "lean_expr_update_mdata"]
|
||
def updateMData (e : Expr) (newExpr : Expr) (h : e.isMData = true) : Expr :=
|
||
match e with
|
||
| mdata d _ => mdata d newExpr
|
||
| _ => e -- unreachable because of `h`
|
||
|
||
@[inline] def updateMData! (e : Expr) (newExpr : Expr) : Expr :=
|
||
match e with
|
||
| mdata d e => updateMData (mdata d e) newExpr rfl
|
||
| _ => panic! "mdata expected"
|
||
|
||
@[inline] def updateProj! (e : Expr) (newExpr : Expr) : Expr :=
|
||
match e with
|
||
| proj s i e => updateProj (proj s i e) newExpr rfl
|
||
| _ => panic! "proj expected"
|
||
|
||
@[extern "lean_expr_update_forall"]
|
||
def updateForall (e : Expr) (newBinfo : BinderInfo) (newDomain : Expr) (newBody : Expr) (h : e.isForall = true) : Expr :=
|
||
forallE e.bindingName! newBinfo newDomain newBody
|
||
|
||
@[inline] def updateForall! (e : Expr) (newBinfo : BinderInfo) (newDomain : Expr) (newBody : Expr) : Expr :=
|
||
match e with
|
||
| forallE n bi d b => updateForall (forallE n bi d b) newBinfo newDomain newBody rfl
|
||
| _ => panic! "forall expected"
|
||
|
||
@[inline] def updateForallE! (e : Expr) (newDomain : Expr) (newBody : Expr) : Expr :=
|
||
match e with
|
||
| forallE n bi d b => updateForall (forallE n bi d b) bi newDomain newBody rfl
|
||
| _ => panic! "forall expected"
|
||
|
||
@[extern "lean_expr_update_lambda"]
|
||
def updateLambda (e : Expr) (newBinfo : BinderInfo) (newDomain : Expr) (newBody : Expr) (h : e.isLambda = true) : Expr :=
|
||
lam e.bindingName! newBinfo newDomain newBody
|
||
|
||
@[inline] def updateLambda! (e : Expr) (newBinfo : BinderInfo) (newDomain : Expr) (newBody : Expr) : Expr :=
|
||
match e with
|
||
| lam n bi d b => updateLambda (lam n bi d b) newBinfo newDomain newBody rfl
|
||
| _ => panic! "lambda expected"
|
||
|
||
@[inline] def updateLambdaE! (e : Expr) (newDomain : Expr) (newBody : Expr) : Expr :=
|
||
match e with
|
||
| lam n bi d b => updateLambda (lam n bi d b) bi newDomain newBody rfl
|
||
| _ => panic! "lambda expected"
|
||
|
||
@[extern "lean_expr_update_let"]
|
||
def updateLet (e : Expr) (newType : Expr) (newVal : Expr) (newBody : Expr) (h : e.isLet = true) : Expr :=
|
||
letE e.letName! newType newVal newBody
|
||
|
||
@[inline] def updateLet! (e : Expr) (newType : Expr) (newVal : Expr) (newBody : Expr) : Expr :=
|
||
match e with
|
||
| letE n t v b => updateLet (letE n t v b) newType newVal newBody rfl
|
||
| _ => panic! "let expression expected"
|
||
|
||
def updateFn : Expr → Expr → Expr
|
||
| app f a, g => app (updateFn f g) a
|
||
| _, g => g
|
||
|
||
end Expr
|
||
end Lean
|