diff --git a/src/BC/Eval.hs b/src/BC/Eval.hs index 9a3008a..9c2cb37 100644 --- a/src/BC/Eval.hs +++ b/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 diff --git a/src/BC/Parse.hs b/src/BC/Parse.hs index 3841171..eeeb914 100644 --- a/src/BC/Parse.hs +++ b/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 diff --git a/src/BC/Types.hs b/src/BC/Types.hs index ff29369..c91feb5 100644 --- a/src/BC/Types.hs +++ b/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