From 42fff2f3109ec9029896437ea429c41285b7d0f4 Mon Sep 17 00:00:00 2001
From: hellerve <veit@veitheller.de>
Date: Fri, 19 May 2017 17:07:33 +0200
Subject: [PATCH] all: multistatement blocks; types: bugfix in multiplication
 of two integers

---
 src/BC/Eval.hs  | 18 ++++++++++++++----
 src/BC/Parse.hs | 23 ++++++++++++++++-------
 src/BC/Types.hs |  8 ++++----
 src/Main.hs     | 14 +++++++++++++-
 4 files changed, 47 insertions(+), 16 deletions(-)

diff --git a/src/BC/Eval.hs b/src/BC/Eval.hs
index 3974d9b..b84c414 100644
--- a/src/BC/Eval.hs
+++ b/src/BC/Eval.hs
@@ -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) ++
diff --git a/src/BC/Parse.hs b/src/BC/Parse.hs
index d8b548c..c9f5fdf 100644
--- a/src/BC/Parse.hs
+++ b/src/BC/Parse.hs
@@ -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
diff --git a/src/BC/Types.hs b/src/BC/Types.hs
index cf224f1..1276b8a 100644
--- a/src/BC/Types.hs
+++ b/src/BC/Types.hs
@@ -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
diff --git a/src/Main.hs b/src/Main.hs
index d291995..f71dfd1 100644
--- a/src/Main.hs
+++ b/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