msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

Added bind operators, do-notation, a cons operator and list sytnax.

Browse Source
This commit is contained in:
bringert
2005-11-30 20:27:01 +00:00
parent d92a26fc9b
commit 7dfa184285
15 changed files with 929 additions and 568 deletions
Download Patch File Download Diff File Expand all files Collapse all files

38
src/Transfer/SyntaxToCore.hs
View File

@@ -352,22 +352,28 @@ desugar = return . map f
where
f :: Tree a -> Tree a
f x = case x of
EIf exp0 exp1 exp2 -> ifBool <| exp0 <| exp1 <| exp2
EPiNoVar exp0 exp1 -> EPi VWild <| exp0 <| exp1
EOr exp0 exp1 -> andBool <| exp0 <| exp1
EAnd exp0 exp1 -> orBool <| exp0 <| exp1
EIf exp0 exp1 exp2 -> ifBool <| exp0 <| exp1 <| exp2
EDo bs e -> mkDo (map f bs) (f e)
BindNoVar exp0 -> BindVar VWild <| exp0
EPiNoVar exp0 exp1 -> EPi VWild <| exp0 <| exp1
EBind exp0 exp1 -> appBind <| exp0 <| exp1
EBindC exp0 exp1 -> appBindC <| exp0 <| exp1
EOr exp0 exp1 -> andBool <| exp0 <| exp1
EAnd exp0 exp1 -> orBool <| exp0 <| exp1
EEq exp0 exp1 -> overlBin "eq" <| exp0 <| exp1
ENe exp0 exp1 -> overlBin "ne" <| exp0 <| exp1
ELt exp0 exp1 -> overlBin "lt" <| exp0 <| exp1
ELe exp0 exp1 -> overlBin "le" <| exp0 <| exp1
EGt exp0 exp1 -> overlBin "gt" <| exp0 <| exp1
EGe exp0 exp1 -> overlBin "ge" <| exp0 <| exp1
EListCons exp0 exp1 -> appCons <| exp0 <| exp1
EAdd exp0 exp1 -> overlBin "plus" <| exp0 <| exp1
ESub exp0 exp1 -> overlBin "minus" <| exp0 <| exp1
EMul exp0 exp1 -> overlBin "times" <| exp0 <| exp1
EDiv exp0 exp1 -> overlBin "div" <| exp0 <| exp1
EMod exp0 exp1 -> overlBin "mod" <| exp0 <| exp1
ENeg exp0 -> overlUn "neg" <| exp0
EList exps -> mkList (map f exps)
_ -> composOp f x
where g <| x = g (f x)
@@ -382,14 +388,28 @@ overlBin :: String -> Exp -> Exp -> Exp
overlBin f e1 e2 = apply (EVar (Ident f)) [EMeta,EVar (Ident "num_Integer"),e1,e2] -- FIXME: hack, should be ?
--
-- * Integers
-- * Monad
--
appIntUn :: String -> Exp -> Exp
appIntUn f e = EApp (var ("prim_"++f++"_Int")) e
mkDo :: [Bind] -> Exp -> Exp
mkDo bs e = foldr (\ (BindVar v r) x -> appBind r (EAbs v x)) e bs
appBind :: Exp -> Exp -> Exp
appBind e1 e2 = apply (EVar (Ident "bind")) [EMeta,EMeta,EMeta,EMeta,e1,e2]
appBindC :: Exp -> Exp -> Exp
appBindC e1 e2 = appBind e1 (EAbs VWild e2)
--
-- * List
--
mkList :: [Exp] -> Exp
mkList = foldr appCons (EApp (EVar (Ident "Nil")) EMeta)
appCons :: Exp -> Exp -> Exp
appCons e1 e2 = apply (EVar (Ident "Cons")) [EMeta,e1,e2]
appIntBin :: String -> Exp -> Exp -> Exp
appIntBin f e1 e2 = EApp (EApp (var ("prim_"++f++"_Int")) e1) e2
--
-- * Booleans