git.iko.soy/rowtype-yoga/purescript-native
on eb2ce65 help sign in
rowtype-yoga/purescript-native/src/Language/PureScript/Types.hs
223 lines 6.0 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, mkT, mkQ, everywhereBut)
24import Control.Monad.Unify
25import Control.Arrow ((***))
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 deriving (Show, Eq, Data, Typeable)
91-- |
92-- Type constructor for functions
93--
94tyFunction :: Type
95tyFunction = TypeConstructor $ (Qualified $ Just $ ModuleName [ProperName "Prim"]) (ProperName "Function")
97-- |
98-- Type constructor for strings
99--
100tyString :: Type
101tyString = TypeConstructor $ (Qualified $ Just $ ModuleName [ProperName "Prim"]) (ProperName "String")
103-- |
104-- Type constructor for numbers
105--
106tyNumber :: Type
107tyNumber = TypeConstructor $ (Qualified $ Just $ ModuleName [ProperName "Prim"]) (ProperName "Number")
109-- |
110-- Type constructor for booleans
111--
112tyBoolean :: Type
113tyBoolean = TypeConstructor $ (Qualified $ Just $ ModuleName [ProperName "Prim"]) (ProperName "Boolean")
115-- |
116-- Type constructor for arrays
117--
118tyArray :: Type
119tyArray = TypeConstructor $ (Qualified $ Just $ ModuleName [ProperName "Prim"]) (ProperName "Array")
121-- |
122-- Smart constructor for function types
123--
124function :: Type -> Type -> Type
125function t1 t2 = TypeApp (TypeApp tyFunction t1) t2
127-- |
128-- Convert a row to a list of pairs of labels and types
129--
130rowToList :: Type -> ([(String, Type)], Type)
131rowToList (RCons name ty row) = let (tys, rest) = rowToList row
132 in ((name, ty):tys, rest)
133rowToList r = ([], r)
135-- |
136-- Convert a list of labels and types to a row
137--
138rowFromList :: ([(String, Type)], Type) -> Type
139rowFromList ([], r) = r
140rowFromList ((name, t):ts, r) = RCons name t (rowFromList (ts, r))
142-- |
143-- Check whether a type is a monotype
144--
145isMonoType :: Type -> Bool
146isMonoType (ForAll _ _ _) = False
147isMonoType ty = True
149-- |
150-- Universally quantify a type
151--
152mkForAll :: [String] -> Type -> Type
153mkForAll args ty = foldl (\t arg -> ForAll arg t Nothing) ty args
155-- |
156-- The empty record type
157--
158unit :: Type
159unit = Object REmpty
161-- |
162-- Replace a type variable, taking into account variable shadowing
163--
164replaceTypeVars :: String -> Type -> Type -> Type
165replaceTypeVars = replaceTypeVars' []
166 where
167 replaceTypeVars' bound name replacement = go bound
168 where
169 go :: [String] -> Type -> Type
170 go bs (Object r) = Object $ go bs r
171 go bs (TypeVar v) | v == name = replacement
172 go bs (TypeApp t1 t2) = TypeApp (go bs t1) (go bs t2)
173 go bs (SaturatedTypeSynonym name ts) = SaturatedTypeSynonym name $ map (go bs) ts
174 go bs f@(ForAll v t sco) | v == name = f
175 | v `elem` usedTypeVariables replacement =
176 let v' = genName v (name : bs ++ usedTypeVariables replacement)
177 t' = replaceTypeVars' bs v (TypeVar v') t
178 in ForAll v' (go (v' : bs) t') sco
179 | otherwise = ForAll v (go (v : bs) t) sco
180 go bs (ConstrainedType cs t) = ConstrainedType (map (id *** map (go bs)) cs) (go bs t)
181 go bs (RCons name t r) = RCons name (go bs t) (go bs r)
182 go _ ty = ty
183 genName orig inUse = try 0
184 where
185 try n | (orig ++ show n) `elem` inUse = try (n + 1)
186 | otherwise = orig ++ show n
188-- |
189-- Replace named type variables with types
190--
191replaceAllTypeVars :: [(String, Type)] -> Type -> Type
192replaceAllTypeVars = foldl (\f (name, ty) -> replaceTypeVars name ty . f) id
194-- |
195-- Collect all type variables appearing in a type
196--
197usedTypeVariables :: Type -> [String]
198usedTypeVariables = nub . everything (++) (mkQ [] go)
199 where
200 go (TypeVar v) = [v]
201 go _ = []
203-- |
204-- Collect all free type variables appearing in a type
205--
206freeTypeVariables :: Type -> [String]
207freeTypeVariables = nub . go []
208 where
209 go :: [String] -> Type -> [String]
210 go bound (Object r) = go bound r
211 go bound (TypeVar v) | v `notElem` bound = [v]
212 go bound (TypeApp t1 t2) = go bound t1 ++ go bound t2
213 go bound (SaturatedTypeSynonym _ ts) = concatMap (go bound) ts
214 go bound (ForAll v t _) = go (v : bound) t
215 go bound (ConstrainedType cs t) = concatMap (concatMap (go bound) . snd) cs ++ go bound t
216 go bound (RCons _ t r) = go bound t ++ go bound r
217 go _ _ = []
219-- |
220-- Universally quantify over all type variables appearing free in a type
221--
222quantify :: Type -> Type
223quantify ty = foldr (\arg t -> ForAll arg t Nothing) ty $ freeTypeVariables ty