git.iko.soy/rowtype-yoga/purescript-native
on 39a3a3d help sign in
rowtype-yoga/purescript-native/src/Language/PureScript/Types.hs
187 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 -- 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-- Convert a row to a list of pairs of labels and types
93--
94rowToList :: Type -> ([(String, Type)], Type)
95rowToList (RCons name ty row) = let (tys, rest) = rowToList row
96 in ((name, ty):tys, rest)
97rowToList r = ([], r)
99-- |
100-- Convert a list of labels and types to a row
101--
102rowFromList :: ([(String, Type)], Type) -> Type
103rowFromList ([], r) = r
104rowFromList ((name, t):ts, r) = RCons name t (rowFromList (ts, r))
106-- |
107-- Check whether a type is a monotype
108--
109isMonoType :: Type -> Bool
110isMonoType ForAll{} = False
111isMonoType _ = True
113-- |
114-- Universally quantify a type
115--
116mkForAll :: [String] -> Type -> Type
117mkForAll args ty = foldl (\t arg -> ForAll arg t Nothing) ty args
119-- |
120-- The empty record type
121--
122unit :: Type
123unit = Object REmpty
125-- |
126-- Replace a type variable, taking into account variable shadowing
127--
128replaceTypeVars :: String -> Type -> Type -> Type
129replaceTypeVars = replaceTypeVars' []
130 where
131 replaceTypeVars' bound name replacement = go bound
132 where
133 go :: [String] -> Type -> Type
134 go bs (Object r) = Object $ go bs r
135 go _ (TypeVar v) | v == name = replacement
136 go bs (TypeApp t1 t2) = TypeApp (go bs t1) (go bs t2)
137 go bs (SaturatedTypeSynonym name' ts) = SaturatedTypeSynonym name' $ map (go bs) ts
138 go bs f@(ForAll v t sco) | v == name = f
139 | v `elem` usedTypeVariables replacement =
140 let v' = genName v (name : bs ++ usedTypeVariables replacement)
141 t' = replaceTypeVars' bs v (TypeVar v') t
142 in ForAll v' (go (v' : bs) t') sco
143 | otherwise = ForAll v (go (v : bs) t) sco
144 go bs (ConstrainedType cs t) = ConstrainedType (map (second $ map (go bs)) cs) (go bs t)
145 go bs (RCons name' t r) = RCons name' (go bs t) (go bs r)
146 go _ ty = ty
147 genName orig inUse = try 0
148 where
149 try n | (orig ++ show n) `elem` inUse = try (n + 1)
150 | otherwise = orig ++ show n
152-- |
153-- Replace named type variables with types
154--
155replaceAllTypeVars :: [(String, Type)] -> Type -> Type
156replaceAllTypeVars = foldl (\f (name, ty) -> replaceTypeVars name ty . f) id
158-- |
159-- Collect all type variables appearing in a type
160--
161usedTypeVariables :: Type -> [String]
162usedTypeVariables = nub . everything (++) (mkQ [] go)
163 where
164 go (TypeVar v) = [v]
165 go _ = []
167-- |
168-- Collect all free type variables appearing in a type
169--
170freeTypeVariables :: Type -> [String]
171freeTypeVariables = nub . go []
172 where
173 go :: [String] -> Type -> [String]
174 go bound (Object r) = go bound r
175 go bound (TypeVar v) | v `notElem` bound = [v]
176 go bound (TypeApp t1 t2) = go bound t1 ++ go bound t2
177 go bound (SaturatedTypeSynonym _ ts) = concatMap (go bound) ts
178 go bound (ForAll v t _) = go (v : bound) t
179 go bound (ConstrainedType cs t) = concatMap (concatMap (go bound) . snd) cs ++ go bound t
180 go bound (RCons _ t r) = go bound t ++ go bound r
181 go _ _ = []
183-- |
184-- Universally quantify over all type variables appearing free in a type
185--
186quantify :: Type -> Type
187quantify ty = foldr (\arg t -> ForAll arg t Nothing) ty $ freeTypeVariables ty