{-# LANGUAGE FlexibleContexts #-}

module Codegen.ExprGen.Operator where

import qualified Ast.Types as AT
import qualified Codegen.Errors as CC
import {-# SOURCE #-} qualified Codegen.ExprGen.ExprGen as EG
import qualified Codegen.State as CS
import qualified Control.Monad.Except as E
import qualified Data.List as L
import qualified LLVM.AST as AST
import qualified LLVM.AST.Constant as C
import qualified LLVM.AST.Float as FF
import qualified LLVM.AST.FloatingPointPredicate as FP
import qualified LLVM.AST.IntegerPredicate as IP
import qualified LLVM.AST.Type as T
import qualified LLVM.AST.Typed as TD
import qualified LLVM.IRBuilder.Instruction as I
import qualified Shared.Utils as SU

-- | Generate LLVM code for binary operations.
generateBinaryOp :: (CS.MonadCodegen m, EG.ExprGen AT.Expr) => AT.Expr -> m AST.Operand
generateBinaryOp :: forall (m :: * -> *).
(MonadCodegen m, ExprGen Expr) =>
Expr -> m Operand
generateBinaryOp (AT.Op SrcLoc
loc Operation
op Expr
e1 Expr
e2) = do
  Operand
v1 <- Expr -> m Operand
forall a (m :: * -> *).
(ExprGen a, MonadCodegen m) =>
a -> m Operand
forall (m :: * -> *). MonadCodegen m => Expr -> m Operand
EG.generateExpr Expr
e1
  Operand
v2 <- Expr -> m Operand
forall a (m :: * -> *).
(ExprGen a, MonadCodegen m) =>
a -> m Operand
forall (m :: * -> *). MonadCodegen m => Expr -> m Operand
EG.generateExpr Expr
e2
  let ty1 :: Type
ty1 = Operand -> Type
forall a. Typed a => a -> Type
TD.typeOf Operand
v1
      ty2 :: Type
ty2 = Operand -> Type
forall a. Typed a => a -> Type
TD.typeOf Operand
v2
  case (Type
ty1, Type
ty2) of
    (T.PointerType Type
_ AddrSpace
_, T.IntegerType Word32
_) -> case Operation
op of
      Operation
AT.Add -> Operand -> [Operand] -> m Operand
forall (m :: * -> *).
(MonadIRBuilder m, MonadModuleBuilder m) =>
Operand -> [Operand] -> m Operand
I.gep Operand
v1 [Operand
v2]
      Operation
AT.Sub -> do
        Operand
negV2 <- Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Operand -> m Operand
I.sub (Constant -> Operand
AST.ConstantOperand (Constant -> Operand) -> Constant -> Operand
forall a b. (a -> b) -> a -> b
$ Word32 -> Integer -> Constant
C.Int Word32
32 Integer
0) Operand
v2
        Operand -> [Operand] -> m Operand
forall (m :: * -> *).
(MonadIRBuilder m, MonadModuleBuilder m) =>
Operand -> [Operand] -> m Operand
I.gep Operand
v1 [Operand
negV2]
      Operation
_ -> CodegenError -> m Operand
forall a. CodegenError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
E.throwError (CodegenError -> m Operand) -> CodegenError -> m Operand
forall a b. (a -> b) -> a -> b
$ SrcLoc -> CodegenErrorType -> CodegenError
CC.CodegenError SrcLoc
loc (CodegenErrorType -> CodegenError)
-> CodegenErrorType -> CodegenError
forall a b. (a -> b) -> a -> b
$ Operation -> CodegenErrorType
CC.UnsupportedOperator Operation
op
    (T.IntegerType Word32
_, T.IntegerType Word32
_) -> case Operation -> Maybe (Operand -> Operand -> m Operand)
forall {m :: * -> *}.
(MonadIRBuilder m, MonadModuleBuilder m, MonadFix m,
 MonadState CodegenState m, MonadError CodegenError m) =>
Operation -> Maybe (Operand -> Operand -> m Operand)
findIntOperator Operation
op of
      Just Operand -> Operand -> m Operand
f -> Operand -> Operand -> m Operand
f Operand
v1 Operand
v2
      Maybe (Operand -> Operand -> m Operand)
Nothing -> CodegenError -> m Operand
forall a. CodegenError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
E.throwError (CodegenError -> m Operand) -> CodegenError -> m Operand
forall a b. (a -> b) -> a -> b
$ SrcLoc -> CodegenErrorType -> CodegenError
CC.CodegenError SrcLoc
loc (CodegenErrorType -> CodegenError)
-> CodegenErrorType -> CodegenError
forall a b. (a -> b) -> a -> b
$ Operation -> CodegenErrorType
CC.UnsupportedOperator Operation
op
    (T.FloatingPointType FloatingPointType
_, T.FloatingPointType FloatingPointType
_) -> case Operation -> Maybe (Operand -> Operand -> m Operand)
forall {m :: * -> *}.
(MonadIRBuilder m, MonadModuleBuilder m, MonadFix m,
 MonadState CodegenState m, MonadError CodegenError m) =>
Operation -> Maybe (Operand -> Operand -> m Operand)
findFloatOperator Operation
op of
      Just Operand -> Operand -> m Operand
f -> Operand -> Operand -> m Operand
f Operand
v1 Operand
v2
      Maybe (Operand -> Operand -> m Operand)
Nothing -> CodegenError -> m Operand
forall a. CodegenError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
E.throwError (CodegenError -> m Operand) -> CodegenError -> m Operand
forall a b. (a -> b) -> a -> b
$ SrcLoc -> CodegenErrorType -> CodegenError
CC.CodegenError SrcLoc
loc (CodegenErrorType -> CodegenError)
-> CodegenErrorType -> CodegenError
forall a b. (a -> b) -> a -> b
$ Operation -> CodegenErrorType
CC.UnsupportedOperator Operation
op
    (Type, Type)
_ -> CodegenError -> m Operand
forall a. CodegenError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
E.throwError (CodegenError -> m Operand) -> CodegenError -> m Operand
forall a b. (a -> b) -> a -> b
$ SrcLoc -> CodegenErrorType -> CodegenError
CC.CodegenError SrcLoc
loc (CodegenErrorType -> CodegenError)
-> CodegenErrorType -> CodegenError
forall a b. (a -> b) -> a -> b
$ Operation -> CodegenErrorType
CC.UnsupportedOperator Operation
op
  where
    findIntOperator :: Operation -> Maybe (Operand -> Operand -> m Operand)
findIntOperator Operation
op' = (BinaryOp m -> Bool) -> [BinaryOp m] -> Maybe (BinaryOp m)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find ((Operation -> Operation -> Bool
forall a. Eq a => a -> a -> Bool
== Operation
op') (Operation -> Bool)
-> (BinaryOp m -> Operation) -> BinaryOp m -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinaryOp m -> Operation
forall (m :: * -> *). BinaryOp m -> Operation
opMapping) [BinaryOp m]
forall (m :: * -> *). MonadCodegen m => [BinaryOp m]
integerBinaryOperators Maybe (BinaryOp m)
-> (BinaryOp m -> Maybe (Operand -> Operand -> m Operand))
-> Maybe (Operand -> Operand -> m Operand)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Operand -> Operand -> m Operand)
-> Maybe (Operand -> Operand -> m Operand)
forall a. a -> Maybe a
Just ((Operand -> Operand -> m Operand)
 -> Maybe (Operand -> Operand -> m Operand))
-> (BinaryOp m -> Operand -> Operand -> m Operand)
-> BinaryOp m
-> Maybe (Operand -> Operand -> m Operand)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinaryOp m -> Operand -> Operand -> m Operand
forall (m :: * -> *). BinaryOp m -> Operand -> Operand -> m Operand
opFunction
    findFloatOperator :: Operation -> Maybe (Operand -> Operand -> m Operand)
findFloatOperator Operation
op' = (BinaryOp m -> Bool) -> [BinaryOp m] -> Maybe (BinaryOp m)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find ((Operation -> Operation -> Bool
forall a. Eq a => a -> a -> Bool
== Operation
op') (Operation -> Bool)
-> (BinaryOp m -> Operation) -> BinaryOp m -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinaryOp m -> Operation
forall (m :: * -> *). BinaryOp m -> Operation
opMapping) [BinaryOp m]
forall (m :: * -> *). MonadCodegen m => [BinaryOp m]
floatingPointBinaryOperators Maybe (BinaryOp m)
-> (BinaryOp m -> Maybe (Operand -> Operand -> m Operand))
-> Maybe (Operand -> Operand -> m Operand)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Operand -> Operand -> m Operand)
-> Maybe (Operand -> Operand -> m Operand)
forall a. a -> Maybe a
Just ((Operand -> Operand -> m Operand)
 -> Maybe (Operand -> Operand -> m Operand))
-> (BinaryOp m -> Operand -> Operand -> m Operand)
-> BinaryOp m
-> Maybe (Operand -> Operand -> m Operand)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinaryOp m -> Operand -> Operand -> m Operand
forall (m :: * -> *). BinaryOp m -> Operand -> Operand -> m Operand
opFunction
generateBinaryOp Expr
expr =
  CodegenError -> m Operand
forall a. CodegenError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
E.throwError (CodegenError -> m Operand) -> CodegenError -> m Operand
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.UnsupportedDefinition Expr
expr

-- | Binary operation data type.
data BinaryOp m = BinaryOp
  { forall (m :: * -> *). BinaryOp m -> Operation
opMapping :: AT.Operation,
    forall (m :: * -> *). BinaryOp m -> Operand -> Operand -> m Operand
opFunction :: AST.Operand -> AST.Operand -> m AST.Operand
  }

-- | List of supported integer binary operators.
integerBinaryOperators :: (CS.MonadCodegen m) => [BinaryOp m]
integerBinaryOperators :: forall (m :: * -> *). MonadCodegen m => [BinaryOp m]
integerBinaryOperators =
  [ Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
forall (m :: * -> *).
Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
BinaryOp Operation
AT.Add Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Operand -> m Operand
I.add,
    Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
forall (m :: * -> *).
Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
BinaryOp Operation
AT.Sub Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Operand -> m Operand
I.sub,
    Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
forall (m :: * -> *).
Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
BinaryOp Operation
AT.Mul Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Operand -> m Operand
I.mul,
    Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
forall (m :: * -> *).
Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
BinaryOp Operation
AT.Div Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Operand -> m Operand
I.sdiv,
    Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
forall (m :: * -> *).
Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
BinaryOp Operation
AT.Mod Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Operand -> m Operand
I.srem,
    Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
forall (m :: * -> *).
Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
BinaryOp Operation
AT.BitAnd Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Operand -> m Operand
I.and,
    Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
forall (m :: * -> *).
Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
BinaryOp Operation
AT.BitOr Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Operand -> m Operand
I.or,
    Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
forall (m :: * -> *).
Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
BinaryOp Operation
AT.BitXor Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Operand -> m Operand
I.xor,
    Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
forall (m :: * -> *).
Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
BinaryOp Operation
AT.BitShl Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Operand -> m Operand
I.shl,
    Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
forall (m :: * -> *).
Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
BinaryOp Operation
AT.BitShr Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Operand -> m Operand
I.ashr,
    Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
forall (m :: * -> *).
Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
BinaryOp Operation
AT.And Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Operand -> m Operand
I.and,
    Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
forall (m :: * -> *).
Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
BinaryOp Operation
AT.Or Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Operand -> m Operand
I.or,
    Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
forall (m :: * -> *).
Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
BinaryOp Operation
AT.Lt ((Operand -> Operand -> m Operand) -> BinaryOp m)
-> (Operand -> Operand -> m Operand) -> BinaryOp m
forall a b. (a -> b) -> a -> b
$ IntegerPredicate -> Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
IntegerPredicate -> Operand -> Operand -> m Operand
I.icmp IntegerPredicate
IP.SLT,
    Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
forall (m :: * -> *).
Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
BinaryOp Operation
AT.Gt ((Operand -> Operand -> m Operand) -> BinaryOp m)
-> (Operand -> Operand -> m Operand) -> BinaryOp m
forall a b. (a -> b) -> a -> b
$ IntegerPredicate -> Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
IntegerPredicate -> Operand -> Operand -> m Operand
I.icmp IntegerPredicate
IP.SGT,
    Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
forall (m :: * -> *).
Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
BinaryOp Operation
AT.Lte ((Operand -> Operand -> m Operand) -> BinaryOp m)
-> (Operand -> Operand -> m Operand) -> BinaryOp m
forall a b. (a -> b) -> a -> b
$ IntegerPredicate -> Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
IntegerPredicate -> Operand -> Operand -> m Operand
I.icmp IntegerPredicate
IP.SLE,
    Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
forall (m :: * -> *).
Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
BinaryOp Operation
AT.Gte ((Operand -> Operand -> m Operand) -> BinaryOp m)
-> (Operand -> Operand -> m Operand) -> BinaryOp m
forall a b. (a -> b) -> a -> b
$ IntegerPredicate -> Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
IntegerPredicate -> Operand -> Operand -> m Operand
I.icmp IntegerPredicate
IP.SGE,
    Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
forall (m :: * -> *).
Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
BinaryOp Operation
AT.Eq ((Operand -> Operand -> m Operand) -> BinaryOp m)
-> (Operand -> Operand -> m Operand) -> BinaryOp m
forall a b. (a -> b) -> a -> b
$ IntegerPredicate -> Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
IntegerPredicate -> Operand -> Operand -> m Operand
I.icmp IntegerPredicate
IP.EQ,
    Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
forall (m :: * -> *).
Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
BinaryOp Operation
AT.Ne ((Operand -> Operand -> m Operand) -> BinaryOp m)
-> (Operand -> Operand -> m Operand) -> BinaryOp m
forall a b. (a -> b) -> a -> b
$ IntegerPredicate -> Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
IntegerPredicate -> Operand -> Operand -> m Operand
I.icmp IntegerPredicate
IP.NE
  ]

-- | List of supported floating-point binary operators.
floatingPointBinaryOperators :: (CS.MonadCodegen m) => [BinaryOp m]
floatingPointBinaryOperators :: forall (m :: * -> *). MonadCodegen m => [BinaryOp m]
floatingPointBinaryOperators =
  [ Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
forall (m :: * -> *).
Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
BinaryOp Operation
AT.Add Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Operand -> m Operand
I.fadd,
    Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
forall (m :: * -> *).
Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
BinaryOp Operation
AT.Sub Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Operand -> m Operand
I.fsub,
    Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
forall (m :: * -> *).
Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
BinaryOp Operation
AT.Mul Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Operand -> m Operand
I.fmul,
    Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
forall (m :: * -> *).
Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
BinaryOp Operation
AT.Div Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Operand -> m Operand
I.fdiv,
    Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
forall (m :: * -> *).
Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
BinaryOp Operation
AT.Mod Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Operand -> m Operand
I.frem,
    Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
forall (m :: * -> *).
Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
BinaryOp Operation
AT.Lt ((Operand -> Operand -> m Operand) -> BinaryOp m)
-> (Operand -> Operand -> m Operand) -> BinaryOp m
forall a b. (a -> b) -> a -> b
$ FloatingPointPredicate -> Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
FloatingPointPredicate -> Operand -> Operand -> m Operand
I.fcmp FloatingPointPredicate
FP.OLT,
    Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
forall (m :: * -> *).
Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
BinaryOp Operation
AT.Gt ((Operand -> Operand -> m Operand) -> BinaryOp m)
-> (Operand -> Operand -> m Operand) -> BinaryOp m
forall a b. (a -> b) -> a -> b
$ FloatingPointPredicate -> Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
FloatingPointPredicate -> Operand -> Operand -> m Operand
I.fcmp FloatingPointPredicate
FP.OGT,
    Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
forall (m :: * -> *).
Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
BinaryOp Operation
AT.Lte ((Operand -> Operand -> m Operand) -> BinaryOp m)
-> (Operand -> Operand -> m Operand) -> BinaryOp m
forall a b. (a -> b) -> a -> b
$ FloatingPointPredicate -> Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
FloatingPointPredicate -> Operand -> Operand -> m Operand
I.fcmp FloatingPointPredicate
FP.OLE,
    Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
forall (m :: * -> *).
Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
BinaryOp Operation
AT.Gte ((Operand -> Operand -> m Operand) -> BinaryOp m)
-> (Operand -> Operand -> m Operand) -> BinaryOp m
forall a b. (a -> b) -> a -> b
$ FloatingPointPredicate -> Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
FloatingPointPredicate -> Operand -> Operand -> m Operand
I.fcmp FloatingPointPredicate
FP.OGE,
    Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
forall (m :: * -> *).
Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
BinaryOp Operation
AT.Eq ((Operand -> Operand -> m Operand) -> BinaryOp m)
-> (Operand -> Operand -> m Operand) -> BinaryOp m
forall a b. (a -> b) -> a -> b
$ FloatingPointPredicate -> Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
FloatingPointPredicate -> Operand -> Operand -> m Operand
I.fcmp FloatingPointPredicate
FP.OEQ,
    Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
forall (m :: * -> *).
Operation -> (Operand -> Operand -> m Operand) -> BinaryOp m
BinaryOp Operation
AT.Ne ((Operand -> Operand -> m Operand) -> BinaryOp m)
-> (Operand -> Operand -> m Operand) -> BinaryOp m
forall a b. (a -> b) -> a -> b
$ FloatingPointPredicate -> Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
FloatingPointPredicate -> Operand -> Operand -> m Operand
I.fcmp FloatingPointPredicate
FP.ONE
  ]

-- | Unary operation data type.
data UnaryOp m = UnaryOp
  { forall (m :: * -> *). UnaryOp m -> UnaryOperation
unaryMapping :: AT.UnaryOperation,
    forall (m :: * -> *). UnaryOp m -> Operand -> m Operand
unaryFunction :: AST.Operand -> m AST.Operand
  }

-- | Generate LLVM code for unary operations.
generateUnaryOp :: (CS.MonadCodegen m, EG.ExprGen AT.Expr) => AT.Expr -> m AST.Operand
generateUnaryOp :: forall (m :: * -> *).
(MonadCodegen m, ExprGen Expr) =>
Expr -> m Operand
generateUnaryOp (AT.UnaryOp SrcLoc
loc UnaryOperation
op Expr
expr) = do
  Operand
operand <- Expr -> m Operand
forall a (m :: * -> *).
(ExprGen a, MonadCodegen m) =>
a -> m Operand
forall (m :: * -> *). MonadCodegen m => Expr -> m Operand
EG.generateExpr Expr
expr
  case UnaryOperation -> Maybe (Operand -> m Operand)
forall {m :: * -> *}.
(MonadIRBuilder m, MonadModuleBuilder m, MonadFix m,
 MonadState CodegenState m, MonadError CodegenError m) =>
UnaryOperation -> Maybe (Operand -> m Operand)
findOperator UnaryOperation
op of
    Just Operand -> m Operand
f -> Operand -> m Operand
f Operand
operand
    Maybe (Operand -> m Operand)
Nothing -> CodegenError -> m Operand
forall a. CodegenError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
E.throwError (CodegenError -> m Operand) -> CodegenError -> m Operand
forall a b. (a -> b) -> a -> b
$ SrcLoc -> CodegenErrorType -> CodegenError
CC.CodegenError SrcLoc
loc (CodegenErrorType -> CodegenError)
-> CodegenErrorType -> CodegenError
forall a b. (a -> b) -> a -> b
$ UnaryOperation -> CodegenErrorType
CC.UnsupportedUnaryOperator UnaryOperation
op
  where
    findOperator :: UnaryOperation -> Maybe (Operand -> m Operand)
findOperator UnaryOperation
op' = (UnaryOp m -> Bool) -> [UnaryOp m] -> Maybe (UnaryOp m)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find ((UnaryOperation -> UnaryOperation -> Bool
forall a. Eq a => a -> a -> Bool
== UnaryOperation
op') (UnaryOperation -> Bool)
-> (UnaryOp m -> UnaryOperation) -> UnaryOp m -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnaryOp m -> UnaryOperation
forall (m :: * -> *). UnaryOp m -> UnaryOperation
unaryMapping) (SrcLoc -> [UnaryOp m]
forall (m :: * -> *). MonadCodegen m => SrcLoc -> [UnaryOp m]
unaryOperators SrcLoc
loc) Maybe (UnaryOp m)
-> (UnaryOp m -> Maybe (Operand -> m Operand))
-> Maybe (Operand -> m Operand)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Operand -> m Operand) -> Maybe (Operand -> m Operand)
forall a. a -> Maybe a
Just ((Operand -> m Operand) -> Maybe (Operand -> m Operand))
-> (UnaryOp m -> Operand -> m Operand)
-> UnaryOp m
-> Maybe (Operand -> m Operand)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnaryOp m -> Operand -> m Operand
forall (m :: * -> *). UnaryOp m -> Operand -> m Operand
unaryFunction
generateUnaryOp Expr
expr =
  CodegenError -> m Operand
forall a. CodegenError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
E.throwError (CodegenError -> m Operand) -> CodegenError -> m Operand
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.UnsupportedDefinition Expr
expr

-- | List of supported unary operators.
unaryOperators :: (CS.MonadCodegen m) => AT.SrcLoc -> [UnaryOp m]
unaryOperators :: forall (m :: * -> *). MonadCodegen m => SrcLoc -> [UnaryOp m]
unaryOperators SrcLoc
loc =
  [ UnaryOperation -> (Operand -> m Operand) -> UnaryOp m
forall (m :: * -> *).
UnaryOperation -> (Operand -> m Operand) -> UnaryOp m
UnaryOp UnaryOperation
AT.PreInc ((Operand -> m Operand) -> UnaryOp m)
-> (Operand -> m Operand) -> UnaryOp m
forall a b. (a -> b) -> a -> b
$ SrcLoc -> Operand -> m Operand
forall (m :: * -> *).
MonadCodegen m =>
SrcLoc -> Operand -> m Operand
handlePreInc SrcLoc
loc,
    UnaryOperation -> (Operand -> m Operand) -> UnaryOp m
forall (m :: * -> *).
UnaryOperation -> (Operand -> m Operand) -> UnaryOp m
UnaryOp UnaryOperation
AT.PreDec ((Operand -> m Operand) -> UnaryOp m)
-> (Operand -> m Operand) -> UnaryOp m
forall a b. (a -> b) -> a -> b
$ SrcLoc -> Operand -> m Operand
forall (m :: * -> *).
MonadCodegen m =>
SrcLoc -> Operand -> m Operand
handlePreDec SrcLoc
loc,
    UnaryOperation -> (Operand -> m Operand) -> UnaryOp m
forall (m :: * -> *).
UnaryOperation -> (Operand -> m Operand) -> UnaryOp m
UnaryOp UnaryOperation
AT.PostInc ((Operand -> m Operand) -> UnaryOp m)
-> (Operand -> m Operand) -> UnaryOp m
forall a b. (a -> b) -> a -> b
$ SrcLoc -> Operand -> m Operand
forall (m :: * -> *).
MonadCodegen m =>
SrcLoc -> Operand -> m Operand
handlePostInc SrcLoc
loc,
    UnaryOperation -> (Operand -> m Operand) -> UnaryOp m
forall (m :: * -> *).
UnaryOperation -> (Operand -> m Operand) -> UnaryOp m
UnaryOp UnaryOperation
AT.PostDec ((Operand -> m Operand) -> UnaryOp m)
-> (Operand -> m Operand) -> UnaryOp m
forall a b. (a -> b) -> a -> b
$ SrcLoc -> Operand -> m Operand
forall (m :: * -> *).
MonadCodegen m =>
SrcLoc -> Operand -> m Operand
handlePostDec SrcLoc
loc,
    UnaryOperation -> (Operand -> m Operand) -> UnaryOp m
forall (m :: * -> *).
UnaryOperation -> (Operand -> m Operand) -> UnaryOp m
UnaryOp UnaryOperation
AT.Not ((Operand -> m Operand) -> UnaryOp m)
-> (Operand -> m Operand) -> UnaryOp m
forall a b. (a -> b) -> a -> b
$ SrcLoc -> Operand -> m Operand
forall (m :: * -> *).
MonadCodegen m =>
SrcLoc -> Operand -> m Operand
handleNot SrcLoc
loc,
    UnaryOperation -> (Operand -> m Operand) -> UnaryOp m
forall (m :: * -> *).
UnaryOperation -> (Operand -> m Operand) -> UnaryOp m
UnaryOp UnaryOperation
AT.BitNot ((Operand -> m Operand) -> UnaryOp m)
-> (Operand -> m Operand) -> UnaryOp m
forall a b. (a -> b) -> a -> b
$ SrcLoc -> Operand -> m Operand
forall (m :: * -> *).
MonadCodegen m =>
SrcLoc -> Operand -> m Operand
handleBitNot SrcLoc
loc,
    UnaryOperation -> (Operand -> m Operand) -> UnaryOp m
forall (m :: * -> *).
UnaryOperation -> (Operand -> m Operand) -> UnaryOp m
UnaryOp UnaryOperation
AT.Deref ((Operand -> m Operand) -> UnaryOp m)
-> (Operand -> m Operand) -> UnaryOp m
forall a b. (a -> b) -> a -> b
$ SrcLoc -> Operand -> m Operand
forall (m :: * -> *).
MonadCodegen m =>
SrcLoc -> Operand -> m Operand
handleDeref SrcLoc
loc,
    UnaryOperation -> (Operand -> m Operand) -> UnaryOp m
forall (m :: * -> *).
UnaryOperation -> (Operand -> m Operand) -> UnaryOp m
UnaryOp UnaryOperation
AT.AddrOf ((Operand -> m Operand) -> UnaryOp m)
-> (Operand -> m Operand) -> UnaryOp m
forall a b. (a -> b) -> a -> b
$ SrcLoc -> Operand -> m Operand
forall (m :: * -> *).
MonadCodegen m =>
SrcLoc -> Operand -> m Operand
handleAddrOf SrcLoc
loc
  ]

-- | Handle pre-increment unary operator.
handlePreInc :: (CS.MonadCodegen m) => AT.SrcLoc -> AST.Operand -> m AST.Operand
handlePreInc :: forall (m :: * -> *).
MonadCodegen m =>
SrcLoc -> Operand -> m Operand
handlePreInc SrcLoc
loc Operand
operand =
  case Operand -> Type
forall a. Typed a => a -> Type
TD.typeOf Operand
operand of
    T.PointerType Type
_ AddrSpace
_ -> do
      Operand
val <- Operand -> Word32 -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Word32 -> m Operand
I.load Operand
operand Word32
0
      Operand
newVal <- Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Operand -> m Operand
I.add Operand
val (Constant -> Operand
AST.ConstantOperand (Constant -> Operand) -> Constant -> Operand
forall a b. (a -> b) -> a -> b
$ Word32 -> Integer -> Constant
C.Int Word32
32 Integer
1)
      Operand -> Word32 -> Operand -> m ()
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Word32 -> Operand -> m ()
I.store Operand
operand Word32
0 Operand
newVal
      Operand -> m Operand
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Operand
newVal
    T.IntegerType Word32
bits ->
      Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Operand -> m Operand
I.add Operand
operand (Constant -> Operand
AST.ConstantOperand (Constant -> Operand) -> Constant -> Operand
forall a b. (a -> b) -> a -> b
$ Word32 -> Integer -> Constant
C.Int Word32
bits Integer
1)
    T.FloatingPointType FloatingPointType
T.FloatFP ->
      Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Operand -> m Operand
I.fadd Operand
operand (Constant -> Operand
AST.ConstantOperand (Constant -> Operand) -> Constant -> Operand
forall a b. (a -> b) -> a -> b
$ SomeFloat -> Constant
C.Float (SomeFloat -> Constant) -> SomeFloat -> Constant
forall a b. (a -> b) -> a -> b
$ Float -> SomeFloat
FF.Single Float
1.0)
    T.FloatingPointType FloatingPointType
T.DoubleFP ->
      Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Operand -> m Operand
I.fadd Operand
operand (Constant -> Operand
AST.ConstantOperand (Constant -> Operand) -> Constant -> Operand
forall a b. (a -> b) -> a -> b
$ SomeFloat -> Constant
C.Float (SomeFloat -> Constant) -> SomeFloat -> Constant
forall a b. (a -> b) -> a -> b
$ Double -> SomeFloat
FF.Double Double
1.0)
    Type
_ -> CodegenError -> m Operand
forall a. CodegenError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
E.throwError (CodegenError -> m Operand) -> CodegenError -> m Operand
forall a b. (a -> b) -> a -> b
$ SrcLoc -> CodegenErrorType -> CodegenError
CC.CodegenError SrcLoc
loc (CodegenErrorType -> CodegenError)
-> CodegenErrorType -> CodegenError
forall a b. (a -> b) -> a -> b
$ UnaryOperation -> CodegenErrorType
CC.UnsupportedUnaryOperator UnaryOperation
AT.PreInc

-- | Handle pre-decrement unary operator.
handlePreDec :: (CS.MonadCodegen m) => AT.SrcLoc -> AST.Operand -> m AST.Operand
handlePreDec :: forall (m :: * -> *).
MonadCodegen m =>
SrcLoc -> Operand -> m Operand
handlePreDec SrcLoc
loc Operand
operand =
  case Operand -> Type
forall a. Typed a => a -> Type
TD.typeOf Operand
operand of
    T.PointerType Type
_ AddrSpace
_ -> do
      Operand
val <- Operand -> Word32 -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Word32 -> m Operand
I.load Operand
operand Word32
0
      Operand
newVal <- Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Operand -> m Operand
I.sub Operand
val (Constant -> Operand
AST.ConstantOperand (Constant -> Operand) -> Constant -> Operand
forall a b. (a -> b) -> a -> b
$ Word32 -> Integer -> Constant
C.Int Word32
32 Integer
1)
      Operand -> Word32 -> Operand -> m ()
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Word32 -> Operand -> m ()
I.store Operand
operand Word32
0 Operand
newVal
      Operand -> m Operand
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Operand
newVal
    T.IntegerType Word32
bits ->
      Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Operand -> m Operand
I.sub Operand
operand (Constant -> Operand
AST.ConstantOperand (Constant -> Operand) -> Constant -> Operand
forall a b. (a -> b) -> a -> b
$ Word32 -> Integer -> Constant
C.Int Word32
bits Integer
1)
    T.FloatingPointType FloatingPointType
T.FloatFP ->
      Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Operand -> m Operand
I.fsub Operand
operand (Constant -> Operand
AST.ConstantOperand (Constant -> Operand) -> Constant -> Operand
forall a b. (a -> b) -> a -> b
$ SomeFloat -> Constant
C.Float (SomeFloat -> Constant) -> SomeFloat -> Constant
forall a b. (a -> b) -> a -> b
$ Float -> SomeFloat
FF.Single Float
1.0)
    T.FloatingPointType FloatingPointType
T.DoubleFP ->
      Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Operand -> m Operand
I.fsub Operand
operand (Constant -> Operand
AST.ConstantOperand (Constant -> Operand) -> Constant -> Operand
forall a b. (a -> b) -> a -> b
$ SomeFloat -> Constant
C.Float (SomeFloat -> Constant) -> SomeFloat -> Constant
forall a b. (a -> b) -> a -> b
$ Double -> SomeFloat
FF.Double Double
1.0)
    Type
_ -> CodegenError -> m Operand
forall a. CodegenError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
E.throwError (CodegenError -> m Operand) -> CodegenError -> m Operand
forall a b. (a -> b) -> a -> b
$ SrcLoc -> CodegenErrorType -> CodegenError
CC.CodegenError SrcLoc
loc (CodegenErrorType -> CodegenError)
-> CodegenErrorType -> CodegenError
forall a b. (a -> b) -> a -> b
$ UnaryOperation -> CodegenErrorType
CC.UnsupportedUnaryOperator UnaryOperation
AT.PreDec

-- | Handle post-increment unary operator.
handlePostInc :: (CS.MonadCodegen m) => AT.SrcLoc -> AST.Operand -> m AST.Operand
handlePostInc :: forall (m :: * -> *).
MonadCodegen m =>
SrcLoc -> Operand -> m Operand
handlePostInc SrcLoc
loc Operand
operand =
  case Operand -> Type
forall a. Typed a => a -> Type
TD.typeOf Operand
operand of
    T.PointerType Type
_ AddrSpace
_ -> do
      Operand
oldVal <- Operand -> Word32 -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Word32 -> m Operand
I.load Operand
operand Word32
0
      Operand
newVal <- Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Operand -> m Operand
I.add Operand
oldVal (Constant -> Operand
AST.ConstantOperand (Constant -> Operand) -> Constant -> Operand
forall a b. (a -> b) -> a -> b
$ Word32 -> Integer -> Constant
C.Int Word32
32 Integer
1)
      Operand -> Word32 -> Operand -> m ()
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Word32 -> Operand -> m ()
I.store Operand
operand Word32
0 Operand
newVal
      Operand -> m Operand
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Operand
oldVal
    T.IntegerType Word32
bits -> do
      let oldVal :: Operand
oldVal = Operand
operand
      Operand
_ <- Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Operand -> m Operand
I.add Operand
operand (Constant -> Operand
AST.ConstantOperand (Constant -> Operand) -> Constant -> Operand
forall a b. (a -> b) -> a -> b
$ Word32 -> Integer -> Constant
C.Int Word32
bits Integer
1)
      Operand -> m Operand
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Operand
oldVal
    T.FloatingPointType FloatingPointType
T.FloatFP -> do
      let oldVal :: Operand
oldVal = Operand
operand
      Operand
_ <- Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Operand -> m Operand
I.fadd Operand
operand (Constant -> Operand
AST.ConstantOperand (Constant -> Operand) -> Constant -> Operand
forall a b. (a -> b) -> a -> b
$ SomeFloat -> Constant
C.Float (SomeFloat -> Constant) -> SomeFloat -> Constant
forall a b. (a -> b) -> a -> b
$ Float -> SomeFloat
FF.Single Float
1.0)
      Operand -> m Operand
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Operand
oldVal
    T.FloatingPointType FloatingPointType
T.DoubleFP -> do
      let oldVal :: Operand
oldVal = Operand
operand
      Operand
_ <- Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Operand -> m Operand
I.fadd Operand
operand (Constant -> Operand
AST.ConstantOperand (Constant -> Operand) -> Constant -> Operand
forall a b. (a -> b) -> a -> b
$ SomeFloat -> Constant
C.Float (SomeFloat -> Constant) -> SomeFloat -> Constant
forall a b. (a -> b) -> a -> b
$ Double -> SomeFloat
FF.Double Double
1.0)
      Operand -> m Operand
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Operand
oldVal
    Type
_ -> CodegenError -> m Operand
forall a. CodegenError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
E.throwError (CodegenError -> m Operand) -> CodegenError -> m Operand
forall a b. (a -> b) -> a -> b
$ SrcLoc -> CodegenErrorType -> CodegenError
CC.CodegenError SrcLoc
loc (CodegenErrorType -> CodegenError)
-> CodegenErrorType -> CodegenError
forall a b. (a -> b) -> a -> b
$ UnaryOperation -> CodegenErrorType
CC.UnsupportedUnaryOperator UnaryOperation
AT.PostInc

-- | Handle post-decrement unary operator.
handlePostDec :: (CS.MonadCodegen m) => AT.SrcLoc -> AST.Operand -> m AST.Operand
handlePostDec :: forall (m :: * -> *).
MonadCodegen m =>
SrcLoc -> Operand -> m Operand
handlePostDec SrcLoc
loc Operand
operand =
  case Operand -> Type
forall a. Typed a => a -> Type
TD.typeOf Operand
operand of
    T.PointerType Type
_ AddrSpace
_ -> do
      Operand
oldVal <- Operand -> Word32 -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Word32 -> m Operand
I.load Operand
operand Word32
0
      Operand
newVal <- Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Operand -> m Operand
I.sub Operand
oldVal (Constant -> Operand
AST.ConstantOperand (Constant -> Operand) -> Constant -> Operand
forall a b. (a -> b) -> a -> b
$ Word32 -> Integer -> Constant
C.Int Word32
32 Integer
1)
      Operand -> Word32 -> Operand -> m ()
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Word32 -> Operand -> m ()
I.store Operand
operand Word32
0 Operand
newVal
      Operand -> m Operand
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Operand
oldVal
    T.IntegerType Word32
bits -> do
      let oldVal :: Operand
oldVal = Operand
operand
      Operand
_ <- Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Operand -> m Operand
I.sub Operand
operand (Constant -> Operand
AST.ConstantOperand (Constant -> Operand) -> Constant -> Operand
forall a b. (a -> b) -> a -> b
$ Word32 -> Integer -> Constant
C.Int Word32
bits Integer
1)
      Operand -> m Operand
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Operand
oldVal
    T.FloatingPointType FloatingPointType
T.FloatFP -> do
      let oldVal :: Operand
oldVal = Operand
operand
      Operand
_ <- Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Operand -> m Operand
I.fsub Operand
operand (Constant -> Operand
AST.ConstantOperand (Constant -> Operand) -> Constant -> Operand
forall a b. (a -> b) -> a -> b
$ SomeFloat -> Constant
C.Float (SomeFloat -> Constant) -> SomeFloat -> Constant
forall a b. (a -> b) -> a -> b
$ Float -> SomeFloat
FF.Single Float
1.0)
      Operand -> m Operand
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Operand
oldVal
    T.FloatingPointType FloatingPointType
T.DoubleFP -> do
      let oldVal :: Operand
oldVal = Operand
operand
      Operand
_ <- Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Operand -> m Operand
I.fsub Operand
operand (Constant -> Operand
AST.ConstantOperand (Constant -> Operand) -> Constant -> Operand
forall a b. (a -> b) -> a -> b
$ SomeFloat -> Constant
C.Float (SomeFloat -> Constant) -> SomeFloat -> Constant
forall a b. (a -> b) -> a -> b
$ Double -> SomeFloat
FF.Double Double
1.0)
      Operand -> m Operand
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Operand
oldVal
    Type
_ -> CodegenError -> m Operand
forall a. CodegenError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
E.throwError (CodegenError -> m Operand) -> CodegenError -> m Operand
forall a b. (a -> b) -> a -> b
$ SrcLoc -> CodegenErrorType -> CodegenError
CC.CodegenError SrcLoc
loc (CodegenErrorType -> CodegenError)
-> CodegenErrorType -> CodegenError
forall a b. (a -> b) -> a -> b
$ UnaryOperation -> CodegenErrorType
CC.UnsupportedUnaryOperator UnaryOperation
AT.PostDec

-- | Handle not unary operator.
handleNot :: (CS.MonadCodegen m) => AT.SrcLoc -> AST.Operand -> m AST.Operand
handleNot :: forall (m :: * -> *).
MonadCodegen m =>
SrcLoc -> Operand -> m Operand
handleNot SrcLoc
loc Operand
operand =
  let operandType :: Type
operandType = Operand -> Type
forall a. Typed a => a -> Type
TD.typeOf Operand
operand
   in case Type
operandType of
        T.PointerType Type
_ AddrSpace
_ ->
          IntegerPredicate -> Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
IntegerPredicate -> Operand -> Operand -> m Operand
I.icmp IntegerPredicate
IP.EQ Operand
operand (Constant -> Operand
AST.ConstantOperand (Constant -> Operand) -> Constant -> Operand
forall a b. (a -> b) -> a -> b
$ Type -> Constant
C.Null Type
operandType)
        T.IntegerType Word32
_ ->
          Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Operand -> m Operand
I.xor Operand
operand (Constant -> Operand
AST.ConstantOperand (Constant -> Operand) -> Constant -> Operand
forall a b. (a -> b) -> a -> b
$ Word32 -> Integer -> Constant
C.Int Word32
32 (-Integer
1))
        T.FloatingPointType FloatingPointType
T.FloatFP ->
          FloatingPointPredicate -> Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
FloatingPointPredicate -> Operand -> Operand -> m Operand
I.fcmp FloatingPointPredicate
FP.OEQ Operand
operand (Constant -> Operand
AST.ConstantOperand (Constant -> Operand) -> Constant -> Operand
forall a b. (a -> b) -> a -> b
$ SomeFloat -> Constant
C.Float (SomeFloat -> Constant) -> SomeFloat -> Constant
forall a b. (a -> b) -> a -> b
$ Float -> SomeFloat
FF.Single Float
0.0)
        T.FloatingPointType FloatingPointType
T.DoubleFP ->
          FloatingPointPredicate -> Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
FloatingPointPredicate -> Operand -> Operand -> m Operand
I.fcmp FloatingPointPredicate
FP.OEQ Operand
operand (Constant -> Operand
AST.ConstantOperand (Constant -> Operand) -> Constant -> Operand
forall a b. (a -> b) -> a -> b
$ SomeFloat -> Constant
C.Float (SomeFloat -> Constant) -> SomeFloat -> Constant
forall a b. (a -> b) -> a -> b
$ Double -> SomeFloat
FF.Double Double
0.0)
        Type
_ -> CodegenError -> m Operand
forall a. CodegenError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
E.throwError (CodegenError -> m Operand) -> CodegenError -> m Operand
forall a b. (a -> b) -> a -> b
$ SrcLoc -> CodegenErrorType -> CodegenError
CC.CodegenError SrcLoc
loc (CodegenErrorType -> CodegenError)
-> CodegenErrorType -> CodegenError
forall a b. (a -> b) -> a -> b
$ UnaryOperation -> CodegenErrorType
CC.UnsupportedUnaryOperator UnaryOperation
AT.Not

-- | Handle bit-not unary operator.
handleBitNot :: (CS.MonadCodegen m) => AT.SrcLoc -> AST.Operand -> m AST.Operand
handleBitNot :: forall (m :: * -> *).
MonadCodegen m =>
SrcLoc -> Operand -> m Operand
handleBitNot SrcLoc
loc Operand
operand =
  case Operand -> Type
forall a. Typed a => a -> Type
TD.typeOf Operand
operand of
    T.IntegerType Word32
bits ->
      Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Operand -> m Operand
I.xor Operand
operand (Constant -> Operand
AST.ConstantOperand (Constant -> Operand) -> Constant -> Operand
forall a b. (a -> b) -> a -> b
$ Word32 -> Integer -> Constant
C.Int Word32
bits (-Integer
1))
    T.FloatingPointType FloatingPointType
T.FloatFP -> do
      Operand
intValue <- Operand -> Type -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Type -> m Operand
I.bitcast Operand
operand (Word32 -> Type
T.IntegerType Word32
32)
      Operand
notted <- Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Operand -> m Operand
I.xor Operand
intValue (Constant -> Operand
AST.ConstantOperand (Constant -> Operand) -> Constant -> Operand
forall a b. (a -> b) -> a -> b
$ Word32 -> Integer -> Constant
C.Int Word32
32 (-Integer
1))
      Operand -> Type -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Type -> m Operand
I.bitcast Operand
notted (FloatingPointType -> Type
T.FloatingPointType FloatingPointType
T.FloatFP)
    T.FloatingPointType FloatingPointType
T.DoubleFP -> do
      Operand
intValue <- Operand -> Type -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Type -> m Operand
I.bitcast Operand
operand (Word32 -> Type
T.IntegerType Word32
64)
      Operand
notted <- Operand -> Operand -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Operand -> m Operand
I.xor Operand
intValue (Constant -> Operand
AST.ConstantOperand (Constant -> Operand) -> Constant -> Operand
forall a b. (a -> b) -> a -> b
$ Word32 -> Integer -> Constant
C.Int Word32
64 (-Integer
1))
      Operand -> Type -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Type -> m Operand
I.bitcast Operand
notted (FloatingPointType -> Type
T.FloatingPointType FloatingPointType
T.DoubleFP)
    Type
_ -> CodegenError -> m Operand
forall a. CodegenError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
E.throwError (CodegenError -> m Operand) -> CodegenError -> m Operand
forall a b. (a -> b) -> a -> b
$ SrcLoc -> CodegenErrorType -> CodegenError
CC.CodegenError SrcLoc
loc (CodegenErrorType -> CodegenError)
-> CodegenErrorType -> CodegenError
forall a b. (a -> b) -> a -> b
$ UnaryOperation -> CodegenErrorType
CC.UnsupportedUnaryOperator UnaryOperation
AT.BitNot

-- | Handle dereference unary operator.
handleDeref :: (CS.MonadCodegen m) => AT.SrcLoc -> AST.Operand -> m AST.Operand
handleDeref :: forall (m :: * -> *).
MonadCodegen m =>
SrcLoc -> Operand -> m Operand
handleDeref SrcLoc
_ Operand
operand = Operand -> Word32 -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Word32 -> m Operand
I.load Operand
operand Word32
0

-- | Handle address-of unary operator.
handleAddrOf :: (CS.MonadCodegen m) => AT.SrcLoc -> AST.Operand -> m AST.Operand
handleAddrOf :: forall (m :: * -> *).
MonadCodegen m =>
SrcLoc -> Operand -> m Operand
handleAddrOf SrcLoc
_ Operand
operand = do
  Operand
ptr <- Type -> Maybe Operand -> Word32 -> m Operand
forall (m :: * -> *).
MonadIRBuilder m =>
Type -> Maybe Operand -> Word32 -> m Operand
I.alloca (Operand -> Type
forall a. Typed a => a -> Type
TD.typeOf Operand
operand) Maybe Operand
forall a. Maybe a
Nothing Word32
0
  Operand -> Word32 -> Operand -> m ()
forall (m :: * -> *).
MonadIRBuilder m =>
Operand -> Word32 -> Operand -> m ()
I.store Operand
ptr Word32
0 Operand
operand
  Operand -> m Operand
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Operand
ptr