commit 158f51d560e8e24b033a4a495008086d9a690e6d from: Omar Polo date: Thu Apr 28 09:13:55 2022 UTC rewrite the parser 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