From eb141a89887bb2994ea626c1aa31766d67292f08 Mon Sep 17 00:00:00 2001 From: tomsmeding Date: Thu, 2 Feb 2017 22:58:22 +0100 Subject: Ease creation of locrefs in genExpression --- codegen.hs | 36 ++++++++++++++---------------------- 1 file 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 -- cgit v1.2.3-70-g09d2