diff --git a/checks/Check.hs b/checks/Check.hs index e95cbea..a40a3db 100644 --- a/checks/Check.hs +++ b/checks/Check.hs @@ -175,14 +175,13 @@ addBK mp mp2 g nid n rhs' <- g rhs >>* deAnd return $ And $ map (\(x,y) -> x `mappend` y) $ product2 (lhs', rhs') | otherwise - = do mOp <- functionOperator fn - ts <- mapM astTypeOf [lhs, rhs] + = do mOp <- builtInOperator fn case mOp of Nothing -> return mempty Just op -> - if A.nameName fn == occamDefaultOperator op ts - then let noAndOr :: PassM a -> PassM (And (Or a)) - noAndOr = liftM (noAnd . noOr) in case op of + let noAndOr :: PassM a -> PassM (And (Or a)) + noAndOr = liftM (noAnd . noOr) + in case op of "=" -> noAndOr $ return $ Equal lhs rhs "<=" -> noAndOr $ return $ LessThanOrEqual lhs rhs ">=" -> noAndOr $ return $ LessThanOrEqual rhs lhs @@ -196,7 +195,6 @@ addBK mp mp2 g nid n return $ Or [LessThanOrEqual lhs_p1 rhs ,LessThanOrEqual rhs_p1 lhs] _ -> return mempty - else return mempty where bop n = A.Name emptyMeta $ occamDefaultOperator n [A.Bool, A.Bool] g (A.FunctionCall _ fn [rhs]) diff --git a/common/Types.hs b/common/Types.hs index c19ac30..f12b993 100644 --- a/common/Types.hs +++ b/common/Types.hs @@ -22,7 +22,7 @@ module Types specTypeOfName, typeOfSpec, typeOfSpec', abbrevModeOfName, underlyingType, underlyingTypeOf, stripArrayType, abbrevModeOfVariable, abbrevModeOfSpec , isRealType, isIntegerType, isNumericType, isCaseableType, isScalarType, isDataType, isCommunicableType, isSequenceType, isMobileType , resolveUserType, isSafeConversion, isPreciseConversion, isImplicitConversionRain - , isOperator, functionOperator, occamDefaultOperator, occamBuiltInOperatorFunctions, occamOperatorTranslateDefault + , isOperator, functionOperator, builtInOperator, occamDefaultOperator, occamBuiltInOperatorFunctions, occamOperatorTranslateDefault , returnTypesOfFunction , BytesInResult(..), bytesInType, countReplicator, countStructured, computeStructured @@ -45,6 +45,7 @@ import qualified Data.Map as Map import Data.Maybe import Data.List import Data.Ord +import qualified Data.Set as Set import qualified AST as A import CompState hiding (CSM) -- all these functions are read-only! @@ -698,6 +699,18 @@ functionOperator n >>* A.ndOrigName >>* (\op -> if isOperator op then Just op else Nothing) +-- Only gives back a Just result if it's a non-overridden operator +builtInOperator :: (CSMR m, Die m) => A.Name -> m (Maybe String) +builtInOperator n + = do mOp <- functionOperator n + return $ case mOp of + Nothing -> Nothing + Just op + | A.nameName n `Set.member` occamBuiltInOperatorFunctionsSet + -> Just op + | otherwise + -> Nothing + isOperator :: String -> Bool isOperator op = any (== op) operatorNames @@ -792,6 +805,9 @@ occamBuiltInOperatorFunctions = [occamDefaultOperator n ts | (n, _, ts) <- occamIntrinsicOperators] +occamBuiltInOperatorFunctionsSet :: Set.Set String +occamBuiltInOperatorFunctionsSet = Set.fromList occamBuiltInOperatorFunctions + -- | Add one to an expression. addOne :: (CSMR m, Die m) => A.Expression -> m A.Expression addOne e = addExprs (makeConstant m 1) e diff --git a/transformations/SimplifyExprs.hs b/transformations/SimplifyExprs.hs index f8dd9ff..a2b1acb 100644 --- a/transformations/SimplifyExprs.hs +++ b/transformations/SimplifyExprs.hs @@ -115,7 +115,7 @@ removeAfter = pass "Convert AFTER to MINUS" doFunctionCall :: (Meta -> A.Name -> [A.Expression] -> a) -> Meta -> A.Name -> [A.Expression] -> PassM a doFunctionCall f m n args - = do mOp <- functionOperator n + = do mOp <- builtInOperator n ts <- mapM astTypeOf args let op s = A.Name (A.nameMeta n) $ occamDefaultOperator s ts case mOp of @@ -128,7 +128,7 @@ removeAfter = pass "Convert AFTER to MINUS" [A.FunctionCall m (op "MINUS") args , one] ,oneTwoSeven] - | n == op "AFTER" -- It hasn't been over-ridden + | otherwise -> let zero = A.Literal m (head ts) $ A.IntLiteral m "0" in return $ f m (op ">") [A.FunctionCall m (op "MINUS") args, zero] _ -> return $ f m n args