commit - 3cfecbe70b45740a6dccf418da6e546e32c9c24e
commit + 158f51d560e8e24b033a4a495008086d9a690e6d
blob - 075cc0dd6f8884cd45254d27e2e00f9d5d851fb2
blob + 2beb70f988221283dffd078adf7facefbea9cac3
--- bfc.hs
+++ bfc.hs
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" ++
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