on master help sign in
Move type annotations out of Environment and into the Basics library
ec86876Evan Czaplicki
compiler/Type/Environment.hs+9−29
@@ -54,23 +54,13 @@ makeConstructors types = Map.fromList builtins
54 where
54 where
55 list t = (types ! "_List") <| t
55 list t = (types ! "_List") <| t
56 maybe t = (types ! "Maybe") <| t
56 maybe t = (types ! "Maybe") <| t
57− bool = types ! "Bool"
57+
58− int = types ! "Int"
59− float = types ! "Float"
60− order = types ! "Order"
61−
62− instance' :: IO Variable -> Int -> ([Type] -> ([Type], Type))
63− -> IO (Int, [Variable], [Type], Type)
58+ inst :: Int -> ([Type] -> ([Type], Type)) -> IO (Int, [Variable], [Type], Type)
64− instance' var numTVars tipe = do
59+ inst numTVars tipe = do
65− vars <- forM [1..numTVars] $ \_ -> var
60+ vars <- forM [1..numTVars] $ \_ -> var Flexible
66 let (args, result) = tipe (map VarN vars)
61 let (args, result) = tipe (map VarN vars)
67 return (length args, vars, args, result)
62 return (length args, vars, args, result)
68
63
69− inst = instance' (var Flexible)
70− nmbr = instance' (var (Is Number)) 1
71− cmpr = instance' (var (Is Comparable)) 1
72− apnd = instance' (var (Is Appendable)) 1
73−
74 tupleCtor n =
64 tupleCtor n =
75 let name = "_Tuple" ++ show n
65 let name = "_Tuple" ++ show n
76 in (name, inst n $ \vs -> (vs, foldl (<|) (types ! name) vs))
66 in (name, inst n $ \vs -> (vs, foldl (<|) (types ! name) vs))
@@ -80,19 +70,6 @@ makeConstructors types = Map.fromList builtins
80 , ("Just" , inst 1 $ \ [t] -> ([t], maybe t))
70 , ("Just" , inst 1 $ \ [t] -> ([t], maybe t))
81 , ("[]" , inst 1 $ \ [t] -> ([], list t))
71 , ("[]" , inst 1 $ \ [t] -> ([], list t))
82 , ("::" , inst 1 $ \ [t] -> ([t, list t], list t))
72 , ("::" , inst 1 $ \ [t] -> ([t, list t], list t))
83− , ("div" , inst 0 $ \ [] -> ([int, int], int))
84− , ("/" , inst 0 $ \ [] -> ([float, float], float))
85− , ("+" , nmbr $ \ [t] -> ([t, t], t))
86− , ("-" , nmbr $ \ [t] -> ([t, t], t))
87− , ("*" , nmbr $ \ [t] -> ([t, t], t))
88− , ("<" , cmpr $ \ [t] -> ([t, t], bool))
89− , (">" , cmpr $ \ [t] -> ([t, t], bool))
90− , ("<=" , cmpr $ \ [t] -> ([t, t], bool))
91− , (">=" , cmpr $ \ [t] -> ([t, t], bool))
92− , ("==" , cmpr $ \ [t] -> ([t, t], bool))
93− , ("/=" , cmpr $ \ [t] -> ([t, t], bool))
94− , ("compare", cmpr $ \ [t] -> ([t, t], order))
95− , ("otherwise", inst 0 $ \ [] -> ([], bool))
96 ] ++ map tupleCtor [0..9]
73 ] ++ map tupleCtor [0..9]
97
74
98
75
@@ -121,7 +98,7 @@ instantiateTypeWithContext env sourceType dict =
121 go :: Src.Type -> State.StateT (Map.Map String Variable) IO Type
98 go :: Src.Type -> State.StateT (Map.Map String Variable) IO Type
122 go sourceType =
99 go sourceType =
123 case sourceType of
100 case sourceType of
124− Src.Lambda t1 t2 -> TermN <$> (Fun1 <$> go t1 <*> go t2)
101+ Src.Lambda t1 t2 -> (==>) <$> go t1 <*> go t2
125
102
126 Src.Var x -> do
103 Src.Var x -> do
127 dict <- State.get
104 dict <- State.get
@@ -137,9 +114,12 @@ instantiateTypeWithContext env sourceType dict =
137 | "appendable" `isPrefixOf` x = Is Appendable
114 | "appendable" `isPrefixOf` x = Is Appendable
138 | otherwise = Flexible
115 | otherwise = Flexible
139
116
117+ Src.Data "String" [] ->
118+ return (get env types "_List" <| get env types "Char")
119+
140 Src.Data name ts -> do
120 Src.Data name ts -> do
141 ts' <- mapM go ts
121 ts' <- mapM go ts
142− return $ foldl (\tyFn ty -> TermN $ App1 tyFn ty) (get env types name) ts'
122+ return $ foldl (<|) (get env types name) ts'
143
123
144 Src.EmptyRecord -> return (TermN EmptyRecord1)
124 Src.EmptyRecord -> return (TermN EmptyRecord1)
145
125