Fix haskell language server broken

pull/25/head
Ethan Reece 2023-10-06 00:29:36 -05:00
parent 7e9d8b434a
commit 5325a845f2
Signed by: me
GPG Key ID: D3993665FF92E1C3
6 changed files with 29 additions and 17 deletions

View File

@ -10,7 +10,7 @@ Main repo: https://git.sudoer.ch/me/really-bad-compiler-in-haskell
- Install `ghcup` (for managing Haskell tools) and `nix` (for managing external dependencies). - Install `ghcup` (for managing Haskell tools) and `nix` (for managing external dependencies).
- Clone the repo. - Clone the repo.
- Use `ghcup` to install `stack 2.9.3`, `HLS 2.2.0.0`, `GHC 9.2.8`, and `cabal 3.6.2.0`. - Use `ghcup` to install `stack 2.11.1`, `HLS 2.3.0.0`, and `cabal 3.8.1.0`.
## Run Instructions ## Run Instructions

View File

@ -1,6 +1,6 @@
cabal-version: 1.12 cabal-version: 1.12
-- This file has been generated from package.yaml by hpack version 0.35.1. -- This file has been generated from package.yaml by hpack version 0.35.2.
-- --
-- see: https://github.com/sol/hpack -- see: https://github.com/sol/hpack

View File

@ -12,12 +12,11 @@ import System.Process (callCommand)
main :: IO () main :: IO ()
main = do main = do
fileName <- fmap head getArgs fileName <- head <$> getArgs
contents <- T.readFile fileName contents <- T.readFile fileName
T.putStrLn "- Parsing file..."
let parsed = parse contents
T.putStrLn "- Generating LLVM to './a.out.ll'..." T.putStrLn "- Generating LLVM to './a.out.ll'..."
llvmGen parsed >>= B.writeFile "a.out.ll" result <- (llvmGen . parse) contents
B.writeFile "a.out.ll" result
T.putStrLn "- Compiling to executable './a.out'..." T.putStrLn "- Compiling to executable './a.out'..."
callCommand "clang a.out.ll" callCommand "clang a.out.ll"
T.putStrLn "- Done." T.putStrLn "- Done."

View File

@ -17,6 +17,9 @@ import LLVM.IRBuilder.Module
import LLVM.IRBuilder.Monad import LLVM.IRBuilder.Monad
import Main.Types.Expr as Expr import Main.Types.Expr as Expr
-- printf :: Operand
-- printf = externVarArgs "printf" [ptr] i32
getLLVM :: Expr -> Module getLLVM :: Expr -> Module
getLLVM expr = getLLVM expr =
buildModule "program" $ mdo buildModule "program" $ mdo
@ -26,7 +29,12 @@ getLLVM expr =
numFormatStr <- globalStringPtr "%d\n" (mkName "str") numFormatStr <- globalStringPtr "%d\n" (mkName "str")
ourExpression <- exprToLLVM expr ourExpression <- exprToLLVM expr
_ <- call (FunctionType i32 [ptr] True) printf [(ConstantOperand numFormatStr, []), (ourExpression, [])] _ <- call (FunctionType i32 [ptr] True) printf [(ConstantOperand numFormatStr, []), (ourExpression, [])]
ret (int32 0) ret $ int32 0
-- getLLVM2 expr =
-- getLLVM $
-- return (printf)
exprToLLVM :: exprToLLVM ::
( MonadIRBuilder m, ( MonadIRBuilder m,
@ -36,6 +44,7 @@ exprToLLVM ::
m Operand m Operand
exprToLLVM (Lit prim) = pure $ primToLLVM prim exprToLLVM (Lit prim) = pure $ primToLLVM prim
exprToLLVM (Paren e) = exprToLLVM e exprToLLVM (Paren e) = exprToLLVM e
-- exprToLLVM (Print e) = mdo
exprToLLVM (Expr.Add a b) = mdo exprToLLVM (Expr.Add a b) = mdo
lhs <- exprToLLVM a lhs <- exprToLLVM a
rhs <- exprToLLVM b rhs <- exprToLLVM b
@ -54,12 +63,9 @@ exprToLLVM (Expr.Div a b) = mdo
sdiv lhs rhs sdiv lhs rhs
primToLLVM :: Int -> Operand primToLLVM :: Int -> Operand
primToLLVM i = int32 (fromIntegral i) primToLLVM i = int32 $ fromIntegral i
llvmGen :: Expr -> IO ByteString llvmGen :: Expr -> IO ByteString
llvmGen expr = do llvmGen expr = do
let l = getLLVM expr let l = getLLVM expr
withContext withContext $ \c -> withModuleFromAST c l moduleLLVMAssembly
( \c ->
withModuleFromAST c l moduleLLVMAssembly
)

View File

@ -50,13 +50,13 @@ table =
] ]
binaryOp :: Text -> (a -> a -> a) -> Operator (ParsecT Void Text Data.Functor.Identity.Identity) a binaryOp :: Text -> (a -> a -> a) -> Operator (ParsecT Void Text Data.Functor.Identity.Identity) a
binaryOp name f = InfixL (f <$ symbol name) binaryOp name f = InfixL $ f <$ symbol name
-- prefixOp :: Text -> (a -> a) -> Operator (ParsecT Void Text Data.Functor.Identity.Identity) a -- prefixOp :: Text -> (a -> a) -> Operator (ParsecT Void Text Data.Functor.Identity.Identity) a
-- prefixOp name f = Prefix (f <$ symbol name) -- prefixOp name f = Prefix (f <$ symbol name)
methodOp :: Text -> (a -> a) -> Operator (ParsecT Void Text Data.Functor.Identity.Identity) a methodOp :: Text -> (a -> a) -> Operator (ParsecT Void Text Data.Functor.Identity.Identity) a
methodOp name f = Prefix (f <$ (string name <* C.space)) methodOp name f = Prefix $ f <$ (string name <* C.space)
-- postfixOp :: Text -> (a -> a) -> Operator (ParsecT Void Text Data.Functor.Identity.Identity) a -- postfixOp :: Text -> (a -> a) -> Operator (ParsecT Void Text Data.Functor.Identity.Identity) a
-- postfixOp name f = Postfix (f <$ symbol name) -- postfixOp name f = Postfix (f <$ symbol name)
@ -68,7 +68,7 @@ parseExpr :: Text -> Either (ParseErrorBundle Text Void) Expr
parseExpr = MP.parse (C.space *> expr <* eof) "" parseExpr = MP.parse (C.space *> expr <* eof) ""
parse :: Text -> Expr parse :: Text -> Expr
parse t = do parse t =
case parseExpr t of case parseExpr t of
Right r -> r Right r -> r

View File

@ -1,4 +1,11 @@
resolver: lts-20.26 resolver: lts-20.26
compiler: ghc-9.2.8
# setup-info:
# ghc:
# aarch64:
# 9.4.6:
# url: "https://downloads.haskell.org/~ghc/9.4.6/ghc-9.4.6-aarch64-deb10-linux.tar.xz"
# sha256: "05896fc4bc52c117d281eac9c621c6c3a0b14f9f9eed5e42cce5e1c4485c7623"
packages: packages:
- . - .
@ -12,4 +19,4 @@ nix:
enable: true enable: true
packages: [llvm_15, clang_15, libxml2] packages: [llvm_15, clang_15, libxml2]
system-ghc: true system-ghc: true
install-ghc: true install-ghc: false