Add RISC-V code generation

app/Commands/Compile.hs

@@ -4,6 +4,7 @@
 module Commands.Compile (compile) where
 
 import CodeGen.Llvm.Runner (compileToBinary, compileToLlvmIr)
+import CodeGen.RiscV.Runner (compileToRiscVAsm)
 import CodeGen.TimedValue (TimedValue (TimedValue))
 import Configuration.AppConfiguration (CompilationTarget (..), Compile (..), Debug (Yes), Input (..), Output (..))
 import Control.Monad (when)
@@ -26,6 +27,9 @@ compile (Compile input target output) debug = do
     TargetLlvmIr -> do
       let outputFilePath = outputToFilePath output moduleName "ll"
       compileToLlvmIr text outputFilePath
+    TargetRiscVAsm -> do
+      let outputFilePath = outputToFilePath output moduleName "s"
+      compileToRiscVAsm text outputFilePath
 
   when (debug == Yes) $ do
     putStrLn $ Printf.printf "Finished compiling in %0.5f sec" (ns2s compTime)

app/Commands/PrintCRuntime.hs

@@ -0,0 +1,16 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Commands.PrintCRuntime (printCRuntime) where
+
+import qualified CodeGen.Runtime.PrintRuntime as R
+import Configuration.AppConfiguration (Output (..), PrintCRuntime (..))
+
+printCRuntime :: PrintCRuntime -> IO ()
+printCRuntime (PrintCRuntime output) = do
+  R.printCRuntime $ outputToFilePath output
+
+outputToFilePath :: Output -> FilePath
+outputToFilePath = \case
+  FileOutput filePath -> filePath
+  AutoFileOutput -> "runtime.c"

app/Configuration/AppConfiguration.hs

@@ -8,6 +8,7 @@ data MiniMl = MiniMl Command Debug
 data Command
   = CmdRun Run
   | CmdCompile Compile
+  | CmdPrintCRuntime PrintCRuntime
   deriving (Show)
 
 data Debug
@@ -28,15 +29,17 @@ data Compile = Compile Input CompilationTarget Output
 data CompilationTarget
   = TargetBinary
   | TargetLlvmIr
+  | TargetRiscVAsm
   deriving (Enum, Bounded)
 
 instance Show CompilationTarget where
   show TargetBinary = "binary"
   show TargetLlvmIr = "llvm-ir"
+  show TargetRiscVAsm = "risc-v-asm"
 
-data Output
-  = FileOutput FilePath
-  | AutoFileOutput
+-- ** Print C Runtime Configuration
+
+newtype PrintCRuntime = PrintCRuntime Output
   deriving (Show)
 
 -- ** Common Configuration
@@ -45,3 +48,8 @@ data Input
   = StdInput
   | FileInput FilePath
   deriving (Show)
+
+data Output
+  = FileOutput FilePath
+  | AutoFileOutput
+  deriving (Show)

app/Configuration/Commands/MiniMl.hs

@@ -2,6 +2,7 @@ module Configuration.Commands.MiniMl (miniMl) where
 
 import Configuration.AppConfiguration (Debug (..), MiniMl (MiniMl))
 import Configuration.Commands.Compile (compile)
+import Configuration.Commands.PrintCRuntime (printCRuntime)
 import Configuration.Commands.Run (run)
 import Options.Applicative
 
@@ -20,7 +21,7 @@ miniMlParserInfo :: ParserInfo MiniMl
 miniMlParserInfo = info (miniMlParser <**> helper) miniMlInfoMod
 
 miniMlParser :: Parser MiniMl
-miniMlParser = MiniMl <$> hsubparser (run <> compile) <*> debugParser
+miniMlParser = MiniMl <$> hsubparser (run <> compile <> printCRuntime) <*> debugParser
 
 miniMlInfoMod :: InfoMod a
 miniMlInfoMod =

app/Configuration/Commands/PrintCRuntime.hs

@@ -0,0 +1,34 @@
+module Configuration.Commands.PrintCRuntime (printCRuntime) where
+
+import Configuration.AppConfiguration
+import Options.Applicative
+
+printCRuntime :: Mod CommandFields Command
+printCRuntime = command "print-c-runtime" compileParserInfo
+
+compileParserInfo :: ParserInfo Command
+compileParserInfo = info printCRuntimeParser printCRuntimeInfoMod
+
+printCRuntimeParser :: Parser Command
+printCRuntimeParser =
+  CmdPrintCRuntime . PrintCRuntime <$> outputParser
+
+printCRuntimeInfoMod :: InfoMod a
+printCRuntimeInfoMod =
+  fullDesc
+    <> header "Print C runtime"
+    <> progDesc "Print C runtime"
+
+outputParser :: Parser Output
+outputParser = fileOutputP <|> defaultP
+  where
+    fileOutputP =
+      FileOutput
+        <$> strOption
+          ( long "output"
+              <> short 'o'
+              <> metavar "OUTPUT"
+              <> help "Output file path (default: runtime.c)"
+          )
+
+    defaultP = pure AutoFileOutput

app/Main.hs

@@ -1,6 +1,7 @@
 module Main where
 
 import Commands.Compile (compile)
+import Commands.PrintCRuntime (printCRuntime)
 import Commands.Run (run)
 import Configuration.AppConfiguration (Command (..), Debug (Yes), MiniMl (MiniMl))
 import Configuration.Commands.MiniMl (miniMl)
@@ -19,3 +20,4 @@ main = do
   case cmd of
     CmdRun r -> run r d
     CmdCompile c -> compile c d
+    CmdPrintCRuntime pcr -> printCRuntime pcr

cabal.project

@@ -1,6 +1,6 @@
 source-repository-package
     type: git
-    location: https://github.com/luc-tielen/llvm-codegen.git
-    tag: 83b04cb576208ea74ddd62016e4fa03f0df138ac
+    location: https://github.com/AzimMuradov/llvm-codegen.git
+    tag: f77d7cd82b40004d7eadc6fcc1ff536db599206e
 
 packages: .

cabal.project.freeze

@@ -16,7 +16,7 @@ constraints: any.Cabal ==3.8.1.0,
              bifunctors +tagged,
              any.binary ==0.8.9.1,
              any.bytestring ==0.11.5.3,
-             any.cabal-doctest ==1.0.9,
+             any.cabal-doctest ==1.0.10,
              any.call-stack ==0.4.0,
              any.case-insensitive ==1.2.1.0,
              any.clock ==0.8.4,
@@ -27,7 +27,7 @@ constraints: any.Cabal ==3.8.1.0,
              any.containers ==0.6.7,
              any.contravariant ==1.5.5,
              contravariant +semigroups +statevar +tagged,
-             any.data-fix ==0.3.3,
+             any.data-fix ==0.3.4,
              any.deepseq ==1.4.8.0,
              any.directory ==1.3.7.1,
              any.distributive ==0.6.2.1,
@@ -45,20 +45,20 @@ constraints: any.Cabal ==3.8.1.0,
              any.ghc-bignum ==1.3,
              any.ghc-boot-th ==9.4.8,
              any.ghc-prim ==0.9.1,
-             any.hashable ==1.4.6.0,
-             hashable +arch-native +integer-gmp -random-initial-seed,
+             any.hashable ==1.4.7.0,
+             hashable -arch-native +integer-gmp -random-initial-seed,
              any.indexed-traversable ==0.1.4,
              any.integer-logarithms ==1.0.3.1,
              integer-logarithms -check-bounds +integer-gmp,
              any.llvm-codegen ==0.1.0.0,
-             any.logict ==0.8.0.0,
+             any.logict ==0.8.1.0,
              any.megaparsec ==9.6.1,
              megaparsec -dev,
              any.mmorph ==1.2.0,
              any.mtl ==2.2.2 || ==2.3.1,
              any.optparse-applicative ==0.18.1.0,
              optparse-applicative +process,
-             any.os-string ==2.0.3,
+             any.os-string ==2.0.6,
              any.parsec ==3.1.16.1,
              any.parser-combinators ==1.3.0,
              parser-combinators -dev,
@@ -91,23 +91,23 @@ constraints: any.Cabal ==3.8.1.0,
              tasty +unix,
              any.tasty-golden ==2.3.5,
              tasty-golden -build-example,
-             any.tasty-hunit ==0.10.1,
+             any.tasty-hunit ==0.10.2,
              any.template-haskell ==2.19.0.0,
              any.temporary ==1.3,
              any.text ==2.0.2,
-             any.text-builder-linear ==0.1.2,
+             any.text-builder-linear ==0.1.3,
              any.th-abstraction ==0.7.0.0,
              any.time ==1.12.2,
              any.transformers ==0.5.6.2,
              any.transformers-base ==0.4.6,
              transformers-base +orphaninstances,
              any.transformers-compat ==0.7.2,
              transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
-             any.typed-process ==0.2.11.1,
-             any.unification-fd ==0.11.2,
+             any.typed-process ==0.2.12.0,
+             any.unification-fd ==0.11.2.2,
              any.unix ==2.7.3,
              any.unliftio-core ==0.2.1.0,
              any.unordered-containers ==0.2.20,
              unordered-containers -debug,
              any.utf8-string ==1.0.2
-index-state: hackage.haskell.org 2024-06-20T07:22:15Z
+index-state: hackage.haskell.org 2024-09-30T23:17:41Z

lib/CodeGen/RiscV/AsmGen.hs

@@ -0,0 +1,166 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecursiveDo #-}
+
+module CodeGen.RiscV.AsmGen (ppRiscVAsm) where
+
+import CodeGen.Module (Module (..))
+import qualified CodeGen.RiscV.Lib as Rv
+import Control.Monad.State (MonadState, State, evalState, gets, modify)
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Text (Text)
+import qualified Data.Text as Txt
+import Foreign (fromBool)
+import MonadUtils (locally)
+import qualified StdLib
+import Transformations.Anf.Anf
+import Trees.Common
+
+ppRiscVAsm :: Module -> Text
+ppRiscVAsm m = Rv.ppCodeLines $ genModule m
+
+-- The Code
+
+type CodeGenM = Rv.AsmBuilderT (State Env)
+
+data Env = Env
+  { locVars :: Map Identifier' Rv.Operand,
+    globVars :: Map Identifier' Rv.Operand,
+    funs :: Map Identifier' (Rv.Operand, Arity)
+  }
+
+genModule :: Module -> [Rv.CodeLine]
+genModule (Module (Program decls)) = flip evalState (Env Map.empty Map.empty Map.empty) $
+  Rv.compileT $ do
+    mapM_ genStdLibDecl StdLib.allDeclsWithArity
+    mapM_ genGlobDecl decls
+
+    -- In the `main` we define our global variables.
+    Rv.mainFunction $ \_ -> mapM_ gVarDef decls
+  where
+    gVarDef :: GlobalDeclaration -> CodeGenM ()
+    gVarDef = \case
+      GlobVarDecl ident value -> do
+        addr <- findGlobVar ident
+        value' <- genExpr value
+        Rv.storeToLabeledAddr addr value'
+      _ -> return ()
+
+genStdLibDecl :: StdLib.DeclarationWithArity -> CodeGenM ()
+genStdLibDecl decl = declareAsExtern decl >>= register decl
+  where
+    declareAsExtern :: StdLib.DeclarationWithArity -> CodeGenM Rv.Operand
+    declareAsExtern (ident, _) = Rv.externFunction ident
+
+    register :: StdLib.DeclarationWithArity -> Rv.Operand -> CodeGenM ()
+    register (ident, arity) fun = regFun (Txt ident) fun arity
+
+genGlobDecl :: GlobalDeclaration -> CodeGenM ()
+genGlobDecl = \case
+  GlobVarDecl ident _ -> do
+    var <- Rv.globalVar (Txt.pack $ genId ident)
+    regGlobVar ident var
+  GlobFunDecl ident params body -> mdo
+    regFun ident fun (length params)
+    fun <- locally $ do
+      Rv.function
+        (Txt.pack $ genId ident)
+        (fromIntegral $ length params)
+        $ \args -> do
+          mapM_ (uncurry regLocVar) (params `zip` args)
+          genExpr body
+    return ()
+
+genId :: Identifier' -> String
+genId = \case
+  Txt txt -> Txt.unpack txt
+  Gen n txt -> Txt.unpack txt <> "_" <> show n
+
+genExpr :: Expression -> CodeGenM Rv.Operand
+genExpr = \case
+  ExprAtom atom -> genAtom atom
+  ExprComp ce -> genComp ce
+  ExprLetIn (ident, val) expr -> do
+    val' <- genExpr val
+    regLocVar ident val'
+    genExpr expr
+
+genAtom :: AtomicExpression -> CodeGenM Rv.Operand
+genAtom = \case
+  AtomId ident -> findAny ident
+  AtomUnit -> Rv.immediate 0
+  AtomBool bool -> Rv.immediate $ fromBool bool
+  AtomInt int -> Rv.immediate int
+
+genComp :: ComplexExpression -> CodeGenM Rv.Operand
+genComp = \case
+  CompApp f arg -> do
+    f' <- findAny f
+    arg' <- genAtom arg
+    applyF <- findFun (Txt "miniml_apply")
+    Rv.call applyF [f', arg']
+  CompIte c t e -> do
+    c' <- genAtom c
+    Rv.ite c' (\_ -> genExpr t) (\_ -> genExpr e)
+  CompBinOp op lhs rhs -> do
+    lhs' <- genAtom lhs
+    rhs' <- genAtom rhs
+    let opF = case op of
+          BoolOp AndOp -> Rv.and
+          BoolOp OrOp -> Rv.or
+          ArithOp PlusOp -> Rv.add
+          ArithOp MinusOp -> Rv.sub
+          ArithOp MulOp -> Rv.mul
+          ArithOp DivOp ->
+            ( \lhs'' rhs'' -> do
+                divF <- findFun (Txt "miniml_div")
+                Rv.call divF [lhs'', rhs'']
+            )
+          CompOp EqOp -> Rv.eq
+          CompOp NeOp -> Rv.ne
+          CompOp LtOp -> Rv.lt
+          CompOp LeOp -> Rv.le
+          CompOp GtOp -> Rv.gt
+          CompOp GeOp -> Rv.ge
+    opF lhs' rhs'
+  CompUnOp op x -> do
+    x' <- genAtom x
+    let opF = case op of
+          UnMinusOp -> Rv.neg
+    opF x'
+
+-- Vars & Funs
+
+findAny :: Identifier' -> CodeGenM Rv.Operand
+findAny ident = do
+  maybeLocVar <- gets ((Map.!? ident) . locVars)
+  case maybeLocVar of
+    Just locVar -> return locVar
+    Nothing -> do
+      maybeFun <- gets ((Map.!? ident) . funs)
+      case maybeFun of
+        Just (fun, arity) -> do
+          funToPafF <- findFun (Txt "miniml_fun_to_paf")
+          arity' <- Rv.immediate $ fromIntegral arity
+          Rv.call funToPafF [fun, arity']
+        Nothing -> findGlobVar ident
+
+findGlobVar :: (MonadState Env m) => Identifier' -> m Rv.Operand
+findGlobVar ident = gets ((Map.! ident) . globVars)
+
+findFun :: Identifier' -> CodeGenM Rv.Operand
+findFun ident = gets (fst . (Map.! ident) . funs)
+
+regLocVar :: (MonadState Env m) => Identifier' -> Rv.Operand -> m ()
+regLocVar ident var = modify $
+  \env -> env {locVars = Map.insert ident var (locVars env)}
+
+regGlobVar :: (MonadState Env m) => Identifier' -> Rv.Operand -> m ()
+regGlobVar ident gVar = modify $
+  \env -> env {globVars = Map.insert ident gVar (globVars env)}
+
+regFun :: (MonadState Env m) => Identifier' -> Rv.Operand -> Arity -> m ()
+regFun ident fun paramsCnt = modify $
+  \env -> env {funs = Map.insert ident (fun, paramsCnt) (funs env)}