pl/bc
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

initial public release

Browse Source
This commit is contained in:
Veit Heller
2017-05-05 14:37:53 +02:00
parent 2aa996e963
commit 5abfdce820
5 changed files with 90 additions and 12 deletions
Download Patch File Download Diff File Expand all files Collapse all files

23
src/BC/Eval.hs
View File

@@ -4,15 +4,17 @@ import BC.Types
eval :: [Value] -> Value
eval [x@(BInt _)] = x
eval [x@(BFloat _)] = x
eval [x@(BErr _)] = x
eval [(BOp x)] = BErr ("operation " ++ x ++ " requires arguments")
eval [(BOp x)] = BErr ("operation " ++ x ++ " requires arguments")
eval [] = BOp ""
eval l = treeEval l [] []
treeEval :: [Value] -> [Value] -> [Value] -> Value
treeEval [] [] (num:_) = num
treeEval [] ops nums = handleOp [] ops nums
treeEval (x@(BInt _):xy) ops nums = treeEval xy ops (nums ++ [x])
treeEval (x@(BInt _):xy) ops nums = treeEval xy ops (x:nums)
treeEval (x@(BFloat _):xy) ops nums = treeEval xy ops (x:nums)
treeEval expr@(x@(BOp _):xy) ops@(op:_) nums =
if precedence x > precedence op
then treeEval xy (x:ops) nums
@@ -20,7 +22,7 @@ treeEval expr@(x@(BOp _):xy) ops@(op:_) nums =
treeEval (x@(BOp _):xy) [] nums = treeEval xy [x] nums
handleOp :: [Value] -> [Value] -> [Value] -> Value
handleOp expr (op:ops) (op1:(op2:nums)) =
handleOp expr (op:ops) (op2:(op1:nums)) =
treeEval expr ops ((evalOp op op1 op2):nums)
handleOp expr ((BOp op):ops) _ = BErr ("Not enough arguments to operation " ++ op)
@@ -30,4 +32,19 @@ evalOp (BOp "/") (BInt x) (BInt y) = BInt $ quot x y
evalOp (BOp "+") (BInt x) (BInt y) = BInt $ x + y
evalOp (BOp "-") (BInt x) (BInt y) = BInt $ x - y
evalOp (BOp "^") (BInt x) (BInt y) = BInt $ x ^ y
evalOp (BOp "*") (BFloat x) (BInt y) = BFloat $ x * fromIntegral y
evalOp (BOp "/") (BFloat x) (BInt y) = BFloat $ x / fromIntegral y
evalOp (BOp "+") (BFloat x) (BInt y) = BFloat $ x + fromIntegral y
evalOp (BOp "-") (BFloat x) (BInt y) = BFloat $ x - fromIntegral y
evalOp (BOp "^") (BFloat x) (BInt y) = BFloat $ x ** fromIntegral y
evalOp (BOp "*") (BInt x) (BFloat y) = BFloat $ fromIntegral x * y
evalOp (BOp "/") (BInt x) (BFloat y) = BFloat $ fromIntegral x / y
evalOp (BOp "+") (BInt x) (BFloat y) = BFloat $ fromIntegral x + y
evalOp (BOp "-") (BInt x) (BFloat y) = BFloat $ fromIntegral x - y
evalOp (BOp "^") (BInt x) (BFloat y) = BFloat $ fromIntegral x ** y
evalOp (BOp "*") (BFloat x) (BFloat y) = BFloat $ x * y
evalOp (BOp "/") (BFloat x) (BFloat y) = BFloat $ x / y
evalOp (BOp "+") (BFloat x) (BFloat y) = BFloat $ x + y
evalOp (BOp "-") (BFloat x) (BFloat y) = BFloat $ x - y
evalOp (BOp "^") (BFloat x) (BFloat y) = BFloat $ x ** y
evalOp _ _ _ = BInt 0