Fix #354, Added support for negating expressions

src/back/CodeGen/Expr.hs

@@ -48,8 +48,10 @@ instance Translatable ID.BinaryOp (CCode Name) where
     ID.MOD -> "%"
 
 instance Translatable ID.UnaryOp (CCode Name) where
-  translate op = Nam $ case op of
-    ID.NOT -> "!"
+  translate op = Nam $
+    case op of
+      ID.NOT -> "!"
+      ID.NEG -> "-"
 
 typeToPrintfFstr :: Ty.Type -> String
 typeToPrintfFstr ty

src/ir/AST/PrettyPrinter.hs

@@ -265,6 +265,7 @@ ppExpr FinishAsync {body} = ppFinish <+> ppExpr body
 
 ppUnary :: UnaryOp -> Doc
 ppUnary Identifiers.NOT = text "not"
+ppUnary Identifiers.NEG = text "-"
 
 ppBinop :: BinaryOp -> Doc
 ppBinop Identifiers.AND = text "and"

src/ir/Identifiers.hs

@@ -50,7 +50,10 @@ instance Show BinaryOp where
     show DIV             = "/"
     show MOD             = "%"
 
-data UnaryOp = NOT deriving(Read, Eq)
+data UnaryOp = NOT
+             | NEG
+               deriving(Read, Eq)
 
 instance Show UnaryOp where
     show Identifiers.NOT = "not"
+    show Identifiers.NEG = "-"

src/parser/Parser/Parser.hs

@@ -84,7 +84,7 @@ maybeBraces p = braces p <|> p
 
 stringLiteral = P.stringLiteral lexer
 charLiteral = P.charLiteral lexer
-integer = P.integer lexer
+natural = P.natural lexer
 float = P.float lexer
 whiteSpace = P.whiteSpace lexer
 
@@ -401,6 +401,7 @@ expression = buildExpressionParser opTable highOrderExpr
                  [textualPrefix "not" Identifiers.NOT],
                  [textualOperator "and" Identifiers.AND,
                   textualOperator "or" Identifiers.OR],
+                 [prefix "-" NEG],
                  [op "*" TIMES, op "/" DIV, op "%" MOD],
                  [op "+" PLUS, op "-" MINUS],
                  [op "<" Identifiers.LT, op ">" Identifiers.GT,
@@ -432,6 +433,7 @@ expression = buildExpressionParser opTable highOrderExpr
           Infix (do pos <- getPosition
                     reservedOp s
                     return (Binop (meta pos) binop)) AssocLeft
+
       typedExpression =
           Postfix (do pos <- getPosition
                       reservedOp ":"
@@ -729,7 +731,7 @@ expr  =  unit
                    char <- charLiteral
                    return $ CharLiteral (meta pos) char
       int = do pos <- getPosition
-               n <- integer
+               n <- natural
                return $ IntLiteral (meta pos) (fromInteger n)
       real = do pos <- getPosition
                 r <- float

src/tests/encore/basic/negation.enc

@@ -0,0 +1,8 @@
+class Main {
+  def main() : void {
+    let x = -(-42);
+    let y = -(-(-x));
+    let z = -y + (-(1+2) + 3);
+    print z;
+  }
+}

src/tests/encore/basic/negation.out

@@ -0,0 +1 @@
+42

src/types/Typechecker/Typechecker.hs

@@ -1100,14 +1100,17 @@ instance Checkable Expr where
     --  E |- operand : bool
     -- -------------------------
     --  E |- not operand : bool
-    doTypecheck unary@(Unary {uop, operand})
-      | uop == Identifiers.NOT = do
+    doTypecheck unary@(Unary {uop, operand}) = do
+        let isExpected | uop == Identifiers.NOT = isBoolType
+                       | uop == Identifiers.NEG = isNumeric
         eOperand <- typecheck operand
         let eType = AST.getType eOperand
-        unless (isBoolType eType) $
-                tcError $ "Operator '" ++ show uop ++ "' is only defined for boolean types\n" ++
-                          "Expression '" ++ show (ppSugared eOperand) ++ "' has type '" ++ show eType ++ "'"
-        return $ setType boolType unary { operand = eOperand }
+        unless (isExpected eType) $
+               tcError $ "Operator '" ++ show uop ++ "' is not defined " ++
+                         "for values of type '" ++ show eType ++ "'"
+        let resultType | uop == Identifiers.NOT = boolType
+                       | uop == Identifiers.NEG = eType
+        return $ setType resultType unary {operand = eOperand}
 
     --  op \in {and, or}
     --  E |- loper : bool