diff --git a/app/Compiler.hs b/app/Compiler.hs index 00f13ff..f328d03 100644 --- a/app/Compiler.hs +++ b/app/Compiler.hs @@ -5,51 +5,9 @@ import Text.Printf (printf) import Control.Monad (void) import System.Process import System.IO - -handleSymbol :: Handle -> ZorthExpr -> IO () - -handleSymbol h (ZorthASTInteger i) = hPutStrLn h $ " push "<>show i - -handleSymbol h (ZorthASTWord "+") = do - hPutStr h - " pop rbx\n\ - \ pop rax\n\ - \ add rax, rbx\n\ - \ push rax\n" - -handleSymbol h (ZorthASTWord "-") = do - hPutStr h - " pop rbx\n\ - \ pop rax\n\ - \ sub rax, rbx\n\ - \ push rax\n" - -handleSymbol h (ZorthASTWord "ret") = do - hPutStr h - " mov rax,60\n\ - \ mov rdi,0\n\ - \ syscall\n" - -handleSymbol h (ZorthASTWord "dup") = do - hPutStr h - " pop rax\n\ - \ push rax\n\ - \ push rax\n" - -handleSymbol h (ZorthASTWord "swap") = do - hPutStr h - " pop rax\n\ - \ pop rbx\n\ - \ push rax\n\ - \ push rbx\n" - -handleSymbol h (ZorthASTWord "drop") = do - hPutStr h " add rsp, 8\n" - -handleSymbol h (ZorthASTWord ".") = do - hPutStr h - " pop rbx\n\ - \ call print_number\n" +import Control.Monad.Trans.State +import Control.Monad.IO.Class (liftIO) +import qualified Data.Map as M forthPrelude :: Handle -> IO () forthPrelude h = do @@ -88,8 +46,79 @@ forthPrelude h = do \ ret\n\ \_start:\n" +type Environment = M.Map String ZorthAST + +handleSymbol :: Handle -> ZorthExpr -> StateT Environment IO () + +handleSymbol h (ZorthASTInteger i) = + do + liftIO $ hPutStrLn h $ " push "<>show i + return () + +handleSymbol h (ZorthASTWord "+") = do + liftIO $ hPutStr h + " pop rbx\n\ + \ pop rax\n\ + \ add rax, rbx\n\ + \ push rax\n" + return () + +handleSymbol h (ZorthASTWord "-") = do + liftIO $ hPutStr h + " pop rbx\n\ + \ pop rax\n\ + \ sub rax, rbx\n\ + \ push rax\n" + return () + +handleSymbol h (ZorthASTWord "ret") = do + liftIO $ hPutStr h + " mov rax,60\n\ + \ mov rdi,0\n\ + \ syscall\n" + return () + +handleSymbol h (ZorthASTWord "dup") = do + liftIO $ hPutStr h + " pop rax\n\ + \ push rax\n\ + \ push rax\n" + return () + +handleSymbol h (ZorthASTWord "swap") = do + liftIO $ hPutStr h + " pop rax\n\ + \ pop rbx\n\ + \ push rax\n\ + \ push rbx\n" + return () + +handleSymbol h (ZorthASTWord "drop") = do + liftIO $ hPutStr h " add rsp, 8\n" + return () + +handleSymbol h (ZorthASTWord ".") = do + liftIO $ hPutStr h + " pop rbx\n\ + \ call print_number\n" + return () + +handleSymbol h (ZorthASTWord w) = do + state <- get + liftIO $ compileZorthAST h (state M.! w) state -- parent env to child and discard + return () + +handleSymbol _ (ZorthASTWordDecl (name,ast)) = do + state <- get + put $ M.insert name ast state + return () + +compileZorthAST :: Handle -> ZorthAST -> Environment -> IO () +compileZorthAST h ast state = runStateT (foldl (\m x -> m >> handleSymbol h x) (return ()) ast) state >> return () + compileZorth :: Handle -> ZorthAST -> IO () -compileZorth h [] = return () +compileZorth _ [] = return () compileZorth h xs = do forthPrelude h - foldr ((>>) . handleSymbol h) (return ()) xs \ No newline at end of file + compileZorthAST h xs M.empty + \ No newline at end of file