git.iko.soy/elk
on 63243ca help sign in
elk/compiler/Type/Constrain/Declaration.hs
63 lines 2.3 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module Type.Constrain.Declaration where
4import SourceSyntax.Declaration
5import qualified SourceSyntax.Expression as E
6import qualified SourceSyntax.Location as L
7import qualified SourceSyntax.Pattern as P
8import qualified SourceSyntax.Type as T
10toExpr :: [Declaration] -> [E.Def]
11toExpr = concatMap toDefs
13toDefs :: Declaration -> [E.Def]
14toDefs decl =
15 case decl of
16 Definition def -> [def]
18 Datatype name tvars constructors _ -> concatMap toDefs' constructors
19 where
20 toDefs' (ctor, tipes) =
21 let vars = take (length tipes) arguments
22 tbody = T.Data name $ map T.Var tvars
23 body = L.none . E.Data ctor $ map (L.none . E.Var) vars
24 in [ definition ctor (buildFunction body vars) (foldr T.Lambda tbody tipes) ]
26 TypeAlias name _ tipe@(T.Record fields ext) _ ->
27 [ definition name (buildFunction record vars) (foldr T.Lambda tipe args) ]
28 where
29 args = map snd fields ++ maybe [] (\x -> [T.Var x]) ext
31 var = L.none . E.Var
32 vars = take (length args) arguments
34 efields = zip (map fst fields) (map var vars)
35 record = case ext of
36 Nothing -> L.none $ E.Record efields
37 Just _ -> foldl (\r (f,v) -> L.none $ E.Insert r f v) (var $ last vars) efields
39 -- Type aliases must be added to an extended equality dictionary,
40 -- but they do not require any basic constraints.
41 -- TODO: with the ability to derive code, you may need to generate stuff!
42 TypeAlias _ _ _ _ -> []
44 Port port ->
45 case port of
46 Out name expr@(L.L s _) tipe ->
47 [ definition name (L.L s $ E.PortOut name tipe expr) tipe ]
48 In name tipe ->
49 [ definition name (L.none $ E.PortIn name tipe) tipe ]
51 -- no constraints are needed for fixity declarations
52 Fixity _ _ _ -> []
55arguments :: [String]
56arguments = map (:[]) ['a'..'z'] ++ map (\n -> "_" ++ show (n :: Int)) [1..]
58buildFunction :: E.LExpr -> [String] -> E.LExpr
59buildFunction body@(L.L s _) vars =
60 foldr (\p e -> L.L s (E.Lambda p e)) body (map P.PVar vars)
62definition :: String -> E.LExpr -> T.Type -> E.Def
63definition name expr tipe = E.Definition (P.PVar name) expr (Just tipe)