diff --git a/Makefile.am b/Makefile.am index 470ccab..66bad54 100644 --- a/Makefile.am +++ b/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 diff --git a/common/Operators.hs b/common/Operators.hs new file mode 100644 index 0000000..a26b960 --- /dev/null +++ b/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 . +-} + +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 + diff --git a/common/ShowCode.hs b/common/ShowCode.hs index 958aa4f..ec93618 100644 --- a/common/ShowCode.hs +++ b/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 diff --git a/common/Types.hs b/common/Types.hs index bff53d7..1aaa268 100644 --- a/common/Types.hs +++ b/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