Commit c6a8497e authored by Ben D's avatar Ben D

Add more Compiler Util functions and functionality for compiling integer decls

parent c97e6834
......@@ -20,6 +20,7 @@ description: Please see the README on GitLab at <https://gitlab.com/Bleu
dependencies:
- base >= 4.7 && < 5
- bytestring
- containers
- data-fix
- filepath
......
module Mushroom.Compiler.Compiler where
import Data.Fix
import LLVM.AST hiding (Type)
import qualified LLVM.AST as AST (Type)
import LLVM.AST.Constant
import LLVM.AST.Type
import LLVM.IRBuilder.Monad
import Mushroom.Types
import Mushroom.Compiler.Util
-- | Compiles a definition into a representation of LLVM IR and stores it into the @CompileState@
-- record.
compileDef :: TypedTerm -> MushroomCompile ()
compileDef Fix{unFix = Term'Define name Fix{unFix = Term'Abs ps env body `Typed` _} `Typed` _} =
undefined
compileDef Fix{unFix = Term'Define name val `Typed` _} = do
-- get an LLVM representation of the variable's value and type
val' <- compileVal val
ty <- compileTy val
-- define the variable
defvar name ty val'
compileDef _ = compileError "Expected definition, but got value instead"
-- | Compiles a value (e.g. a string, int, collection, etc) into an LLVM constant.
compileVal :: TypedTerm -> MushroomCompile Constant
compileVal Fix{unFix = Term'IntLit i `Typed` _} = return $ Int 32 (fromIntegral i)
compileVal _ = compileError "Could not compile value"
compileTy :: TypedTerm -> MushroomCompile AST.Type
compileTy Fix{unFix = _ `Typed` Type'Int} = return i32
compileTy _ = compileError "Could not compile type"
......@@ -2,18 +2,30 @@
module Mushroom.Compiler.Util where
import Control.Monad.Except
import Control.Lens
import qualified Data.ByteString.Char8 as C (pack)
import qualified Data.ByteString.Short as S (toShort)
import LLVM.AST hiding (Type)
import qualified LLVM.AST as AST (Type)
import LLVM.AST.Constant
import LLVM.AST.Global
import Mushroom.Types
compileError :: String -> MushroomCompile a
compileError = throwError . newMushroomError CompileError
-- | Defines a function globally.
-- defn :: AST.Type -> String -> [(String, Type)] -> [BasicBlock] -> MushroomCompile ()
defn :: AST.Type -> Symbol -> [(Symbol, AST.Type)] -> [BasicBlock] -> MushroomCompile ()
defn retty fname params blocks = addGlobal (mkFn retty fname params blocks)
-- | Defines a global variable.
defvar :: Symbol -> AST.Type -> Constant -> MushroomCompile ()
defvar vname ty val = addGlobal (mkVar vname ty val)
-- | Adds a global definition.
addGlobal :: Global -> MushroomCompile ()
addGlobal = addDefinition . GlobalDefinition
......@@ -22,15 +34,26 @@ addGlobal = addDefinition . GlobalDefinition
addDefinition :: Definition -> MushroomCompile ()
addDefinition def = defs %= (def:)
-- | Constructs a function definition given a return type, name, and parameter list.
-- mkFn :: AST.Type -> String -> [(String, Type)] -> [BasicBlock] -> Global
-- | Constructs a global variable given a name, type, and value.
mkVar :: Symbol -> AST.Type -> Constant -> Global
mkVar vname ty val = globalVariableDefaults
{ name = symToName vname
, LLVM.AST.Global.type' = ty
, initializer = Just val }
-- | Constructs a global function given a return type, name, and parameter list.
mkFn :: AST.Type -> Symbol -> [(Symbol, AST.Type)] -> [BasicBlock] -> Global
mkFn retty fname params blocks = functionDefaults
{ returnType = retty
, name = Name fname
, name = symToName fname
, parameters = (map mkParams params, False {- False = no varargs -})
, basicBlocks = blocks }
where mkParams (str, ty) = Parameter ty (Name str) []
where mkParams (str, ty) = Parameter ty (symToName str) []
-- | Increases the counter for variables.
incVars :: MushroomCompile ()
incVars = varCount += 1
-- | Converts a symbol into a name.
symToName :: Symbol -> Name
symToName = Name . S.toShort . C.pack
......@@ -103,17 +103,18 @@ data Type =
| Type'None -- ^ For terms that don't yield *any* value, not even unit (i.e. variable definitions)
deriving (Eq, Ord, Show)
data ErrorType = TypeError | RuntimeError
data ErrorType = TypeError | RuntimeError | CompileError
-- | A data type that holds info on a MushroomError.
data MushroomError = MushroomError
{ errorType :: ErrorType
, errorMessage :: String }
instance Show MushroomError where
show err = etype ++ " Error: " ++ errorMessage err
show err = "[" ++ etype ++ " Error]: " ++ errorMessage err
where etype = case errorType err of
TypeError -> "Type"
RuntimeError -> "Runtime"
CompileError -> "Compile"
newMushroomError :: ErrorType -> String -> MushroomError
newMushroomError = MushroomError
......@@ -194,8 +195,9 @@ newCompilerState = CompilerState
, _defs = [] }
newtype MushroomCompile a = MushroomCompile
{ runCompile :: IRBuilderT (State CompilerState) a }
deriving (Functor, Applicative, Monad, MonadState CompilerState)
{ runCompile :: ExceptT MushroomError (IRBuilderT (State CompilerState)) a }
deriving (Functor, Applicative, Monad, MonadState CompilerState,
MonadError MushroomError)
------------------------------------------
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment