Moved some of the operators stuff out into its own module, and corrected ShowCode to display operators nicely

Makefile.am

@@ -164,6 +164,7 @@ tock_SOURCES_hs += common/Errors.hs
 tock_SOURCES_hs += common/EvalConstants.hs
 tock_SOURCES_hs += common/EvalLiterals.hs
 tock_SOURCES_hs += common/Intrinsics.hs
+tock_SOURCES_hs += common/Operators.hs
 tock_SOURCES_hs += common/Pattern.hs
 tock_SOURCES_hs += common/PrettyShow.hs
 tock_SOURCES_hs += common/ShowCode.hs

common/Operators.hs

@@ -0,0 +1,107 @@
+{-
+Tock: a compiler for parallel languages
+Copyright (C) 2009  University of Kent
+
+This program is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation, either version 2 of the License, or (at your
+option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License along
+with this program.  If not, see <http://www.gnu.org/licenses/>.
+-}
+
+module Operators where
+
+import Data.Char
+
+isOperator :: String -> Bool
+isOperator op = any (== op) operatorNames
+
+operatorNames :: [String]
+operatorNames =
+  ["??"
+  ,"@@"
+  ,"$$"
+  ,"%"
+  ,"%%"
+  ,"&&"
+  ,"<%"
+  ,"%>"
+  ,"<&"
+  ,"&>"
+  ,"<]"
+  ,"[>"
+  ,"<@"
+  ,"@>"
+  ,"@"
+  ,"++"
+  ,"!!"
+  ,"=="
+  ,"^"
+  ,"-"
+  ,"MINUS"
+  ,"~"
+  ,"NOT"
+  ,"+"
+  ,"*"
+  ,"/"
+  ,"\\"
+  ,"REM"
+  ,"PLUS"
+  ,"TIMES"
+  ,"AFTER"
+  ,"/\\"
+  ,"\\/"
+  ,"><"
+  ,"BITNOT"
+  ,"BITAND"
+  ,"BITOR"
+  ,"<<"
+  ,">>"
+  ,"AND"
+  ,"OR"
+  ,"="
+  ,"<>"
+  ,"<="
+  ,"<"
+  ,">="
+  ,">"
+  ]
+
+-- | This gives a default mapping from operator (such as "+") to a valid name string
+-- to be used in the backend (i.e. the Tock support headers), such as "add", which
+-- will later be suffixed by the types in question.
+occamOperatorTranslateDefault :: String -> String
+occamOperatorTranslateDefault "+" = "add"
+occamOperatorTranslateDefault "-" = "subtr"
+occamOperatorTranslateDefault "*" = "mul"
+occamOperatorTranslateDefault "/" = "div"
+occamOperatorTranslateDefault "TIMES" = "times"
+occamOperatorTranslateDefault "PLUS" = "plus"
+occamOperatorTranslateDefault "MINUS" = "minus"
+occamOperatorTranslateDefault "AFTER" = "after"
+occamOperatorTranslateDefault ">" = "more"
+occamOperatorTranslateDefault "<" = "less"
+occamOperatorTranslateDefault ">=" = "moreEq"
+occamOperatorTranslateDefault "<=" = "lessEq"
+occamOperatorTranslateDefault "=" = "eq"
+occamOperatorTranslateDefault "<>" = "notEq"
+occamOperatorTranslateDefault "\\" = "rem"
+occamOperatorTranslateDefault "REM" = "REM"
+occamOperatorTranslateDefault "/\\" = "and"
+occamOperatorTranslateDefault "\\/" = "or"
+occamOperatorTranslateDefault "><" = "xor"
+occamOperatorTranslateDefault "<<" = "lshift"
+occamOperatorTranslateDefault ">>" = "rshift"
+occamOperatorTranslateDefault "AND" = "and"
+occamOperatorTranslateDefault "OR" = "or"
+occamOperatorTranslateDefault "NOT" = "not"
+occamOperatorTranslateDefault "~" = "not"
+occamOperatorTranslateDefault cs = "op_" ++ concatMap (show . ord) cs
+

common/ShowCode.hs

@@ -45,6 +45,7 @@ import Text.Regex
 
 import qualified AST as A
 import CompState hiding (CSM) -- everything here is read-only
+import Operators
 import Utils
 
 data ShowCodeState = ShowCodeState {
@@ -365,6 +366,22 @@ convOrSpace A.DefaultConversion = space
 convOrSpace A.Round = tell [" ROUND "]
 convOrSpace A.Trunc = tell [" TRUNC "]
 
+showOccamFunctionCall :: A.Name -> [A.Expression] -> CodeWriter ()
+showOccamFunctionCall n es
+  = do mOp <- functionOperator' n
+       case (mOp, es) of
+         (Nothing, _) -> showName n >> tell ["("] >> showWithCommas es >> tell [")"]
+         (Just op, [e]) -> tell [op, " "] >> showOccamM e
+         (Just op, [e,f]) -> showOccamM e >> tell [" ", op, " "] >> showOccamM f
+  where
+    functionOperator' (A.Name _ n)
+      = do origs <- get >>* originalNames
+           case Map.lookup n origs of
+             Nothing -> return Nothing
+             Just orig
+               | isOperator orig -> return $ Just orig
+               | otherwise -> return Nothing
+
 instance ShowOccam A.Expression where
   showOccamM (A.MostPos _ t) = bracket $ tell ["MOSTPOS "] >> showOccamM t
   showOccamM (A.MostNeg _ t) = bracket $ tell ["MOSTNEG "] >> showOccamM t
@@ -375,7 +392,7 @@ instance ShowOccam A.Expression where
   showOccamM (A.Literal _ _ lit) = showOccamM lit
   showOccamM (A.True _) = tell ["TRUE"]
   showOccamM (A.False _) = tell ["FALSE"]
-  showOccamM (A.FunctionCall _ n es) = showName n >> tell ["("] >> showWithCommas es >> tell [")"]
+  showOccamM (A.FunctionCall _ n es) = showOccamFunctionCall n es
   showOccamM (A.IntrinsicFunctionCall _ n es) = tell [n, "("] >> showWithCommas es >> tell [")"]
   showOccamM (A.SubscriptedExpr _ s e) = showSubscriptOccamM e s
   showOccamM (A.BytesInExpr _ e) = bracket $ tell ["BYTESIN "] >> showOccamM e
@@ -599,7 +616,7 @@ showWithSemis ss = sequence_ $ intersperse (tell [" ; "]) $ map showOccamM ss
 instance ShowOccam A.ExpressionList where
   showOccamM (A.ExpressionList _ es) = showWithCommas es
   showOccamM (A.FunctionCallList _ n es)
-    = showOccamM n >> tell ["("] >> showOccamM es >> tell [")"]
+    = showOccamFunctionCall n es
   showOccamM (A.IntrinsicFunctionCallList _ n es)
     = tell [n, "("] >> showOccamM es >> tell [")"]
   showOccamM (A.AllocChannelBundle _ n)
@@ -722,7 +739,6 @@ instance ShowRain a => ShowRain [a] where
   showRainM xs = tell ["["] >> sequence (intersperse (tell [", "]) $ map
     showRainM xs) >> tell ["]"]
 
-
 -- | Extends an existing (probably generic) function with cases for everything that has a specific ShowOccam and ShowRain instance
 -- This is a bit of manual wiring.  Because we can't generically deduce whether or not 
 -- a given Data item has a showRain\/showOccam implementation (that I know of), I have 

common/Types.hs

@@ -54,6 +54,7 @@ import Errors
 import EvalLiterals
 import Intrinsics
 import Metadata
+import Operators
 import PrettyShow
 import ShowCode
 import Traversal
@@ -698,7 +699,6 @@ specificDimSize :: Int -> A.Variable -> A.Variable
 specificDimSize n v = A.SubscriptedVariable (findMeta v) (A.Subscript (findMeta v) A.NoCheck
   $ makeConstant (findMeta v) n) $ A.VariableSizes (findMeta v) v
 
-
 functionOperator :: (CSMR m, Die m) => A.Name -> m (Maybe String)
 functionOperator n
   = lookupNameOrError n (dieP (A.nameMeta n) $ "Can't find operator definition for " ++ A.nameName n)
@@ -717,91 +717,6 @@ builtInOperator n
            | otherwise
              -> Nothing
 
-isOperator :: String -> Bool
-isOperator op = any (== op) operatorNames
-
-operatorNames :: [String]
-operatorNames =
-  ["??"
-  ,"@@"
-  ,"$$"
-  ,"%"
-  ,"%%"
-  ,"&&"
-  ,"<%"
-  ,"%>"
-  ,"<&"
-  ,"&>"
-  ,"<]"
-  ,"[>"
-  ,"<@"
-  ,"@>"
-  ,"@"
-  ,"++"
-  ,"!!"
-  ,"=="
-  ,"^"
-  ,"-"
-  ,"MINUS"
-  ,"~"
-  ,"NOT"
-  ,"+"
-  ,"*"
-  ,"/"
-  ,"\\"
-  ,"REM"
-  ,"PLUS"
-  ,"TIMES"
-  ,"AFTER"
-  ,"/\\"
-  ,"\\/"
-  ,"><"
-  ,"BITNOT"
-  ,"BITAND"
-  ,"BITOR"
-  ,"<<"
-  ,">>"
-  ,"AND"
-  ,"OR"
-  ,"="
-  ,"<>"
-  ,"<="
-  ,"<"
-  ,">="
-  ,">"
-  ]
-
--- | This gives a default mapping from operator (such as "+") to a valid name string
--- to be used in the backend (i.e. the Tock support headers), such as "add", which
--- will later be suffixed by the types in question.
-occamOperatorTranslateDefault :: String -> String
-occamOperatorTranslateDefault "+" = "add"
-occamOperatorTranslateDefault "-" = "subtr"
-occamOperatorTranslateDefault "*" = "mul"
-occamOperatorTranslateDefault "/" = "div"
-occamOperatorTranslateDefault "TIMES" = "times"
-occamOperatorTranslateDefault "PLUS" = "plus"
-occamOperatorTranslateDefault "MINUS" = "minus"
-occamOperatorTranslateDefault "AFTER" = "after"
-occamOperatorTranslateDefault ">" = "more"
-occamOperatorTranslateDefault "<" = "less"
-occamOperatorTranslateDefault ">=" = "moreEq"
-occamOperatorTranslateDefault "<=" = "lessEq"
-occamOperatorTranslateDefault "=" = "eq"
-occamOperatorTranslateDefault "<>" = "notEq"
-occamOperatorTranslateDefault "\\" = "rem"
-occamOperatorTranslateDefault "REM" = "REM"
-occamOperatorTranslateDefault "/\\" = "and"
-occamOperatorTranslateDefault "\\/" = "or"
-occamOperatorTranslateDefault "><" = "xor"
-occamOperatorTranslateDefault "<<" = "lshift"
-occamOperatorTranslateDefault ">>" = "rshift"
-occamOperatorTranslateDefault "AND" = "and"
-occamOperatorTranslateDefault "OR" = "or"
-occamOperatorTranslateDefault "NOT" = "not"
-occamOperatorTranslateDefault "~" = "not"
-occamOperatorTranslateDefault cs = "op_" ++ concatMap (show . ord) cs
-
 occamDefaultOperator :: String -> [A.Type] -> String
 occamDefaultOperator op ts = "occam_" ++ occamOperatorTranslateDefault op
   ++ concatMap (('_':) . showOccam) ts