on master help sign in
Get rid of pointless polymorphism in Type representations
commit9593f00ac539fc02b5821cf298e51b88d189a8dd authorEvan Czaplicki <evancz@users.noreply.github.com> dateThu 1 Jun 2017, 20:08 (9 years ago) parentf922d2a
1 file changed+41−55
src/Type/Type.hs+41−55
src/Type/Type.hs+41−55
@@ -9,7 +9,6 @@ import qualified Data.Char as Char
99import qualified Data.Map as Map
1010import Data.Monoid ((<>))
1111import qualified Data.Text as Text
12−import qualified Data.UnionFind.IO as UF
1312import Data.Text (Text)
1413
1514import qualified AST.Type as T
@@ -17,49 +16,32 @@ import qualified AST.Variable as Var
1716import qualified Reporting.Annotation as A
1817import qualified Reporting.Error.Type as Error
1918import qualified Reporting.Region as R
19+import qualified Type.UnionFind as UF
2020
2121
2222
23−-- CONCRETE TYPES
24−
25−
26−type Type =
27− TermN Variable
23+-- TYPE PRIMITIVES
2824
2925
3026type Variable =
3127 UF.Point Descriptor
3228
3329
34−type TypeConstraint =
35− Constraint Type Variable
36−
37−
38−type TypeScheme =
39− Scheme Type Variable
40−
41−
42−
43−-- TYPE PRIMITIVES
44−
45−
46−data Term1 a
47− = App1 a a
48− | Fun1 a a
30+data FlatType
31+ = App1 Variable Variable
32+ | Fun1 Variable Variable
4933 | EmptyRecord1
50− | Record1 (Map.Map Text a) a
34+ | Record1 (Map.Map Text Variable) Variable
5135
5236
53−data TermN a
37+data Type
5438 = PlaceHolder Text
55− | AliasN Var.Canonical [(Text, TermN a)] (TermN a)
56− | VarN a
57− | TermN (Term1 (TermN a))
58−
59−
60−record :: Map.Map Text (TermN a) -> TermN a -> TermN a
61−record fs rec =
62− TermN (Record1 fs rec)
39+ | AliasN Var.Canonical [(Text, Type)] Type
40+ | VarN Variable
41+ | AppN Type Type
42+ | FunN Type Type
43+ | EmptyRecordN
44+ | RecordN (Map.Map Text Type) Type
6345
6446
6547
@@ -76,7 +58,7 @@ data Descriptor =
7658
7759
7860data Content
79− = Structure (Term1 Variable)
61+ = Structure FlatType
8062 | Atom Var.Canonical
8163 | Var Flex (Maybe Super) (Maybe Text)
8264 | Alias Var.Canonical [(Text,Variable)] Variable
@@ -126,23 +108,24 @@ getVarNamesMark =
126108-- CONSTRAINTS
127109
128110
129−data Constraint a b
111+data Constraint
130112 = CTrue
131113 | CSaveEnv
132− | CEqual Error.Hint R.Region a a
133− | CAnd [Constraint a b]
134− | CLet [Scheme a b] (Constraint a b)
135− | CInstance R.Region SchemeName a
114+ | CEqual Error.Hint R.Region Type Type
115+ | CAnd [Constraint]
116+ | CLet [Scheme] Constraint
117+ | CInstance R.Region SchemeName Type
136118
137119
138120type SchemeName = Text
139121
140122
141−data Scheme a b = Scheme
142− { _rigidQuantifiers :: [b]
143− , _flexibleQuantifiers :: [b]
144− , _constraint :: Constraint a b
145− , _header :: Map.Map Text (A.Located a)
123+data Scheme =
124+ Scheme
125+ { _rigidQuantifiers :: [Variable]
126+ , _flexibleQuantifiers :: [Variable]
127+ , _constraint :: Constraint
128+ , _header :: Map.Map Text (A.Located Type)
146129 }
147130
148131
@@ -153,14 +136,16 @@ data Scheme a b = Scheme
153136infixr 9 ==>
154137
155138
139+{-# INLINE (==>) #-}
156140(==>) :: Type -> Type -> Type
157−(==>) a b =
158− TermN (Fun1 a b)
141+(==>) =
142+ FunN
159143
160144
161−(<|) :: TermN a -> TermN a -> TermN a
162−(<|) f a =
163− TermN (App1 f a)
145+{-# INLINE (<|) #-}
146+(<|) :: Type -> Type -> Type
147+(<|) =
148+ AppN
164149
165150
166151
@@ -211,7 +196,7 @@ toSuper name =
211196-- CONSTRAINT HELPERS
212197
213198
214−monoscheme :: Map.Map Text (A.Located a) -> Scheme a b
199+monoscheme :: Map.Map Text (A.Located Type) -> Scheme
215200monoscheme headers =
216201 Scheme [] [] CTrue headers
217202
@@ -219,7 +204,7 @@ monoscheme headers =
219204infixl 8 /\
220205
221206
222−(/\) :: Constraint a b -> Constraint a b -> Constraint a b
207+(/\) :: Constraint -> Constraint -> Constraint
223208(/\) c1 c2 =
224209 case (c1, c2) of
225210 (CTrue, _) -> c2
@@ -228,23 +213,23 @@ infixl 8 /\
228213
229214
230215-- ex qs constraint == exists qs. constraint
231−ex :: [Variable] -> TypeConstraint -> TypeConstraint
216+ex :: [Variable] -> Constraint -> Constraint
232217ex fqs constraint =
233218 CLet [Scheme [] fqs constraint Map.empty] CTrue
234219
235220
236−forall :: [Variable] -> TypeConstraint -> TypeConstraint
221+forall :: [Variable] -> Constraint -> Constraint
237222forall rqs constraint =
238223 CLet [Scheme rqs [] constraint Map.empty] CTrue
239224
240225
241−exists :: (Type -> IO TypeConstraint) -> IO TypeConstraint
226+exists :: (Type -> IO Constraint) -> IO Constraint
242227exists f =
243228 do v <- mkVar Nothing
244229 ex [v] <$> f (VarN v)
245230
246231
247−existsNumber :: (Type -> IO TypeConstraint) -> IO TypeConstraint
232+existsNumber :: (Type -> IO Constraint) -> IO Constraint
248233existsNumber f =
249234 do v <- mkVar (Just Number)
250235 ex [v] <$> f (VarN v)
@@ -304,7 +289,7 @@ contentToSrcType variable content =
304289 return (T.Var "?")
305290
306291
307−termToSrcType :: Term1 Variable -> StateT NameState IO T.Canonical
292+termToSrcType :: FlatType -> StateT NameState IO T.Canonical
308293termToSrcType term =
309294 case term of
310295 App1 func arg ->
@@ -344,7 +329,8 @@ termToSrcType term =
344329-- MANAGE FRESH VARIABLE NAMES
345330
346331
347−data NameState = NameState
332+data NameState =
333+ NameState
348334 { _taken :: TakenNames
349335 , _normals :: Int
350336 , _numbers :: Int