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