summaryrefslogtreecommitdiff
path: root/codegen.hs
diff options
context:
space:
mode:
Diffstat (limited to 'codegen.hs')
-rw-r--r--codegen.hs42
1 files changed, 31 insertions, 11 deletions
diff --git a/codegen.hs b/codegen.hs
index 7569a39..37c7154 100644
--- a/codegen.hs
+++ b/codegen.hs
@@ -383,8 +383,8 @@ genExpression (ExBinOp bo e1 e2 (Just t)) = do
TypeFloat -> addInstr $ A.FAdd A.NoFastMathFlags e1op' e2op' []
TypeDouble -> addInstr $ A.FAdd A.NoFastMathFlags e1op' e2op' []
(TypePtr _) -> addInstr $ A.Add False False e1op' e2op' []
- (TypeName _) -> undefined
(TypeFunc _ _) -> throwError $ "Plus '+' operator not defined on function pointers"
+ (TypeName _) -> undefined
TypeVoid -> undefined
return $ A.LocalReference (toLLVMType t) (A.Name label)
Minus -> do
@@ -396,8 +396,8 @@ genExpression (ExBinOp bo e1 e2 (Just t)) = do
TypeFloat -> addInstr $ A.FSub A.NoFastMathFlags e1op' e2op' []
TypeDouble -> addInstr $ A.FSub A.NoFastMathFlags e1op' e2op' []
(TypePtr _) -> addInstr $ A.Sub False False e1op' e2op' []
- (TypeName _) -> undefined
(TypeFunc _ _) -> throwError $ "Minus '-' operator not defined on function pointers"
+ (TypeName _) -> undefined
TypeVoid -> undefined
return $ A.LocalReference (toLLVMType t) (A.Name label)
Divide -> do
@@ -409,8 +409,8 @@ genExpression (ExBinOp bo e1 e2 (Just t)) = do
TypeFloat -> addInstr $ A.FDiv A.NoFastMathFlags e1op' e2op' []
TypeDouble -> addInstr $ A.FDiv A.NoFastMathFlags e1op' e2op' []
(TypePtr _) -> throwError $ "Modulo '%' operator not defined on pointers"
- (TypeName _) -> undefined
(TypeFunc _ _) -> throwError $ "Divide '/' operator not defined on function pointers"
+ (TypeName _) -> undefined
TypeVoid -> undefined
return $ A.LocalReference (toLLVMType t) (A.Name label)
Modulo -> do
@@ -422,8 +422,8 @@ genExpression (ExBinOp bo e1 e2 (Just t)) = do
TypeFloat -> addInstr $ A.FRem A.NoFastMathFlags e1op' e2op' []
TypeDouble -> addInstr $ A.FRem A.NoFastMathFlags e1op' e2op' []
(TypePtr _) -> throwError $ "Modulo '%' operator not defined on pointers"
- (TypeName _) -> undefined
(TypeFunc _ _) -> throwError $ "Modulo '%' operator not defined on function pointers"
+ (TypeName _) -> undefined
TypeVoid -> undefined
return $ A.LocalReference (toLLVMType t) (A.Name label)
Equal -> do
@@ -436,8 +436,8 @@ genExpression (ExBinOp bo e1 e2 (Just t)) = do
TypeFloat -> addInstr $ A.FCmp A.FPP.OEQ e1op' e2op' []
TypeDouble -> addInstr $ A.FCmp A.FPP.OEQ e1op' e2op' []
(TypePtr _) -> addInstr $ A.ICmp A.IP.EQ e1op' e2op' []
- (TypeName _) -> undefined
(TypeFunc _ _) -> addInstr $ A.ICmp A.IP.EQ e1op' e2op' []
+ (TypeName _) -> undefined
TypeVoid -> undefined
return $ A.LocalReference (A.IntegerType 1) (A.Name label)
Greater -> do
@@ -447,7 +447,12 @@ genExpression (ExBinOp bo e1 e2 (Just t)) = do
label <- case sharedType of
(TypeInt _) -> addInstr $ A.ICmp A.IP.SGT e1op' e2op' []
(TypeUInt _) -> addInstr $ A.ICmp A.IP.UGT e1op' e2op' []
- _ -> undefined
+ TypeFloat -> addInstr $ A.FCmp A.FPP.OGT e1op' e2op' []
+ TypeDouble -> addInstr $ A.FCmp A.FPP.OGT e1op' e2op' []
+ (TypePtr _) -> addInstr $ A.ICmp A.IP.UGT e1op' e2op' []
+ (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))
@@ -456,7 +461,12 @@ genExpression (ExBinOp bo e1 e2 (Just t)) = do
label <- case sharedType of
(TypeInt _) -> addInstr $ A.ICmp A.IP.SLT e1op' e2op' []
(TypeUInt _) -> addInstr $ A.ICmp A.IP.ULT e1op' e2op' []
- _ -> undefined
+ TypeFloat -> addInstr $ A.FCmp A.FPP.OLT e1op' e2op' []
+ TypeDouble -> addInstr $ A.FCmp A.FPP.OLT e1op' e2op' []
+ (TypePtr _) -> addInstr $ A.ICmp A.IP.ULT e1op' e2op' []
+ (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))
@@ -465,7 +475,12 @@ genExpression (ExBinOp bo e1 e2 (Just t)) = do
label <- case sharedType of
(TypeInt _) -> addInstr $ A.ICmp A.IP.SGE e1op' e2op' []
(TypeUInt _) -> addInstr $ A.ICmp A.IP.UGE e1op' e2op' []
- _ -> undefined
+ TypeFloat -> addInstr $ A.FCmp A.FPP.OGE e1op' e2op' []
+ TypeDouble -> addInstr $ A.FCmp A.FPP.OGE e1op' e2op' []
+ (TypePtr _) -> addInstr $ A.ICmp A.IP.UGE e1op' e2op' []
+ (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))
@@ -474,7 +489,12 @@ genExpression (ExBinOp bo e1 e2 (Just t)) = do
label <- case sharedType of
(TypeInt _) -> addInstr $ A.ICmp A.IP.SLE e1op' e2op' []
(TypeUInt _) -> addInstr $ A.ICmp A.IP.ULE e1op' e2op' []
- _ -> undefined
+ TypeFloat -> addInstr $ A.FCmp A.FPP.OLE e1op' e2op' []
+ TypeDouble -> addInstr $ A.FCmp A.FPP.OLE e1op' e2op' []
+ (TypePtr _) -> addInstr $ A.ICmp A.IP.ULE e1op' e2op' []
+ (TypeFunc _ _) -> addInstr $ A.ICmp A.IP.ULE e1op' e2op' []
+ (TypeName _) -> undefined
+ TypeVoid -> undefined
return $ A.LocalReference (A.IntegerType 1) (A.Name label)
BoolOr -> do
e1op' <- castToBool e1op
@@ -563,7 +583,7 @@ castOperand orig@(A.ConstantOperand (A.C.GlobalReference (A.PointerType t1 _) _)
| toLLVMType t2 == t1 = return orig
| otherwise = throwError $ "Cannot implicitly cast between pointer to '" ++ show t1
++ "' and '" ++ pshow t2 ++ "'"
-castOperand orig@(A.LocalReference (A.FunctionType rt1 at1 False) _) t2@(TypeFunc rt2 at2)
+castOperand orig@(A.LocalReference (A.PointerType (A.FunctionType rt1 at1 False) _) _) t2@(TypeFunc rt2 at2)
| toLLVMType rt2 == rt1 && all (uncurry (==)) (zip at1 (map toLLVMType at2)) = return orig
| otherwise = throwError $ "Cannot implicitly cast between '" ++ show orig
++ "' and '" ++ pshow t2 ++ "'"
@@ -672,7 +692,7 @@ toLLVMType TypeFloat = A.float
toLLVMType TypeDouble = A.double
toLLVMType (TypePtr t) = A.ptr $ toLLVMType t
toLLVMType (TypeName _) = undefined
-toLLVMType (TypeFunc r a) = A.FunctionType (toLLVMType r) (map toLLVMType a) False
+toLLVMType (TypeFunc r a) = A.ptr $ A.FunctionType (toLLVMType r) (map toLLVMType a) False
toLLVMType TypeVoid = A.VoidType
initializerFor :: Type -> A.C.Constant
generated by cgit v1.2.3-54-g00ecf (git 2.45.0) at 2024-05-09 11:59:16 +0200