added function declarations
This commit is contained in:
123
app/Compiler.hs
123
app/Compiler.hs
@@ -5,51 +5,9 @@ import Text.Printf (printf)
|
|||||||
import Control.Monad (void)
|
import Control.Monad (void)
|
||||||
import System.Process
|
import System.Process
|
||||||
import System.IO
|
import System.IO
|
||||||
|
import Control.Monad.Trans.State
|
||||||
handleSymbol :: Handle -> ZorthExpr -> IO ()
|
import Control.Monad.IO.Class (liftIO)
|
||||||
|
import qualified Data.Map as M
|
||||||
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"
|
|
||||||
|
|
||||||
forthPrelude :: Handle -> IO ()
|
forthPrelude :: Handle -> IO ()
|
||||||
forthPrelude h = do
|
forthPrelude h = do
|
||||||
@@ -88,8 +46,79 @@ forthPrelude h = do
|
|||||||
\ ret\n\
|
\ ret\n\
|
||||||
\_start:\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 :: Handle -> ZorthAST -> IO ()
|
||||||
compileZorth h [] = return ()
|
compileZorth _ [] = return ()
|
||||||
compileZorth h xs = do
|
compileZorth h xs = do
|
||||||
forthPrelude h
|
forthPrelude h
|
||||||
foldr ((>>) . handleSymbol h) (return ()) xs
|
compileZorthAST h xs M.empty
|
||||||
|
|
||||||
Reference in New Issue
Block a user