From f8fa60d1ed57f4ed711ee62220c50164d25dc60b Mon Sep 17 00:00:00 2001
From: Adam Sampson <ats@offog.org>
Date: Wed, 25 Apr 2007 17:48:16 +0000
Subject: [PATCH] Implement << and >>

---
 fco2/AST.hs               |  1 +
 fco2/GenerateC.hs         |  2 ++
 fco2/Parse.hs             | 13 +++++++++++++
 fco2/TODO                 |  2 --
 fco2/testcases/shifts.occ |  8 ++++++++
 5 files changed, 24 insertions(+), 2 deletions(-)
 create mode 100644 fco2/testcases/shifts.occ

diff --git a/fco2/AST.hs b/fco2/AST.hs
index 75c63e5..2ff6dcf 100644
--- a/fco2/AST.hs
+++ b/fco2/AST.hs
@@ -122,6 +122,7 @@ data DyadicOp =
   Add | Subtr | Mul | Div | Rem
   | Plus | Minus | Times
   | BitAnd | BitOr | BitXor
+  | LeftShift | RightShift
   | And | Or
   | Eq | NotEq | Less | More | LessEq | MoreEq
   | After
diff --git a/fco2/GenerateC.hs b/fco2/GenerateC.hs
index 0749928..e9b7476 100644
--- a/fco2/GenerateC.hs
+++ b/fco2/GenerateC.hs
@@ -427,6 +427,8 @@ genDyadic m A.Rem e f = genFuncDyadic m "rem" e f
 genDyadic _ A.Plus e f = genSimpleDyadic "+" e f
 genDyadic _ A.Minus e f = genSimpleDyadic "-" e f
 genDyadic _ A.Times e f = genSimpleDyadic "*" e f
+genDyadic _ A.LeftShift e f = genSimpleDyadic "<<" e f
+genDyadic _ A.RightShift e f = genSimpleDyadic ">>" e f
 genDyadic _ A.BitAnd e f = genSimpleDyadic "&" e f
 genDyadic _ A.BitOr e f = genSimpleDyadic "|" e f
 genDyadic _ A.BitXor e f = genSimpleDyadic "^" e f
diff --git a/fco2/Parse.hs b/fco2/Parse.hs
index 0d6d2e4..4b655b4 100644
--- a/fco2/Parse.hs
+++ b/fco2/Parse.hs
@@ -53,6 +53,8 @@ occamStyle
                           "/\\",
                           "\\/",
                           "><",
+                          "<<",
+                          ">>",
                           "=",
                           "<>",
                           "<",
@@ -788,6 +790,10 @@ expression
            t <- typeOfExpression l
            r <- operandOfType t
            return $ A.Dyadic m o l r
+    <|> do m <- md
+           (l, o) <- tryVV operand shiftOperator
+           r <- operandOfType A.Int
+           return $ A.Dyadic m o l r
     <|> do m <- md
            (l, o) <- tryVV (noTypeContext operand) comparisonOperator
            t <- typeOfExpression l
@@ -862,6 +868,13 @@ dyadicOperator
     <|> do { sOR; return A.Or }
     <?> "dyadic operator"
 
+-- These always need an INT on their right-hand side.
+shiftOperator :: OccParser A.DyadicOp
+shiftOperator
+    =   do { reservedOp "<<"; return A.LeftShift }
+    <|> do { reservedOp ">>"; return A.RightShift }
+    <?> "shift operator"
+
 -- These always return a BOOL, so we have to deal with them specially for type
 -- context.
 comparisonOperator :: OccParser A.DyadicOp
diff --git a/fco2/TODO b/fco2/TODO
index cf1f950..5be7308 100644
--- a/fco2/TODO
+++ b/fco2/TODO
@@ -27,8 +27,6 @@ Add an option for whether to compile out overflow/bounds checks.
 
 The indentation parser is way too simplistic.
 
-Shift counts aren't implemented.
-
 Record literals aren't implemented.
 
 ## Passes
diff --git a/fco2/testcases/shifts.occ b/fco2/testcases/shifts.occ
new file mode 100644
index 0000000..93b1a9c
--- /dev/null
+++ b/fco2/testcases/shifts.occ
@@ -0,0 +1,8 @@
+PROC P ()
+  INT a:
+  SEQ
+    a := 42
+    a := a << 4
+    a := a >> 4
+    a := a >> (a - 40)
+: