69 lines
1.9 KiB
Idris
69 lines
1.9 KiB
Idris
module Term
|
|
|
|
import Data.Nat
|
|
|
|
import Misc
|
|
|
|
%default total
|
|
|
|
{-
|
|
The type of terms is indexed by the size of the environment in which
|
|
they are valid, that is, it is impossible to construct an ill-scoped term.
|
|
-}
|
|
public export
|
|
data Term : (_ : Index) -> Type where
|
|
TType : Term n -- Type of types
|
|
TLam : Term (S n) -> Term n -- Lambda abstraction (λ _ . Scope)
|
|
TPi : Term n -> Term (S n) -> Term n -- Pi type (∏ _ : A . B _ )
|
|
TApp : Term n -> Term n -> Term n -- Appliction
|
|
TVar : (n : Nat) -> LT n m -> Term m -- Variable
|
|
|
|
public export
|
|
Show (Term n) where
|
|
show TType = "TType"
|
|
show (TLam sc) = "TLam (" ++ show sc ++ ")"
|
|
show (TPi ty sc) = "TPi (" ++ show ty ++ ") (" ++ show sc ++ ")"
|
|
show (TApp f x) = "TApp (" ++ show f ++ ") (" ++ show x ++ ")"
|
|
show (TVar i _) = "TVar " ++ show i
|
|
|
|
public export
|
|
weaken : {p, q : _} -> LTE p q -> Term p -> Term q
|
|
weaken _ TType = TType
|
|
weaken p (TLam sc) = TLam (weaken (LTESucc p) sc)
|
|
weaken p (TPi a bx) = TPi (weaken p a) (weaken (LTESucc p) bx)
|
|
weaken p (TApp f x) = TApp (weaken p f) (weaken p x)
|
|
{-
|
|
Getting new index
|
|
=================
|
|
|
|
New index is
|
|
|
|
old + Δctx
|
|
|
|
in this case
|
|
|
|
r + (q - p)
|
|
|
|
which since p <= q is equivalent to
|
|
|
|
(r + q) - p
|
|
|
|
|
|
Proving validity of new index
|
|
=============================
|
|
|
|
r < p => (+mono)
|
|
r + q < p + q => (-mono)
|
|
(r + q) - p < (p + q) - p => (lteTransp -+)
|
|
(r + q) - p < q ∎
|
|
|
|
-}
|
|
weaken {p = S p} {q = S q} (LTESucc p1) (TVar r p2' ) =
|
|
case p2' of
|
|
LTESucc p2 => TVar (minus (r + q) p)
|
|
(LTESucc (lteTransp (minusLteMonotone (plusLteMonotoneRight q r p p2)) Refl (minusPlus p)))
|
|
|
|
|
|
weaken1 : {n : _} -> Term n -> Term (S n)
|
|
weaken1 = weaken lteS
|