diff --git a/src/BC/Eval.hs b/src/BC/Eval.hs index 7a7e9d0..8e86da7 100644 --- a/src/BC/Eval.hs +++ b/src/BC/Eval.hs @@ -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 diff --git a/src/BC/Parse.hs b/src/BC/Parse.hs index 2a90356..e2971bd 100644 --- a/src/BC/Parse.hs +++ b/src/BC/Parse.hs @@ -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 diff --git a/src/BC/Types.hs b/src/BC/Types.hs index 6fbc219..945203e 100644 --- a/src/BC/Types.hs +++ b/src/BC/Types.hs @@ -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