diff options
Diffstat (limited to 'src/Transfer/SyntaxToCore.hs')
| -rw-r--r-- | src/Transfer/SyntaxToCore.hs | 38 |
1 files changed, 29 insertions, 9 deletions
diff --git a/src/Transfer/SyntaxToCore.hs b/src/Transfer/SyntaxToCore.hs index a2dcde8a2..f3e7f828d 100644 --- a/src/Transfer/SyntaxToCore.hs +++ b/src/Transfer/SyntaxToCore.hs @@ -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 |