From ee1b739c0f0b1379d5b699160d2ae10b6ff0f323 Mon Sep 17 00:00:00 2001 From: bunny Date: Fri, 12 Sep 2025 00:08:22 +0100 Subject: [PATCH] finally setup an LSP - fixed all warnings --- app/Compiler.hs | 36 +++++++++++++++++------------------- app/Main.hs | 6 +++--- app/Monpar.hs | 10 ++++------ app/Parser.hs | 15 ++++++--------- build.sh | 2 +- zorth.cabal | 1 + 6 files changed, 32 insertions(+), 38 deletions(-) diff --git a/app/Compiler.hs b/app/Compiler.hs index 737ebe3..6914679 100644 --- a/app/Compiler.hs +++ b/app/Compiler.hs @@ -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" \ No newline at end of file + \ mem: resq 640000\n" diff --git a/app/Main.hs b/app/Main.hs index 3e18c82..f17ca3c 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -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 () \ No newline at end of file + _ <- readProcess "nasm" ["-f", "elf64", "out.asm", "-o", "out.o"] "" + _ <- readProcess "ld" ["out.o", "-o", "a.out"] "" + return () diff --git a/app/Monpar.hs b/app/Monpar.hs index beb7614..6ae1a16 100644 --- a/app/Monpar.hs +++ b/app/Monpar.hs @@ -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 } \ No newline at end of file +manyTill p q = (q >> return []) <++ do { x <- p; xs <- manyTill p q; return $ x:xs } diff --git a/app/Parser.hs b/app/Parser.hs index 4249e6c..56bcde6 100644 --- a/app/Parser.hs +++ b/app/Parser.hs @@ -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 diff --git a/build.sh b/build.sh index 00b977e..edf13d5 100755 --- a/build.sh +++ b/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 \ No newline at end of file +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 diff --git a/zorth.cabal b/zorth.cabal index 5a12f0f..74925ec 100644 --- a/zorth.cabal +++ b/zorth.cabal @@ -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,