all: multistatement blocks; types: bugfix in multiplication of two integers

This commit is contained in:
2017-05-19 17:07:33 +02:00
parent 1c46c60206
commit 42fff2f310
4 changed files with 47 additions and 16 deletions

View File

@@ -11,6 +11,13 @@ truthy (BBool x) = x
truthy _ = False 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 -> [Value] -> (Value, State)
eval state [x@(BNum _)] = (x, state) eval state [x@(BNum _)] = (x, state)
eval state [(BDef (BSym sym) expr)] = eval state [(BDef (BSym sym) expr)] =
@@ -24,7 +31,7 @@ eval state [x@(BWhile cond body)] =
in in
if truthy evald if truthy evald
then let then let
(bodyval, newstate) = eval whilestate body (bodyval, newstate) = evalAll whilestate body
(val, retstate) = eval newstate [x] (val, retstate) = eval newstate [x]
in if truthy val then (val, retstate) else (bodyval, retstate) in if truthy val then (val, retstate) else (bodyval, retstate)
else (BBool False, whilestate) else (BBool False, whilestate)
@@ -32,9 +39,9 @@ eval state [(BIf cond body alt)] =
let (evald, ifstate) = eval state cond let (evald, ifstate) = eval state cond
in in
if truthy evald if truthy evald
then eval ifstate body then evalAll ifstate body
else case alt of else case alt of
Just vals -> eval ifstate vals Just vals -> evalAll ifstate vals
Nothing -> (BBool False, ifstate) Nothing -> (BBool False, ifstate)
eval state [(BSym x)] = eval state [(BSym x)] =
case M.lookup x state of case M.lookup x state of
@@ -72,6 +79,9 @@ treeEval state (x@(BSym sym):xy) [] nums =
if isOp sym if isOp sym
then treeEval state xy [x] nums then treeEval state xy [x] nums
else BErr (sym ++ " is undefined") 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 handleOp :: State -> [Value] -> [Value] -> [Value] -> Value
@@ -112,7 +122,7 @@ funCall state (BFun name args body) provided =
if length args == length provided if length args == length provided
then let then let
nstate = callWith state args provided nstate = callWith state args provided
(val, _) = eval nstate body (val, _) = evalAll nstate body
in (val, state) in (val, state)
else else
(BErr ("Expected " ++ show (length args) ++ (BErr ("Expected " ++ show (length args) ++

View File

@@ -63,14 +63,18 @@ symbol = do
else return $ BSym res else return $ BSym res
block :: P.Parser [Value] block :: P.Parser [[Value]]
block = do block = do
_ <- P.string "{" _ <- P.string "{"
_ <- optspace _ <- optspace
body <- P.sepBy expr P.spaces body <- P.sepBy parser newline
_ <- optspace _ <- optspace
_ <- P.string "}" _ <- P.string "}"
return $ body 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 -- I obviously can't parsec
@@ -80,7 +84,7 @@ parseIf = do
_ <- optspace _ <- optspace
_ <- P.string "(" _ <- P.string "("
_ <- optspace _ <- optspace
cond <- P.sepBy expr P.spaces cond <- parser
_ <- optspace _ <- optspace
_ <- P.string ")" _ <- P.string ")"
_ <- optspace _ <- optspace
@@ -101,7 +105,7 @@ while = do
_ <- optspace _ <- optspace
_ <- P.string "(" _ <- P.string "("
_ <- optspace _ <- optspace
cond <- P.sepBy expr P.spaces cond <- parser
_ <- optspace _ <- optspace
_ <- P.string ")" _ <- P.string ")"
_ <- optspace _ <- optspace
@@ -116,7 +120,7 @@ def = do
_ <- P.spaces _ <- P.spaces
_ <- P.string "=" _ <- P.string "="
_ <- optspace _ <- optspace
expr <- P.sepBy expr P.spaces expr <- parser
return $ BDef sym expr return $ BDef sym expr
@@ -161,10 +165,15 @@ expr = P.try bool
parser :: P.Parser [Value] 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 :: 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] Left err -> [BErr $ show err]
Right val -> val Right val -> val
where trim s = trimR "" $ dropWhile isSpace s where trim s = trimR "" $ dropWhile isSpace s

View File

@@ -5,10 +5,10 @@ import Data.List (intercalate)
data Value = BNum Number data Value = BNum Number
| BBool Bool | BBool Bool
| BSym String | BSym String
| BIf [Value] [Value] (Maybe [Value]) | BIf [Value] [[Value]] (Maybe [[Value]])
| BWhile [Value] [Value] | BWhile [Value] [[Value]]
| BDef Value [Value] | BDef Value [Value]
| BFun String [String] [Value] | BFun String [String] [[Value]]
| BCall Value [[Value]] | BCall Value [[Value]]
| BErr String | BErr String
instance Show Value where instance Show Value where
@@ -63,7 +63,7 @@ instance Num Number where
(BFloat x) + (BFloat y) = BFloat $ x + y (BFloat x) + (BFloat y) = BFloat $ x + y
(BInt x) + (BFloat y) = BFloat $ fromIntegral x + y (BInt x) + (BFloat y) = BFloat $ fromIntegral x + y
(BFloat x) + (BInt y) = BFloat $ x + fromIntegral 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 (BFloat x) * (BFloat y) = BFloat $ x * y
(BInt x) * (BFloat y) = BFloat $ fromIntegral x * y (BInt x) * (BFloat y) = BFloat $ fromIntegral x * y
(BFloat x) * (BInt y) = BFloat $ x * fromIntegral y (BFloat x) * (BInt y) = BFloat $ x * fromIntegral y

View File

@@ -1,6 +1,18 @@
module Main where module Main where
import System.Posix.Terminal (queryTerminal)
import System.Posix.IO (stdInput)
import BC.Parse
import BC.Eval
import BC.Prompt import BC.Prompt
import BC.State
main :: IO () 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