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