More operators and less function pointers

3 files changed, 36 insertions, 15 deletions

diff --git a/check.hs b/check.hs
index b6a660b..9b8ffc6 100644
--- a/check.hs
+++ b/check.hs
@@ -80,6 +80,7 @@ typeCheck (Program decls) = Program <$> mapM (goD topLevelNames) decls
     goD names (DecFunction frt name args body) = do
         newbody <- goB frt (foldr (\(t,n) m -> Map.insert n t m) names args) body
         return $ DecFunction frt name args newbody
+    goD _ (DecVariable (TypeFunc _ _) _ _) = Left $ "Cannot declare global variable with function type"
     goD _ dec = return dec
 
     goB :: Type  -- function return type
@@ -94,6 +95,7 @@ typeCheck (Program decls) = Program <$> mapM (goD topLevelNames) decls
 
     goS :: Type  -- function return type
         -> Map.Map Name Type -> Statement -> Error (Map.Map Name Type, Statement)
+    goS _ _ (StVarDeclaration (TypeFunc _ _) _ _) = Left $ "Cannot declare variable with function type"
     goS _ names st@(StVarDeclaration t n Nothing) = do
         maybe (return (Map.insert n t names, st))
               (const $ Left $ "Duplicate variable '" ++ n ++ "'")
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
diff --git a/nl/test_string.nl b/nl/test_string.nl
index c70b395..e71fc3c 100644
--- a/nl/test_string.nl
+++ b/nl/test_string.nl
@@ -3,6 +3,7 @@ type char = i8;
 type string = ptr(char);
 
 extern func void(int) putchar;
+extern func int(string) puts;
 
 void f(char c) {
 	putchar(c);
@@ -11,9 +12,7 @@ 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');
+	//f('x');
+	puts(s2);
 	return 0;
 }