From 42e46b1d2373ac4a5bb8d4a4adb595280d9e23d9 Mon Sep 17 00:00:00 2001
From: Adam Sampson <ats@offog.org>
Date: Mon, 2 Oct 2006 21:23:02 +0000
Subject: [PATCH] Make monadic and dyadic ops use a common node (rather than
 one per op)

---
 fco/Parse.hs       |  6 ++--
 fco/SExpression.hs | 80 ++++++++++++++++++++--------------------------
 fco/Tree.hs        | 54 +++++++++++++++++--------------
 3 files changed, 67 insertions(+), 73 deletions(-)

diff --git a/fco/Parse.hs b/fco/Parse.hs
index f5e46e1..558e20e 100644
--- a/fco/Parse.hs
+++ b/fco/Parse.hs
@@ -398,11 +398,11 @@ occamExponent
 
 expression :: Parser N.Node
 expression
-    =   try (do { o <- monadicOperator ; v <- operand ; return $ o v })
+    =   try (do { o <- monadicOperator ; v <- operand ; return $ N.MonadicOp o v })
     <|> do { a <- sMOSTPOS ; t <- dataType ; return $ N.MostPos t }
     <|> do { a <- sMOSTNEG ; t <- dataType ; return $ N.MostNeg t }
     <|> do { a <- sSIZE ; t <- dataType ; return $ N.Size t }
-    <|> try (do { a <- operand ; o <- dyadicOperator ; b <- operand ; return $ o a b })
+    <|> try (do { a <- operand ; o <- dyadicOperator ; b <- operand ; return $ N.DyadicOp o a b })
     <|> try conversion
     <|> operand
     <?> "expression"
@@ -503,7 +503,7 @@ monadicOperator
     <|> do { reservedOp "~" ; return $ N.MonBitNot }
     <|> do { sBITNOT ; return $ N.MonBitNot }
     <|> do { sNOT ; return $ N.MonNot }
-    <|> do { sSIZE ; return $ N.Size }
+    <|> do { sSIZE ; return $ N.MonSize }
     <?> "monadicOperator"
 
 name
diff --git a/fco/SExpression.hs b/fco/SExpression.hs
index a9ee3d7..b2d0287 100644
--- a/fco/SExpression.hs
+++ b/fco/SExpression.hs
@@ -11,6 +11,36 @@ instance Show SExp where
   show (Item s) = s
   show (List is) = "(" ++ (concat $ intersperse " " $ map show is) ++ ")"
 
+dyadicName :: N.Node -> String
+dyadicName n = case n of
+  N.Add -> "+"
+  N.Subtr -> "-"
+  N.Mul -> "*"
+  N.Div -> "/"
+  N.Rem -> "mod"
+  N.Plus -> "plus"
+  N.Minus -> "minus"
+  N.Times -> "times"
+  N.BitAnd -> "bitand"
+  N.BitOr -> "bitor"
+  N.BitXor -> "bitxor"
+  N.And -> "and"
+  N.Or -> "or"
+  N.Eq -> "="
+  N.NEq -> "<>"
+  N.Less -> "<"
+  N.More -> ">"
+  N.LessEq -> "<="
+  N.MoreEq -> ">="
+  N.After -> "after"
+
+monadicName :: N.Node -> String
+monadicName n = case n of
+  N.MonSub -> "-"
+  N.MonBitNot -> "bitnot"
+  N.MonNot -> "not"
+  N.MonSize -> "size"
+
 nodeToSExp :: N.Node -> SExp
 nodeToSExp node
   = case node of
@@ -78,29 +108,8 @@ nodeToSExp node
       N.Conv a b -> wrap2 "conv" (top a) (top b)
       N.Round a b -> wrap2 "round" (top a) (top b)
       N.Trunc a b -> wrap2 "trunc" (top a) (top b)
-      N.Add a b -> wrap2 "+" (top a) (top b)
-      N.Subtr a b -> wrap2 "-" (top a) (top b)
-      N.Mul a b -> wrap2 "*" (top a) (top b)
-      N.Div a b -> wrap2 "/" (top a) (top b)
-      N.Rem a b -> wrap2 "mod" (top a) (top b)
-      N.Plus a b -> wrap2 "plus" (top a) (top b)
-      N.Minus a b -> wrap2 "minus" (top a) (top b)
-      N.Times a b -> wrap2 "times" (top a) (top b)
-      N.BitAnd a b -> wrap2 "bitand" (top a) (top b)
-      N.BitOr a b -> wrap2 "bitor" (top a) (top b)
-      N.BitXor a b -> wrap2 "bitxor" (top a) (top b)
-      N.And a b -> wrap2 "and" (top a) (top b)
-      N.Or a b -> wrap2 "or" (top a) (top b)
-      N.Eq a b -> wrap2 "=" (top a) (top b)
-      N.NEq a b -> wrap2 "<>" (top a) (top b)
-      N.Less a b -> wrap2 "<" (top a) (top b)
-      N.More a b -> wrap2 ">" (top a) (top b)
-      N.LessEq a b -> wrap2 "<=" (top a) (top b)
-      N.MoreEq a b -> wrap2 ">=" (top a) (top b)
-      N.After a b -> wrap2 "after" (top a) (top b)
-      N.MonSub a -> wrap "-" (top a)
-      N.MonBitNot a -> wrap "bitnot" (top a)
-      N.MonNot a -> wrap "not" (top a)
+      N.DyadicOp o a b -> wrap2 (dyadicName o) (top a) (top b)
+      N.MonadicOp o a -> wrap (monadicName o) (top a)
       N.MostPos a -> wrap "mostpos" (top a)
       N.MostNeg a -> wrap "mostneg" (top a)
       N.Size a -> wrap "size" (top a)
@@ -211,29 +220,8 @@ nodeToSOccam node
       N.Conv a b -> wrap2 "conv" (top a) (top b)
       N.Round a b -> wrap2 "round" (top a) (top b)
       N.Trunc a b -> wrap2 "trunc" (top a) (top b)
-      N.Add a b -> wrap2 "+" (top a) (top b)
-      N.Subtr a b -> wrap2 "-" (top a) (top b)
-      N.Mul a b -> wrap2 "*" (top a) (top b)
-      N.Div a b -> wrap2 "/" (top a) (top b)
-      N.Rem a b -> wrap2 "mod" (top a) (top b)
-      N.Plus a b -> wrap2 "plus" (top a) (top b)
-      N.Minus a b -> wrap2 "minus" (top a) (top b)
-      N.Times a b -> wrap2 "times" (top a) (top b)
-      N.BitAnd a b -> wrap2 "bitand" (top a) (top b)
-      N.BitOr a b -> wrap2 "bitor" (top a) (top b)
-      N.BitXor a b -> wrap2 "bitxor" (top a) (top b)
-      N.And a b -> wrap2 "and" (top a) (top b)
-      N.Or a b -> wrap2 "or" (top a) (top b)
-      N.Eq a b -> wrap2 "=" (top a) (top b)
-      N.NEq a b -> wrap2 "<>" (top a) (top b)
-      N.Less a b -> wrap2 "<" (top a) (top b)
-      N.More a b -> wrap2 ">" (top a) (top b)
-      N.LessEq a b -> wrap2 "<=" (top a) (top b)
-      N.MoreEq a b -> wrap2 ">=" (top a) (top b)
-      N.After a b -> wrap2 "after" (top a) (top b)
-      N.MonSub a -> wrap "-" (top a)
-      N.MonBitNot a -> wrap "bitnot" (top a)
-      N.MonNot a -> wrap "not" (top a)
+      N.DyadicOp o a b -> wrap2 (dyadicName o) (top a) (top b)
+      N.MonadicOp o a -> wrap (monadicName o) (top a)
       N.MostPos a -> wrap "mostpos" (top a)
       N.MostNeg a -> wrap "mostneg" (top a)
       N.Size a -> wrap "size" (top a)
diff --git a/fco/Tree.hs b/fco/Tree.hs
index 197bfb7..e3366a5 100644
--- a/fco/Tree.hs
+++ b/fco/Tree.hs
@@ -1,4 +1,4 @@
--- Tree datatype and operations
+-- occam parse tree
 -- This is intended to be imported qualified:
 --   import qualified Tree as N
 
@@ -79,29 +79,35 @@ data Node =
   | Conv Node Node
   | Round Node Node
   | Trunc Node Node
-  | Add Node Node
-  | Subtr Node Node
-  | Mul Node Node
-  | Div Node Node
-  | Rem Node Node
-  | Plus Node Node
-  | Minus Node Node
-  | Times Node Node
-  | BitAnd Node Node
-  | BitOr Node Node
-  | BitXor Node Node
-  | And Node Node
-  | Or Node Node
-  | Eq Node Node
-  | NEq Node Node
-  | Less Node Node
-  | More Node Node
-  | LessEq Node Node
-  | MoreEq Node Node
-  | After Node Node
-  | MonSub Node
-  | MonBitNot Node
-  | MonNot Node
+
+  | DyadicOp Node Node Node
+  | Add
+  | Subtr
+  | Mul
+  | Div
+  | Rem
+  | Plus
+  | Minus
+  | Times
+  | BitAnd
+  | BitOr
+  | BitXor
+  | And
+  | Or
+  | Eq
+  | NEq
+  | Less
+  | More
+  | LessEq
+  | MoreEq
+  | After
+
+  | MonadicOp Node Node
+  | MonSub
+  | MonBitNot
+  | MonNot
+  | MonSize
+
   | MostPos Node
   | MostNeg Node
   | Size Node