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
|
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) ++
|
||||||
|
@@ -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
|
||||||
|
@@ -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
|
||||||
|
14
src/Main.hs
14
src/Main.hs
@@ -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
|
||||||
|
Reference in New Issue
Block a user