@@ -14,10 +14,10 @@ import qualified SourceSyntax.Location as L
14import qualified SourceSyntax.Pattern as P
14import qualified SourceSyntax.Pattern as P
15import qualified SourceSyntax.Type as Type
15import qualified SourceSyntax.Type as Type
17−toExpr :: [Declaration t v] -> [Src.Def t v]
17+toExpr :: [Declaration] -> [Src.Def]
18toExpr = concatMap toDefs
18toExpr = concatMap toDefs
20−toDefs :: Declaration t v -> [Src.Def t v]
20+toDefs :: Declaration -> [Src.Def]
21toDefs decl =
21toDefs decl =
22 case decl of
22 case decl of
23 Definition def -> [def]
23 Definition def -> [def]
@@ -28,13 +28,10 @@ toDefs decl =
28 let vars = take (length tipes) arguments
28 let vars = take (length tipes) arguments
29 tbody = Type.Data name $ map Type.Var tvars
29 tbody = Type.Data name $ map Type.Var tvars
30 body = L.none . Src.Data ctor $ map (L.none . Src.Var) vars
30 body = L.none . Src.Data ctor $ map (L.none . Src.Var) vars
31− in [ Src.TypeAnnotation ctor $ foldr Type.Lambda tbody tipes
31+ in [ definition ctor (buildFunction body vars) (foldr Type.Lambda tbody tipes) ]
32− , Src.Def (P.PVar ctor) $ buildFunction body vars
35 TypeAlias name tvars tipe@(Type.Record fields ext) _ ->
33 TypeAlias name tvars tipe@(Type.Record fields ext) _ ->
36− [ Src.TypeAnnotation name $ foldr Type.Lambda tipe args
34+ [ definition name (buildFunction record vars) (foldr Type.Lambda tipe args) ]
37− , Src.Def (P.PVar name) $ buildFunction record vars ]
39 args = case ext of
36 args = case ext of
40 Type.EmptyRecord -> map snd fields
37 Type.EmptyRecord -> map snd fields
@@ -53,10 +50,11 @@ toDefs decl =
53 -- TODO: with the ability to derive code, you may need to generate stuff!
50 -- TODO: with the ability to derive code, you may need to generate stuff!
54 TypeAlias _ _ _ _ -> []
51 TypeAlias _ _ _ _ -> []
56− Port name tipe maybe ->
53+ Port port ->
57− Src.TypeAnnotation name tipe : case maybe of
54+ case port of
58− Nothing -> []
55+ Send name expr tipe -> [ definition name expr tipe ]
59− Just expr -> [ Src.Def (P.PVar name) expr ]
56+ Recv name expr tipe -> -- [ definition name ]
57+ error "not sure how to generate constraints for recv yet"
61 -- no constraints are needed for fixity declarations
59 -- no constraints are needed for fixity declarations
62 Fixity _ _ _ -> []
60 Fixity _ _ _ -> []
@@ -66,4 +64,6 @@ arguments :: [String]
66arguments = map (:[]) ['a'..'z'] ++ map (\n -> "_" ++ show n) [1..]
64arguments = map (:[]) ['a'..'z'] ++ map (\n -> "_" ++ show n) [1..]
68buildFunction body@(L.L s _) vars =
66buildFunction body@(L.L s _) vars =
69− foldr (\p e -> L.L s (Src.Lambda p e)) body (map P.PVar vars)
67+ foldr (\p e -> L.L s (Src.Lambda p e)) body (map P.PVar vars)
69+definition name expr tipe = Src.Definition (P.PVar name) expr (Just tipe)