rhi/quox
rhi/quox
1
0
Fork 0
Code Issues 15 Pull requests 1 Releases Wiki Activity

add FromVarR, etc

Browse source 
`FromVarR` is a version of `FromVar` which needs the scope size
to be relevant at runtime
This commit is contained in:
rhiannon morris 2024-05-24 00:23:09 +02:00
parent 85f20680e6
commit c063107ecc
5 changed files with 199 additions and 69 deletions
Download patch file Download diff file Expand all files Collapse all files

99
lib/Quox/Untyped/Syntax.idr
View file

@ -255,49 +255,66 @@ USubst : Nat -> Nat -> Type
USubst = Subst Term
public export FromVar Term where fromVar = B
public export %inline
FromVarR Term where fromVarR = B
public export %inline
FromVar Term where fromVar = B; fromVarSame _ _ = Refl
public export
CanSubstSelf Term where
s // th = case s of
F x loc =>
F x loc
B i loc =>
get th i loc
Lam x body loc =>
Lam x (assert_total $ body // push x.loc th) loc
App fun arg loc =>
App (fun // th) (arg // th) loc
Pair fst snd loc =>
Pair (fst // th) (snd // th) loc
Fst pair loc =>
Fst (pair // th) loc
Snd pair loc =>
Snd (pair // th) loc
Tag tag loc =>
Tag tag loc
CaseEnum tag cases loc =>
CaseEnum (tag // th) (map (assert_total mapSnd (// th)) cases) loc
Absurd loc =>
Absurd loc
Nat n loc =>
Nat n loc
Succ nat loc =>
Succ (nat // th) loc
CaseNat nat zer suc loc =>
CaseNat (nat // th) (zer // th) (assert_total substSuc suc th) loc
Str s loc =>
Str s loc
Let u x rhs body loc =>
Let u x (rhs // th) (assert_total $ body // push x.loc th) loc
Erased loc =>
Erased loc
where
substSuc : forall from, to.
CaseNatSuc from -> USubst from to -> CaseNatSuc to
substSuc (NSRec x ih t) th = NSRec x ih $ t // pushN 2 x.loc th
substSuc (NSNonrec x t) th = NSNonrec x $ t // push x.loc th
export
CanSubstSelf Term
substTerm : Term from -> Lazy (USubst from to) -> Term to
substTerm s th = case s of
F x loc =>
F x loc
B i loc =>
get th i loc
Lam x body loc =>
Lam x (assert_total substTerm body $ push x.loc th) loc
App fun arg loc =>
App (substTerm fun th) (substTerm arg th) loc
Pair fst snd loc =>
Pair (substTerm fst th) (substTerm snd th) loc
Fst pair loc =>
Fst (substTerm pair th) loc
Snd pair loc =>
Snd (substTerm pair th) loc
Tag tag loc =>
Tag tag loc
CaseEnum tag cases loc =>
CaseEnum (substTerm tag th)
(map (mapSnd (\b => assert_total substTerm b th)) cases) loc
Absurd loc =>
Absurd loc
Nat n loc =>
Nat n loc
Succ nat loc =>
Succ (substTerm nat th) loc
CaseNat nat zer suc loc =>
CaseNat (substTerm nat th)
(substTerm zer th)
(assert_total substSuc suc th) loc
Str s loc =>
Str s loc
Let u x rhs body loc =>
Let u x (substTerm rhs th)
(assert_total substTerm body $ push x.loc th) loc
Erased loc =>
Erased loc
where
substSuc : forall from, to.
CaseNatSuc from -> Lazy (USubst from to) -> CaseNatSuc to
substSuc (NSRec x ih t) th = NSRec x ih $ substTerm t $ pushN 2 x.loc th
substSuc (NSNonrec x t) th = NSNonrec x $ substTerm t $ push x.loc th
export
CanSubstSelfR Term where (//?) = substTerm
export
CanSubstSelf Term where (//) = substTerm; substSame _ _ = Refl
public export
subN : SnocVect s (Term n) -> Term (s + n) -> Term n