@@ -10,6 +10,7 @@ import Data.List (isPrefixOf)
1010import qualified Data.UnionFind.IO as UF
1111
1212import qualified SourceSyntax.Type as Src
13+import SourceSyntax.Module (ADT)
1314import Type.Type
1415
1516data Environment = Environment {
@@ -18,17 +19,17 @@ data Environment = Environment {
1819 value :: Map.Map String Type
1920}
2021
21−initialEnvironment :: [(String, [String], [(String,[Src.Type])])] -> IO Environment
22+initialEnvironment :: [ADT] -> IO Environment
2223initialEnvironment datatypes = do
2324 types <- makeTypes datatypes
2425
2526 return $ Environment {
26− constructor = makeConstructors types,
27+ constructor = makeConstructors types datatypes,
2728 types = types,
2829 value = Map.empty
2930 }
3031
31−makeTypes :: [(String, [String], [(String, [Src.Type])])] -> IO (Map.Map String Type)
32+makeTypes :: [ADT] -> IO (Map.Map String Type)
3233makeTypes datatypes =
3334 Map.fromList <$> mapM makeCtor (builtins ++ map nameAndKind datatypes)
3435 where
@@ -44,17 +45,18 @@ makeTypes datatypes =
4445
4546 builtins :: [(String,Int)]
4647 builtins = concat [ map tuple [0..9]
47− , kind 1 ["_List","Maybe","Signal"]
48+ , kind 1 ["_List","Signal"]
4849 , kind 0 ["Int","Float","Char","Bool","Element","Text"
49− ,"Color","Order","Matrix2D"]
50+ ,"Color","Order"]
5051 ]
5152
5253
53−makeConstructors :: Map.Map String Type -> Map.Map String (IO (Int, [Variable], [Type], Type))
54−makeConstructors types = Map.fromList builtins
54+makeConstructors :: Map.Map String Type
55+ -> [ADT]
56+ -> Map.Map String (IO (Int, [Variable], [Type], Type))
57+makeConstructors types datatypes = Map.fromList builtins
5558 where
5659 list t = (types ! "_List") <| t
57− maybe t = (types ! "Maybe") <| t
5860
5961 inst :: Int -> ([Type] -> ([Type], Type)) -> IO (Int, [Variable], [Type], Type)
6062 inst numTVars tipe = do
@@ -67,11 +69,28 @@ makeConstructors types = Map.fromList builtins
6769 in (name, inst n $ \vs -> (vs, foldl (<|) (types ! name) vs))
6870
6971 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))
7373 , ("::" , inst 1 $ \ [t] -> ([t, list t], list t))
7474 ] ++ 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)
7594
7695
7796get :: Environment -> (Environment -> Map.Map String a) -> String -> a
@@ -93,8 +112,11 @@ instantiateTypeWithContext :: Environment
93112 -> Map.Map String Variable
94113 -> IO ([Variable], Type)
95114instantiateTypeWithContext env sourceType dict =
96− do (tipe, dict') <- State.runStateT (go sourceType) dict
115+ do (tipe, dict') <- State.runStateT (instantiator env sourceType) dict
97116 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
98120 where
99121 go :: Src.Type -> State.StateT (Map.Map String Variable) IO Type
100122 go sourceType =