From 1c46c602067cca93e45b70716d7c23da803fe1e2 Mon Sep 17 00:00:00 2001
From: hellerve <veit@veitheller.de>
Date: Fri, 19 May 2017 16:19:55 +0200
Subject: [PATCH] all: minor refactor and better error handling

---
 src/BC/Eval.hs   | 39 +++++++++++++++++++++------------------
 src/BC/Parse.hs  |  7 +------
 src/BC/Prompt.hs |  4 +---
 src/BC/Types.hs  | 48 ++++++++++++++++++++++++++++++++----------------
 4 files changed, 55 insertions(+), 43 deletions(-)

diff --git a/src/BC/Eval.hs b/src/BC/Eval.hs
index 5933c36..3974d9b 100644
--- a/src/BC/Eval.hs
+++ b/src/BC/Eval.hs
@@ -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
 
 
diff --git a/src/BC/Parse.hs b/src/BC/Parse.hs
index d978261..d8b548c 100644
--- a/src/BC/Parse.hs
+++ b/src/BC/Parse.hs
@@ -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]
diff --git a/src/BC/Prompt.hs b/src/BC/Prompt.hs
index a7c3377..2adfb7b 100644
--- a/src/BC/Prompt.hs
+++ b/src/BC/Prompt.hs
@@ -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
diff --git a/src/BC/Types.hs b/src/BC/Types.hs
index 95630ba..cf224f1 100644
--- a/src/BC/Types.hs
+++ b/src/BC/Types.hs
@@ -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