added function declarations

This commit is contained in:
2025-09-06 18:24:51 +01:00
parent 4fd4ef20ab
commit 545137ce76

View File

@@ -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
compileZorthAST h xs M.empty