git.iko.soy/elk
on master help sign in
Update to use canonical variables
commitd99e4124338e03ffe4488a979f0195999eaa7e10 authorEvan Czaplicki <info@elm-lang.org> dateFri 25 Apr 2014, 03:33 (13 years ago) parent964d296
2 files changed+18−12
compare with master
unifiedsplit
compiler/Type/Constrain/Expression.hs+13−9 compiler/Type/Constrain/Pattern.hs+5−3
compiler/Type/Constrain/Expression.hs+13−9
@@ -11,6 +11,7 @@ import qualified Text.PrettyPrint as PP
1111import AST.Literal as Lit
1212import AST.Annotation as Ann
1313import AST.Expression.General
14+import qualified AST.Expression.Canonical as Canonical
1415import qualified AST.Pattern as P
1516import qualified AST.Type as ST
1617import qualified AST.Variable as V
@@ -20,7 +21,8 @@ import qualified Type.Environment as Env
2021import qualified Type.Constrain.Literal as Literal
2122import qualified Type.Constrain.Pattern as Pattern
2223
23−constrain :: Env.Environment -> Expr -> Type -> ErrorT [PP.Doc] IO TypeConstraint
24+constrain :: Env.Environment -> Canonical.Expr -> Type
25+ -> ErrorT [PP.Doc] IO TypeConstraint
2426constrain env (A region expr) tipe =
2527 let list t = Env.get env Env.types "_List" <| t
2628 and = A region . CAnd
@@ -48,9 +50,11 @@ constrain env (A region expr) tipe =
4850 varying = makeRec Lit.varying (TermN EmptyRecord1)
4951 in return . A region $ CEqual tipe (shaderTipe attribute uniform varying)
5052
51− Var (V.Raw name)
53+ Var var
5254 | name == saveEnvName -> return (A region CSaveEnv)
5355 | otherwise -> return (name <? tipe)
56+ where
57+ name = V.toString var
5458
5559 Range lo hi ->
5660 existsNumber $ \n -> do
@@ -68,7 +72,7 @@ constrain env (A region expr) tipe =
6872 exists $ \t2 -> do
6973 c1 <- constrain env e1 t1
7074 c2 <- constrain env e2 t2
71− return $ and [ c1, c2, op <? (t1 ==> t2 ==> tipe) ]
75+ return $ and [ c1, c2, V.toString op <? (t1 ==> t2 ==> tipe) ]
7276
7377 Lambda p e ->
7478 exists $ \t1 ->
@@ -169,7 +173,7 @@ constrain env (A region expr) tipe =
169173 PortOut _ _ signal ->
170174 constrain env signal tipe
171175
172−constrainDef env info (Definition pattern expr maybeTipe) =
176+constrainDef env info (Canonical.Definition pattern expr maybeTipe) =
173177 let qs = [] -- should come from the def, but I'm not sure what would live there...
174178 (schemes, rigidQuantifiers, flexibleQuantifiers, headers, c2, c1) = info
175179 in
@@ -208,16 +212,16 @@ constrainDef env info (Definition pattern expr maybeTipe) =
208212
209213 _ -> error (show pattern)
210214
211−expandPattern :: Def -> [Def]
212−expandPattern def@(Definition pattern lexpr@(A r _) maybeType) =
215+expandPattern :: Canonical.Def -> [Canonical.Def]
216+expandPattern def@(Canonical.Definition pattern lexpr@(A r _) maybeType) =
213217 case pattern of
214218 P.Var _ -> [def]
215− _ -> Definition (P.Var x) lexpr maybeType : map toDef vars
219+ _ -> Canonical.Definition (P.Var x) lexpr maybeType : map toDef vars
216220 where
217221 vars = P.boundVarList pattern
218222 x = "$" ++ concat vars
219− mkVar = A r . rawVar
220− toDef y = Definition (P.Var y) (A r $ Case (mkVar x) [(pattern, mkVar y)]) Nothing
223+ mkVar = A r . localVar
224+ toDef y = Canonical.Definition (P.Var y) (A r $ Case (mkVar x) [(pattern, mkVar y)]) Nothing
221225
222226try :: Region -> ErrorT (Region -> PP.Doc) IO a -> ErrorT [PP.Doc] IO a
223227try region computation = do
compiler/Type/Constrain/Pattern.hs+5−3
@@ -11,6 +11,7 @@ import qualified Text.PrettyPrint as PP
1111
1212import qualified AST.Annotation as A
1313import qualified AST.Pattern as P
14+import qualified AST.Variable as V
1415import AST.PrettyPrint (pretty)
1516import Type.Type
1617import Type.Fragment
@@ -18,7 +19,8 @@ import Type.Environment as Env
1819import qualified Type.Constrain.Literal as Literal
1920
2021
21−constrain :: Environment -> P.Pattern -> Type -> ErrorT (A.Region -> PP.Doc) IO Fragment
22+constrain :: Environment -> P.CanonicalPattern -> Type
23+ -> ErrorT (A.Region -> PP.Doc) IO Fragment
2224constrain env pattern tipe =
2325 let region = A.None (pretty pattern)
2426 t1 === t2 = A.A region (CEqual t1 t2)
@@ -47,8 +49,8 @@ constrain env pattern tipe =
4749 }
4850
4951 P.Data name patterns -> do
50− (kind, cvars, args, result) <- liftIO $ freshDataScheme env name
51− let msg = concat [ "Constructor '", name, "' expects ", show kind
52+ (kind, cvars, args, result) <- liftIO $ freshDataScheme env (V.toString name)
53+ let msg = concat [ "Constructor '", V.toString name, "' expects ", show kind
5254 , " argument", if kind == 1 then "" else "s"
5355 , " but was given ", show (length patterns), "." ]
5456 err span = PP.vcat [ PP.text $ "Type error " ++ show span