Moved some of the operators stuff out into its own module, and corrected ShowCode to display operators nicely
This commit is contained in:
Neil Brown
parent
79c31ea201
commit
46b1b29e12
|
|
@ -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
|
||||
|
|
|
|||
107
common/Operators.hs
Normal file
107
common/Operators.hs
Normal file
|
|
@ -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
|
||||
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user