diff --git a/AST.hs b/AST.hs index 2a9aeb0..3689fcb 100644 --- a/AST.hs +++ b/AST.hs @@ -275,6 +275,7 @@ data ExpressionList = -- Nothing to do with Haskell monads. data MonadicOp = MonadicSubtr + | MonadicMinus | MonadicBitNot | MonadicNot deriving (Show, Eq, Typeable, Data) diff --git a/EvalConstants.hs b/EvalConstants.hs index 7375d96..0b6e753 100644 --- a/EvalConstants.hs +++ b/EvalConstants.hs @@ -185,6 +185,7 @@ evalMonadic :: A.MonadicOp -> OccValue -> EvalM OccValue -- This, oddly, is probably the most important rule here: "-4" isn't a literal -- in occam, it's an operator applied to a literal. evalMonadic A.MonadicSubtr a = evalMonadicOp negate a +evalMonadic A.MonadicMinus a = evalMonadicOp negate a evalMonadic A.MonadicBitNot a = evalMonadicOp complement a evalMonadic A.MonadicNot (OccBool b) = return $ OccBool (not b) evalMonadic _ _ = throwError "bad monadic op" diff --git a/GenerateC.hs b/GenerateC.hs index ab3cdd1..6fccf75 100644 --- a/GenerateC.hs +++ b/GenerateC.hs @@ -106,6 +106,7 @@ data GenOps = GenOps { genFormal :: GenOps -> A.Formal -> CGen (), genFormals :: GenOps -> [A.Formal] -> CGen (), genFuncDyadic :: GenOps -> Meta -> String -> A.Expression -> A.Expression -> CGen (), + genFuncMonadic :: GenOps -> Meta -> String -> A.Expression -> CGen (), genIf :: GenOps -> Meta -> A.Structured -> CGen (), genInput :: GenOps -> A.Variable -> A.InputMode -> CGen (), genInputCase :: GenOps -> Meta -> A.Variable -> A.Structured -> CGen (), @@ -191,6 +192,7 @@ cgenOps = GenOps { genFormal = cgenFormal, genFormals = cgenFormals, genFuncDyadic = cgenFuncDyadic, + genFuncMonadic = cgenFuncMonadic, genIf = cgenIf, genInput = cgenInput, genInputCase = cgenInputCase, @@ -826,8 +828,19 @@ cgenSimpleMonadic ops s e call genExpression ops e 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 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.MonadicNot e = call genSimpleMonadic ops "!" e diff --git a/ParseOccam.hs b/ParseOccam.hs index 509b3f6..934c040 100644 --- a/ParseOccam.hs +++ b/ParseOccam.hs @@ -1010,7 +1010,8 @@ intrinsicFunctionSingle monadicOperator :: OccParser A.MonadicOp monadicOperator - = do { reserved "-" <|> sMINUS; return A.MonadicSubtr } + = do { reserved "-"; return A.MonadicSubtr } + <|> do { sMINUS; return A.MonadicMinus } <|> do { reserved "~" <|> sBITNOT; return A.MonadicBitNot } <|> do { sNOT; return A.MonadicNot } "monadic operator" diff --git a/RainParse.hs b/RainParse.hs index d14b363..439e5e6 100644 --- a/RainParse.hs +++ b/RainParse.hs @@ -103,7 +103,7 @@ dyadicCompOp monadicArithOp :: RainParser (Meta,A.MonadicOp) monadicArithOp - = do {m <- reserved "-" ; return (m,A.MonadicSubtr) } + = do {m <- reserved "-" ; return (m,A.MonadicMinus) } diff --git a/RainParseTest.hs b/RainParseTest.hs index de141ba..3238509 100644 --- a/RainParseTest.hs +++ b/RainParseTest.hs @@ -124,13 +124,13 @@ testExprs = --Monadic operators: - ,passE ("-b", 101, Mon A.MonadicSubtr (Var "b") ) + ,passE ("-b", 101, Mon A.MonadicMinus (Var "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", 103, Dy (Var "a") A.Minus (Mon A.MonadicSubtr $ Var "b") ) --TODO change this to MonadicMinus - ,passE ("a---b", 104, Dy (Var "a") A.Minus (Mon A.MonadicSubtr $ Mon A.MonadicSubtr $ Var "b") ) --TODO change this to MonadicMinus - ,passE ("-b+c", 105, Dy (Mon A.MonadicSubtr $ Var "b") A.Plus (Var "c") ) - ,passE ("-(b+c)", 106, Mon A.MonadicSubtr $ Dy (Var "b") A.Plus (Var "c") ) + ,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.MonadicMinus $ Var "b") ) + ,passE ("a---b", 104, Dy (Var "a") A.Minus (Mon A.MonadicMinus $ Mon A.MonadicMinus $ Var "b") ) + ,passE ("-b+c", 105, Dy (Mon A.MonadicMinus $ Var "b") A.Plus (Var "c") ) + ,passE ("-(b+c)", 106, Mon A.MonadicMinus $ Dy (Var "b") A.Plus (Var "c") ) --Casting: