git.iko.soy/elk
on 6f75310 help sign in
elk/compiler/Type/Constrain/Declaration.hs
69 lines 2.4 kB history raw
1module Type.Constrain.Declaration where
3import Control.Monad
4import Control.Applicative ((<$>))
6import qualified Data.Map as Map
8import qualified Type.Constrain.Expression as TcExpr
9import qualified Type.Environment as Env
11import SourceSyntax.Declaration
12import qualified SourceSyntax.Expression as Src
13import qualified SourceSyntax.Location as L
14import qualified SourceSyntax.Pattern as P
15import qualified SourceSyntax.Type as Type
17toExpr :: [Declaration] -> [Src.Def]
18toExpr = concatMap toDefs
20toDefs :: Declaration -> [Src.Def]
21toDefs decl =
22 case decl of
23 Definition def -> [def]
25 Datatype name tvars constructors _ -> concatMap toDefs constructors
26 where
27 toDefs (ctor, tipes) =
28 let vars = take (length tipes) arguments
29 tbody = Type.Data name $ map Type.Var tvars
30 body = L.none . Src.Data ctor $ map (L.none . Src.Var) vars
31 in [ definition ctor (buildFunction body vars) (foldr Type.Lambda tbody tipes) ]
33 TypeAlias name tvars tipe@(Type.Record fields ext) _ ->
34 [ definition name (buildFunction record vars) (foldr Type.Lambda tipe args) ]
35 where
36 args = case ext of
37 Type.EmptyRecord -> map snd fields
38 _ -> map snd fields ++ [ext]
40 var = L.none . Src.Var
41 vars = take (length args) arguments
43 efields = zip (map fst fields) (map var vars)
44 record = case ext of
45 Type.EmptyRecord -> L.none $ Src.Record efields
46 _ -> foldl (\r (f,v) -> L.none $ Src.Insert r f v) (var $ last vars) efields
48 -- Type aliases must be added to an extended equality dictionary,
49 -- but they do not require any basic constraints.
50 -- TODO: with the ability to derive code, you may need to generate stuff!
51 TypeAlias _ _ _ _ -> []
53 Port port ->
54 case port of
55 Send name expr tipe -> [ definition name expr tipe ]
56 Recv name expr tipe -> -- [ definition name ]
57 error "not sure how to generate constraints for recv yet"
59 -- no constraints are needed for fixity declarations
60 Fixity _ _ _ -> []
63arguments :: [String]
64arguments = map (:[]) ['a'..'z'] ++ map (\n -> "_" ++ show n) [1..]
66buildFunction body@(L.L s _) vars =
67 foldr (\p e -> L.L s (Src.Lambda p e)) body (map P.PVar vars)
69definition name expr tipe = Src.Definition (P.PVar name) expr (Just tipe)