add let to the core
This commit is contained in:
parent
68d8019f00
commit
b1699ce022
13 changed files with 234 additions and 136 deletions
|
|
@ -249,89 +249,90 @@ mutual
|
|||
isCloE (DCloE {}) = True
|
||||
isCloE _ = False
|
||||
|
||||
mutual
|
||||
export
|
||||
PushSubsts Term Subst.isCloT where
|
||||
pushSubstsWith th ph (TYPE l loc) =
|
||||
nclo $ TYPE l loc
|
||||
pushSubstsWith th ph (IOState loc) =
|
||||
nclo $ IOState loc
|
||||
pushSubstsWith th ph (Pi qty a body loc) =
|
||||
nclo $ Pi qty (a // th // ph) (body // th // ph) loc
|
||||
pushSubstsWith th ph (Lam body loc) =
|
||||
nclo $ Lam (body // th // ph) loc
|
||||
pushSubstsWith th ph (Sig a b loc) =
|
||||
nclo $ Sig (a // th // ph) (b // th // ph) loc
|
||||
pushSubstsWith th ph (Pair s t loc) =
|
||||
nclo $ Pair (s // th // ph) (t // th // ph) loc
|
||||
pushSubstsWith th ph (Enum tags loc) =
|
||||
nclo $ Enum tags loc
|
||||
pushSubstsWith th ph (Tag tag loc) =
|
||||
nclo $ Tag tag loc
|
||||
pushSubstsWith th ph (Eq ty l r loc) =
|
||||
nclo $ Eq (ty // th // ph) (l // th // ph) (r // th // ph) loc
|
||||
pushSubstsWith th ph (DLam body loc) =
|
||||
nclo $ DLam (body // th // ph) loc
|
||||
pushSubstsWith _ _ (NAT loc) =
|
||||
nclo $ NAT loc
|
||||
pushSubstsWith _ _ (Nat n loc) =
|
||||
nclo $ Nat n loc
|
||||
pushSubstsWith th ph (Succ n loc) =
|
||||
nclo $ Succ (n // th // ph) loc
|
||||
pushSubstsWith _ _ (STRING loc) =
|
||||
nclo $ STRING loc
|
||||
pushSubstsWith _ _ (Str s loc) =
|
||||
nclo $ Str s loc
|
||||
pushSubstsWith th ph (BOX pi ty loc) =
|
||||
nclo $ BOX pi (ty // th // ph) loc
|
||||
pushSubstsWith th ph (Box val loc) =
|
||||
nclo $ Box (val // th // ph) loc
|
||||
pushSubstsWith th ph (E e) =
|
||||
let Element e nc = pushSubstsWith th ph e in nclo $ E e
|
||||
pushSubstsWith th ph (CloT (Sub s ps)) =
|
||||
pushSubstsWith th (comp th ps ph) s
|
||||
pushSubstsWith th ph (DCloT (Sub s ps)) =
|
||||
pushSubstsWith (ps . th) ph s
|
||||
export
|
||||
PushSubsts Elim Subst.isCloE where
|
||||
pushSubstsWith th ph (F x u loc) =
|
||||
nclo $ F x u loc
|
||||
pushSubstsWith th ph (B i loc) =
|
||||
let res = getLoc ph i loc in
|
||||
case nchoose $ isCloE res of
|
||||
Left yes => assert_total pushSubsts res
|
||||
Right no => Element res no
|
||||
pushSubstsWith th ph (App f s loc) =
|
||||
nclo $ App (f // th // ph) (s // th // ph) loc
|
||||
pushSubstsWith th ph (CasePair pi p r b loc) =
|
||||
nclo $ CasePair pi (p // th // ph) (r // th // ph) (b // th // ph) loc
|
||||
pushSubstsWith th ph (Fst pair loc) =
|
||||
nclo $ Fst (pair // th // ph) loc
|
||||
pushSubstsWith th ph (Snd pair loc) =
|
||||
nclo $ Snd (pair // th // ph) loc
|
||||
pushSubstsWith th ph (CaseEnum pi t r arms loc) =
|
||||
nclo $ CaseEnum pi (t // th // ph) (r // th // ph)
|
||||
(map (\b => b // th // ph) arms) loc
|
||||
pushSubstsWith th ph (CaseNat pi pi' n r z s loc) =
|
||||
nclo $ CaseNat pi pi' (n // th // ph) (r // th // ph)
|
||||
(z // th // ph) (s // th // ph) loc
|
||||
pushSubstsWith th ph (CaseBox pi x r b loc) =
|
||||
nclo $ CaseBox pi (x // th // ph) (r // th // ph) (b // th // ph) loc
|
||||
pushSubstsWith th ph (DApp f d loc) =
|
||||
nclo $ DApp (f // th // ph) (d // th) loc
|
||||
pushSubstsWith th ph (Ann s a loc) =
|
||||
nclo $ Ann (s // th // ph) (a // th // ph) loc
|
||||
pushSubstsWith th ph (Coe ty p q val loc) =
|
||||
nclo $ Coe (ty // th // ph) (p // th) (q // th) (val // th // ph) loc
|
||||
pushSubstsWith th ph (Comp ty p q val r zero one loc) =
|
||||
nclo $ Comp (ty // th // ph) (p // th) (q // th)
|
||||
(val // th // ph) (r // th)
|
||||
(zero // th // ph) (one // th // ph) loc
|
||||
pushSubstsWith th ph (TypeCase ty ret arms def loc) =
|
||||
nclo $ TypeCase (ty // th // ph) (ret // th // ph)
|
||||
(map (\t => t // th // ph) arms) (def // th // ph) loc
|
||||
pushSubstsWith th ph (CloE (Sub e ps)) =
|
||||
pushSubstsWith th (comp th ps ph) e
|
||||
pushSubstsWith th ph (DCloE (Sub e ps)) =
|
||||
pushSubstsWith (ps . th) ph e
|
||||
|
||||
export
|
||||
PushSubsts Elim Subst.isCloE where
|
||||
pushSubstsWith th ph (F x u loc) =
|
||||
nclo $ F x u loc
|
||||
pushSubstsWith th ph (B i loc) =
|
||||
let res = getLoc ph i loc in
|
||||
case nchoose $ isCloE res of
|
||||
Left yes => assert_total pushSubsts res
|
||||
Right no => Element res no
|
||||
pushSubstsWith th ph (App f s loc) =
|
||||
nclo $ App (f // th // ph) (s // th // ph) loc
|
||||
pushSubstsWith th ph (CasePair pi p r b loc) =
|
||||
nclo $ CasePair pi (p // th // ph) (r // th // ph) (b // th // ph) loc
|
||||
pushSubstsWith th ph (Fst pair loc) =
|
||||
nclo $ Fst (pair // th // ph) loc
|
||||
pushSubstsWith th ph (Snd pair loc) =
|
||||
nclo $ Snd (pair // th // ph) loc
|
||||
pushSubstsWith th ph (CaseEnum pi t r arms loc) =
|
||||
nclo $ CaseEnum pi (t // th // ph) (r // th // ph)
|
||||
(map (\b => b // th // ph) arms) loc
|
||||
pushSubstsWith th ph (CaseNat pi pi' n r z s loc) =
|
||||
nclo $ CaseNat pi pi' (n // th // ph) (r // th // ph)
|
||||
(z // th // ph) (s // th // ph) loc
|
||||
pushSubstsWith th ph (CaseBox pi x r b loc) =
|
||||
nclo $ CaseBox pi (x // th // ph) (r // th // ph) (b // th // ph) loc
|
||||
pushSubstsWith th ph (DApp f d loc) =
|
||||
nclo $ DApp (f // th // ph) (d // th) loc
|
||||
pushSubstsWith th ph (Ann s a loc) =
|
||||
nclo $ Ann (s // th // ph) (a // th // ph) loc
|
||||
pushSubstsWith th ph (Coe ty p q val loc) =
|
||||
nclo $ Coe (ty // th // ph) (p // th) (q // th) (val // th // ph) loc
|
||||
pushSubstsWith th ph (Comp ty p q val r zero one loc) =
|
||||
nclo $ Comp (ty // th // ph) (p // th) (q // th)
|
||||
(val // th // ph) (r // th)
|
||||
(zero // th // ph) (one // th // ph) loc
|
||||
pushSubstsWith th ph (TypeCase ty ret arms def loc) =
|
||||
nclo $ TypeCase (ty // th // ph) (ret // th // ph)
|
||||
(map (\t => t // th // ph) arms) (def // th // ph) loc
|
||||
pushSubstsWith th ph (CloE (Sub e ps)) =
|
||||
pushSubstsWith th (comp th ps ph) e
|
||||
pushSubstsWith th ph (DCloE (Sub e ps)) =
|
||||
pushSubstsWith (ps . th) ph e
|
||||
export
|
||||
PushSubsts Term Subst.isCloT where
|
||||
pushSubstsWith th ph (TYPE l loc) =
|
||||
nclo $ TYPE l loc
|
||||
pushSubstsWith th ph (IOState loc) =
|
||||
nclo $ IOState loc
|
||||
pushSubstsWith th ph (Pi qty a body loc) =
|
||||
nclo $ Pi qty (a // th // ph) (body // th // ph) loc
|
||||
pushSubstsWith th ph (Lam body loc) =
|
||||
nclo $ Lam (body // th // ph) loc
|
||||
pushSubstsWith th ph (Sig a b loc) =
|
||||
nclo $ Sig (a // th // ph) (b // th // ph) loc
|
||||
pushSubstsWith th ph (Pair s t loc) =
|
||||
nclo $ Pair (s // th // ph) (t // th // ph) loc
|
||||
pushSubstsWith th ph (Enum tags loc) =
|
||||
nclo $ Enum tags loc
|
||||
pushSubstsWith th ph (Tag tag loc) =
|
||||
nclo $ Tag tag loc
|
||||
pushSubstsWith th ph (Eq ty l r loc) =
|
||||
nclo $ Eq (ty // th // ph) (l // th // ph) (r // th // ph) loc
|
||||
pushSubstsWith th ph (DLam body loc) =
|
||||
nclo $ DLam (body // th // ph) loc
|
||||
pushSubstsWith _ _ (NAT loc) =
|
||||
nclo $ NAT loc
|
||||
pushSubstsWith _ _ (Nat n loc) =
|
||||
nclo $ Nat n loc
|
||||
pushSubstsWith th ph (Succ n loc) =
|
||||
nclo $ Succ (n // th // ph) loc
|
||||
pushSubstsWith _ _ (STRING loc) =
|
||||
nclo $ STRING loc
|
||||
pushSubstsWith _ _ (Str s loc) =
|
||||
nclo $ Str s loc
|
||||
pushSubstsWith th ph (BOX pi ty loc) =
|
||||
nclo $ BOX pi (ty // th // ph) loc
|
||||
pushSubstsWith th ph (Box val loc) =
|
||||
nclo $ Box (val // th // ph) loc
|
||||
pushSubstsWith th ph (E e) =
|
||||
let Element e nc = pushSubstsWith th ph e in nclo $ E e
|
||||
pushSubstsWith th ph (Let qty rhs body loc) =
|
||||
nclo $ Let qty (rhs // th // ph) (body // th // ph) loc
|
||||
pushSubstsWith th ph (CloT (Sub s ps)) =
|
||||
pushSubstsWith th (comp th ps ph) s
|
||||
pushSubstsWith th ph (DCloT (Sub s ps)) =
|
||||
pushSubstsWith (ps . th) ph s
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue