git.iko.soy/elk
on master help sign in
Actually fill in a type variable when generating PortIn expressions
9ea9854Evan Czaplicki
compiler/Type/Constrain/Declaration.hs+13−9
compare with master
unifiedsplit
@@ -5,7 +5,9 @@ import SourceSyntax.Declaration
5import qualified SourceSyntax.Expression as E
5import qualified SourceSyntax.Expression as E
6import qualified SourceSyntax.Location as L
6import qualified SourceSyntax.Location as L
7import qualified SourceSyntax.Pattern as P
7import qualified SourceSyntax.Pattern as P
8−import qualified SourceSyntax.Type as Type
8+import qualified SourceSyntax.Type as T
9+import qualified Type.Type as Type
10+import System.IO.Unsafe
9
11
10toExpr :: [Declaration] -> [E.Def]
12toExpr :: [Declaration] -> [E.Def]
11toExpr = concatMap toDefs
13toExpr = concatMap toDefs
@@ -19,15 +21,15 @@ toDefs decl =
19 where
21 where
20 toDefs' (ctor, tipes) =
22 toDefs' (ctor, tipes) =
21 let vars = take (length tipes) arguments
23 let vars = take (length tipes) arguments
22− tbody = Type.Data name $ map Type.Var tvars
24+ tbody = T.Data name $ map T.Var tvars
23 body = L.none . E.Data ctor $ map (L.none . E.Var) vars
25 body = L.none . E.Data ctor $ map (L.none . E.Var) vars
24− in [ definition ctor (buildFunction body vars) (foldr Type.Lambda tbody tipes) ]
26+ in [ definition ctor (buildFunction body vars) (foldr T.Lambda tbody tipes) ]
25
27
26− TypeAlias name _ tipe@(Type.Record fields ext) _ ->
28+ TypeAlias name _ tipe@(T.Record fields ext) _ ->
27− [ definition name (buildFunction record vars) (foldr Type.Lambda tipe args) ]
29+ [ definition name (buildFunction record vars) (foldr T.Lambda tipe args) ]
28 where
30 where
29 args = case ext of
31 args = case ext of
30− Type.EmptyRecord -> map snd fields
32+ T.EmptyRecord -> map snd fields
31 _ -> map snd fields ++ [ext]
33 _ -> map snd fields ++ [ext]
32
34
33 var = L.none . E.Var
35 var = L.none . E.Var
@@ -35,7 +37,7 @@ toDefs decl =
35
37
36 efields = zip (map fst fields) (map var vars)
38 efields = zip (map fst fields) (map var vars)
37 record = case ext of
39 record = case ext of
38− Type.EmptyRecord -> L.none $ E.Record efields
40+ T.EmptyRecord -> L.none $ E.Record efields
39 _ -> foldl (\r (f,v) -> L.none $ E.Insert r f v) (var $ last vars) efields
41 _ -> foldl (\r (f,v) -> L.none $ E.Insert r f v) (var $ last vars) efields
40
42
41 -- Type aliases must be added to an extended equality dictionary,
43 -- Type aliases must be added to an extended equality dictionary,
@@ -48,7 +50,9 @@ toDefs decl =
48 Send name expr@(L.L s _) tipe ->
50 Send name expr@(L.L s _) tipe ->
49 [ definition name (L.L s $ E.PortOut name tipe expr) tipe ]
51 [ definition name (L.L s $ E.PortOut name tipe expr) tipe ]
50 Recv name expr@(L.L s _) tipe ->
52 Recv name expr@(L.L s _) tipe ->
53+ unsafePerformIO $ do
54+ tvar <- Type.var Type.Flexible
51− [ definition name (L.L s $ E.PortIn name tipe undefined expr) tipe ]
55+ return $ [ definition name (L.L s $ E.PortIn name tipe tvar expr) tipe ]
52
56
53 -- no constraints are needed for fixity declarations
57 -- no constraints are needed for fixity declarations
54 Fixity _ _ _ -> []
58 Fixity _ _ _ -> []
@@ -61,5 +65,5 @@ buildFunction :: E.LExpr -> [String] -> E.LExpr
61buildFunction body@(L.L s _) vars =
65buildFunction body@(L.L s _) vars =
62 foldr (\p e -> L.L s (E.Lambda p e)) body (map P.PVar vars)
66 foldr (\p e -> L.L s (E.Lambda p e)) body (map P.PVar vars)
63
67
64−definition :: String -> E.LExpr -> Type.Type -> E.Def
68+definition :: String -> E.LExpr -> T.Type -> E.Def
65definition name expr tipe = E.Definition (P.PVar name) expr (Just tipe)
69definition name expr tipe = E.Definition (P.PVar name) expr (Just tipe)