parse: refactored block parsing; all: added while loops

src/BC/Eval.hs

@@ -18,6 +18,15 @@ eval state [(BDef (BSym sym) expr)] =
     in (val, M.insert sym val newstate)
 eval state [x@(BBool _)] = (x, state)
 eval state [x@(BErr _)] = (x, state)
+eval state [x@(BWhile cond body)] =
+    let (evald, whilestate) = eval state cond
+    in
+      if truthy evald
+        then let
+          (bodyval, newstate) = eval whilestate body
+          (val, retstate) = eval newstate [x]
+          in if truthy val then (val, retstate) else (bodyval, retstate)
+        else (BBool False, whilestate)
 eval state [(BIf cond body alt)] =
     let (evald, ifstate) = eval state cond
     in

src/BC/Parse.hs

@@ -50,6 +50,16 @@ symbol = do
     return $ BSym res
 
 
+block :: P.Parser [Value]
+block = do
+    _ <- P.string "{"
+    _ <- P.optionMaybe P.spaces
+    body <- P.sepBy expr P.spaces
+    _ <- P.optionMaybe P.spaces
+    _ <- P.string "}"
+    return $ body
+
+
 -- I obviously can't parsec
 parseIf :: P.Parser Value
 parseIf = do
@@ -61,25 +71,32 @@ parseIf = do
     _ <- 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 "}"
+    body <- block
     _ <- 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 "}"
+        altbody <- block
         return $ BIf cond body (Just altbody)
       Nothing -> return $ BIf cond body Nothing
 
 
+while :: P.Parser Value
+while = do
+    _ <- P.string "while"
+    _ <- 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
+    body <- block
+    _ <- P.optionMaybe P.spaces
+    return $ BWhile cond body
+
+
 def :: P.Parser Value
 def = do
     sym <- symbol
@@ -93,6 +110,7 @@ def = do
 expr :: P.Parser Value
 expr = P.try bool
  P.<|> P.try def
+ P.<|> P.try while
  P.<|> P.try parseIf
  P.<|> P.try number
  P.<|> symbol

src/BC/Types.hs

@@ -6,18 +6,22 @@ data Value = BNum Number
            | BBool Bool
            | BSym String
            | BIf [Value] [Value] (Maybe [Value])
+           | BWhile [Value] [Value]
            | BDef Value [Value]
            | BErr String
 instance Show Value where
   show (BBool b) = if b then "true" else "false"
   show (BDef sym expr) = show sym ++ " = " ++ unwords (map show expr)
-  show (BIf x y z) =
-    "if (" ++ unwords (map show x) ++ ") {\n\t" ++
-    intercalate "\n\t" (map show y) ++ "\n}" ++
-      (case z of
+  show (BIf cond body alt) =
+    "if (" ++ unwords (map show cond) ++ ") {\n\t" ++
+    intercalate "\n\t" (map show body) ++ "\n}" ++
+      (case alt of
         Just vals ->
           " else {\n\t" ++ intercalate "\n\t" (map show vals) ++ "\n}"
         Nothing -> "")
+  show (BWhile cond body) =
+    "while (" ++ unwords (map show cond) ++ ") {\n\t" ++
+    intercalate "\n\t" (map show body) ++ "\n}"
   show (BSym  o) = o
   show (BNum n) = show n
   show (BErr e) = "error: " ++ e