Commit Diff


commit - 3cfecbe70b45740a6dccf418da6e546e32c9c24e
commit + 158f51d560e8e24b033a4a495008086d9a690e6d
blob - 075cc0dd6f8884cd45254d27e2e00f9d5d851fb2
blob + 2beb70f988221283dffd078adf7facefbea9cac3
--- bfc.hs
+++ bfc.hs
@@ -61,37 +61,27 @@ data Expr = Inc
 
 type AST = [Expr]
 
-data State = State ([AST], [Token]) deriving (Show)
+pushexpr expr (y:ys) = (expr:y):ys
 
-initialState tokens = State ([[]], tokens)
-
-finalize (State ([x], _)) = Just x
-finalize _ = Nothing
-
-simplexpr :: Expr -> [AST] -> [Token] -> State
-simplexpr e (x:xs) tokens = State ((x ++ [e]):xs, tokens)
-
-translate :: Token -> Expr
-translate x = case x of
-                Plus    -> Inc
-                Minus   -> Dec
-                Lesser  -> ShiftLeft
-                Greater -> ShiftRight
-                Point   -> Output
-                Comma   -> Input
-
-parser :: State -> Maybe State
-parser (State (stack, (x:xs))) =
+parser :: [Token] -> [AST] -> Either String AST
+parser (x:xs) stack =
   case x of
-    BracketOpen -> parser $ State ([]:stack, xs)
+    BracketOpen -> parser xs ([]:stack)
     BracketClose -> case stack of
-                      (y:ys) -> parser $ simplexpr (Loop y) (ys) xs
-                      _      -> Nothing
-    _ -> parser $ simplexpr (translate x) stack xs
-parser state = Just state
+                      (y:ys) -> parser xs $ pushexpr (Loop (reverse y)) ys
+                      _      -> Left "unexpected end of loop"
+    _ -> parser xs $ pushexpr expr stack
+      where expr = case x of
+                     Plus    -> Inc
+                     Minus   -> Dec
+                     Lesser  -> ShiftLeft
+                     Greater -> ShiftRight
+                     Point   -> Output
+                     Comma   -> Input
+parser _ [x] = return (reverse x)
+parser _ _ = Left "unterminated loop"
 
-parse :: [Token] -> Maybe AST
-parse tokens = parser (initialState tokens) >>= finalize
+parse toks = parser toks [[]]
 
 prologue = "export function w $main() {\n" ++
            "@start\n" ++
@@ -184,10 +174,10 @@ compile ast = compile' 1 1 [ast] []
 compileProg program = do
   let t = parse $ tokenize program in
     case t of
-      Just ast -> do putStrLn prologue
-                     mapM_ print (compile ast)
-                     putStrLn epilogue
-      Nothing  -> error "Compilation failed"
+      Right ast -> do putStrLn prologue
+                      mapM_ print (compile ast)
+                      putStrLn epilogue
+      Left err  -> error err
 
 parseArgs [] = getContents
 parseArgs path = concat `fmap` mapM readFile path