git.iko.soy/elk
on master help sign in
Update a couple Type/ modules for AST shuffle
6e2f87eEvan Czaplicki
src/Type/Constrain/Effects.hs+2−2
compare with master
unifiedsplit
@@ -9,7 +9,7 @@ module Type.Constrain.Effects
9import Control.Monad (replicateM)
9import Control.Monad (replicateM)
10import qualified Data.Map.Strict as Map
10import qualified Data.Map.Strict as Map
11
11
12−import qualified AST.Expression.Canonical as Can
12+import qualified AST.Canonical as Can
13import qualified AST.Module.Name as ModuleName
13import qualified AST.Module.Name as ModuleName
14import qualified AST.Type as T
14import qualified AST.Type as T
15import qualified Elm.Name as N
15import qualified Elm.Name as N
@@ -122,7 +122,7 @@ constrainEffects r0 r1 r2 toFinalArgs =
122 , CEqual Error.SelfMsg r2 (VarN selfMsg1) (VarN selfMsg2)
122 , CEqual Error.SelfMsg r2 (VarN selfMsg1) (VarN selfMsg2)
123 ]
123 ]
124
124
125− return $ CLet [ Scheme [] vars (CAnd constrains) Map.empty ] CSaveEnv
125+ return $ CLet [ Scheme [] vars Map.empty (CAnd constrains) ] CSaveEnv
126
126
127
127
128{-# NOINLINE never #-}
128{-# NOINLINE never #-}
src/Type/Constrain/Pattern.hs+1−1
@@ -10,7 +10,7 @@ import Control.Arrow (second)
10import Control.Monad (foldM)
10import Control.Monad (foldM)
11import qualified Data.Map.Strict as Map
11import qualified Data.Map.Strict as Map
12
12
13−import qualified AST.Expression.Canonical as Can
13+import qualified AST.Canonical as Can
14import qualified AST.Module.Name as ModuleName
14import qualified AST.Module.Name as ModuleName
15import qualified Data.Bag as Bag
15import qualified Data.Bag as Bag
16import qualified Data.Index as Index
16import qualified Data.Index as Index
src/Type/Instantiate.hs+21−21
@@ -11,7 +11,7 @@ module Type.Instantiate
11import qualified Data.Map.Strict as Map
11import qualified Data.Map.Strict as Map
12import Data.Map.Strict ((!))
12import Data.Map.Strict ((!))
13
13
14−import qualified AST.Type as T
14+import qualified AST.Canonical as Can
15import qualified Elm.Name as N
15import qualified Elm.Name as N
16import Type.Type
16import Type.Type
17
17
@@ -22,7 +22,7 @@ import Type.Type
22
22
23-- TODO should the freeFlexVars be ranked a certain way?
23-- TODO should the freeFlexVars be ranked a certain way?
24-- How does this interact with `TS.flatten` exactly?
24-- How does this interact with `TS.flatten` exactly?
25−flexible :: T.Canonical -> IO ( Type, Map.Map N.Name Variable )
25+flexible :: Can.Type -> IO ( Type, Map.Map N.Name Variable )
26flexible srcType =
26flexible srcType =
27 do let freeVars = gatherFreeVars srcType Map.empty
27 do let freeVars = gatherFreeVars srcType Map.empty
28 freeFlexVars <- Map.traverseWithKey (\name () -> nameToFlex name) freeVars
28 freeFlexVars <- Map.traverseWithKey (\name () -> nameToFlex name) freeVars
@@ -30,7 +30,7 @@ flexible srcType =
30 return ( tipe, freeFlexVars )
30 return ( tipe, freeFlexVars )
31
31
32
32
33−rigid :: T.Canonical -> IO ( Type, Map.Map N.Name Variable )
33+rigid :: Can.Type -> IO ( Type, Map.Map N.Name Variable )
34rigid srcType =
34rigid srcType =
35 do let freeVars = gatherFreeVars srcType Map.empty
35 do let freeVars = gatherFreeVars srcType Map.empty
36 freeRigidVars <- Map.traverseWithKey (\name () -> nameToRigid name) freeVars
36 freeRigidVars <- Map.traverseWithKey (\name () -> nameToRigid name) freeVars
@@ -42,22 +42,22 @@ rigid srcType =
42-- GATHER FREE VARS
42-- GATHER FREE VARS
43
43
44
44
45−gatherFreeVars :: T.Canonical -> Map.Map N.Name () -> Map.Map N.Name ()
45+gatherFreeVars :: Can.Type -> Map.Map N.Name () -> Map.Map N.Name ()
46gatherFreeVars tipe dict =
46gatherFreeVars tipe dict =
47 case tipe of
47 case tipe of
48− T.Lambda arg result ->
48+ Can.TLambda arg result ->
49 gatherFreeVars result (gatherFreeVars arg dict)
49 gatherFreeVars result (gatherFreeVars arg dict)
50
50
51− T.Var name ->
51+ Can.TVar name ->
52 Map.insert name () dict
52 Map.insert name () dict
53
53
54− T.Type _ _ args ->
54+ Can.TType _ _ args ->
55 foldr gatherFreeVars dict args
55 foldr gatherFreeVars dict args
56
56
57− T.Aliased _ _ args _ ->
57+ Can.TAlias _ _ args _ ->
58 foldr gatherFreeVars dict (map snd args)
58 foldr gatherFreeVars dict (map snd args)
59
59
60− T.Tuple a b maybeC ->
60+ Can.TTuple a b maybeC ->
61 gatherFreeVars a $ gatherFreeVars b $
61 gatherFreeVars a $ gatherFreeVars b $
62 case maybeC of
62 case maybeC of
63 Nothing ->
63 Nothing ->
@@ -66,10 +66,10 @@ gatherFreeVars tipe dict =
66 Just c ->
66 Just c ->
67 gatherFreeVars c dict
67 gatherFreeVars c dict
68
68
69− T.Unit ->
69+ Can.TUnit ->
70 dict
70 dict
71
71
72− T.Record fields maybeExt ->
72+ Can.TRecord fields maybeExt ->
73 case maybeExt of
73 case maybeExt of
74 Nothing ->
74 Nothing ->
75 Map.foldr gatherFreeVars dict fields
75 Map.foldr gatherFreeVars dict fields
@@ -82,40 +82,40 @@ gatherFreeVars tipe dict =
82-- FROM SOURCE TYPE
82-- FROM SOURCE TYPE
83
83
84
84
85−fromSrcType :: Map.Map N.Name Type -> T.Canonical -> IO Type
85+fromSrcType :: Map.Map N.Name Type -> Can.Type -> IO Type
86fromSrcType freeVars sourceType =
86fromSrcType freeVars sourceType =
87 case sourceType of
87 case sourceType of
88− T.Lambda arg result ->
88+ Can.TLambda arg result ->
89 FunN
89 FunN
90 <$> fromSrcType freeVars arg
90 <$> fromSrcType freeVars arg
91 <*> fromSrcType freeVars result
91 <*> fromSrcType freeVars result
92
92
93− T.Var name ->
93+ Can.TVar name ->
94 return (freeVars ! name)
94 return (freeVars ! name)
95
95
96− T.Type home name args ->
96+ Can.TType home name args ->
97 AppN home name <$> traverse (fromSrcType freeVars) args
97 AppN home name <$> traverse (fromSrcType freeVars) args
98
98
99− T.Aliased home name args aliasedType ->
99+ Can.TAlias home name args aliasedType ->
100 do targs <- traverse (traverse (fromSrcType freeVars)) args
100 do targs <- traverse (traverse (fromSrcType freeVars)) args
101 AliasN home name targs <$>
101 AliasN home name targs <$>
102 case aliasedType of
102 case aliasedType of
103− T.Filled realType ->
103+ Can.Filled realType ->
104 fromSrcType freeVars realType
104 fromSrcType freeVars realType
105
105
106− T.Holey realType ->
106+ Can.Holey realType ->
107 fromSrcType (Map.fromList targs) realType
107 fromSrcType (Map.fromList targs) realType
108
108
109− T.Tuple a b maybeC ->
109+ Can.TTuple a b maybeC ->
110 TupleN
110 TupleN
111 <$> fromSrcType freeVars a
111 <$> fromSrcType freeVars a
112 <*> fromSrcType freeVars b
112 <*> fromSrcType freeVars b
113 <*> traverse (fromSrcType freeVars) maybeC
113 <*> traverse (fromSrcType freeVars) maybeC
114
114
115− T.Unit ->
115+ Can.TUnit ->
116 return UnitN
116 return UnitN
117
117
118− T.Record fields maybeExt ->
118+ Can.TRecord fields maybeExt ->
119 RecordN
119 RecordN
120 <$> traverse (fromSrcType freeVars) fields
120 <$> traverse (fromSrcType freeVars) fields
121 <*>
121 <*>
src/Type/Type.hs+46−38
@@ -35,8 +35,9 @@ import qualified Data.Text as Text
35import Data.Text (Text)
35import Data.Text (Text)
36import Data.Word (Word32)
36import Data.Word (Word32)
37
37
38+import qualified AST.Canonical as Can
38import qualified AST.Module.Name as ModuleName
39import qualified AST.Module.Name as ModuleName
39−import qualified AST.Type as T
40+import qualified AST.Utils.Type as Type
40import qualified Elm.Name as N
41import qualified Elm.Name as N
41import qualified Type.UnionFind as UF
42import qualified Type.UnionFind as UF
42
43
@@ -85,14 +86,21 @@ data Descriptor =
85
86
86data Content
87data Content
87 = FlexVar (Maybe N.Name)
88 = FlexVar (Maybe N.Name)
88− | FlexSuper T.Super (Maybe N.Name)
89+ | FlexSuper SuperType (Maybe N.Name)
89 | RigidVar N.Name
90 | RigidVar N.Name
90− | RigidSuper T.Super N.Name
91+ | RigidSuper SuperType N.Name
91 | Structure FlatType
92 | Structure FlatType
92 | Alias ModuleName.Canonical N.Name [(N.Name,Variable)] Variable
93 | Alias ModuleName.Canonical N.Name [(N.Name,Variable)] Variable
93 | Error Text
94 | Error Text
94
95
95
96
97+data SuperType
98+ = Number
99+ | Comparable
100+ | Appendable
101+ | CompAppend
102+
103+
96makeDescriptor :: Content -> Descriptor
104makeDescriptor :: Content -> Descriptor
97makeDescriptor content =
105makeDescriptor content =
98 Descriptor content noRank noMark Nothing
106 Descriptor content noRank noMark Nothing
@@ -245,10 +253,10 @@ mkFlexNumber =
245{-# NOINLINE flexNumberDescriptor #-}
253{-# NOINLINE flexNumberDescriptor #-}
246flexNumberDescriptor :: Descriptor
254flexNumberDescriptor :: Descriptor
247flexNumberDescriptor =
255flexNumberDescriptor =
248− makeDescriptor (unnamedFlexSuper T.Number)
256+ makeDescriptor (unnamedFlexSuper Number)
249
257
250
258
251−unnamedFlexSuper :: T.Super -> Content
259+unnamedFlexSuper :: SuperType -> Content
252unnamedFlexSuper super =
260unnamedFlexSuper super =
253 FlexSuper super Nothing
261 FlexSuper super Nothing
254
262
@@ -269,19 +277,19 @@ nameToRigid name =
269 maybe RigidVar RigidSuper (toSuper name) name
277 maybe RigidVar RigidSuper (toSuper name) name
270
278
271
279
272−toSuper :: N.Name -> Maybe T.Super
280+toSuper :: N.Name -> Maybe SuperType
273toSuper name =
281toSuper name =
274 if Text.isPrefixOf "number" name then
282 if Text.isPrefixOf "number" name then
275− Just T.Number
283+ Just Number
276
284
277 else if Text.isPrefixOf "comparable" name then
285 else if Text.isPrefixOf "comparable" name then
278− Just T.Comparable
286+ Just Comparable
279
287
280 else if Text.isPrefixOf "appendable" name then
288 else if Text.isPrefixOf "appendable" name then
281− Just T.Appendable
289+ Just Appendable
282
290
283 else if Text.isPrefixOf "compappend" name then
291 else if Text.isPrefixOf "compappend" name then
284− Just T.CompAppend
292+ Just CompAppend
285
293
286 else
294 else
287 Nothing
295 Nothing
@@ -293,19 +301,19 @@ toSuper name =
293
301
294-- TODO: Attach resulting type to the descriptor so that you
302-- TODO: Attach resulting type to the descriptor so that you
295-- never have to do extra work, particularly nice for aliased types
303-- never have to do extra work, particularly nice for aliased types
296−toSrcType :: Variable -> IO T.Canonical
304+toSrcType :: Variable -> IO Can.Type
297toSrcType variable =
305toSrcType variable =
298 do takenNames <- getVarNames variable Map.empty
306 do takenNames <- getVarNames variable Map.empty
299 State.evalStateT (variableToSrcType variable) (makeNameState takenNames)
307 State.evalStateT (variableToSrcType variable) (makeNameState takenNames)
300
308
301
309
302−variableToSrcType :: Variable -> StateT NameState IO T.Canonical
310+variableToSrcType :: Variable -> StateT NameState IO Can.Type
303variableToSrcType variable =
311variableToSrcType variable =
304 do descriptor <- liftIO $ UF.descriptor variable
312 do descriptor <- liftIO $ UF.descriptor variable
305 let mark = _mark descriptor
313 let mark = _mark descriptor
306 if mark == occursMark
314 if mark == occursMark
307 then
315 then
308− return (T.Var "∞")
316+ return (Can.TVar "∞")
309
317
310 else
318 else
311 do liftIO $ UF.modifyDescriptor variable (\desc -> desc { _mark = occursMark })
319 do liftIO $ UF.modifyDescriptor variable (\desc -> desc { _mark = occursMark })
@@ -314,7 +322,7 @@ variableToSrcType variable =
314 return srcType
322 return srcType
315
323
316
324
317−contentToSrcType :: Variable -> Content -> StateT NameState IO T.Canonical
325+contentToSrcType :: Variable -> Content -> StateT NameState IO Can.Type
318contentToSrcType variable content =
326contentToSrcType variable content =
319 case content of
327 case content of
320 Structure term ->
328 Structure term ->
@@ -323,71 +331,71 @@ contentToSrcType variable content =
323 FlexVar maybeName ->
331 FlexVar maybeName ->
324 case maybeName of
332 case maybeName of
325 Just name ->
333 Just name ->
326− return (T.Var name)
334+ return (Can.TVar name)
327
335
328 Nothing ->
336 Nothing ->
329 do name <- getFreshVarName
337 do name <- getFreshVarName
330 liftIO $ UF.modifyDescriptor variable (\desc -> desc { _content = FlexVar (Just name) })
338 liftIO $ UF.modifyDescriptor variable (\desc -> desc { _content = FlexVar (Just name) })
331− return (T.Var name)
339+ return (Can.TVar name)
332
340
333 FlexSuper super maybeName ->
341 FlexSuper super maybeName ->
334 case maybeName of
342 case maybeName of
335 Just name ->
343 Just name ->
336− return (T.Var name)
344+ return (Can.TVar name)
337
345
338 Nothing ->
346 Nothing ->
339 do name <- getFreshSuperName super
347 do name <- getFreshSuperName super
340 liftIO $ UF.modifyDescriptor variable (\desc -> desc { _content = FlexSuper super (Just name) })
348 liftIO $ UF.modifyDescriptor variable (\desc -> desc { _content = FlexSuper super (Just name) })
341− return (T.Var name)
349+ return (Can.TVar name)
342
350
343 RigidVar name ->
351 RigidVar name ->
344− return (T.Var name)
352+ return (Can.TVar name)
345
353
346 RigidSuper _ name ->
354 RigidSuper _ name ->
347− return (T.Var name)
355+ return (Can.TVar name)
348
356
349 Alias home name args realVariable ->
357 Alias home name args realVariable ->
350 do srcArgs <- traverse (traverse variableToSrcType) args
358 do srcArgs <- traverse (traverse variableToSrcType) args
351 srcType <- variableToSrcType realVariable
359 srcType <- variableToSrcType realVariable
352− return (T.Aliased home name srcArgs (T.Filled srcType))
360+ return (Can.TAlias home name srcArgs (Can.Filled srcType))
353
361
354 Error name ->
362 Error name ->
355− return (T.Var name)
363+ return (Can.TVar name)
356
364
357
365
358−termToSrcType :: FlatType -> StateT NameState IO T.Canonical
366+termToSrcType :: FlatType -> StateT NameState IO Can.Type
359termToSrcType term =
367termToSrcType term =
360 case term of
368 case term of
361 App1 home name args ->
369 App1 home name args ->
362− T.Type home name <$> traverse variableToSrcType args
370+ Can.TType home name <$> traverse variableToSrcType args
363
371
364 Fun1 a b ->
372 Fun1 a b ->
365− T.Lambda
373+ Can.TLambda
366 <$> variableToSrcType a
374 <$> variableToSrcType a
367 <*> variableToSrcType b
375 <*> variableToSrcType b
368
376
369 EmptyRecord1 ->
377 EmptyRecord1 ->
370− return $ T.Record Map.empty Nothing
378+ return $ Can.TRecord Map.empty Nothing
371
379
372 Record1 fields extension ->
380 Record1 fields extension ->
373 do srcFields <- traverse variableToSrcType fields
381 do srcFields <- traverse variableToSrcType fields
374− srcExt <- T.iteratedDealias <$> variableToSrcType extension
382+ srcExt <- Type.iteratedDealias <$> variableToSrcType extension
375 return $
383 return $
376 case srcExt of
384 case srcExt of
377− T.Record subFields subExt ->
385+ Can.TRecord subFields subExt ->
378− T.Record (Map.union subFields srcFields) subExt
386+ Can.TRecord (Map.union subFields srcFields) subExt
379
387
380− T.Var _ ->
388+ Can.TVar _ ->
381− T.Record srcFields (Just srcExt)
389+ Can.TRecord srcFields (Just srcExt)
382
390
383 _ ->
391 _ ->
384 error "Used toSrcType on a type that is not well-formed"
392 error "Used toSrcType on a type that is not well-formed"
385
393
386 Unit1 ->
394 Unit1 ->
387− return T.Unit
395+ return Can.TUnit
388
396
389 Tuple1 a b maybeC ->
397 Tuple1 a b maybeC ->
390− T.Tuple
398+ Can.TTuple
391 <$> variableToSrcType a
399 <$> variableToSrcType a
392 <*> variableToSrcType b
400 <*> variableToSrcType b
393 <*> traverse variableToSrcType maybeC
401 <*> traverse variableToSrcType maybeC
@@ -425,19 +433,19 @@ getFreshVarName =
425 return uniqueName
433 return uniqueName
426
434
427
435
428−getFreshSuperName :: (Monad m) => T.Super -> StateT NameState m Text
436+getFreshSuperName :: (Monad m) => SuperType -> StateT NameState m Text
429getFreshSuperName super =
437getFreshSuperName super =
430 case super of
438 case super of
431− T.Number ->
439+ Number ->
432 getFreshSuper "number" _numbers (\index state -> state { _numbers = index })
440 getFreshSuper "number" _numbers (\index state -> state { _numbers = index })
433
441
434− T.Comparable ->
442+ Comparable ->
435 getFreshSuper "comparable" _comparables (\index state -> state { _comparables = index })
443 getFreshSuper "comparable" _comparables (\index state -> state { _comparables = index })
436
444
437− T.Appendable ->
445+ Appendable ->
438 getFreshSuper "appendable" _appendables (\index state -> state { _appendables = index })
446 getFreshSuper "appendable" _appendables (\index state -> state { _appendables = index })
439
447
440− T.CompAppend ->
448+ CompAppend ->
441 getFreshSuper "compappend" _compAppends (\index state -> state { _compAppends = index })
449 getFreshSuper "compappend" _compAppends (\index state -> state { _compAppends = index })
442
450
443
451