Merge branch 'main' into 104-parse-program

Jabolol · Jan 7, 2025 · 2110801 · 2110801
2 parents e74b88b + ab276a7
commit 2110801
Show file tree

Hide file tree

Showing 8 changed files with 859 additions and 231 deletions.
diff --git a/app/Main.hs b/app/Main.hs
@@ -2,7 +2,8 @@
 
 module Main where
 
-import qualified Ast.Parser as P
+-- import qualified Ast.Parser as P
+import Ast.Types
 import qualified Codegen.Codegen as C
 import qualified Control.Monad as M
 import qualified Control.Monad.IO.Class as IO
@@ -59,16 +60,105 @@ optionsInfo =
         <> O.header "Scheme-to-LLVM Compiler"
     )
 
+sampleProgram :: Program
+sampleProgram =
+  Program
+    { globals =
+        [ ("fibonacci", fibonacciFunction),
+          ("main", mainFunction)
+        ],
+      types = [],
+      sourceFile = "fibonacci.c"
+    }
+  where
+    fibonacciLoc = SrcLoc "fibonacci.c" 1 1
+    nParamLoc = SrcLoc "fibonacci.c" 2 3
+    ifLoc = SrcLoc "fibonacci.c" 3 3
+    returnBaseCaseLoc = SrcLoc "fibonacci.c" 4 5
+    recursiveCallLoc = SrcLoc "fibonacci.c" 5 5
+    returnRecursiveLoc = SrcLoc "fibonacci.c" 6 5
+    mainLoc = SrcLoc "fibonacci.c" 8 1
+    resultLoc = SrcLoc "fibonacci.c" 9 3
+    returnLoc = SrcLoc "fibonacci.c" 10 3
+
+    fibonacciFunction =
+      Function
+        { funcLoc = fibonacciLoc,
+          funcName = "fibonacci",
+          funcType = TFunction (TInt 32) [TInt 32] False,
+          funcParams = ["n"],
+          funcBody =
+            Block
+              [ If
+                  { ifLoc = ifLoc,
+                    ifCond = Op ifLoc Lte (Var nParamLoc "n" (TInt 32)) (Lit nParamLoc (LInt 1)),
+                    ifThen = Return returnBaseCaseLoc (Just (Var nParamLoc "n" (TInt 32))),
+                    ifElse =
+                      Just $
+                        Return
+                          returnRecursiveLoc
+                          ( Just
+                              ( Op
+                                  recursiveCallLoc
+                                  Add
+                                  ( Call
+                                      recursiveCallLoc
+                                      (Var recursiveCallLoc "fibonacci" (TFunction (TInt 32) [TInt 32] False))
+                                      [Op recursiveCallLoc Sub (Var nParamLoc "n" (TInt 32)) (Lit recursiveCallLoc (LInt 1))]
+                                  )
+                                  ( Call
+                                      recursiveCallLoc
+                                      (Var recursiveCallLoc "fibonacci" (TFunction (TInt 32) [TInt 32] False))
+                                      [Op recursiveCallLoc Sub (Var nParamLoc "n" (TInt 32)) (Lit recursiveCallLoc (LInt 2))]
+                                  )
+                              )
+                          )
+                  }
+              ]
+        }
+
+    mainFunction =
+      Function
+        { funcLoc = mainLoc,
+          funcName = "$$generated",
+          funcType = TFunction (TInt 32) [] False,
+          funcParams = [],
+          funcBody =
+            Block
+              [ Declaration
+                  { declLoc = resultLoc,
+                    declName = "n",
+                    declType = TInt 32,
+                    declInit = Just (Lit resultLoc (LInt 8))
+                  },
+                Declaration
+                  { declLoc = resultLoc,
+                    declName = "result",
+                    declType = TInt 32,
+                    declInit =
+                      Just
+                        ( Call
+                            resultLoc
+                            (Var resultLoc "fibonacci" (TFunction (TInt 32) [TInt 32] False))
+                            [Var resultLoc "n" (TInt 32)]
+                        )
+                  },
+                Return returnLoc (Just (Var returnLoc "result" (TInt 32)))
+              ]
+        }
+
 compile :: String -> String -> Bool -> E.ExceptT CompileError IO String
-compile input source verbose = do
-  ast <- case P.parse input source of
-    Left err -> E.throwE $ ParseError err
-    Right res -> return res
+compile _ _ verbose = do
+  -- ast <- case P.parse input source of
+  --   Left err -> E.throwE $ ParseError err
+  --   Right res -> return res
+
+  let ast = sampleProgram
 
   IO.liftIO $ logMsg verbose (TL.unpack $ PS.pShow ast)
 
   case C.codegen ast of
-    Left err -> E.throwE $ CodegenError (show err)
+    Left err -> E.throwE $ CodegenError (TL.unpack $ PS.pShow err)
     Right lmod -> return $ TL.unpack $ LLVM.ppllvm lmod
 
 logMsg :: Bool -> String -> IO ()
@@ -87,7 +177,8 @@ handleError errType errMsg verbose = do
 main :: IO ()
 main = do
   Options {input, out, verbose} <- O.execParser optionsInfo
-  source <- readInput input
+  -- source <- readInput input
+  let source = ""
 
   logMsg verbose "Starting compilation..."
   result <- E.runExceptT $ compile (DM.fromMaybe "stdin" input) source verbose

diff --git a/glados.cabal b/glados.cabal
@@ -34,7 +34,6 @@ library
     Ast.Types
     Codegen.Codegen
     Codegen.Utils
-    Misc
 
   build-depends:
     base ^>=4.17.2.1,
@@ -74,6 +73,7 @@ test-suite glados-test
     Ast.Parser.UnaryOperationSpec
     Ast.ParserSpec
     Misc.MiscSpec
+    Codegen.CodegenSpec
 
   hs-source-dirs: test
   main-is: Spec.hs
@@ -83,5 +83,6 @@ test-suite glados-test
     glados,
     hspec,
     hspec-discover,
+    llvm-hs-pure >=9.0.0 && <9.1,
     megaparsec >=9.7.0,
-    mtl >=2.2.2 && <2.3
+    mtl >=2.2.2 && <2.3,
diff --git a/lib/Ast/Types.hs b/lib/Ast/Types.hs
@@ -16,6 +16,7 @@ data Literal
   | LBool Bool
   | LArray [Literal]
   | LNull
+  | LStruct [(String, Literal)]
   deriving (Show, Eq, Ord)
 
 -- | Enhanced type system with size information and qualifiers