More Equal rules

2 files changed, 30 insertions, 14 deletions

diff --git a/codegen.hs b/codegen.hs
index 9a8bf1c..7569a39 100644
--- a/codegen.hs
+++ b/codegen.hs
@@ -14,7 +14,8 @@ import qualified LLVM.General.AST.Float as A.F
 -- import qualified LLVM.General.AST.Operand as A
 -- import qualified LLVM.General.AST.Name as A
 -- import qualified LLVM.General.AST.Instruction as A
-import qualified LLVM.General.AST.IntegerPredicate as A
+import qualified LLVM.General.AST.IntegerPredicate as A.IP
+import qualified LLVM.General.AST.FloatingPointPredicate as A.FPP
 import qualified LLVM.General.AST.Linkage as A.L
 -- import qualified LLVM.General.AST.Visibility as A.V
 import qualified LLVM.General.AST as A
@@ -427,21 +428,25 @@ genExpression (ExBinOp bo e1 e2 (Just t)) = do
             return $ A.LocalReference (toLLVMType t) (A.Name label)
         Equal -> do
             sharedType <- commonTypeM (fromJust (exTypeOf e1)) (fromJust (exTypeOf e2))
-            -- trace ("Shared type for Equal of " ++ pshow e1 ++ " and " ++ pshow e2 ++ " is: " ++ pshow sharedType)
-                -- $ return ()
             e1op' <- castOperand e1op sharedType
             e2op' <- castOperand e2op sharedType
             label <- case sharedType of
-                (TypeInt _) -> addInstr $ A.ICmp A.EQ e1op' e2op' []
-                _ -> undefined
+                (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' []
+                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' []
+                TypeVoid -> undefined
             return $ A.LocalReference (A.IntegerType 1) (A.Name label)
         Greater -> do
             sharedType <- commonTypeM (fromJust (exTypeOf e1)) (fromJust (exTypeOf e2))
             e1op' <- castOperand e1op sharedType
             e2op' <- castOperand e2op sharedType
             label <- case sharedType of
-                (TypeInt _) -> addInstr $ A.ICmp A.SGT e1op' e2op' []
-                (TypeUInt _) -> addInstr $ A.ICmp A.UGT e1op' e2op' []
+                (TypeInt _) -> addInstr $ A.ICmp A.IP.SGT e1op' e2op' []
+                (TypeUInt _) -> addInstr $ A.ICmp A.IP.UGT e1op' e2op' []
                 _ -> undefined
             return $ A.LocalReference (A.IntegerType 1) (A.Name label)
         Less -> do
@@ -449,8 +454,8 @@ genExpression (ExBinOp bo e1 e2 (Just t)) = do
             e1op' <- castOperand e1op sharedType
             e2op' <- castOperand e2op sharedType
             label <- case sharedType of
-                (TypeInt _) -> addInstr $ A.ICmp A.SLT e1op' e2op' []
-                (TypeUInt _) -> addInstr $ A.ICmp A.ULT e1op' e2op' []
+                (TypeInt _) -> addInstr $ A.ICmp A.IP.SLT e1op' e2op' []
+                (TypeUInt _) -> addInstr $ A.ICmp A.IP.ULT e1op' e2op' []
                 _ -> undefined
             return $ A.LocalReference (A.IntegerType 1) (A.Name label)
         GEqual -> do
@@ -458,8 +463,8 @@ genExpression (ExBinOp bo e1 e2 (Just t)) = do
             e1op' <- castOperand e1op sharedType
             e2op' <- castOperand e2op sharedType
             label <- case sharedType of
-                (TypeInt _) -> addInstr $ A.ICmp A.SGE e1op' e2op' []
-                (TypeUInt _) -> addInstr $ A.ICmp A.UGE e1op' e2op' []
+                (TypeInt _) -> addInstr $ A.ICmp A.IP.SGE e1op' e2op' []
+                (TypeUInt _) -> addInstr $ A.ICmp A.IP.UGE e1op' e2op' []
                 _ -> undefined
             return $ A.LocalReference (A.IntegerType 1) (A.Name label)
         LEqual -> do
@@ -467,8 +472,8 @@ genExpression (ExBinOp bo e1 e2 (Just t)) = do
             e1op' <- castOperand e1op sharedType
             e2op' <- castOperand e2op sharedType
             label <- case sharedType of
-                (TypeInt _) -> addInstr $ A.ICmp A.SLE e1op' e2op' []
-                (TypeUInt _) -> addInstr $ A.ICmp A.ULE e1op' e2op' []
+                (TypeInt _) -> addInstr $ A.ICmp A.IP.SLE e1op' e2op' []
+                (TypeUInt _) -> addInstr $ A.ICmp A.IP.ULE e1op' e2op' []
                 _ -> undefined
             return $ A.LocalReference (A.IntegerType 1) (A.Name label)
         BoolOr -> do
@@ -558,13 +563,17 @@ 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)
+    | toLLVMType rt2 == rt1 && all (uncurry (==)) (zip at1 (map toLLVMType at2)) = return orig
+    | otherwise = throwError $ "Cannot implicitly cast between '" ++ show orig
+                               ++ "' and '" ++ pshow t2 ++ "'"
 castOperand orig t2 = throwError $ "Cast from '" ++ show orig ++ "' to type '" ++ pshow t2 ++ "' not implemented"
 
 castToBool :: A.Operand -> CGMonad A.Operand
 castToBool orig@(A.LocalReference (A.IntegerType 1) _) =
     return orig
 castToBool orig@(A.LocalReference (A.IntegerType s1) _) = do
-    label <- addInstr $ A.ICmp A.NE orig (A.ConstantOperand (A.C.Int s1 0)) []
+    label <- addInstr $ A.ICmp A.IP.NE orig (A.ConstantOperand (A.C.Int s1 0)) []
     return $ A.LocalReference (A.IntegerType 1) (A.Name label)
 castToBool (A.ConstantOperand (A.C.Int _ val)) =
     return $ A.ConstantOperand (A.C.Int 1 (if val == 0 then 1 else 0))
@@ -587,6 +596,10 @@ commonType (TypeInt _) TypeDouble = Just TypeDouble
 commonType TypeFloat TypeDouble = Just TypeDouble
 commonType TypeDouble TypeFloat = Just TypeDouble
 
+commonType t@(TypeFunc rt1 at1) (TypeFunc rt2 at2)
+    | rt1 == rt2 && at1 == at2 = Just t
+    | otherwise = Nothing
+
 commonType _ _ = Nothing
 
 commonTypeM :: Type -> Type -> CGMonad Type
diff --git a/nl/test_string.nl b/nl/test_string.nl
index d120b48..c70b395 100644
--- a/nl/test_string.nl
+++ b/nl/test_string.nl
@@ -11,6 +11,9 @@ void f(char c) {
 int main(int argc, ptr(string) argv) {
 	string s = "kaas";
 	ptr(i8) s2 = "kaas2";
+	ptr(func void(char)) ptr1;
+	ptr(func void(char)) ptr2;
+	f((ptr1 == ptr2) + 'a');
 	f('x');
 	return 0;
 }