all: multistatement blocks; types: bugfix in multiplication of two integers
This commit is contained in:
@@ -11,6 +11,13 @@ truthy (BBool x) = x
|
||||
truthy _ = False
|
||||
|
||||
|
||||
evalAll :: State -> [[Value]] -> (Value, State)
|
||||
evalAll state [x] = eval state x
|
||||
evalAll state (x:xs) =
|
||||
let (_, nstate) = eval state x
|
||||
in evalAll nstate xs
|
||||
|
||||
|
||||
eval :: State -> [Value] -> (Value, State)
|
||||
eval state [x@(BNum _)] = (x, state)
|
||||
eval state [(BDef (BSym sym) expr)] =
|
||||
@@ -24,7 +31,7 @@ eval state [x@(BWhile cond body)] =
|
||||
in
|
||||
if truthy evald
|
||||
then let
|
||||
(bodyval, newstate) = eval whilestate body
|
||||
(bodyval, newstate) = evalAll whilestate body
|
||||
(val, retstate) = eval newstate [x]
|
||||
in if truthy val then (val, retstate) else (bodyval, retstate)
|
||||
else (BBool False, whilestate)
|
||||
@@ -32,9 +39,9 @@ eval state [(BIf cond body alt)] =
|
||||
let (evald, ifstate) = eval state cond
|
||||
in
|
||||
if truthy evald
|
||||
then eval ifstate body
|
||||
then evalAll ifstate body
|
||||
else case alt of
|
||||
Just vals -> eval ifstate vals
|
||||
Just vals -> evalAll ifstate vals
|
||||
Nothing -> (BBool False, ifstate)
|
||||
eval state [(BSym x)] =
|
||||
case M.lookup x state of
|
||||
@@ -72,6 +79,9 @@ treeEval state (x@(BSym sym):xy) [] nums =
|
||||
if isOp sym
|
||||
then treeEval state xy [x] nums
|
||||
else BErr (sym ++ " is undefined")
|
||||
treeEval state (x:xy) ops vals =
|
||||
let (val, nstate) = eval state [x]
|
||||
in treeEval nstate xy ops (val:vals)
|
||||
|
||||
|
||||
handleOp :: State -> [Value] -> [Value] -> [Value] -> Value
|
||||
@@ -112,7 +122,7 @@ funCall state (BFun name args body) provided =
|
||||
if length args == length provided
|
||||
then let
|
||||
nstate = callWith state args provided
|
||||
(val, _) = eval nstate body
|
||||
(val, _) = evalAll nstate body
|
||||
in (val, state)
|
||||
else
|
||||
(BErr ("Expected " ++ show (length args) ++
|
||||
|
@@ -63,14 +63,18 @@ symbol = do
|
||||
else return $ BSym res
|
||||
|
||||
|
||||
block :: P.Parser [Value]
|
||||
block :: P.Parser [[Value]]
|
||||
block = do
|
||||
_ <- P.string "{"
|
||||
_ <- optspace
|
||||
body <- P.sepBy expr P.spaces
|
||||
body <- P.sepBy parser newline
|
||||
_ <- optspace
|
||||
_ <- P.string "}"
|
||||
return $ body
|
||||
where newline = do
|
||||
_ <- P.many (P.string " " P.<|> P.string "\t")
|
||||
_ <- P.string "\n"
|
||||
P.many (P.string " " P.<|> P.string "\t")
|
||||
|
||||
|
||||
-- I obviously can't parsec
|
||||
@@ -80,7 +84,7 @@ parseIf = do
|
||||
_ <- optspace
|
||||
_ <- P.string "("
|
||||
_ <- optspace
|
||||
cond <- P.sepBy expr P.spaces
|
||||
cond <- parser
|
||||
_ <- optspace
|
||||
_ <- P.string ")"
|
||||
_ <- optspace
|
||||
@@ -101,7 +105,7 @@ while = do
|
||||
_ <- optspace
|
||||
_ <- P.string "("
|
||||
_ <- optspace
|
||||
cond <- P.sepBy expr P.spaces
|
||||
cond <- parser
|
||||
_ <- optspace
|
||||
_ <- P.string ")"
|
||||
_ <- optspace
|
||||
@@ -116,7 +120,7 @@ def = do
|
||||
_ <- P.spaces
|
||||
_ <- P.string "="
|
||||
_ <- optspace
|
||||
expr <- P.sepBy expr P.spaces
|
||||
expr <- parser
|
||||
return $ BDef sym expr
|
||||
|
||||
|
||||
@@ -161,10 +165,15 @@ expr = P.try bool
|
||||
|
||||
|
||||
parser :: P.Parser [Value]
|
||||
parser = (P.sepBy expr P.spaces)
|
||||
parser = (P.sepBy expr (P.string " " P.<|> P.string "\t"))
|
||||
|
||||
|
||||
outerparser :: P.Parser [Value]
|
||||
outerparser = (P.sepBy expr P.spaces)
|
||||
|
||||
|
||||
parse :: String -> [Value]
|
||||
parse input = case P.parse (parser <* P.eof) (trim input) (trim input) of
|
||||
parse input = case P.parse (outerparser <* P.eof) (trim input) (trim input) of
|
||||
Left err -> [BErr $ show err]
|
||||
Right val -> val
|
||||
where trim s = trimR "" $ dropWhile isSpace s
|
||||
|
@@ -5,10 +5,10 @@ import Data.List (intercalate)
|
||||
data Value = BNum Number
|
||||
| BBool Bool
|
||||
| BSym String
|
||||
| BIf [Value] [Value] (Maybe [Value])
|
||||
| BWhile [Value] [Value]
|
||||
| BIf [Value] [[Value]] (Maybe [[Value]])
|
||||
| BWhile [Value] [[Value]]
|
||||
| BDef Value [Value]
|
||||
| BFun String [String] [Value]
|
||||
| BFun String [String] [[Value]]
|
||||
| BCall Value [[Value]]
|
||||
| BErr String
|
||||
instance Show Value where
|
||||
@@ -63,7 +63,7 @@ instance Num Number where
|
||||
(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
|
||||
|
14
src/Main.hs
14
src/Main.hs
@@ -1,6 +1,18 @@
|
||||
module Main where
|
||||
|
||||
import System.Posix.Terminal (queryTerminal)
|
||||
import System.Posix.IO (stdInput)
|
||||
|
||||
import BC.Parse
|
||||
import BC.Eval
|
||||
import BC.Prompt
|
||||
import BC.State
|
||||
|
||||
|
||||
main :: IO ()
|
||||
main = startPrompt
|
||||
main = do
|
||||
tty <- queryTerminal stdInput
|
||||
if tty
|
||||
then startPrompt
|
||||
else getContents >>= putStrLn . show . evalOne . parse
|
||||
where evalOne inp = let (val, _) = eval newState inp in val
|
||||
|
Reference in New Issue
Block a user