* 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