13 May
2014
13 May
'14
5:08 p.m.
* src/Ir.hs (Op): Add binary operators And, Or, Lshift, Rshift,
Arshift and Xor. Remove operator Mod.
Add relational operators Ult, Ule, Ugt and Uge.
* src/StdBinop.hs (binop): Implement operators And, Or, Lshift,
Rshift, Arshift and Xor. Remove operator Mod.
(unsigned): New helper routine.
* src/StdRelop.hs (relop): Implement operators Ult, Ule, Ugt and
Uge.
(unsigned): New helper routine.
* src/Scan.hs (scanTokKeyword): Adjust.
* NEWS: Update.
---
NEWS | 6 ++++++
src/Ir.hs | 46 ++++++++++++++++++++++++++++++----------------
src/Scan.hs | 17 +++++++++++------
src/StdBinop.hs | 24 ++++++++++++++++++------
src/StdRelop.hs | 10 +++++++++-
5 files changed, 74 insertions(+), 29 deletions(-)
diff --git a/NEWS b/NEWS
index d251097..9b79c56 100644
--- a/NEWS
+++ b/NEWS
@@ -1,5 +1,11 @@
New in 0.26a:
+* Binary and relational operators implementation
+
+ All binary (arithmetic/logic) and relational operators now follow
+ the specification of the Tree language defined by Andrew Appel in
+ his ``Modern Compiler Implementation'' books.
+
New in 0.26, 2014-05-06:
diff --git a/src/Ir.hs b/src/Ir.hs
index 2dda499..e3ee0a4 100644
--- a/src/Ir.hs
+++ b/src/Ir.hs
@@ -1,7 +1,7 @@
module Ir (Exp (Const, Name, Temp, Binop, Mem, Call, ESeq),
Stm (Move, Sxp, Jump, CJump, Seq, Label, LabelEnd, Literal),
- Op (Add, Sub, Mul, Div, Mod, And, Or),
- Relop (Eq, Ne, Lt, Gt, Le, Ge))
+ Op (Add, Sub, Mul, Div, And, Or, Lshift, Rshift, Arshift, Xor),
+ Relop (Eq, Ne, Lt, Gt, Le, Ge, Ult, Ule, Ugt, Uge))
where
data Exp a = Const a Int
@@ -42,9 +42,12 @@ data Op = Add
| Sub
| Mul
| Div
- | Mod
| And
| Or
+ | Lshift
+ | Rshift
+ | Arshift
+ | Xor
data Relop = Eq
| Ne
@@ -52,20 +55,31 @@ data Relop = Eq
| Gt
| Le
| Ge
+ | Ult
+ | Ule
+ | Ugt
+ | Uge
instance Show Op where
- show Add = "add"
- show Sub = "sub"
- show Mul = "mul"
- show Div = "div"
- show Mod = "mod"
- show And = "and"
- show Or = "or"
+ show Add = "add"
+ show Sub = "sub"
+ show Mul = "mul"
+ show Div = "div"
+ show And = "and"
+ show Or = "or"
+ show Lshift = "lshift"
+ show Rshift = "rshift"
+ show Arshift = "arshift"
+ show Xor = "xor"
instance Show Relop where
- show Eq = "eq"
- show Ne = "ne"
- show Lt = "lt"
- show Gt = "gt"
- show Le = "le"
- show Ge = "ge"
+ show Eq = "eq"
+ show Ne = "ne"
+ show Lt = "lt"
+ show Gt = "gt"
+ show Le = "le"
+ show Ge = "ge"
+ show Ult = "ult"
+ show Ule = "ule"
+ show Ugt = "ugt"
+ show Uge = "uge"
diff --git a/src/Scan.hs b/src/Scan.hs
index 2023545..e88c19b 100644
--- a/src/Scan.hs
+++ b/src/Scan.hs
@@ -146,17 +146,18 @@ scanTokKeyword "name" loc = TokName loc
scanTokKeyword "seq" loc = TokSeq loc
scanTokKeyword "temp" loc = TokTemp loc
-scanTokKeyword "add" loc = TokOp (Add, loc)
-scanTokKeyword "mul" loc = TokOp (Mul, loc)
-scanTokKeyword "sub" loc = TokOp (Sub, loc)
-scanTokKeyword "div" loc = TokOp (Div, loc)
-scanTokKeyword "mod" loc = TokOp (Mod, loc)
+scanTokKeyword "add" loc = TokOp (Add, loc)
+scanTokKeyword "mul" loc = TokOp (Mul, loc)
+scanTokKeyword "sub" loc = TokOp (Sub, loc)
+scanTokKeyword "div" loc = TokOp (Div, loc)
+scanTokKeyword "lshift" loc = TokOp (Lshift, loc)
+scanTokKeyword "rshift" loc = TokOp (Rshift, loc)
+scanTokKeyword "arshift" loc = TokOp (Arshift, loc)
scanTokKeyword "(+)" loc = TokOp (Add, loc)
scanTokKeyword "(*)" loc = TokOp (Mul, loc)
scanTokKeyword "(-)" loc = TokOp (Sub, loc)
scanTokKeyword "(/)" loc = TokOp (Div, loc)
-scanTokKeyword "(%)" loc = TokOp (Mod, loc)
scanTokKeyword "eq" loc = TokRelop (Eq, loc)
scanTokKeyword "ne" loc = TokRelop (Ne, loc)
@@ -164,6 +165,10 @@ scanTokKeyword "lt" loc = TokRelop (Lt, loc)
scanTokKeyword "gt" loc = TokRelop (Gt, loc)
scanTokKeyword "le" loc = TokRelop (Le, loc)
scanTokKeyword "ge" loc = TokRelop (Ge, loc)
+scanTokKeyword "ult" loc = TokRelop (Ult, loc)
+scanTokKeyword "ule" loc = TokRelop (Ule, loc)
+scanTokKeyword "ugt" loc = TokRelop (Ugt, loc)
+scanTokKeyword "uge" loc = TokRelop (Uge, loc)
scanTokKeyword "(=)" loc = TokRelop (Eq, loc)
scanTokKeyword "(<>)" loc = TokRelop (Ne, loc)
diff --git a/src/StdBinop.hs b/src/StdBinop.hs
index 673f26a..a15eb68 100644
--- a/src/StdBinop.hs
+++ b/src/StdBinop.hs
@@ -2,16 +2,28 @@ module StdBinop (binop)
where
import Data.Int
+import Data.Word
+import Data.Bits
import Ir
modulo32 op a b =
fromIntegral((fromIntegral a :: Int32) `op` (fromIntegral b :: Int32))
--- FIXME: Add all binary operators.
+unsigned op a b = fromIntegral((fromIntegral a :: Word) `op` b)
+
binop :: Op -> Int -> Int -> Int
-binop Add = modulo32 (+)
-binop Sub = modulo32 (-)
-binop Mul = modulo32 (*)
-binop Div = modulo32 quot
-binop Mod = modulo32 rem
+binop Add = modulo32 (+)
+binop Sub = modulo32 (-)
+binop Mul = modulo32 (*)
+binop Div = modulo32 quot
+binop And = modulo32 (.&.)
+binop Or = modulo32 (.|.)
+-- Logical shifts. When shifting Words (unsigned integers) instead of
+-- Ints (signed integers), the shifts become logical shifts (see
+-- http://rosettacode.org/wiki/Bitwise_operations#Haskell).
+binop Lshift = unsigned shiftL
+binop Rshift = unsigned shiftR
+-- Arithmetic right shift.
+binop Arshift = shiftR
+binop Xor = xor
diff --git a/src/StdRelop.hs b/src/StdRelop.hs
index bd94ea6..183fef2 100644
--- a/src/StdRelop.hs
+++ b/src/StdRelop.hs
@@ -1,9 +1,12 @@
module StdRelop (relop)
where
+import Data.Word
+
import Ir
--- FIXME: Add all relational operators.
+unsigned op a b = (fromIntegral a :: Word) `op` (fromIntegral b :: Word)
+
relop :: Relop -> Int -> Int -> Bool
relop Eq = (==)
relop Ne = (/=)
@@ -11,3 +14,8 @@ relop Lt = (<)
relop Gt = (>)
relop Le = (<=)
relop Ge = (>=)
+-- Unsigned integer inequalities.
+relop Ult = unsigned (<)
+relop Ule = unsigned (<=)
+relop Ugt = unsigned (>)
+relop Uge = unsigned (>=)
--
1.7.10.4