summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--codegen.hs36
1 files changed, 14 insertions, 22 deletions
diff --git a/codegen.hs b/codegen.hs
index 93b8c1f..bee7c49 100644
--- a/codegen.hs
+++ b/codegen.hs
@@ -406,6 +406,9 @@ pointerArith eptr eint inttypeconstr = do
(toLLVMType ptrtype) []
return $ A.LocalReference (toLLVMType ptrtype) (A.Name res)
+makeLocRef :: Type -> CGMonad LLName -> CGMonad A.Operand
+makeLocRef t = liftM $ A.LocalReference (toLLVMType t) . A.Name
+
genExpression :: Expression -> CGMonad A.Operand
genExpression (ExLit lit (Just t)) = literalToOperand lit t
genExpression (ExBinOp bo e1 e2 (Just t)) = do
@@ -418,7 +421,7 @@ genExpression (ExBinOp bo e1 e2 (Just t)) = do
_ -> do
e1op <- genExprArgument e1 >>= flip castOperand t
e2op <- genExprArgument e2 >>= flip castOperand t
- label <- case t of
+ makeLocRef t $ case t of
(TypeInt _) -> addInstr $ A.Add False False e1op e2op []
(TypeUInt _) -> addInstr $ A.Add False False e1op e2op []
TypeFloat -> addInstr $ A.FAdd A.NoFastMathFlags e1op e2op []
@@ -427,7 +430,6 @@ genExpression (ExBinOp bo e1 e2 (Just t)) = do
(TypeFunc _ _) -> throwError $ "Plus '+' operator not defined on function pointers"
(TypeName _) -> undefined
TypeVoid -> undefined
- return $ A.LocalReference (toLLVMType t) (A.Name label)
Minus -> let exneg e ty = ExUnOp Negate e (Just ty)
in case (fromJust (exTypeOf e1), fromJust (exTypeOf e2)) of
(TypePtr _, it@(TypeInt _)) -> pointerArith e1 (exneg e2 it) TypeInt
@@ -437,7 +439,7 @@ genExpression (ExBinOp bo e1 e2 (Just t)) = do
_ -> do
e1op <- genExprArgument e1 >>= flip castOperand t
e2op <- genExprArgument e2 >>= flip castOperand t
- label <- case t of
+ makeLocRef t $ case t of
(TypeInt _) -> addInstr $ A.Sub False False e1op e2op []
(TypeUInt _) -> addInstr $ A.Sub False False e1op e2op []
TypeFloat -> addInstr $ A.FSub A.NoFastMathFlags e1op e2op []
@@ -446,11 +448,10 @@ genExpression (ExBinOp bo e1 e2 (Just t)) = do
(TypeFunc _ _) -> throwError $ "Minus '-' operator not defined on function pointers"
(TypeName _) -> undefined
TypeVoid -> undefined
- return $ A.LocalReference (toLLVMType t) (A.Name label)
Times -> do
e1op <- genExprArgument e1 >>= flip castOperand t
e2op <- genExprArgument e2 >>= flip castOperand t
- label <- case t of
+ makeLocRef t $ case t of
(TypeInt _) -> addInstr $ A.Mul False False e1op e2op []
(TypeUInt _) -> addInstr $ A.Mul False False e1op e2op []
TypeFloat -> addInstr $ A.FMul A.NoFastMathFlags e1op e2op []
@@ -459,11 +460,10 @@ genExpression (ExBinOp bo e1 e2 (Just t)) = do
(TypeFunc _ _) -> throwError $ "Multiply '*' operator not defined on function pointers"
(TypeName _) -> undefined
TypeVoid -> undefined
- return $ A.LocalReference (toLLVMType t) (A.Name label)
Divide -> do
e1op <- genExprArgument e1 >>= flip castOperand t
e2op <- genExprArgument e2 >>= flip castOperand t
- label <- case t of
+ makeLocRef t $ case t of
(TypeInt _) -> addInstr $ A.SDiv False e1op e2op []
(TypeUInt _) -> addInstr $ A.UDiv False e1op e2op []
TypeFloat -> addInstr $ A.FDiv A.NoFastMathFlags e1op e2op []
@@ -472,11 +472,10 @@ genExpression (ExBinOp bo e1 e2 (Just t)) = do
(TypeFunc _ _) -> throwError $ "Divide '/' operator not defined on function pointers"
(TypeName _) -> undefined
TypeVoid -> undefined
- return $ A.LocalReference (toLLVMType t) (A.Name label)
Modulo -> do
e1op <- genExprArgument e1 >>= flip castOperand t
e2op <- genExprArgument e2 >>= flip castOperand t
- label <- case t of
+ makeLocRef t $ case t of
(TypeInt _) -> addInstr $ A.SRem e1op e2op []
(TypeUInt _) -> addInstr $ A.URem e1op e2op []
TypeFloat -> addInstr $ A.FRem A.NoFastMathFlags e1op e2op []
@@ -485,12 +484,11 @@ genExpression (ExBinOp bo e1 e2 (Just t)) = do
(TypeFunc _ _) -> throwError $ "Modulo '%' operator not defined on function pointers"
(TypeName _) -> undefined
TypeVoid -> undefined
- return $ A.LocalReference (toLLVMType t) (A.Name label)
Equal -> do
sharedType <- commonTypeM (fromJust (exTypeOf e1)) (fromJust (exTypeOf e2))
e1op <- genExprArgument e1 >>= flip castOperand sharedType
e2op <- genExprArgument e2 >>= flip castOperand sharedType
- label <- case sharedType of
+ makeLocRef (TypeInt 1) $ case sharedType of
(TypeInt _) -> addInstr $ A.ICmp A.IP.EQ e1op e2op []
(TypeUInt _) -> addInstr $ A.ICmp A.IP.EQ e1op e2op []
TypeFloat -> addInstr $ A.FCmp A.FPP.OEQ e1op e2op []
@@ -499,12 +497,11 @@ genExpression (ExBinOp bo e1 e2 (Just t)) = do
(TypeFunc _ _) -> addInstr $ A.ICmp A.IP.EQ e1op e2op []
(TypeName _) -> undefined
TypeVoid -> undefined
- return $ A.LocalReference (A.IntegerType 1) (A.Name label)
Unequal -> do
sharedType <- commonTypeM (fromJust (exTypeOf e1)) (fromJust (exTypeOf e2))
e1op <- genExprArgument e1 >>= flip castOperand sharedType
e2op <- genExprArgument e2 >>= flip castOperand sharedType
- label <- case sharedType of
+ makeLocRef (TypeInt 1) $ case sharedType of
(TypeInt _) -> addInstr $ A.ICmp A.IP.NE e1op e2op []
(TypeUInt _) -> addInstr $ A.ICmp A.IP.NE e1op e2op []
TypeFloat -> addInstr $ A.FCmp A.FPP.ONE e1op e2op []
@@ -513,12 +510,11 @@ genExpression (ExBinOp bo e1 e2 (Just t)) = do
(TypeFunc _ _) -> addInstr $ A.ICmp A.IP.NE e1op e2op []
(TypeName _) -> undefined
TypeVoid -> undefined
- return $ A.LocalReference (A.IntegerType 1) (A.Name label)
Greater -> do
sharedType <- commonTypeM (fromJust (exTypeOf e1)) (fromJust (exTypeOf e2))
e1op <- genExprArgument e1 >>= flip castOperand sharedType
e2op <- genExprArgument e2 >>= flip castOperand sharedType
- label <- case sharedType of
+ makeLocRef (TypeInt 1) $ case sharedType of
(TypeInt _) -> addInstr $ A.ICmp A.IP.SGT e1op e2op []
(TypeUInt _) -> addInstr $ A.ICmp A.IP.UGT e1op e2op []
TypeFloat -> addInstr $ A.FCmp A.FPP.OGT e1op e2op []
@@ -527,12 +523,11 @@ genExpression (ExBinOp bo e1 e2 (Just t)) = do
(TypeFunc _ _) -> addInstr $ A.ICmp A.IP.UGT e1op e2op []
(TypeName _) -> undefined
TypeVoid -> undefined
- return $ A.LocalReference (A.IntegerType 1) (A.Name label)
Less -> do
sharedType <- commonTypeM (fromJust (exTypeOf e1)) (fromJust (exTypeOf e2))
e1op <- genExprArgument e1 >>= flip castOperand sharedType
e2op <- genExprArgument e2 >>= flip castOperand sharedType
- label <- case sharedType of
+ makeLocRef (TypeInt 1) $ case sharedType of
(TypeInt _) -> addInstr $ A.ICmp A.IP.SLT e1op e2op []
(TypeUInt _) -> addInstr $ A.ICmp A.IP.ULT e1op e2op []
TypeFloat -> addInstr $ A.FCmp A.FPP.OLT e1op e2op []
@@ -541,12 +536,11 @@ genExpression (ExBinOp bo e1 e2 (Just t)) = do
(TypeFunc _ _) -> addInstr $ A.ICmp A.IP.ULT e1op e2op []
(TypeName _) -> undefined
TypeVoid -> undefined
- return $ A.LocalReference (A.IntegerType 1) (A.Name label)
GEqual -> do
sharedType <- commonTypeM (fromJust (exTypeOf e1)) (fromJust (exTypeOf e2))
e1op <- genExprArgument e1 >>= flip castOperand sharedType
e2op <- genExprArgument e2 >>= flip castOperand sharedType
- label <- case sharedType of
+ makeLocRef (TypeInt 1) $ case sharedType of
(TypeInt _) -> addInstr $ A.ICmp A.IP.SGE e1op e2op []
(TypeUInt _) -> addInstr $ A.ICmp A.IP.UGE e1op e2op []
TypeFloat -> addInstr $ A.FCmp A.FPP.OGE e1op e2op []
@@ -555,12 +549,11 @@ genExpression (ExBinOp bo e1 e2 (Just t)) = do
(TypeFunc _ _) -> addInstr $ A.ICmp A.IP.UGE e1op e2op []
(TypeName _) -> undefined
TypeVoid -> undefined
- return $ A.LocalReference (A.IntegerType 1) (A.Name label)
LEqual -> do
sharedType <- commonTypeM (fromJust (exTypeOf e1)) (fromJust (exTypeOf e2))
e1op <- genExprArgument e1 >>= flip castOperand sharedType
e2op <- genExprArgument e2 >>= flip castOperand sharedType
- label <- case sharedType of
+ makeLocRef (TypeInt 1) $ case sharedType of
(TypeInt _) -> addInstr $ A.ICmp A.IP.SLE e1op e2op []
(TypeUInt _) -> addInstr $ A.ICmp A.IP.ULE e1op e2op []
TypeFloat -> addInstr $ A.FCmp A.FPP.OLE e1op e2op []
@@ -569,7 +562,6 @@ genExpression (ExBinOp bo e1 e2 (Just t)) = do
(TypeFunc _ _) -> addInstr $ A.ICmp A.IP.ULE e1op e2op []
(TypeName _) -> undefined
TypeVoid -> undefined
- return $ A.LocalReference (A.IntegerType 1) (A.Name label)
BoolAnd -> do
firstbb <- liftM (fromJust . currentBlock) get
(A.LocalReference (A.IntegerType 1) (A.Name label1)) <- genExprArgument e1 >>= castToBool
generated by cgit v1.2.3-70-g09d2 (git 2.47.0) at 2024-11-23 10:58:58 +0100