git.iko.soy/elk
on 294fdfd help sign in
elk/compiler/Types/Substitutions.hs
90 lines 2.8 kB history raw
2module Types.Substitutions (subst,
3 occurs,
4 freeVars,
5 concretize,
6 rescheme,
7 generalize) where
9import Ast
10import Context
11import Control.DeepSeq (NFData (..), deepseq)
12import Control.Monad (liftM)
13import Data.List (foldl')
14import qualified Data.Set as Set
15import qualified Data.Map as Map
16import Guid
17import Types.Types
19class Subst a where
20 subst :: [(X,Type)] -> a -> a
22instance Subst Type where
23 subst ss t =
24 case t of
25 VarT x -> case lookup x ss of
26 Nothing -> VarT x
27 Just (Super _) -> VarT x
28 Just t -> t
29 LambdaT t1 t2 -> LambdaT (subst ss t1) (subst ss t2)
30 ADT name ts -> ADT name (subst ss ts)
31 RecordT fs t -> RecordT (Map.map (subst ss) fs) (subst ss t)
32 EmptyRecord -> EmptyRecord
33 Super ts -> Super ts
35instance Subst Scheme where
36 subst ss (Forall vs cs t) = Forall vs (subst ss cs) (subst ss t)
38instance Subst Constraint where
39 subst ss (t1 :=: t2) = subst ss t1 :=: subst ss t2
40 subst ss (t :<: super) = subst ss t :<: super
41 subst ss (x :<<: poly) = x :<<: subst ss poly
43instance Subst a => Subst (Context a) where
44 subst ss (C str span c) = C str span (subst ss c)
46instance Subst a => Subst [a] where
47 subst ss as = map (subst ss) as
50class FreeVars a where
51 freeVars :: a -> [X]
53instance FreeVars Type where
54 freeVars (VarT v) = [v]
55 freeVars (LambdaT t1 t2) = freeVars t1 ++ freeVars t2
56 freeVars (ADT _ ts) = concatMap freeVars ts
57 freeVars (RecordT fs t) =
58 freeVars (concat $ Map.elems fs) ++ freeVars t
59 freeVars EmptyRecord = []
60 freeVars (Super _ ) = []
62instance FreeVars Constraint where
63 freeVars (t1 :=: t2) = freeVars t1 ++ freeVars t2
64 freeVars (t1 :<: t2) = freeVars t1 ++ freeVars t2
65 freeVars (x :<<: Forall xs cs t) = filter (`notElem` xs) frees
66 where frees = concatMap freeVars cs ++ freeVars t
68instance FreeVars a => FreeVars (Context a) where
69 freeVars (C _ _ c) = freeVars c
71instance FreeVars a => FreeVars [a] where
72 freeVars = concatMap freeVars
74occurs x t = x `elem` freeVars t
76concretize :: Scheme -> GuidCounter (Type, [Context Constraint])
77concretize (Forall xs cs t) = do
78 ss <- zip xs `liftM` mapM (\_ -> liftM VarT guid) xs
79 return (subst ss t, subst ss cs)
81rescheme :: Scheme -> GuidCounter Scheme
82rescheme (Forall xs cs t) = do
83 xs' <- mapM (const guid) xs
84 let ss = zip xs (map VarT xs')
85 return $ Forall xs' (subst ss cs) (subst ss t)
87generalize :: [X] -> Scheme -> GuidCounter Scheme
88generalize exceptions (Forall xs cs t) = rescheme (Forall (xs ++ frees) cs t)
89 where allFrees = Set.fromList $ freeVars t ++ concatMap freeVars cs
90 frees = Set.toList $ Set.difference allFrees (Set.fromList exceptions)