diff options
author | Juan J. Martinez <jjm@usebox.net> | 2022-09-12 08:01:09 +0100 |
---|---|---|
committer | Juan J. Martinez <jjm@usebox.net> | 2022-09-12 08:01:09 +0100 |
commit | b78d4f28adee1d0dab1dd7626650a3c767cd7cb8 (patch) | |
tree | 268eab7bb2ccdbc739ee454964ba8ff5c730ea19 | |
parent | df9f7c237f61ab0e3aeae28be3d6187d273d1996 (diff) | |
download | micro-lang-hs-b78d4f28adee1d0dab1dd7626650a3c767cd7cb8.tar.gz micro-lang-hs-b78d4f28adee1d0dab1dd7626650a3c767cd7cb8.zip |
Some checks
-rw-r--r-- | src/Micro/Compiler.hs | 15 | ||||
-rw-r--r-- | src/Micro/Error.hs | 3 | ||||
-rw-r--r-- | test/Language.hs | 11 |
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 ] |