all: add stub for if

This commit is contained in:
2017-05-17 13:21:03 +02:00
parent fa032ff54c
commit 30ecca462d
3 changed files with 63 additions and 9 deletions

View File

@@ -2,10 +2,22 @@ module BC.Eval (eval) where
import BC.Types
truthy :: Value -> Bool
truthy (BNum num) = num /= 0
truthy (BBool x) = x
truthy _ = False
eval :: [Value] -> Value
eval [x@(BNum _)] = x
eval [x@(BBool _)] = x
eval [x@(BErr _)] = x
eval [x@(BIf cond body alt)] =
if truthy (eval cond)
then eval body
else case alt of
Just vals -> eval vals
Nothing -> BBool False
eval [(BOp x)] = BErr ("operation " ++ x ++ " requires arguments")
eval [] = BOp ""
eval l = treeEval l [] []
@@ -13,6 +25,7 @@ eval l = treeEval l [] []
treeEval :: [Value] -> [Value] -> [Value] -> Value
treeEval [] [] (num:_) = num
treeEval [] ops nums = handleOp [] ops nums
treeEval (x@(BIf _ _ _):xy) ops nums = treeEval (eval [x]:xy) ops nums
treeEval (x@(BNum _):xy) ops nums = treeEval xy ops (x:nums)
treeEval ((BBool x):xy) ops nums =
treeEval xy ops ((BNum $ BInt $ if x then 1 else 0):nums)
@@ -50,6 +63,6 @@ binOp :: Value -> Maybe (Number -> Number -> Number)
binOp (BOp "*") = Just (*)
binOp (BOp "/") = Just (/)
binOp (BOp "+") = Just (+)
binOp (BOp "-") = Just (-)
binOp (BOp "-") = Just ( - )
binOp (BOp "^") = Just (**)
binOp _ = Nothing

View File

@@ -50,12 +50,43 @@ operator = do
return $ BOp res
types :: P.Parser Value
types = P.try bool P.<|> P.try operator P.<|> number
-- I obviously can't parsec
parseIf :: P.Parser Value
parseIf = do
_ <- P.string "if"
_ <- P.optionMaybe P.spaces
_ <- P.string "("
_ <- P.optionMaybe P.spaces
cond <- P.sepBy expr P.spaces
_ <- P.optionMaybe P.spaces
_ <- P.string ")"
_ <- P.optionMaybe P.spaces
_ <- P.string "{"
_ <- P.optionMaybe P.spaces
body <- P.sepBy expr P.spaces
_ <- P.optionMaybe P.spaces
_ <- P.string "}"
_ <- P.optionMaybe P.spaces
alt <- P.optionMaybe (P.string "else")
case alt of
Just _ -> do
_ <- P.optionMaybe P.spaces
_ <- P.string "{"
_ <- P.optionMaybe P.spaces
altbody <- P.sepBy expr P.spaces
_ <- P.optionMaybe P.spaces
_ <- P.string "}"
return $ BIf cond body (Just altbody)
Nothing -> return $ BIf cond body Nothing
expr :: P.Parser Value
expr = P.try bool P.<|> P.try parseIf P.<|> P.try number P.<|> operator
parser :: P.Parser [Value]
parser = (P.sepBy types P.spaces) <* P.eof
parser = (P.sepBy expr P.spaces) <* P.eof
parse :: String -> [Value]
parse input = case P.parse parser (trim input) (trim input) of

View File

@@ -1,11 +1,21 @@
module BC.Types where
import Data.List (intercalate)
data Value = BNum Number
| BBool Bool
| BOp String
| BIf [Value] [Value] (Maybe [Value])
| BErr String
instance Show Value where
show (BBool b) = if b then "true" else "false"
show (BIf x y z) =
"if (" ++ unwords (map show x) ++ ") {\n\t" ++
intercalate "\n\t" (map show y) ++ "\n}" ++
(case z of
Just vals ->
" else {\n\t" ++ intercalate "\n\t" (map show vals) ++ "\n}"
Nothing -> "")
show (BOp o) = o
show (BNum n) = show n
show (BErr e) = "error: " ++ e
@@ -36,11 +46,11 @@ instance Floating Number where
tanh x = sinh x / cosh x
instance Num Number where
(BInt x) + (BInt y) = BInt $ x * y
(BFloat x) + (BFloat y) = BFloat $ x * y
(BInt x) + (BFloat y) = BFloat $ fromIntegral x * y
(BFloat x) + (BInt y) = BFloat $ x * fromIntegral y
(BInt x) * (BInt y) = BInt $ x * y
(BInt x) + (BInt y) = BInt $ x + y
(BFloat x) + (BFloat y) = BFloat $ x + y
(BInt x) + (BFloat y) = BFloat $ fromIntegral x + y
(BFloat x) + (BInt y) = BFloat $ x + fromIntegral y
(BInt x) * (BInt y) = BInt $ x + y
(BFloat x) * (BFloat y) = BFloat $ x * y
(BInt x) * (BFloat y) = BFloat $ fromIntegral x * y
(BFloat x) * (BInt y) = BFloat $ x * fromIntegral y