git.iko.soy/rowtype-yoga/purescript-native
on 4dc1c58 help sign in
rowtype-yoga/purescript-native/src/Language/PureScript/Types.hs
184 lines 5.1 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 -- A named type variable
44 --
45 | TypeVar String
46 -- |
47 -- A type constructor
48 --
49 | TypeConstructor (Qualified ProperName)
50 -- |
51 -- A type application
52 --
53 | TypeApp Type Type
54 -- |
55 -- A type synonym which is \"saturated\", i.e. fully applied
56 --
57 | SaturatedTypeSynonym (Qualified ProperName) [Type]
58 -- |
59 -- Forall quantifier
60 --
61 | ForAll String Type (Maybe SkolemScope)
62 -- |
63 -- A type with a set of type class constraints
64 --
65 | ConstrainedType [(Qualified ProperName, [Type])] Type
66 -- |
67 -- A skolem constant
68 --
69 | Skolem Int SkolemScope
70 -- |
71 -- An empty row
72 --
73 | REmpty
74 -- |
75 -- A non-empty row
76 --
77 | RCons String Type Type
78 -- |
79 -- A placeholder used in pretty printing
80 --
81 | PrettyPrintFunction Type Type
82 -- |
83 -- A placeholder used in pretty printing
84 --
85 | PrettyPrintArray Type
86 -- |
87 -- A placeholder used in pretty printing
88 --
89 | PrettyPrintObject 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-- Replace a type variable, taking into account variable shadowing
125--
126replaceTypeVars :: String -> Type -> Type -> Type
127replaceTypeVars = replaceTypeVars' []
128 where
129 replaceTypeVars' bound name replacement = go bound
130 where
131 go :: [String] -> Type -> Type
132 go _ (TypeVar v) | v == name = replacement
133 go bs (TypeApp t1 t2) = TypeApp (go bs t1) (go bs t2)
134 go bs (SaturatedTypeSynonym name' ts) = SaturatedTypeSynonym name' $ map (go bs) ts
135 go bs f@(ForAll v t sco) | v == name = f
136 | v `elem` usedTypeVariables replacement =
137 let v' = genName v (name : bs ++ usedTypeVariables replacement)
138 t' = replaceTypeVars' bs v (TypeVar v') t
139 in ForAll v' (go (v' : bs) t') sco
140 | otherwise = ForAll v (go (v : bs) t) sco
141 go bs (ConstrainedType cs t) = ConstrainedType (map (second $ map (go bs)) cs) (go bs t)
142 go bs (RCons name' t r) = RCons name' (go bs t) (go bs r)
143 go _ ty = ty
144 genName orig inUse = try 0
145 where
146 try :: Integer -> String
147 try n | (orig ++ show n) `elem` inUse = try (n + 1)
148 | otherwise = orig ++ show n
150-- |
151-- Replace named type variables with types
152--
153replaceAllTypeVars :: [(String, Type)] -> Type -> Type
154replaceAllTypeVars = foldl (\f (name, ty) -> replaceTypeVars name ty . f) id
156-- |
157-- Collect all type variables appearing in a type
158--
159usedTypeVariables :: Type -> [String]
160usedTypeVariables = nub . everything (++) (mkQ [] go)
161 where
162 go (TypeVar v) = [v]
163 go _ = []
165-- |
166-- Collect all free type variables appearing in a type
167--
168freeTypeVariables :: Type -> [String]
169freeTypeVariables = nub . go []
170 where
171 go :: [String] -> Type -> [String]
172 go bound (TypeVar v) | v `notElem` bound = [v]
173 go bound (TypeApp t1 t2) = go bound t1 ++ go bound t2
174 go bound (SaturatedTypeSynonym _ ts) = concatMap (go bound) ts
175 go bound (ForAll v t _) = go (v : bound) t
176 go bound (ConstrainedType cs t) = concatMap (concatMap (go bound) . snd) cs ++ go bound t
177 go bound (RCons _ t r) = go bound t ++ go bound r
178 go _ _ = []
180-- |
181-- Universally quantify over all type variables appearing free in a type
182--
183quantify :: Type -> Type
184quantify ty = foldr (\arg t -> ForAll arg t Nothing) ty $ freeTypeVariables ty