Ease creation of locrefs in genExpression

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