finally setup an LSP - fixed all warnings

This commit is contained in:
2025-09-12 00:08:22 +01:00
parent e440585f90
commit ee1b739c0f
6 changed files with 32 additions and 38 deletions

View File

@@ -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"

View File

@@ -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 ()

View File

@@ -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 }

View File

@@ -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

View File

@@ -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

View File

@@ -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,