git.iko.soy/elk
on master help sign in
Name changes for simpler Type representation
d5b0b43Evan Czaplicki
src/Type/Constrain/Effects.hs+4−4
compare with master
unifiedsplit
@@ -11,8 +11,8 @@ import qualified Reporting.Annotation as A
11import qualified Reporting.Error.Type as Error
11import qualified Reporting.Error.Type as Error
12import qualified Type.Environment as Env
12import qualified Type.Environment as Env
13import Type.Type
13import Type.Type
14− ( Variable, Type, TypeConstraint, Constraint(..), Scheme(Scheme)
14+ ( Variable, Type(VarN), Constraint(..), Scheme(Scheme)
15− , TermN(VarN), (==>), (<|), mkVar
15+ , (==>), (<|), mkVar
16 )
16 )
17
17
18
18
@@ -20,7 +20,7 @@ import Type.Type
20-- CONSTRAIN EFFECTS
20-- CONSTRAIN EFFECTS
21
21
22
22
23−constrain :: Env.Env -> ModuleName.Canonical -> Effects.Canonical -> IO TypeConstraint
23+constrain :: Env.Env -> ModuleName.Canonical -> Effects.Canonical -> IO Constraint
24constrain env moduleName effects =
24constrain env moduleName effects =
25 case effects of
25 case effects of
26 Effects.None ->
26 Effects.None ->
@@ -33,7 +33,7 @@ constrain env moduleName effects =
33 constrainHelp env moduleName info
33 constrainHelp env moduleName info
34
34
35
35
36−constrainHelp :: Env.Env -> ModuleName.Canonical -> Effects.Info -> IO TypeConstraint
36+constrainHelp :: Env.Env -> ModuleName.Canonical -> Effects.Info -> IO Constraint
37constrainHelp env moduleName (Effects.Info tagRegion r0 r1 r2 managerType) =
37constrainHelp env moduleName (Effects.Info tagRegion r0 r1 r2 managerType) =
38 let
38 let
39 task t =
39 task t =
src/Type/Constrain/Expression.hs+19−19
@@ -24,7 +24,7 @@ import Type.Type hiding (Descriptor(..))
24
24
25
25
26
26
27−constrain :: Env.Env -> C.Expr -> Type -> IO TypeConstraint
27+constrain :: Env.Env -> C.Expr -> Type -> IO Constraint
28constrain env annotatedExpr@(A.A region expression) tipe =
28constrain env annotatedExpr@(A.A region expression) tipe =
29 case expression of
29 case expression of
30 C.Literal lit ->
30 C.Literal lit ->
@@ -64,11 +64,11 @@ constrain env annotatedExpr@(A.A region expression) tipe =
64 if Map.null decls then
64 if Map.null decls then
65 baseRec
65 baseRec
66 else
66 else
67− record (Map.map glToType decls) baseRec
67+ RecordN (Map.map glToType decls) baseRec
68
68
69 attribute = makeRec Lit.attribute attr
69 attribute = makeRec Lit.attribute attr
70 uniform = makeRec Lit.uniform unif
70 uniform = makeRec Lit.uniform unif
71− varying = makeRec Lit.varying (TermN EmptyRecord1)
71+ varying = makeRec Lit.varying EmptyRecordN
72 in
72 in
73 return (CEqual Error.Shader region (shaderTipe attribute uniform varying) tipe)
73 return (CEqual Error.Shader region (shaderTipe attribute uniform varying) tipe)
74
74
@@ -117,7 +117,7 @@ constrain env annotatedExpr@(A.A region expression) tipe =
117 exists $ \ext ->
117 exists $ \ext ->
118 do recordCon <- constrain env expr recordType
118 do recordCon <- constrain env expr recordType
119 let maybeBody = C.collectFields expr
119 let maybeBody = C.collectFields expr
120− let desiredType = record (Map.singleton field tipe) ext
120+ let desiredType = RecordN (Map.singleton field tipe) ext
121 let fieldCon = CEqual (Error.Access maybeBody field) region recordType desiredType
121 let fieldCon = CEqual (Error.Access maybeBody field) region recordType desiredType
122 return $ recordCon /\ fieldCon
122 return $ recordCon /\ fieldCon
123
123
@@ -125,11 +125,11 @@ constrain env annotatedExpr@(A.A region expression) tipe =
125 exists $ \t ->
125 exists $ \t ->
126 do oldVars <- mapM (\_ -> mkVar Nothing) fields
126 do oldVars <- mapM (\_ -> mkVar Nothing) fields
127 let oldFields = Map.fromList (zip (map fst fields) (map VarN oldVars))
127 let oldFields = Map.fromList (zip (map fst fields) (map VarN oldVars))
128− cOld <- ex oldVars <$> constrain env expr (record oldFields t)
128+ cOld <- ex oldVars <$> constrain env expr (RecordN oldFields t)
129
129
130 newVars <- mapM (\_ -> mkVar Nothing) fields
130 newVars <- mapM (\_ -> mkVar Nothing) fields
131 let newFields = Map.fromList (zip (map fst fields) (map VarN newVars))
131 let newFields = Map.fromList (zip (map fst fields) (map VarN newVars))
132− let cNew = CEqual Error.Record region (record newFields t) tipe
132+ let cNew = CEqual Error.Record region (RecordN newFields t) tipe
133
133
134 cs <- Monad.zipWithM (constrain env) (map snd fields) (map VarN newVars)
134 cs <- Monad.zipWithM (constrain env) (map snd fields) (map VarN newVars)
135
135
@@ -143,7 +143,7 @@ constrain env annotatedExpr@(A.A region expression) tipe =
143 (map snd fields)
143 (map snd fields)
144 (map VarN vars)
144 (map VarN vars)
145 let fields' = Map.fromList (zip (map fst fields) (map VarN vars))
145 let fields' = Map.fromList (zip (map fst fields) (map VarN vars))
146− let recordType = record fields' (TermN EmptyRecord1)
146+ let recordType = RecordN fields' EmptyRecordN
147 return (ex vars (CAnd (fieldCons ++ [CEqual Error.Record region recordType tipe])))
147 return (ex vars (CAnd (fieldCons ++ [CEqual Error.Record region recordType tipe])))
148
148
149 C.Let defs body ->
149 C.Let defs body ->
@@ -171,7 +171,7 @@ constrainApp
171 -> C.Expr
171 -> C.Expr
172 -> [C.Expr]
172 -> [C.Expr]
173 -> Type
173 -> Type
174− -> IO TypeConstraint
174+ -> IO Constraint
175constrainApp env region f args tipe =
175constrainApp env region f args tipe =
176 do funcVar <- mkVar Nothing
176 do funcVar <- mkVar Nothing
177 funcCon <- constrain env f (VarN funcVar)
177 funcCon <- constrain env f (VarN funcVar)
@@ -202,7 +202,7 @@ argConstraints
202 -> Variable
202 -> Variable
203 -> Int
203 -> Int
204 -> [C.Expr]
204 -> [C.Expr]
205− -> IO ([Variable], [TypeConstraint], [TypeConstraint], [TypeConstraint], Maybe R.Region, Variable)
205+ -> IO ([Variable], [Constraint], [Constraint], [Constraint], Maybe R.Region, Variable)
206argConstraints env name region totalArgs overallVar index args =
206argConstraints env name region totalArgs overallVar index args =
207 case args of
207 case args of
208 [] ->
208 [] ->
@@ -255,7 +255,7 @@ constrainBinop
255 -> C.Expr
255 -> C.Expr
256 -> C.Expr
256 -> C.Expr
257 -> Type
257 -> Type
258− -> IO TypeConstraint
258+ -> IO Constraint
259constrainBinop env region op leftExpr@(A.A leftRegion _) rightExpr@(A.A rightRegion _) tipe =
259constrainBinop env region op leftExpr@(A.A leftRegion _) rightExpr@(A.A rightRegion _) tipe =
260 do leftVar <- mkVar Nothing
260 do leftVar <- mkVar Nothing
261 rightVar <- mkVar Nothing
261 rightVar <- mkVar Nothing
@@ -284,7 +284,7 @@ constrainBinop env region op leftExpr@(A.A leftRegion _) rightExpr@(A.A rightReg
284-- CONSTRAIN LISTS
284-- CONSTRAIN LISTS
285
285
286
286
287−constrainList :: Env.Env -> R.Region -> [C.Expr] -> Type -> IO TypeConstraint
287+constrainList :: Env.Env -> R.Region -> [C.Expr] -> Type -> IO Constraint
288constrainList env region exprs tipe =
288constrainList env region exprs tipe =
289 do (exprInfo, exprCons) <-
289 do (exprInfo, exprCons) <-
290 unzip <$> mapM elementConstraint exprs
290 unzip <$> mapM elementConstraint exprs
@@ -312,7 +312,7 @@ constrainIf
312 -> [(C.Expr, C.Expr)]
312 -> [(C.Expr, C.Expr)]
313 -> C.Expr
313 -> C.Expr
314 -> Type
314 -> Type
315− -> IO TypeConstraint
315+ -> IO Constraint
316constrainIf env region branches finally tipe =
316constrainIf env region branches finally tipe =
317 do let (conditions, branchExprs) =
317 do let (conditions, branchExprs) =
318 second (++ [finally]) (unzip branches)
318 second (++ [finally]) (unzip branches)
@@ -371,7 +371,7 @@ constrainCase
371 -> C.Expr
371 -> C.Expr
372 -> [(P.Canonical, C.Expr)]
372 -> [(P.Canonical, C.Expr)]
373 -> Type
373 -> Type
374− -> IO TypeConstraint
374+ -> IO Constraint
375constrainCase env region expr branches tipe =
375constrainCase env region expr branches tipe =
376 do exprVar <- mkVar Nothing
376 do exprVar <- mkVar Nothing
377 exprCon <- constrain env expr (VarN exprVar)
377 exprCon <- constrain env expr (VarN exprVar)
@@ -411,9 +411,9 @@ data Pair = Pair
411pairCons
411pairCons
412 :: R.Region
412 :: R.Region
413 -> (Int -> R.Region -> Error.Hint)
413 -> (Int -> R.Region -> Error.Hint)
414− -> (Variable -> TypeConstraint)
414+ -> (Variable -> Constraint)
415 -> [(Variable, R.Region)]
415 -> [(Variable, R.Region)]
416− -> IO ([Variable], [TypeConstraint])
416+ -> IO ([Variable], [Constraint])
417pairCons region pairHint varToCon items =
417pairCons region pairHint varToCon items =
418 let
418 let
419 pairToCon (Pair index var1 var2 subregion) =
419 pairToCon (Pair index var1 var2 subregion) =
@@ -488,12 +488,12 @@ expandPattern def@(C.Def facts lpattern expr maybeType) =
488
488
489data Info =
489data Info =
490 Info
490 Info
491− { iSchemes :: [TypeScheme]
491+ { iSchemes :: [Scheme]
492 , iRigid :: [Variable]
492 , iRigid :: [Variable]
493 , iFlex :: [Variable]
493 , iFlex :: [Variable]
494 , iHeaders :: Map.Map Text (A.Located Type)
494 , iHeaders :: Map.Map Text (A.Located Type)
495− , iC2 :: TypeConstraint
495+ , iC2 :: Constraint
496− , iC1 :: TypeConstraint
496+ , iC1 :: Constraint
497 }
497 }
498
498
499
499
@@ -566,7 +566,7 @@ data ArgInfo =
566 }
566 }
567
567
568
568
569−constrainAnnDefHelp :: C.Expr -> ST.Canonical -> ArgInfo -> IO TypeConstraint
569+constrainAnnDefHelp :: C.Expr -> ST.Canonical -> ArgInfo -> IO Constraint
570constrainAnnDefHelp expr tipe (ArgInfo name defRegion env args vars) =
570constrainAnnDefHelp expr tipe (ArgInfo name defRegion env args vars) =
571 case (expr, tipe) of
571 case (expr, tipe) of
572 (A.A _ (C.Lambda arg result), ST.Lambda argType resultType) ->
572 (A.A _ (C.Lambda arg result), ST.Lambda argType resultType) ->
src/Type/Constrain/Literal.hs+1−1
@@ -13,7 +13,7 @@ import qualified Type.Environment as Env
13-- CONSTRAIN LITERALS
13-- CONSTRAIN LITERALS
14
14
15
15
16−constrain :: Env.Env -> R.Region -> L.Literal -> T.Type -> IO T.TypeConstraint
16+constrain :: Env.Env -> R.Region -> L.Literal -> T.Type -> IO T.Constraint
17constrain env region literal tipe =
17constrain env region literal tipe =
18 do definiteType <- litType
18 do definiteType <- litType
19 return (T.CEqual (Error.Literal name) region definiteType tipe)
19 return (T.CEqual (Error.Literal name) region definiteType tipe)
src/Type/Constrain/Pattern.hs+3−3
@@ -24,7 +24,7 @@ data Info =
24 Info
24 Info
25 { _headers :: Map.Map Text (A.Located Type)
25 { _headers :: Map.Map Text (A.Located Type)
26 , _vars :: [Variable]
26 , _vars :: [Variable]
27− , _cons :: TypeConstraint
27+ , _cons :: Constraint
28 }
28 }
29
29
30
30
@@ -47,7 +47,7 @@ joinInfos infos =
47 List.foldl' (flip joinInfo) emptyInfo infos
47 List.foldl' (flip joinInfo) emptyInfo infos
48
48
49
49
50−infoToScheme :: Info -> Scheme Type Variable
50+infoToScheme :: Info -> Scheme
51infoToScheme (Info headers vars cons) =
51infoToScheme (Info headers vars cons) =
52 Scheme [] vars cons headers
52 Scheme [] vars cons headers
53
53
@@ -116,7 +116,7 @@ constrain env (A.A region pattern) tipe =
116 Map.map A.drop tenv
116 Map.map A.drop tenv
117
117
118 con <- exists $ \t ->
118 con <- exists $ \t ->
119− return (equal Error.PRecord tipe (record unannotatedTenv t))
119+ return (equal Error.PRecord tipe (RecordN unannotatedTenv t))
120
120
121 return $ Info
121 return $ Info
122 { _headers = tenv
122 { _headers = tenv
src/Type/Environment.hs+2−2
@@ -255,9 +255,9 @@ instantiatorHelp flex env aliasVars sourceType =
255 text <-
255 text <-
256 case ext of
256 case ext of
257 Nothing ->
257 Nothing ->
258− return $ TermN EmptyRecord1
258+ return EmptyRecordN
259
259
260 Just extType ->
260 Just extType ->
261 go extType
261 go extType
262
262
263− return $ TermN (Record1 tfields text)
263+ return $ RecordN tfields text
src/Type/Inference.hs+1−1
@@ -44,7 +44,7 @@ infer interfaces modul =
44genConstraints
44genConstraints
45 :: Module.Interfaces
45 :: Module.Interfaces
46 -> Module.Canonical
46 -> Module.Canonical
47− -> IO (Map.Map Text T.Type, T.TypeConstraint)
47+ -> IO (Map.Map Text T.Type, T.Constraint)
48genConstraints interfaces modul =
48genConstraints interfaces modul =
49 do env <-
49 do env <-
50 Env.initialize (canonicalizeUnions interfaces modul)
50 Env.initialize (canonicalizeUnions interfaces modul)
src/Type/Solve.hs+4−4
@@ -7,7 +7,6 @@ import Control.Monad.Except (ExceptT, liftIO, throwError)
7import qualified Data.Foldable as F
7import qualified Data.Foldable as F
8import qualified Data.Map as Map
8import qualified Data.Map as Map
9import qualified Data.Text as Text
9import qualified Data.Text as Text
10−import qualified Data.UnionFind.IO as UF
11
10
12import qualified AST.Module.Name as ModuleName
11import qualified AST.Module.Name as ModuleName
13import qualified Reporting.Annotation as A
12import qualified Reporting.Annotation as A
@@ -15,6 +14,7 @@ import qualified Reporting.Error.Type as Error
15import qualified Type.State as TS
14import qualified Type.State as TS
16import Type.Type as Type
15import Type.Type as Type
17import Type.Unify
16import Type.Unify
17+import qualified Type.UnionFind as UF
18
18
19
19
20
20
@@ -150,7 +150,7 @@ adjustRankContent youngMark visitedMark groupRank content =
150-- SOLVER
150-- SOLVER
151
151
152
152
153−solve :: TypeConstraint -> ExceptT [A.Located Error.Error] IO TS.State
153+solve :: Constraint -> ExceptT [A.Located Error.Error] IO TS.State
154solve constraint =
154solve constraint =
155 {-# SCC elm_compiler_type_solve #-}
155 {-# SCC elm_compiler_type_solve #-}
156 do state <- liftIO (TS.run (actuallySolve constraint))
156 do state <- liftIO (TS.run (actuallySolve constraint))
@@ -161,7 +161,7 @@ solve constraint =
161 throwError errors
161 throwError errors
162
162
163
163
164−actuallySolve :: TypeConstraint -> TS.Solver ()
164+actuallySolve :: Constraint -> TS.Solver ()
165actuallySolve constraint =
165actuallySolve constraint =
166 case constraint of
166 case constraint of
167 CTrue ->
167 CTrue ->
@@ -210,7 +210,7 @@ actuallySolve constraint =
210 unify (Error.Instance name) region freshCopy t
210 unify (Error.Instance name) region freshCopy t
211
211
212
212
213−solveScheme :: TypeScheme -> TS.Solver TS.Env
213+solveScheme :: Scheme -> TS.Solver TS.Env
214solveScheme scheme =
214solveScheme scheme =
215 let
215 let
216 flatten (A.A region term) =
216 flatten (A.A region term) =