git.iko.soy/rowtype-yoga/purescript-native
on f8da0b9 help sign in
rowtype-yoga/purescript-native/src/Language/PureScript/Types.hs
192 lines 5.2 kB history raw
1-----------------------------------------------------------------------------
2--
3-- Module : Language.PureScript.Types
4-- Copyright : (c) Phil Freeman 2013
5-- License : MIT
6--
7-- Maintainer : Phil Freeman <paf31@cantab.net>
8-- Stability : experimental
9-- Portability :
10--
11-- |
12-- Data types for types
13--
14-----------------------------------------------------------------------------
16{-# LANGUAGE DeriveDataTypeable #-}
18module Language.PureScript.Types where
20import Data.Data
21import Data.List (nub)
22import Data.Generics (everything, mkQ)
24import Control.Monad.Unify
25import Control.Arrow (second)
27import Language.PureScript.Names
29-- |
30-- An identifier for the scope of a skolem variable
31--
32newtype SkolemScope = SkolemScope { runSkolemScope :: Int } deriving (Show, Eq, Ord, Data, Typeable)
34-- |
35-- The type of types
36--
37data Type
38 -- |
39 -- A unification variable of type Type
40 --
41 = TUnknown Unknown
42 -- |
43 -- Javascript numbers
44 --
45 | Object Type
46 -- |
47 -- A named type variable
48 --
49 | TypeVar String
50 -- |
51 -- A type constructor
52 --
53 | TypeConstructor (Qualified ProperName)
54 -- |
55 -- A type application
56 --
57 | TypeApp Type Type
58 -- |
59 -- A type synonym which is \"saturated\", i.e. fully applied
60 --
61 | SaturatedTypeSynonym (Qualified ProperName) [Type]
62 -- |
63 -- Forall quantifier
64 --
65 | ForAll String Type (Maybe SkolemScope)
66 -- |
67 -- A type with a set of type class constraints
68 --
69 | ConstrainedType [(Qualified ProperName, [Type])] Type
70 -- |
71 -- A skolem constant
72 --
73 | Skolem Int SkolemScope
74 -- |
75 -- An empty row
76 --
77 | REmpty
78 -- |
79 -- A non-empty row
80 --
81 | RCons String Type Type
82 -- |
83 -- A placeholder used in pretty printing
84 --
85 | PrettyPrintFunction Type Type
86 -- |
87 -- A placeholder used in pretty printing
88 --
89 | PrettyPrintArray Type
90 -- |
91 -- A placeholder used in pretty printing
92 --
93 | PrettyPrintForAll [String] Type deriving (Show, Eq, Data, Typeable)
95-- |
96-- Convert a row to a list of pairs of labels and types
97--
98rowToList :: Type -> ([(String, Type)], Type)
99rowToList (RCons name ty row) = let (tys, rest) = rowToList row
100 in ((name, ty):tys, rest)
101rowToList r = ([], r)
103-- |
104-- Convert a list of labels and types to a row
105--
106rowFromList :: ([(String, Type)], Type) -> Type
107rowFromList ([], r) = r
108rowFromList ((name, t):ts, r) = RCons name t (rowFromList (ts, r))
110-- |
111-- Check whether a type is a monotype
112--
113isMonoType :: Type -> Bool
114isMonoType ForAll{} = False
115isMonoType _ = True
117-- |
118-- Universally quantify a type
119--
120mkForAll :: [String] -> Type -> Type
121mkForAll args ty = foldl (\t arg -> ForAll arg t Nothing) ty args
123-- |
124-- The empty record type
125--
126unit :: Type
127unit = Object REmpty
129-- |
130-- Replace a type variable, taking into account variable shadowing
131--
132replaceTypeVars :: String -> Type -> Type -> Type
133replaceTypeVars = replaceTypeVars' []
134 where
135 replaceTypeVars' bound name replacement = go bound
136 where
137 go :: [String] -> Type -> Type
138 go bs (Object r) = Object $ go bs r
139 go _ (TypeVar v) | v == name = replacement
140 go bs (TypeApp t1 t2) = TypeApp (go bs t1) (go bs t2)
141 go bs (SaturatedTypeSynonym name' ts) = SaturatedTypeSynonym name' $ map (go bs) ts
142 go bs f@(ForAll v t sco) | v == name = f
143 | v `elem` usedTypeVariables replacement =
144 let v' = genName v (name : bs ++ usedTypeVariables replacement)
145 t' = replaceTypeVars' bs v (TypeVar v') t
146 in ForAll v' (go (v' : bs) t') sco
147 | otherwise = ForAll v (go (v : bs) t) sco
148 go bs (ConstrainedType cs t) = ConstrainedType (map (second $ map (go bs)) cs) (go bs t)
149 go bs (RCons name' t r) = RCons name' (go bs t) (go bs r)
150 go _ ty = ty
151 genName orig inUse = try 0
152 where
153 try :: Integer -> String
154 try n | (orig ++ show n) `elem` inUse = try (n + 1)
155 | otherwise = orig ++ show n
157-- |
158-- Replace named type variables with types
159--
160replaceAllTypeVars :: [(String, Type)] -> Type -> Type
161replaceAllTypeVars = foldl (\f (name, ty) -> replaceTypeVars name ty . f) id
163-- |
164-- Collect all type variables appearing in a type
165--
166usedTypeVariables :: Type -> [String]
167usedTypeVariables = nub . everything (++) (mkQ [] go)
168 where
169 go (TypeVar v) = [v]
170 go _ = []
172-- |
173-- Collect all free type variables appearing in a type
174--
175freeTypeVariables :: Type -> [String]
176freeTypeVariables = nub . go []
177 where
178 go :: [String] -> Type -> [String]
179 go bound (Object r) = go bound r
180 go bound (TypeVar v) | v `notElem` bound = [v]
181 go bound (TypeApp t1 t2) = go bound t1 ++ go bound t2
182 go bound (SaturatedTypeSynonym _ ts) = concatMap (go bound) ts
183 go bound (ForAll v t _) = go (v : bound) t
184 go bound (ConstrainedType cs t) = concatMap (concatMap (go bound) . snd) cs ++ go bound t
185 go bound (RCons _ t r) = go bound t ++ go bound r
186 go _ _ = []
188-- |
189-- Universally quantify over all type variables appearing free in a type
190--
191quantify :: Type -> Type
192quantify ty = foldr (\arg t -> ForAll arg t Nothing) ty $ freeTypeVariables ty