finally setup an LSP - fixed all warnings
This commit is contained in:
@@ -1,9 +1,7 @@
|
|||||||
module Compiler where
|
module Compiler where
|
||||||
|
|
||||||
import Parser
|
import Parser
|
||||||
import Text.Printf (printf)
|
|
||||||
import Control.Monad (void)
|
import Control.Monad (void)
|
||||||
import System.Process
|
|
||||||
import System.IO
|
import System.IO
|
||||||
import Control.Monad.Trans.State
|
import Control.Monad.Trans.State
|
||||||
import Control.Monad.IO.Class (liftIO)
|
import Control.Monad.IO.Class (liftIO)
|
||||||
@@ -183,51 +181,51 @@ handleSymbol h (ZorthASTWord "<=") = do
|
|||||||
return ()
|
return ()
|
||||||
|
|
||||||
handleSymbol h (ZorthASTWord w) = do
|
handleSymbol h (ZorthASTWord w) = do
|
||||||
state <- get
|
s <- get
|
||||||
_ <- compileZorthASTState h ((environment state) M.! w) -- parent env to child and discard
|
_ <- compileZorthASTState h (environment s M.! w) -- parent env to child and discard
|
||||||
return ()
|
return ()
|
||||||
|
|
||||||
handleSymbol _ (ZorthASTWordDecl (name,ast)) = do
|
handleSymbol _ (ZorthASTWordDecl (name,ast)) = do
|
||||||
(Environment labels state) <- get
|
(Environment labels s) <- get
|
||||||
put $ Environment labels (M.insert name ast state) -- maybe use `lens`?..
|
put $ Environment labels (M.insert name ast s) -- maybe use `lens`?..
|
||||||
return ()
|
return ()
|
||||||
|
|
||||||
-- honestly, this feels kinda janky, the way I manipulate state
|
-- honestly, this feels kinda janky, the way I manipulate state
|
||||||
handleSymbol h (ZorthASTIfElse (ifBranch,elseBranch)) = do
|
handleSymbol h (ZorthASTIfElse (ifBranch,elseBranch)) = do
|
||||||
(Environment l state) <- get
|
(Environment l s) <- get
|
||||||
let l1 = show $ l+1
|
let l1 = show $ l+1
|
||||||
let l2 = show $ l+2
|
let l2 = show $ l+2
|
||||||
put $ Environment (l+2) state
|
put $ Environment (l+2) s
|
||||||
liftIO $ hPutStr h $
|
liftIO $ hPutStr h $
|
||||||
" pop rax\n\
|
" pop rax\n\
|
||||||
\ cmp rax, 0\n\
|
\ cmp rax, 0\n\
|
||||||
\ je .L"<>l1<>"\n"
|
\ je .L"<>l1<>"\n"
|
||||||
compileZorthASTState h ifBranch
|
compileZorthASTState h ifBranch
|
||||||
(Environment l' _) <- get
|
(Environment l' _) <- get
|
||||||
put $ Environment l' state
|
put $ Environment l' s
|
||||||
liftIO $ hPutStr h $ " jmp .L"<>l2<>"\n.L"<>l1<>":\n"
|
liftIO $ hPutStr h $ " jmp .L"<>l2<>"\n.L"<>l1<>":\n"
|
||||||
compileZorthASTState h elseBranch
|
compileZorthASTState h elseBranch
|
||||||
(Environment l'' _) <- get
|
(Environment l'' _) <- get
|
||||||
put $ Environment l'' state
|
put $ Environment l'' s
|
||||||
liftIO $ hPutStr h $ ".L"<>l2<>":\n"
|
liftIO $ hPutStr h $ ".L"<>l2<>":\n"
|
||||||
|
|
||||||
handleSymbol h (ZorthASTWhile (condition,body)) = do
|
handleSymbol h (ZorthASTWhile (condition,body)) = do
|
||||||
(Environment l state) <- get
|
(Environment l s) <- get
|
||||||
let bodyl = show $ l+1
|
let bodyl = show $ l+1
|
||||||
let conditionl = show $ l+2
|
let conditionl = show $ l+2
|
||||||
let restl = show $ l+3
|
let restl = show $ l+3
|
||||||
put $ Environment (l+3) state
|
put $ Environment (l+3) s
|
||||||
liftIO $ hPutStrLn h $ " jmp .L"<>conditionl
|
liftIO $ hPutStrLn h $ " jmp .L"<>conditionl
|
||||||
liftIO $ hPutStrLn h $ ".L"<>bodyl<>":"
|
liftIO $ hPutStrLn h $ ".L"<>bodyl<>":"
|
||||||
compileZorthASTState h body
|
compileZorthASTState h body
|
||||||
(Environment l' _) <- get
|
(Environment l' _) <- get
|
||||||
put $ Environment l' state
|
put $ Environment l' s
|
||||||
liftIO $ hPutStrLn h $ "\n.L"<>conditionl<>":"
|
liftIO $ hPutStrLn h $ "\n.L"<>conditionl<>":"
|
||||||
compileZorthASTState h condition
|
compileZorthASTState h condition
|
||||||
(Environment l'' _) <- get
|
(Environment l'' _) <- get
|
||||||
put $ Environment l'' state
|
put $ Environment l'' s
|
||||||
liftIO $ hPutStrLn h $ " pop rax"
|
liftIO $ hPutStrLn h " pop rax"
|
||||||
liftIO $ hPutStrLn h $ " cmp rax,0"
|
liftIO $ hPutStrLn h " cmp rax,0"
|
||||||
liftIO $ hPutStrLn h $ " jg .L"<>bodyl
|
liftIO $ hPutStrLn h $ " jg .L"<>bodyl
|
||||||
liftIO $ hPutStrLn h $ ".L"<>restl<>":"
|
liftIO $ hPutStrLn h $ ".L"<>restl<>":"
|
||||||
|
|
||||||
@@ -242,10 +240,10 @@ truthOperator h s =
|
|||||||
\ push rax\n"
|
\ push rax\n"
|
||||||
|
|
||||||
compileZorthASTState :: Handle -> ZorthAST -> StateT Environment IO ()
|
compileZorthASTState :: Handle -> ZorthAST -> StateT Environment IO ()
|
||||||
compileZorthASTState h ast = (foldl (\m x -> m >> handleSymbol h x) (return ()) ast)
|
compileZorthASTState h = foldl (\m x -> m >> handleSymbol h x) (return ())
|
||||||
|
|
||||||
compileZorthAST :: Handle -> ZorthAST -> Environment -> IO ()
|
compileZorthAST :: Handle -> ZorthAST -> Environment -> IO ()
|
||||||
compileZorthAST h ast state = runStateT (compileZorthASTState h ast) state >> return ()
|
compileZorthAST h ast s = void $ runStateT (compileZorthASTState h ast) s
|
||||||
|
|
||||||
compileZorth :: Handle -> ZorthAST -> IO ()
|
compileZorth :: Handle -> ZorthAST -> IO ()
|
||||||
compileZorth _ [] = return ()
|
compileZorth _ [] = return ()
|
||||||
@@ -256,4 +254,4 @@ compileZorth h xs = do
|
|||||||
\ mov rdi,0\n\
|
\ mov rdi,0\n\
|
||||||
\ syscall\n"
|
\ syscall\n"
|
||||||
hPutStr h "section .bss\n\
|
hPutStr h "section .bss\n\
|
||||||
\ mem: resq 640000\n"
|
\ mem: resq 640000\n"
|
||||||
|
|||||||
@@ -9,6 +9,6 @@ main :: IO ()
|
|||||||
main = do
|
main = do
|
||||||
contents <- getContents
|
contents <- getContents
|
||||||
withFile "out.asm" WriteMode (\f -> compileZorth f $ parseZorth contents)
|
withFile "out.asm" WriteMode (\f -> compileZorth f $ parseZorth contents)
|
||||||
readProcess "nasm" ["-f", "elf64", "out.asm", "-o", "out.o"] ""
|
_ <- readProcess "nasm" ["-f", "elf64", "out.asm", "-o", "out.o"] ""
|
||||||
readProcess "ld" ["out.o", "-o", "a.out"] ""
|
_ <- readProcess "ld" ["out.o", "-o", "a.out"] ""
|
||||||
return ()
|
return ()
|
||||||
|
|||||||
@@ -3,9 +3,7 @@ module Monpar where
|
|||||||
|
|
||||||
import qualified Control.Applicative as Ap
|
import qualified Control.Applicative as Ap
|
||||||
import Control.Applicative ((<|>), Alternative, many, some)
|
import Control.Applicative ((<|>), Alternative, many, some)
|
||||||
import Data.Char (isDigit, digitToInt)
|
import Control.Monad ( MonadPlus(mzero))
|
||||||
import Control.Monad ( MonadPlus(mzero), void )
|
|
||||||
import Text.Printf (printf)
|
|
||||||
newtype Parser a = Parser {runParser :: String -> [(a, String)]}
|
newtype Parser a = Parser {runParser :: String -> [(a, String)]}
|
||||||
|
|
||||||
instance Functor Parser where
|
instance Functor Parser where
|
||||||
@@ -59,8 +57,8 @@ char c = sat (== c)
|
|||||||
string :: String -> Parser String
|
string :: String -> Parser String
|
||||||
string "" = return ""
|
string "" = return ""
|
||||||
string (x:xs) = do
|
string (x:xs) = do
|
||||||
char x
|
_ <- char x
|
||||||
string xs
|
_ <- string xs
|
||||||
return (x:xs)
|
return (x:xs)
|
||||||
|
|
||||||
eof :: Parser ()
|
eof :: Parser ()
|
||||||
@@ -78,4 +76,4 @@ word = neWord <|> return ""
|
|||||||
return $ x:xs
|
return $ x:xs
|
||||||
|
|
||||||
manyTill :: Parser a -> Parser b -> Parser [a]
|
manyTill :: Parser a -> Parser b -> Parser [a]
|
||||||
manyTill p q = (q >> return []) <++ do { x <- p; xs <- manyTill p q; return $ x:xs }
|
manyTill p q = (q >> return []) <++ do { x <- p; xs <- manyTill p q; return $ x:xs }
|
||||||
|
|||||||
@@ -1,9 +1,9 @@
|
|||||||
module Parser where
|
module Parser where
|
||||||
|
|
||||||
import Monpar
|
import Monpar
|
||||||
import Control.Applicative ((<|>), Alternative, many, some)
|
import Control.Applicative ((<|>), many, some)
|
||||||
|
import Control.Monad (void)
|
||||||
import Data.Char (isDigit, digitToInt)
|
import Data.Char (isDigit, digitToInt)
|
||||||
import Control.Monad (MonadPlus(mzero), void)
|
|
||||||
|
|
||||||
type ZorthAST = [ZorthExpr]
|
type ZorthAST = [ZorthExpr]
|
||||||
|
|
||||||
@@ -35,21 +35,18 @@ pZorthUnsignedInteger = ZorthASTInteger . foldr (\n t -> n + t*10) 0 . reverse
|
|||||||
|
|
||||||
pZorthSignedInteger :: Parser ZorthExpr
|
pZorthSignedInteger :: Parser ZorthExpr
|
||||||
pZorthSignedInteger = do
|
pZorthSignedInteger = do
|
||||||
char '-'
|
_ <- char '-'
|
||||||
(ZorthASTInteger i) <- pZorthUnsignedInteger
|
(ZorthASTInteger i) <- pZorthUnsignedInteger
|
||||||
return $ ZorthASTInteger $ negate i
|
return $ ZorthASTInteger $ negate i
|
||||||
|
|
||||||
pZorthInteger :: Parser ZorthExpr
|
pZorthInteger :: Parser ZorthExpr
|
||||||
pZorthInteger = do
|
pZorthInteger = skipNonsenseSymbols >> pZorthSignedInteger <|> pZorthUnsignedInteger
|
||||||
skipNonsenseSymbols
|
|
||||||
i <- pZorthSignedInteger <|> pZorthUnsignedInteger
|
|
||||||
return i
|
|
||||||
|
|
||||||
pZorthWord :: Parser ZorthExpr
|
pZorthWord :: Parser ZorthExpr
|
||||||
pZorthWord = do
|
pZorthWord = do
|
||||||
skipNonsenseSymbols
|
_ <- skipNonsenseSymbols
|
||||||
w <- word1
|
w <- word1
|
||||||
eof <|> (nonsenseSymbol >> return ())
|
eof <|> void nonsenseSymbol
|
||||||
return $ ZorthASTWord w
|
return $ ZorthASTWord w
|
||||||
|
|
||||||
pZorthWordDecl :: Parser ZorthExpr
|
pZorthWordDecl :: Parser ZorthExpr
|
||||||
|
|||||||
2
build.sh
2
build.sh
@@ -1 +1 @@
|
|||||||
cabal build && dist-newstyle/build/x86_64-linux/ghc-9.6.7/zorth-0.0.6.9/x/zorth/build/zorth/zorth && ./a.out
|
rm -rf dist-newstyle && cabal build && dist-newstyle/build/x86_64-linux/ghc-9.6.7/zorth-0.0.6.9/x/zorth/build/zorth/zorth && ./a.out
|
||||||
|
|||||||
@@ -14,6 +14,7 @@ common warnings
|
|||||||
executable zorth
|
executable zorth
|
||||||
import: warnings
|
import: warnings
|
||||||
main-is: Main.hs
|
main-is: Main.hs
|
||||||
|
other-modules: Compiler, Parser, Monpar
|
||||||
build-depends: base ^>=4.18.3.0,
|
build-depends: base ^>=4.18.3.0,
|
||||||
process ^>=1.6.26.1,
|
process ^>=1.6.26.1,
|
||||||
containers ^>=0.8,
|
containers ^>=0.8,
|
||||||
|
|||||||
Reference in New Issue
Block a user