diff options
| author | bringert <bringert@cs.chalmers.se> | 2005-11-30 17:40:32 +0000 |
|---|---|---|
| committer | bringert <bringert@cs.chalmers.se> | 2005-11-30 17:40:32 +0000 |
| commit | a68cd282cb83d8ace42baffe0b0d3a00f3455920 (patch) | |
| tree | c73296337b84652ac3fe5e1cb4ddece681402729 /src/Transfer/SyntaxToCore.hs | |
| parent | 94b99219b8a438c4f29f68a0c19ee86caa608904 (diff) | |
Transfer: reimplement operators with type classes.
Diffstat (limited to 'src/Transfer/SyntaxToCore.hs')
| -rw-r--r-- | src/Transfer/SyntaxToCore.hs | 38 |
1 files changed, 24 insertions, 14 deletions
diff --git a/src/Transfer/SyntaxToCore.hs b/src/Transfer/SyntaxToCore.hs index 3a5bdac20..ad3e68f86 100644 --- a/src/Transfer/SyntaxToCore.hs +++ b/src/Transfer/SyntaxToCore.hs @@ -28,11 +28,11 @@ declsToCore :: [Decl] -> [Decl] declsToCore m = evalState (declsToCore_ m) newState declsToCore_ :: [Decl] -> C [Decl] -declsToCore_ = numberMetas +declsToCore_ = desugar + >>> numberMetas >>> deriveDecls >>> replaceCons >>> compilePattDecls - >>> desugar >>> optimize optimize :: [Decl] -> C [Decl] @@ -361,22 +361,32 @@ desugar = return . map f EPiNoVar exp0 exp1 -> EPi VWild <| exp0 <| exp1 EOr exp0 exp1 -> andBool <| exp0 <| exp1 EAnd exp0 exp1 -> orBool <| exp0 <| exp1 - EEq exp0 exp1 -> appIntBin "eq" <| exp0 <| exp1 - ENe exp0 exp1 -> appIntBin "ne" <| exp0 <| exp1 - ELt exp0 exp1 -> appIntBin "lt" <| exp0 <| exp1 - ELe exp0 exp1 -> appIntBin "le" <| exp0 <| exp1 - EGt exp0 exp1 -> appIntBin "gt" <| exp0 <| exp1 - EGe exp0 exp1 -> appIntBin "ge" <| exp0 <| exp1 - EAdd exp0 exp1 -> appIntBin "add" <| exp0 <| exp1 - ESub exp0 exp1 -> appIntBin "sub" <| exp0 <| exp1 - EMul exp0 exp1 -> appIntBin "mul" <| exp0 <| exp1 - EDiv exp0 exp1 -> appIntBin "div" <| exp0 <| exp1 - EMod exp0 exp1 -> appIntBin "mod" <| exp0 <| exp1 - ENeg exp0 -> appIntUn "neg" <| exp0 + 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 + 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 _ -> composOp f x where g <| x = g (f x) -- +-- * Use an overloaded function. +-- + +overlUn :: String -> Exp -> Exp +overlUn f e1 = apply (EVar (Ident f)) [EMeta,EVar (Ident "num_Integer"),e1] -- FIXME: hack, should be ? + +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 -- |