all: minor refactor and better error handling
This commit is contained in:
@@ -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
|
||||
|
||||
|
||||
|
@@ -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]
|
||||
|
@@ -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
|
||||
|
@@ -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
|
||||
|
Reference in New Issue
Block a user