aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJuan J. Martinez <jjm@usebox.net>2022-09-12 08:01:09 +0100
committerJuan J. Martinez <jjm@usebox.net>2022-09-12 08:01:09 +0100
commitb78d4f28adee1d0dab1dd7626650a3c767cd7cb8 (patch)
tree268eab7bb2ccdbc739ee454964ba8ff5c730ea19
parentdf9f7c237f61ab0e3aeae28be3d6187d273d1996 (diff)
downloadmicro-lang-hs-b78d4f28adee1d0dab1dd7626650a3c767cd7cb8.tar.gz
micro-lang-hs-b78d4f28adee1d0dab1dd7626650a3c767cd7cb8.zip
Some checks
-rw-r--r--src/Micro/Compiler.hs15
-rw-r--r--src/Micro/Error.hs3
-rw-r--r--test/Language.hs11
3 files changed, 23 insertions, 6 deletions
diff --git a/src/Micro/Compiler.hs b/src/Micro/Compiler.hs
index f305893..89ba802 100644
--- a/src/Micro/Compiler.hs
+++ b/src/Micro/Compiler.hs
@@ -5,6 +5,7 @@ module Micro.Compiler
)
where
+import Control.Arrow (ArrowChoice (left))
import Control.Monad.State
import Data.Maybe (catMaybes, fromMaybe, isNothing)
import Micro.Asm.Sdcc (generate)
@@ -108,6 +109,9 @@ compileOne x = do
(A.Module _ _) -> pure Nothing
(A.Num _ _) -> pure $ Just $ A.Type "u8" -- TODO: placeholder
(A.Bool' _ _) -> pure $ Just $ A.Type "bool"
+ (A.BinOp _ pos (A.Bool' _ _) (A.Bool' _ _)) ->
+ -- for now this is true
+ addError $ Error InvalidOperation "invalid operation for type bool" pos
(A.BinOp op pos a b) -> do
ta <- compileOne a
tb <- compileOne b
@@ -179,13 +183,16 @@ compileOne x = do
Just Sym {symType = t} -> pure $ Just t
Nothing -> addError $ Error Undefined ("undefined \"" ++ ident ++ "\"") pos
-foldConstant :: A.Expr -> Either [Error] A.Expr
+foldConstant :: A.Expr -> Either Error A.Expr
foldConstant x =
case x of
- -- FIXME: overflow, invalid, etc
+ -- FIXME: overflow?
(A.BinOp A.Plus pos (A.Num a _) (A.Num b _)) -> Right $ A.Num (a + b) pos
(A.BinOp A.Minus pos (A.Num a _) (A.Num b _)) -> Right $ A.Num (a - b) pos
(A.BinOp A.Mul pos (A.Num a _) (A.Num b _)) -> Right $ A.Num (a * b) pos
+ (A.BinOp A.Mul pos _ (A.Num 0 _)) -> Right $ A.Num 0 pos
+ (A.BinOp A.Mul pos (A.Num 0 _) _) -> Right $ A.Num 0 pos
+ (A.BinOp A.Div pos _ (A.Num 0 _)) -> Left $ Error InvalidOperation "division by zero" pos
(A.BinOp A.Div pos (A.Num a _) (A.Num b _)) -> Right $ A.Num (a `div` b) pos
(A.BinOp op pos a b) -> do
fa <- foldConstant a
@@ -220,10 +227,10 @@ compileAll ast = do
compileToAst :: [A.Expr] -> Either [Error] [A.Expr]
compileToAst ast = do
_ <- evalState (compileAll ast) startState
- traverse foldConstant ast
+ left (\e -> [e]) $ traverse foldConstant ast
compile :: [A.Expr] -> Either [Error] String
compile ast = do
sym <- evalState (compileAll ast) startState
- fast <- traverse foldConstant ast
+ fast <- left (\e -> [e]) $ traverse foldConstant ast
return $ generate version sym fast
diff --git a/src/Micro/Error.hs b/src/Micro/Error.hs
index ced1318..e82c0da 100644
--- a/src/Micro/Error.hs
+++ b/src/Micro/Error.hs
@@ -4,7 +4,7 @@ import Data.List (sort)
import Text.Parsec (SourcePos, errorPos)
import Text.Parsec.Error (ParseError, errorMessages, showErrorMessages)
-data ErrorType = GenericError | TypeError | UnexpectedReturn | AlreadyDefined | NonCallable | Undefined | UndefinedType | InvalidTarget deriving (Show)
+data ErrorType = GenericError | TypeError | UnexpectedReturn | AlreadyDefined | NonCallable | Undefined | UndefinedType | InvalidTarget | InvalidOperation deriving (Show)
instance Enum ErrorType where
fromEnum GenericError = 0
@@ -15,6 +15,7 @@ instance Enum ErrorType where
fromEnum Undefined = 5
fromEnum UndefinedType = 6
fromEnum InvalidTarget = 7
+ fromEnum InvalidOperation = 8
toEnum _ = error "toEnum is undefined for Error"
data Error = Error ErrorType String SourcePos
diff --git a/test/Language.hs b/test/Language.hs
index 6e15525..84c10b4 100644
--- a/test/Language.hs
+++ b/test/Language.hs
@@ -416,6 +416,14 @@ testCaseE17 =
\1 + false;\n"
E.TypeError
+testCaseE18 =
+ TestLabel "div by 0" $
+ TestCase $
+ expectError
+ "module main\n\
+ \1 / 0;\n"
+ E.InvalidOperation
+
language =
[ testCase2,
testCase3,
@@ -452,5 +460,6 @@ language =
testCaseE14,
testCaseE15,
testCaseE16,
- testCaseE17
+ testCaseE17,
+ testCaseE18
]