all: minor refactor and better error handling

This commit is contained in:
2017-05-19 16:19:55 +02:00
parent a011b5647f
commit 1c46c60206
4 changed files with 55 additions and 43 deletions

View File

@@ -58,23 +58,26 @@ treeEval state (x@(BIf _ _ _):xy) ops nums =
treeEval state (x@(BNum _):xy) ops nums = treeEval state xy ops (x:nums)
treeEval state ((BBool x):xy) ops nums =
treeEval state xy ops ((BNum $ BInt $ if x then 1 else 0):nums)
treeEval state expr@(x@(BSym sym):xy) ops@(op:_) nums =
treeEval state expr@(x@(BSym sym):xy) ops@((BSym op):_) nums =
case M.lookup sym state of
Just val -> treeEval state xy ops (val:nums)
Nothing ->
if precedence x > precedence op
if precedence sym > precedence op
then treeEval state xy (x:ops) nums
else handleOp state expr ops nums
treeEval state (x@(BSym sym):xy) [] nums =
case M.lookup sym state of
Just val -> treeEval state xy [] (val:nums)
Nothing -> treeEval state xy [x] nums
Nothing ->
if isOp sym
then treeEval state xy [x] nums
else BErr (sym ++ " is undefined")
handleOp :: State -> [Value] -> [Value] -> [Value] -> Value
handleOp state expr (op:ops) ((BNum op2):((BNum op1):nums)) =
handleOp state expr ((BSym op):ops) ((BNum op2):((BNum op1):nums)) =
treeEval state expr ops (((findOp op) op1 op2):nums)
handleOp _ expr ((BSym op):ops) _ = BErr ("Not enough arguments to operation " ++ op)
handleOp _ expr ((BSym op):ops) x = BErr ("Not enough arguments to operation " ++ op)
findOp x = case binOp x of
@@ -85,22 +88,22 @@ findOp x = case binOp x of
Nothing -> \a -> \b -> (BNum $ BInt 0)
logicalOp :: Value -> Maybe (Number -> Number -> Bool)
logicalOp (BSym ">") = Just (>)
logicalOp (BSym "<") = Just (<)
logicalOp (BSym ">=") = Just (>=)
logicalOp (BSym "<=") = Just (<=)
logicalOp (BSym "==") = Just (==)
logicalOp (BSym "!=") = Just (/=)
logicalOp :: String -> Maybe (Number -> Number -> Bool)
logicalOp ">" = Just (>)
logicalOp "<" = Just (<)
logicalOp ">=" = Just (>=)
logicalOp "<=" = Just (<=)
logicalOp "==" = Just (==)
logicalOp "!=" = Just (/=)
logicalOp _ = Nothing
binOp :: Value -> Maybe (Number -> Number -> Number)
binOp (BSym "*") = Just (*)
binOp (BSym "/") = Just (/)
binOp (BSym "+") = Just (+)
binOp (BSym "-") = Just ( - )
binOp (BSym "^") = Just (**)
binOp :: String -> Maybe (Number -> Number -> Number)
binOp "*" = Just (*)
binOp "/" = Just (/)
binOp "+" = Just (+)
binOp "-" = Just ( - )
binOp "^" = Just (**)
binOp _ = Nothing

View File

@@ -6,9 +6,6 @@ import qualified Text.ParserCombinators.Parsec as P
import BC.Types
keywords = ["define", "if", "else", "while"]
optspace :: P.Parser (Maybe ())
optspace = P.optionMaybe P.spaces
@@ -61,11 +58,9 @@ bool = P.try parseTrue P.<|> parseFalse
symbol :: P.Parser Value
symbol = do
res <- P.many1 $ P.letter P.<|> symchar
if contains keywords res
if isKeyword res
then P.unexpected res
else return $ BSym res
where contains [] _ = False
contains (x:xy) y = if x == y then True else contains xy y
block :: P.Parser [Value]

View File

@@ -44,11 +44,9 @@ printStatus state str =
in putStr (str ++ repeat '\b' (length str - 9))
where repeat str 0 = ""
repeat str n = (str:repeat str (n-1))
contains c [] = False
contains c (s:xs) = if c == s then True else contains c xs
trunc s =
let tr = truncLen s
in if contains '\n' tr
in if contains tr '\n'
then takeWhile (\x -> x /= '\n') tr ++ "..."
else tr
truncLen s = if length s > 20 then take 20 s ++ "..." else s

View File

@@ -81,19 +81,35 @@ isErr (BErr _) = True
isErr _ = False
precedence :: Value -> Int
precedence (BSym "^") = 5
precedence (BSym "*") = 4
precedence (BSym "/") = 4
precedence (BSym "-") = 3
precedence (BSym "+") = 3
precedence (BSym "%") = 4
precedence (BSym "||") = 1
precedence (BSym "&&") = 1
precedence (BSym "<") = 2
precedence (BSym ">") = 2
precedence (BSym "<=") = 2
precedence (BSym ">=") = 2
precedence (BSym "==") = 2
precedence (BSym "!=") = 2
precedence _ = 0
precedence :: String -> Int
precedence "^" = 5
precedence "*" = 4
precedence "/" = 4
precedence "-" = 3
precedence "+" = 3
precedence "%" = 4
precedence "||" = 1
precedence "&&" = 1
precedence "<" = 2
precedence ">" = 2
precedence "<=" = 2
precedence ">=" = 2
precedence "==" = 2
precedence "!=" = 2
contains :: Eq a => [a] -> a -> Bool
contains [] _ = False
contains (x:xy) y = if x == y then True else contains xy y
operators = ["<=", ">=", "==", "!=", "<", ">", "||", "&&", "^", "*", "/", "-", "+", "%"]
isOp = contains operators
keywords = ["define", "if", "else", "while"]
isKeyword = contains keywords