git.iko.soy/elk
on master help sign in
Load ADTs into the environment to fix constraint generation for patterns
32a331bEvan Czaplicki
compiler/SourceSyntax/Module.hs+2−1
compare with master
unifiedsplit
@@ -39,10 +39,11 @@ data MetadataModule t v = MetadataModule {
39}
39}
40
40
41type Interfaces = Map.Map String ModuleInterface
41type Interfaces = Map.Map String ModuleInterface
42+type ADT = (String, [String], [(String,[Type])])
42
43
43data ModuleInterface = ModuleInterface {
44data ModuleInterface = ModuleInterface {
44 iTypes :: Map.Map String Type,
45 iTypes :: Map.Map String Type,
45− iAdts :: [(String, [String], [(String,[Type])])]
46+ iAdts :: [ADT]
46} deriving Show
47} deriving Show
47
48
48instance Binary ModuleInterface where
49instance Binary ModuleInterface where
compiler/Type/Environment.hs+34−12
@@ -10,6 +10,7 @@ import Data.List (isPrefixOf)
10import qualified Data.UnionFind.IO as UF
10import qualified Data.UnionFind.IO as UF
11
11
12import qualified SourceSyntax.Type as Src
12import qualified SourceSyntax.Type as Src
13+import SourceSyntax.Module (ADT)
13import Type.Type
14import Type.Type
14
15
15data Environment = Environment {
16data Environment = Environment {
@@ -18,17 +19,17 @@ data Environment = Environment {
18 value :: Map.Map String Type
19 value :: Map.Map String Type
19}
20}
20
21
21−initialEnvironment :: [(String, [String], [(String,[Src.Type])])] -> IO Environment
22+initialEnvironment :: [ADT] -> IO Environment
22initialEnvironment datatypes = do
23initialEnvironment datatypes = do
23 types <- makeTypes datatypes
24 types <- makeTypes datatypes
24
25
25 return $ Environment {
26 return $ Environment {
26− constructor = makeConstructors types,
27+ constructor = makeConstructors types datatypes,
27 types = types,
28 types = types,
28 value = Map.empty
29 value = Map.empty
29 }
30 }
30
31
31−makeTypes :: [(String, [String], [(String, [Src.Type])])] -> IO (Map.Map String Type)
32+makeTypes :: [ADT] -> IO (Map.Map String Type)
32makeTypes datatypes =
33makeTypes datatypes =
33 Map.fromList <$> mapM makeCtor (builtins ++ map nameAndKind datatypes)
34 Map.fromList <$> mapM makeCtor (builtins ++ map nameAndKind datatypes)
34 where
35 where
@@ -44,17 +45,18 @@ makeTypes datatypes =
44
45
45 builtins :: [(String,Int)]
46 builtins :: [(String,Int)]
46 builtins = concat [ map tuple [0..9]
47 builtins = concat [ map tuple [0..9]
47− , kind 1 ["_List","Maybe","Signal"]
48+ , kind 1 ["_List","Signal"]
48 , kind 0 ["Int","Float","Char","Bool","Element","Text"
49 , kind 0 ["Int","Float","Char","Bool","Element","Text"
49− ,"Color","Order","Matrix2D"]
50+ ,"Color","Order"]
50 ]
51 ]
51
52
52
53
54+makeConstructors :: Map.Map String Type
55+ -> [ADT]
53−makeConstructors :: Map.Map String Type -> Map.Map String (IO (Int, [Variable], [Type], Type))
56+ -> Map.Map String (IO (Int, [Variable], [Type], Type))
54−makeConstructors types = Map.fromList builtins
57+makeConstructors types datatypes = Map.fromList builtins
55 where
58 where
56 list t = (types ! "_List") <| t
59 list t = (types ! "_List") <| t
57− maybe t = (types ! "Maybe") <| t
58
60
59 inst :: Int -> ([Type] -> ([Type], Type)) -> IO (Int, [Variable], [Type], Type)
61 inst :: Int -> ([Type] -> ([Type], Type)) -> IO (Int, [Variable], [Type], Type)
60 inst numTVars tipe = do
62 inst numTVars tipe = do
@@ -67,11 +69,28 @@ makeConstructors types = Map.fromList builtins
67 in (name, inst n $ \vs -> (vs, foldl (<|) (types ! name) vs))
69 in (name, inst n $ \vs -> (vs, foldl (<|) (types ! name) vs))
68
70
69 builtins :: [ (String, IO (Int, [Variable], [Type], Type)) ]
71 builtins :: [ (String, IO (Int, [Variable], [Type], Type)) ]
70− builtins = [ ("Nothing", inst 1 $ \ [t] -> ([], maybe t))
71− , ("Just" , inst 1 $ \ [t] -> ([t], maybe t))
72− , ("[]" , inst 1 $ \ [t] -> ([], list t))
72+ builtins = [ ("[]" , inst 1 $ \ [t] -> ([], list t))
73 , ("::" , inst 1 $ \ [t] -> ([t, list t], list t))
73 , ("::" , inst 1 $ \ [t] -> ([t, list t], list t))
74 ] ++ map tupleCtor [0..9]
74 ] ++ map tupleCtor [0..9]
75+ ++ concatMap (ctorToType tempEnv) datatypes
76+
77+ tempEnv = Environment { types = types, constructor = Map.empty, value = Map.empty }
78+
79+ctorToType :: Environment -> ADT -> [ (String, IO (Int, [Variable], [Type], Type)) ]
80+ctorToType env (name, tvars, ctors) =
81+ zip (map fst ctors) (map inst ctors)
82+ where
83+ inst :: (String, [Src.Type]) -> IO (Int, [Variable], [Type], Type)
84+ inst ctor = do
85+ ((args, tipe), dict) <- State.runStateT (go ctor) Map.empty
86+ return (length args, Map.elems dict, args, tipe)
87+
88+
89+ go :: (String, [Src.Type]) -> State.StateT (Map.Map String Variable) IO ([Type], Type)
90+ go (ctor, args) = do
91+ types <- mapM (instantiator env) args
92+ returnType <- instantiator env (Src.Data name (map Src.Var tvars))
93+ return (types, returnType)
75
94
76
95
77get :: Environment -> (Environment -> Map.Map String a) -> String -> a
96get :: Environment -> (Environment -> Map.Map String a) -> String -> a
@@ -93,8 +112,11 @@ instantiateTypeWithContext :: Environment
93 -> Map.Map String Variable
112 -> Map.Map String Variable
94 -> IO ([Variable], Type)
113 -> IO ([Variable], Type)
95instantiateTypeWithContext env sourceType dict =
114instantiateTypeWithContext env sourceType dict =
96− do (tipe, dict') <- State.runStateT (go sourceType) dict
115+ do (tipe, dict') <- State.runStateT (instantiator env sourceType) dict
97 return (Map.elems dict', tipe)
116 return (Map.elems dict', tipe)
117+
118+instantiator :: Environment -> Src.Type -> State.StateT (Map.Map String Variable) IO Type
119+instantiator env sourceType = go sourceType
98 where
120 where
99 go :: Src.Type -> State.StateT (Map.Map String Variable) IO Type
121 go :: Src.Type -> State.StateT (Map.Map String Variable) IO Type
100 go sourceType =
122 go sourceType =