InutitionTC
0.30
|
Basic proof-theoretic operations such as substitutions, alpha and beta equivalence. More...
Go to the source code of this file.
Functions | |
nameSet * | freeNames (const Any any) |
Any | substT (Name n, Type *s, const Any any) |
Type * | substT_type (Name n, Type *s, const Type const *t) |
24 substT :: Name -> Type -> a -> a More... | |
Term * | substT_term (Name n, Type *s, const Term const *t) |
195 217 substT n s t = sub t where fvs = freeNames s sub m@(Mvar _) = m – substT does not touch Mvars sub m@(Mapp m1 m2) = Mapp (sub m1) (sub m2) sub m@(Mlam n1 t1 m1) = uncurry3 Mlam $ substT n s (n1,t1,m1) sub m@(Mwit t m1 m2) = Mwit t' m1' m2' where (t',(m1',m2')) = substT n s (t,(m1,m2)) sub m@(Mabs n1 t1 n2 t2 m1 m2) = Mabs n1' t1' n2' t2' m1' m2' where fvs = freeNames s n1' = freshNameFvs fvs n2' = freshNameFvs (n1':fvs) t1' = substT n s t1 t2' = substT n s t2 m1' = sub m1 m2' = sub . renameM n2 n2' . renameM n1 n1' $ m2 sub m@(Mtup t m1 m2) = Mtup t' m1' m2' where (t',(m1',m2')) = substT n s (t,(m1,m2)) – (uncurry . uncurry $ Mtup) (substT n s ((t,m1),m2)) sub m@(Mpi1 m1) = Mpi1 $ sub m1 sub m@(Mpi2 m1) = Mpi2 $ sub m1 sub m@(Min1 t1 m1) = uncurry Min1 $ substT n s (t1,m1) sub m@(Min2 t1 m1) = uncurry Min2 $ substT n s (t1,m1) sub m@(Mcas m1 c1 c2) = Mcas m1' c1' c2' where (m1',(c1',c2')) = substT n s (m1,(c1,c2)) sub m@(Meps t1 m1) = uncurry Meps $ substT n s (t1,m1) | |
Any | substM (Name n, Term *s, const Any any) |
28 substM :: Name -> Term -> a -> a | |
Type * | substM_type (Name n, Term *s, const Type const *t) |
138 145 substM n s t = sub t where sub t@(Tvar _) = t – substM does not touch Tvars sub t@(Tall n1 t1 t2) = uncurry3 Tall $ substM n s (n1,t1,t2) sub t@(Tapp t1 m) = Tapp (sub t1) (substM n s m) sub t@(Texi n1 t1 t2) = uncurry3 Texi $ substM n s (n1,t1,t2) sub t@(Tand t1 t2) = Tand (sub t1) (sub t2) sub t@(Tor t1 t2) = Tor (sub t1) (sub t2) sub Tbot = Tbot | |
Term * | substM_term (Name n, Term *s, const Term const *t) |
219 244 substM n s t = sub t where fvs = freeNames s sub m@(Mvar n1) | n == n1 = s | otherwise = m sub m@(Mapp m1 m2) = Mapp (sub m1) (sub m2) sub m@(Mlam n1 t1 m1) = uncurry3 Mlam $ substM n s(n1,t1,m1) More... | |
Kind * | substM_kind (Name n, Term *s, const Kind const *t) |
Name | freshNameFvs (nameSet *) |
Any | renameT (Name n1, Name n2, const Any a) |
25 renameT :: Name -> Name -> a -> a | |
Any | renameM (Name n1, Name n2, const Any a) |
FILE GenChecker.hs. More... | |
Any | refreshWith (namemap r, nameSet *ns, const Any any) |
Term * | refreshWith_term (namemap r, nameSet *ns, const Term const *t) |
33 refreshWith r ns = id | |
Type * | refreshWith_type (namemap r, nameSet *ns, const Type const *t) |
165 174 refreshWith r ns t = sub t where sub t@(Tvar n) = case Map.lookup n r of Nothing -> t Just n' -> Tvar n' sub t@(Tall n1 t1 t2) = uncurry3 Tall $ refreshWith r ns (n1,t1,t2) sub t@(Tapp t1 m) = uncurry Tapp $ refreshWith r ns (t1,m) sub t@(Texi n1 t1 t2) = uncurry3 Texi $ refreshWith r ns (n1,t1,t2) sub t@(Tand t1 t2) = uncurry Tand $ refreshWith r ns (t1,t2) sub t@(Tor t1 t2) = uncurry Tor $ refreshWith r ns (t1,t2) sub t = Tbot | |
bool | alphaeq_type (const Type const *t, const Type const *t_) |
155 163 alphaEq (Tvar n) (Tvar n') = n == n' alphaEq (Tall n t s) (Tall n' t' s') = alphaEq t t' && alphaEq s (renameM n' n s') alphaEq (Tapp t m) (Tapp t' m') = alphaEq t t' && alphaEq m m' alphaEq (Texi n t s) (Texi n' t' s') = alphaEq (n,t,s) (n',t',s') alphaEq (Tand t1 t2) (Tand t1' t2') = alphaEq t1 t1' && alphaEq t2 t2' alphaEq (Tor t1 t2) (Tor t1' t2') = alphaEq t1 t1' && alphaEq t2 t2' alphaEq Tbot Tbot = True alphaEq _ _ = False | |
bool | alphaeq_term (const Term const *t, const Term const *t_) |
bool | alphaeq (const Any t, const Any t_) |
bool | betaeq (const Any t, const Any t_) |
Any | nf (const Any any) |
Term * | nf_term (const Term const *t) |
271 302 nf (Mlam x t e) = Mlam x (nf t) (nf e) nf (Mapp f a) = case whnf f of Mlam x t b -> nf (substM x a b) f1 -> Mapp (nf f1) (nf a) nf m@(Mvar n) = m More... | |
Type * | nf_type (const Type const *t) |
147 153 nf (Tapp t m) = Tapp (nf t) (nf m) nf (Tall n t1 t2) = Tall n (nf t1) (nf t2) nf t@(Tvar _) = t nf (Texi n t1 t2) = Texi n (nf t1) (nf t2) nf (Tand t1 t2) = Tand (nf t1) (nf t2) nf (Tor t1 t2) = Tor (nf t1) (nf t2) nf Tbot = Tbot | |
Basic proof-theoretic operations such as substitutions, alpha and beta equivalence.
304 330 alphaEq (Mvar n) (Mvar n') = n == n' alphaEq (Mlam n t s) (Mlam n' t' s') = alphaEq t t' && alphaEq s (renameM n' n s') alphaEq (Mapp t m) (Mapp t' m') = alphaEq t t' && alphaEq m m'
alphaEq (Mwit t m1 m2) (Mwit t' m1' m2') = alphaEq (t,(m1,m2)) (t,(m1',m2')) alphaEq (Mabs n1 t1 n2 t2 m1 m2) (Mabs n1' t1' n2' t2' m1' m2') = alphaEq t1 t1' && alphaEq t2 t2' && alphaEq m1 m1' && alphaEq m2 (renameM n1' n1 (renameM n2' n2 m2'))
alphaEq (Mtup t m1 m2) (Mtup t' m1' m2') = alphaEq (t,(m1,m2)) (t,(m1',m2')) alphaEq (Mpi1 m) (Mpi1 m') = alphaEq m m' alphaEq (Mpi2 m) (Mpi2 m') = alphaEq m m' alphaEq (Min1 t m) (Min1 t' m') = alphaEq t t' && alphaEq m m' alphaEq (Min2 t m) (Min2 t' m') = alphaEq t t' && alphaEq m m'
alphaEq (Mcas m c1 c2) (Mcas m' c1' c2') = alphaEq m m' && alphaEq c1 c1' && alphaEq c2 c2'
alphaEq (Meps t m) (Meps t' m') = alphaEq t t' && alphaEq m m'
alphaEq _ _ = False
14 17 freshNameFvs :: [Name] -> Name freshNameFvs fvs = go 0 where go n = if v n elem
fvs then go (n+1) else v n
271 302 nf (Mlam x t e) = Mlam x (nf t) (nf e) nf (Mapp f a) = case whnf f of Mlam x t b -> nf (substM x a b) f1 -> Mapp (nf f1) (nf a) nf m@(Mvar n) = m
nf (Mwit t m1 m2) = Mwit (nf t) (nf m1) (nf m2)
nf (Mabs n1 t1 n2 t2 m1 m2) = case whnf m1 of (Mwit _ w1 w2) -> nf $ substM n1 w1 $ substM n2 w2 $ m2 m1' -> (Mabs n1 (nf t1) n2 (nf t2) (nf m1') (nf m2))
nf (Mtup t m1 m2) = Mtup (nf t) (nf m1) (nf m2)
nf (Mpi1 m) = case whnf m of (Mtup _ m1 m2) -> nf m1 m' -> Mpi1 (nf m')
nf (Mpi2 m) = case whnf m of (Mtup _ m1 m2) -> nf m2 m' -> Mpi2 (nf m')
nf (Min1 t m) = Min1 (nf t) (nf m) nf (Min2 t m) = Min2 (nf t) (nf m)
nf (Mcas m c1 c2) = case whnf m of Min1 _ m1 -> nf(applycase c1 m1) Min2 _ m2 -> nf(applycase c2 m2) m' -> nf (Mcas m' c1 c2) where applycase (n,_,p) q = substM n q p
FILE GenChecker.hs.
29 30 renameM :: Name -> Name -> a -> a renameM n n1 = substM n (Mvar n1)
219 244 substM n s t = sub t where fvs = freeNames s sub m@(Mvar n1) | n == n1 = s | otherwise = m sub m@(Mapp m1 m2) = Mapp (sub m1) (sub m2) sub m@(Mlam n1 t1 m1) = uncurry3 Mlam $ substM n s(n1,t1,m1)
sub m@(Mwit t m1 m2) = Mwit t' m1' m2' where (t',(m1',m2')) = substM n s (t,(m1,m2)) sub m@(Mabs n1 t1 n2 t2 m1 m2) = Mabs n1' t1' n2' t2' m1' m2' where fvs = freeNames s n1' = freshNameFvs fvs n2' = freshNameFvs (n1':fvs) t1' = substM n s t1 t2' = substM n s t2 m1' = sub m1 m2' = sub . renameM n2 n2' . renameM n1 n1' $ m2 sub m@(Mtup t m1 m2) = Mtup t' m1' m2' where (t',(m1',m2')) = substM n s (t,(m1,m2)) – (uncurry . uncurry $ Mtup) (substT n s ((t,m1),m2)) sub m@(Mpi1 m1) = Mpi1 $ sub m1 sub m@(Mpi2 m1) = Mpi2 $ sub m1 sub m@(Min1 t1 m1) = uncurry Min1 $ substM n s (t1,m1) sub m@(Min2 t1 m1) = uncurry Min2 $ substM n s (t1,m1) sub m@(Mcas m1 c1 c2) = Mcas m1' c1' c2' where (m1',(c1',c2')) = substM n s (m1,(c1,c2)) sub m@(Meps t1 m1) = uncurry Meps $ substM n s (t1,m1)
24 substT :: Name -> Type -> a -> a
130 136 sub t@(Tvar n1) = if n == n1 then s else t sub t@(Tall n1 t1 t2) = uncurry3 Tall $ substT n s (n1,t1,t2) sub t@(Tapp t1 m) = uncurry Tapp $ substT n s (t1,m) sub t@(Texi n1 t1 t2) = uncurry3 Texi $ substT n s (n1,t1,t2) sub t@(Tand t1 t2) = Tand (sub t1) (sub t2) sub t@(Tor t1 t2) = Tor (sub t1) (sub t2) sub Tbot = Tbot