{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MonoLocalBinds #-}

module Codegen.ExprGen.Global where

import qualified Ast.Types as AT
import qualified Codegen.Errors as CC
import qualified Codegen.ExprGen.ExprGen as EG
import qualified Codegen.ExprGen.Function as EFU
import qualified Codegen.ExprGen.Types as ET
import qualified Codegen.ExprGen.Variable as EV
import qualified Codegen.State as CS
import qualified Codegen.Utils as U
import qualified Control.Monad as CM
import qualified Control.Monad.Except as E
import qualified LLVM.AST as AST
import qualified LLVM.AST.Constant as C
import qualified LLVM.IRBuilder.Module as M
import qualified Shared.Utils as SU

-- | Generate LLVM code for global expressions.
generateGlobal :: (CS.MonadCodegen m, EG.ExprGen AT.Expr) => AT.Expr -> m ()
generateGlobal :: forall (m :: * -> *).
(MonadCodegen m, ExprGen Expr) =>
Expr -> m ()
generateGlobal Expr
expr = case Expr
expr of
  AT.Function {} -> m Operand -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
CM.void (m Operand -> m ()) -> m Operand -> m ()
forall a b. (a -> b) -> a -> b
$ Expr -> m Operand
forall (m :: * -> *).
(MonadCodegen m, ExprGen Expr) =>
Expr -> m Operand
EFU.generateFunction Expr
expr
  AT.ForeignFunction {} -> m Operand -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
CM.void (m Operand -> m ()) -> m Operand -> m ()
forall a b. (a -> b) -> a -> b
$ Expr -> m Operand
forall (m :: * -> *).
(MonadCodegen m, ExprGen Expr) =>
Expr -> m Operand
EFU.generateForeignFunction Expr
expr
  AT.Declaration {} -> m () -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
CM.void (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Expr -> m ()
forall (m :: * -> *).
(MonadCodegen m, ExprGen Expr) =>
Expr -> m ()
generateGlobalDeclaration Expr
expr
  Expr
_ -> CodegenError -> m ()
forall a. CodegenError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
E.throwError (CodegenError -> m ()) -> CodegenError -> m ()
forall a b. (a -> b) -> a -> b
$ SrcLoc -> CodegenErrorType -> CodegenError
CC.CodegenError (Expr -> SrcLoc
SU.getLoc Expr
expr) (CodegenErrorType -> CodegenError)
-> CodegenErrorType -> CodegenError
forall a b. (a -> b) -> a -> b
$ Expr -> CodegenErrorType
CC.UnsupportedTopLevel Expr
expr

-- | Generate LLVM code for global declarations.
generateGlobalDeclaration :: (CS.MonadCodegen m, EG.ExprGen AT.Expr) => AT.Expr -> m ()
generateGlobalDeclaration :: forall (m :: * -> *).
(MonadCodegen m, ExprGen Expr) =>
Expr -> m ()
generateGlobalDeclaration (AT.Declaration SrcLoc
_ String
name Type
typ Maybe Expr
initExpr) = do
  let varType :: Type
varType = Type -> Type
forall a. ToLLVM a => a -> Type
ET.toLLVM Type
typ
  case Maybe Expr
initExpr of
    Just (AT.Lit SrcLoc
loc Literal
lit) -> do
      Constant
initConstant <- Literal -> SrcLoc -> m Constant
forall (m :: * -> *).
(MonadCodegen m, ExprGen Expr) =>
Literal -> SrcLoc -> m Constant
EV.generateConstant Literal
lit SrcLoc
loc
      Operand
var <- Name -> Type -> Constant -> m Operand
forall (m :: * -> *).
MonadModuleBuilder m =>
Name -> Type -> Constant -> m Operand
M.global (ShortByteString -> Name
AST.Name (ShortByteString -> Name) -> ShortByteString -> Name
forall a b. (a -> b) -> a -> b
$ String -> ShortByteString
U.stringToByteString String
name) Type
varType Constant
initConstant
      String -> Operand -> m ()
forall (m :: * -> *). VarBinding m => String -> Operand -> m ()
CS.addGlobalVar String
name Operand
var
    Maybe Expr
Nothing -> do
      Operand
var <- Name -> Type -> Constant -> m Operand
forall (m :: * -> *).
MonadModuleBuilder m =>
Name -> Type -> Constant -> m Operand
M.global (ShortByteString -> Name
AST.Name (ShortByteString -> Name) -> ShortByteString -> Name
forall a b. (a -> b) -> a -> b
$ String -> ShortByteString
U.stringToByteString String
name) Type
varType (Type -> Constant
C.Undef Type
varType)
      String -> Operand -> m ()
forall (m :: * -> *). VarBinding m => String -> Operand -> m ()
CS.addGlobalVar String
name Operand
var
    Just Expr
expr -> CodegenError -> m ()
forall a. CodegenError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
E.throwError (CodegenError -> m ()) -> CodegenError -> m ()
forall a b. (a -> b) -> a -> b
$ SrcLoc -> CodegenErrorType -> CodegenError
CC.CodegenError (Expr -> SrcLoc
SU.getLoc Expr
expr) (CodegenErrorType -> CodegenError)
-> CodegenErrorType -> CodegenError
forall a b. (a -> b) -> a -> b
$ Expr -> CodegenErrorType
CC.UnsupportedGlobalDeclaration Expr
expr
generateGlobalDeclaration Expr
expr = CodegenError -> m ()
forall a. CodegenError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
E.throwError (CodegenError -> m ()) -> CodegenError -> m ()
forall a b. (a -> b) -> a -> b
$ SrcLoc -> CodegenErrorType -> CodegenError
CC.CodegenError (Expr -> SrcLoc
SU.getLoc Expr
expr) (CodegenErrorType -> CodegenError)
-> CodegenErrorType -> CodegenError
forall a b. (a -> b) -> a -> b
$ Expr -> CodegenErrorType
CC.UnsupportedGlobalDeclaration Expr
expr