yogsototh/elm
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Update for new def and port formats

Browse source
This commit is contained in:
Evan Czaplicki 2014-01-02 23:52:27 -08:00
parent acce931530
commit 41dd0c8742
1 changed files with 12 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

24
compiler/Type/Constrain/Declaration.hs
View file

@ -14,10 +14,10 @@ import qualified SourceSyntax.Location as L
import qualified SourceSyntax.Pattern as P import qualified SourceSyntax.Pattern as P
import qualified SourceSyntax.Type as Type import qualified SourceSyntax.Type as Type
toExpr :: [Declaration t v] -> [Src.Def t v] toExpr :: [Declaration] -> [Src.Def]
toExpr = concatMap toDefs toExpr = concatMap toDefs
toDefs :: Declaration t v -> [Src.Def t v] toDefs :: Declaration -> [Src.Def]
toDefs decl = toDefs decl =
case decl of case decl of
Definition def -> [def] Definition def -> [def]
@ -28,13 +28,10 @@ toDefs decl =
let vars = take (length tipes) arguments let vars = take (length tipes) arguments
tbody = Type.Data name $ map Type.Var tvars tbody = Type.Data name $ map Type.Var tvars
body = L.none . Src.Data ctor $ map (L.none . Src.Var) vars body = L.none . Src.Data ctor $ map (L.none . Src.Var) vars
in [ Src.TypeAnnotation ctor $ foldr Type.Lambda tbody tipes in [ definition ctor (buildFunction body vars) (foldr Type.Lambda tbody tipes) ]
, Src.Def (P.PVar ctor) $ buildFunction body vars
]
TypeAlias name tvars tipe@(Type.Record fields ext) _ -> TypeAlias name tvars tipe@(Type.Record fields ext) _ ->
[ Src.TypeAnnotation name $ foldr Type.Lambda tipe args [ definition name (buildFunction record vars) (foldr Type.Lambda tipe args) ]
, Src.Def (P.PVar name) $ buildFunction record vars ]
where where
args = case ext of args = case ext of
Type.EmptyRecord -> map snd fields Type.EmptyRecord -> map snd fields
@ -53,10 +50,11 @@ toDefs decl =
-- TODO: with the ability to derive code, you may need to generate stuff! -- TODO: with the ability to derive code, you may need to generate stuff!
TypeAlias _ _ _ _ -> [] TypeAlias _ _ _ _ -> []
Port name tipe maybe -> Port port ->
Src.TypeAnnotation name tipe : case maybe of case port of
Nothing -> [] Send name expr tipe -> [ definition name expr tipe ]
Just expr -> [ Src.Def (P.PVar name) expr ] Recv name expr tipe -> -- [ definition name ]
error "not sure how to generate constraints for recv yet"
-- no constraints are needed for fixity declarations -- no constraints are needed for fixity declarations
Fixity _ _ _ -> [] Fixity _ _ _ -> []
@ -66,4 +64,6 @@ arguments :: [String]
arguments = map (:[]) ['a'..'z'] ++ map (\n -> "_" ++ show n) [1..] arguments = map (:[]) ['a'..'z'] ++ map (\n -> "_" ++ show n) [1..]
buildFunction body@(L.L s _) vars = buildFunction body@(L.L s _) vars =
foldr (\p e -> L.L s (Src.Lambda p e)) body (map P.PVar vars) foldr (\p e -> L.L s (Src.Lambda p e)) body (map P.PVar vars)
definition name expr tipe = Src.Definition (P.PVar name) expr (Just tipe)