Generate a call to _divide_by_zero_error on RiscV

TODO

@@ -21,11 +21,6 @@
   there more variables the allocation will fail with out of bounds runtime
   error. Implement spill over.
 
-# Prarsing and abstract syntax tree
-
-- Parse signed hexadecimal numbers.
-
 # Other
 
 - Type analysis.
-- Generate a call to _divide_by_zero_error on RiscV.

lib/Language/Elna/Frontend/AST.hs

@@ -15,9 +15,10 @@ module Language.Elna.Frontend.AST
 import Data.Char (chr)
 import Data.Int (Int32)
 import Data.List (intercalate)
-import Data.Word (Word8, Word32)
+import Data.Word (Word8)
 import Language.Elna.Location (Identifier(..), showArrayType)
 import Numeric (showHex)
+import Data.Bifunctor (Bifunctor(bimap))
 
 newtype Program = Program [Declaration]
     deriving Eq
@@ -57,13 +58,14 @@ showParameters parameters =
 
 data TypeExpression
     = NamedType Identifier
-    | ArrayType Word32 TypeExpression
+    | ArrayType Literal TypeExpression
     deriving Eq
 
 instance Show TypeExpression
   where
     show (NamedType typeName) = show typeName
-    show (ArrayType elementCount typeName) = showArrayType elementCount typeName
+    show (ArrayType elementCount typeName) =
+        showArrayType elementCount typeName
 
 data Statement
     = EmptyStatement
@@ -96,18 +98,59 @@ data VariableDeclaration =
     deriving Eq
 
 data Literal
-    = IntegerLiteral Int32
+    = DecimalLiteral Int32
     | HexadecimalLiteral Int32
     | CharacterLiteral Word8
     deriving Eq
 
 instance Show Literal
   where
-    show (IntegerLiteral integer) = show integer
+    show (DecimalLiteral integer) = show integer
     show (HexadecimalLiteral integer) = '0' : 'x' : showHex integer ""
     show (CharacterLiteral character) =
         '\'' : chr (fromEnum character) : ['\'']
 
+instance Ord Literal
+  where
+    compare x y = compare (int32Literal x) (int32Literal y)
+
+instance Num Literal
+  where
+    x + y = DecimalLiteral $ int32Literal x + int32Literal y
+    x * y = DecimalLiteral $ int32Literal x * int32Literal y
+    abs (DecimalLiteral x) = DecimalLiteral $ abs x
+    abs (HexadecimalLiteral x) = HexadecimalLiteral $ abs x
+    abs (CharacterLiteral x) = CharacterLiteral $ abs x
+    negate (DecimalLiteral x) = DecimalLiteral $ negate x
+    negate (HexadecimalLiteral x) = HexadecimalLiteral $ negate x
+    negate (CharacterLiteral x) = CharacterLiteral $ negate x
+    signum (DecimalLiteral x) = DecimalLiteral $ signum x
+    signum (HexadecimalLiteral x) = HexadecimalLiteral $ signum x
+    signum (CharacterLiteral x) = CharacterLiteral $ signum x
+    fromInteger = DecimalLiteral . fromInteger
+
+instance Real Literal
+  where
+    toRational (DecimalLiteral integer) = toRational integer
+    toRational (HexadecimalLiteral integer) = toRational integer
+    toRational (CharacterLiteral integer) = toRational integer
+
+instance Enum Literal
+  where
+   toEnum = DecimalLiteral . fromIntegral
+   fromEnum = fromEnum . int32Literal
+
+instance Integral Literal
+  where
+    toInteger = toInteger . int32Literal
+    quotRem x y = bimap DecimalLiteral DecimalLiteral
+        $ quotRem (int32Literal x) (int32Literal y)
+
+int32Literal :: Literal -> Int32
+int32Literal (DecimalLiteral integer) = integer
+int32Literal (HexadecimalLiteral integer) = integer
+int32Literal (CharacterLiteral integer) = fromIntegral integer
+
 instance Show VariableDeclaration
   where
     show (VariableDeclaration identifier typeExpression) =

lib/Language/Elna/Frontend/NameAnalysis.hs

@@ -134,7 +134,7 @@ dataType environmentSymbolTable (AST.NamedType baseType) = do
             | otherwise -> NameAnalysis $ throwE $ UnexpectedTypeInfoError baseInfo
         _ -> NameAnalysis $ throwE $ UndefinedTypeError baseType
 dataType environmentSymbolTable (AST.ArrayType arraySize baseType) =
-    dataType environmentSymbolTable baseType <&> ArrayType arraySize
+    dataType environmentSymbolTable baseType <&> ArrayType (fromIntegral arraySize)
 
 checkSymbol :: SymbolTable -> Identifier -> NameAnalysis ()
 checkSymbol globalTable identifier

lib/Language/Elna/Frontend/Parser.hs

@@ -46,8 +46,8 @@ type Parser = Parsec Void Text
 
 literalP :: Parser Literal
 literalP
-    = HexadecimalLiteral <$> (string "0x" *> lexeme Lexer.hexadecimal)
-    <|> IntegerLiteral <$> Lexer.signed space integerP
+    = HexadecimalLiteral <$> Lexer.signed space hexadecimalP
+    <|> DecimalLiteral <$> Lexer.signed space decimalP
     <|> CharacterLiteral <$> lexeme charP
   where
     charP = fromIntegral . fromEnum
@@ -141,8 +141,11 @@ commaP = void $ symbol ","
 semicolonP :: Parser ()
 semicolonP = void $ symbol ";"
 
-integerP :: Integral a => Parser a
-integerP = lexeme Lexer.decimal
+decimalP :: Integral a => Parser a
+decimalP = lexeme Lexer.decimal
+
+hexadecimalP :: Integral a => Parser a
+hexadecimalP = string "0x" *> lexeme Lexer.hexadecimal
 
 identifierP :: Parser Identifier
 identifierP =
@@ -166,7 +169,7 @@ typeExpressionP = arrayTypeExpression
     <?> "type expression"
   where
     arrayTypeExpression = ArrayType
-        <$> (symbol "array" *> bracketsP integerP)
+        <$> (symbol "array" *> bracketsP literalP)
         <*> (symbol "of" *> typeExpressionP)
 
 procedureDeclarationP :: Parser Declaration

lib/Language/Elna/Glue.hs

@@ -267,6 +267,6 @@ expression localTable = \case
             )
 
 literal :: AST.Literal -> Operand Variable
-literal (AST.IntegerLiteral integer) = IntOperand integer
+literal (AST.DecimalLiteral integer) = IntOperand integer
 literal (AST.HexadecimalLiteral integer) = IntOperand integer
 literal (AST.CharacterLiteral character) = IntOperand $ fromIntegral character

lib/Language/Elna/Location.hs

@@ -53,6 +53,6 @@ instance Hashable Identifier
   where
     hashWithSalt salt (Identifier identifier) = hashWithSalt salt identifier
 
-showArrayType :: Show a => Word32 -> a -> String
+showArrayType :: (Show a, Show b) => a -> b -> String
 showArrayType elementCount typeName = concat
     ["array[", show elementCount, "] of ", show typeName]

lib/Language/Elna/RiscV/CodeGenerator.hs

@@ -234,20 +234,31 @@ quadruple (DivisionQuadruple operand1 operand2 (Store register))
     , IntOperand immediateOperand2 <- operand2 =
         let statements2 = lui immediateOperand2 register
             Store operandRegister1 = variableOperand1
-        in pure $ Vector.snoc statements2
-            $ Instruction
-            $ RiscV.BaseInstruction RiscV.Op
-            $ RiscV.R register RiscV.DIV operandRegister1 register
-            $ RiscV.Funct7 0b0000001
+            operationInstruction
+                | immediateOperand2 == 0 =
+                    RiscV.CallInstruction "_divide_by_zero_error"
+                | otherwise = RiscV.BaseInstruction RiscV.Op
+                    $ RiscV.R register RiscV.DIV operandRegister1 register
+                    $ RiscV.Funct7 0b0000001
+         in pure $ Vector.snoc statements2
+            $ Instruction operationInstruction
     | IntOperand immediateOperand1 <- operand1
-    , VariableOperand variableOperand2 <- operand2 =
+    , VariableOperand variableOperand2 <- operand2 = do
         let statements1 = lui immediateOperand1 register
             Store operandRegister2 = variableOperand2
-        in pure $ Vector.snoc statements1
-            $ Instruction
-            $ RiscV.BaseInstruction RiscV.Op
-            $ RiscV.R register RiscV.DIV register operandRegister2
-            $ RiscV.Funct7 0b0000001
+            divisionInstruction = Instruction
+                $ RiscV.BaseInstruction RiscV.Op
+                $ RiscV.R register RiscV.DIV register operandRegister2 (RiscV.Funct7 0b0000001)
+        branchLabel <- createLabel
+        let branchInstruction = Instruction
+                $ RiscV.RelocatableInstruction RiscV.Branch
+                $ RiscV.RBranch branchLabel RiscV.BNE RiscV.Zero operandRegister2
+        pure $ mappend statements1 $ Vector.fromList 
+            [ branchInstruction
+            , Instruction (RiscV.CallInstruction "_divide_by_zero_error")
+            , JumpLabel branchLabel []
+            , divisionInstruction
+            ]
 quadruple (LabelQuadruple (Label label)) = pure $ Vector.singleton $ JumpLabel label mempty
 quadruple (GoToQuadruple label) = pure $ Vector.singleton $ unconditionalJal label
 quadruple (EqualQuadruple operand1 operand2 goToLabel)

tests/expectations/printi_negative_hex.txt

@@ -0,0 +1 @@
+-129

tests/expectations/printi_signed_hex.txt

@@ -0,0 +1 @@
+129

tests/vm/printi_negative_hex.elna

@@ -0,0 +1,3 @@
+proc main() {
+  printi(-0x81);
+}

tests/vm/printi_signed_hex.elna

@@ -0,0 +1,3 @@
+proc main() {
+  printi(+0x81);
+}