Monadic - and MINUS are not the same operator.

Neil spotted this while using MonadicSubtr in the Rain frontend -- -(MOSTNEG
INT) should fail, MINUS (MOSTNEG INT) shouldn't. This adds a MonadicMinus.
This commit is contained in:
Adam Sampson 2007-08-23 22:17:15 +00:00
parent 82df59dcfb
commit 64f0e1f4cb
6 changed files with 25 additions and 9 deletions

1
AST.hs
View File

@ -275,6 +275,7 @@ data ExpressionList =
-- Nothing to do with Haskell monads. -- Nothing to do with Haskell monads.
data MonadicOp = data MonadicOp =
MonadicSubtr MonadicSubtr
| MonadicMinus
| MonadicBitNot | MonadicBitNot
| MonadicNot | MonadicNot
deriving (Show, Eq, Typeable, Data) deriving (Show, Eq, Typeable, Data)

View File

@ -185,6 +185,7 @@ evalMonadic :: A.MonadicOp -> OccValue -> EvalM OccValue
-- This, oddly, is probably the most important rule here: "-4" isn't a literal -- This, oddly, is probably the most important rule here: "-4" isn't a literal
-- in occam, it's an operator applied to a literal. -- in occam, it's an operator applied to a literal.
evalMonadic A.MonadicSubtr a = evalMonadicOp negate a evalMonadic A.MonadicSubtr a = evalMonadicOp negate a
evalMonadic A.MonadicMinus a = evalMonadicOp negate a
evalMonadic A.MonadicBitNot a = evalMonadicOp complement a evalMonadic A.MonadicBitNot a = evalMonadicOp complement a
evalMonadic A.MonadicNot (OccBool b) = return $ OccBool (not b) evalMonadic A.MonadicNot (OccBool b) = return $ OccBool (not b)
evalMonadic _ _ = throwError "bad monadic op" evalMonadic _ _ = throwError "bad monadic op"

View File

@ -106,6 +106,7 @@ data GenOps = GenOps {
genFormal :: GenOps -> A.Formal -> CGen (), genFormal :: GenOps -> A.Formal -> CGen (),
genFormals :: GenOps -> [A.Formal] -> CGen (), genFormals :: GenOps -> [A.Formal] -> CGen (),
genFuncDyadic :: GenOps -> Meta -> String -> A.Expression -> A.Expression -> CGen (), genFuncDyadic :: GenOps -> Meta -> String -> A.Expression -> A.Expression -> CGen (),
genFuncMonadic :: GenOps -> Meta -> String -> A.Expression -> CGen (),
genIf :: GenOps -> Meta -> A.Structured -> CGen (), genIf :: GenOps -> Meta -> A.Structured -> CGen (),
genInput :: GenOps -> A.Variable -> A.InputMode -> CGen (), genInput :: GenOps -> A.Variable -> A.InputMode -> CGen (),
genInputCase :: GenOps -> Meta -> A.Variable -> A.Structured -> CGen (), genInputCase :: GenOps -> Meta -> A.Variable -> A.Structured -> CGen (),
@ -191,6 +192,7 @@ cgenOps = GenOps {
genFormal = cgenFormal, genFormal = cgenFormal,
genFormals = cgenFormals, genFormals = cgenFormals,
genFuncDyadic = cgenFuncDyadic, genFuncDyadic = cgenFuncDyadic,
genFuncMonadic = cgenFuncMonadic,
genIf = cgenIf, genIf = cgenIf,
genInput = cgenInput, genInput = cgenInput,
genInputCase = cgenInputCase, genInputCase = cgenInputCase,
@ -826,8 +828,19 @@ cgenSimpleMonadic ops s e
call genExpression ops e call genExpression ops e
tell [")"] tell [")"]
cgenFuncMonadic :: GenOps -> Meta -> String -> A.Expression -> CGen ()
cgenFuncMonadic ops m s e
= do t <- typeOfExpression e
call genTypeSymbol ops s t
tell [" ("]
call genExpression ops e
tell [", "]
genMeta m
tell [")"]
cgenMonadic :: GenOps -> Meta -> A.MonadicOp -> A.Expression -> CGen () cgenMonadic :: GenOps -> Meta -> A.MonadicOp -> A.Expression -> CGen ()
cgenMonadic ops _ A.MonadicSubtr e = call genSimpleMonadic ops "-" e cgenMonadic ops m A.MonadicSubtr e = call genFuncMonadic ops m "negate" e
cgenMonadic ops _ A.MonadicMinus e = call genSimpleMonadic ops "-" e
cgenMonadic ops _ A.MonadicBitNot e = call genSimpleMonadic ops "~" e cgenMonadic ops _ A.MonadicBitNot e = call genSimpleMonadic ops "~" e
cgenMonadic ops _ A.MonadicNot e = call genSimpleMonadic ops "!" e cgenMonadic ops _ A.MonadicNot e = call genSimpleMonadic ops "!" e

View File

@ -1010,7 +1010,8 @@ intrinsicFunctionSingle
monadicOperator :: OccParser A.MonadicOp monadicOperator :: OccParser A.MonadicOp
monadicOperator monadicOperator
= do { reserved "-" <|> sMINUS; return A.MonadicSubtr } = do { reserved "-"; return A.MonadicSubtr }
<|> do { sMINUS; return A.MonadicMinus }
<|> do { reserved "~" <|> sBITNOT; return A.MonadicBitNot } <|> do { reserved "~" <|> sBITNOT; return A.MonadicBitNot }
<|> do { sNOT; return A.MonadicNot } <|> do { sNOT; return A.MonadicNot }
<?> "monadic operator" <?> "monadic operator"

View File

@ -103,7 +103,7 @@ dyadicCompOp
monadicArithOp :: RainParser (Meta,A.MonadicOp) monadicArithOp :: RainParser (Meta,A.MonadicOp)
monadicArithOp monadicArithOp
= do {m <- reserved "-" ; return (m,A.MonadicSubtr) } = do {m <- reserved "-" ; return (m,A.MonadicMinus) }

View File

@ -124,13 +124,13 @@ testExprs =
--Monadic operators: --Monadic operators:
,passE ("-b", 101, Mon A.MonadicSubtr (Var "b") ) ,passE ("-b", 101, Mon A.MonadicMinus (Var "b") )
,failE ("+b") ,failE ("+b")
,passE ("a - - b", 102, Dy (Var "a") A.Minus (Mon A.MonadicSubtr $ Var "b") ) --TODO change this to MonadicMinus ,passE ("a - - b", 102, Dy (Var "a") A.Minus (Mon A.MonadicMinus $ Var "b") )
,passE ("a--b", 103, Dy (Var "a") A.Minus (Mon A.MonadicSubtr $ Var "b") ) --TODO change this to MonadicMinus ,passE ("a--b", 103, Dy (Var "a") A.Minus (Mon A.MonadicMinus $ Var "b") )
,passE ("a---b", 104, Dy (Var "a") A.Minus (Mon A.MonadicSubtr $ Mon A.MonadicSubtr $ Var "b") ) --TODO change this to MonadicMinus ,passE ("a---b", 104, Dy (Var "a") A.Minus (Mon A.MonadicMinus $ Mon A.MonadicMinus $ Var "b") )
,passE ("-b+c", 105, Dy (Mon A.MonadicSubtr $ Var "b") A.Plus (Var "c") ) ,passE ("-b+c", 105, Dy (Mon A.MonadicMinus $ Var "b") A.Plus (Var "c") )
,passE ("-(b+c)", 106, Mon A.MonadicSubtr $ Dy (Var "b") A.Plus (Var "c") ) ,passE ("-(b+c)", 106, Mon A.MonadicMinus $ Dy (Var "b") A.Plus (Var "c") )
--Casting: --Casting: