Pointer arithmetic now also for Minus

string_index.nl now doesn't compile anymore because I need to implement casts
from i32 to u64

3 files changed, 62 insertions, 47 deletions

diff --git a/check.hs b/check.hs
index 65c1470..b30ff25 100644
--- a/check.hs
+++ b/check.hs
@@ -215,7 +215,9 @@ resultTypeBO :: BinaryOperator -> Type -> Type -> Maybe Type
 resultTypeBO Minus (TypePtr t1) (TypePtr t2) | t1 == t2 = Just $ TypeUInt 1
 resultTypeBO bo (TypePtr t1) (TypePtr t2) | t1 == t2 && bo `elem` complogBO = Just $ TypeUInt 1
 resultTypeBO bo t@(TypePtr _) (TypeInt _) | bo `elem` [Plus, Minus] = Just t
+resultTypeBO bo t@(TypePtr _) (TypeUInt _) | bo `elem` [Plus, Minus] = Just t
 resultTypeBO bo (TypeInt _) t@(TypePtr _) | bo `elem` [Plus, Minus] = Just t
+resultTypeBO bo (TypeUInt _) t@(TypePtr _) | bo `elem` [Plus, Minus] = Just t
 resultTypeBO _ (TypePtr _) _ = Nothing
 resultTypeBO _ _ (TypePtr _) = Nothing
 
diff --git a/codegen.hs b/codegen.hs
index afa600c..93b8c1f 100644
--- a/codegen.hs
+++ b/codegen.hs
@@ -388,55 +388,65 @@ genSingle (StWhile cexpr st) following = do
     setTerminator $ A.CondBr coper' (A.Name stbb) (A.Name following) []
     return cbb
 
+pointerArith :: Expression  -- Expression that produces the pointer
+             -> Expression  -- Expression that produces the integer to add
+             -> (Int -> Type)  -- TypeInt or TypeUInt, the type of the integer
+             -> CGMonad A.Operand  -- The resulting pointer
+pointerArith eptr eint inttypeconstr = do
+    let inttype = inttypeconstr 64
+        ptrtype@(TypePtr subt) = fromJust (exTypeOf eptr)
+    ptrop <- genExprArgument eptr
+    intop <- genExprArgument eint >>= flip castOperand inttype
+    ptrlabel <- addInstr $ A.PtrToInt ptrop (toLLVMType (TypeUInt 64)) []
+    intlabel <- addInstr $ A.Mul False False intop
+                                 (A.ConstantOperand (A.C.Int 64 (fromIntegral (sizeOf subt)))) []
+    add <- addInstr $ A.Add False False (A.LocalReference (toLLVMType ptrtype) (A.Name ptrlabel))
+                            (A.LocalReference (toLLVMType inttype) (A.Name intlabel)) []
+    res <- addInstr $ A.IntToPtr (A.LocalReference (toLLVMType (TypeUInt 64)) (A.Name add))
+                                 (toLLVMType ptrtype) []
+    return $ A.LocalReference (toLLVMType ptrtype) (A.Name res)
+
 genExpression :: Expression -> CGMonad A.Operand
 genExpression (ExLit lit (Just t)) = literalToOperand lit t
 genExpression (ExBinOp bo e1 e2 (Just t)) = do
     case bo of
-        Plus ->
-            let pointerArith eptr eint inttypeconstr = do
-                    let inttype = inttypeconstr 64
-                        ptrtype@(TypePtr subt) = fromJust (exTypeOf eptr)
-                    ptrop <- genExprArgument eptr
-                    intop <- genExprArgument eint >>= flip castOperand inttype
-                    ptrlabel <- addInstr $ A.PtrToInt ptrop (toLLVMType (TypeUInt 64)) []
-                    intlabel <- addInstr $ A.Mul False False intop
-                                                 (A.ConstantOperand (A.C.Int 64 (fromIntegral (sizeOf subt)))) []
-                    add <- addInstr $ A.Add False False (A.LocalReference (toLLVMType ptrtype) (A.Name ptrlabel))
-                                            (A.LocalReference (toLLVMType inttype) (A.Name intlabel)) []
-                    res <- addInstr $ A.IntToPtr (A.LocalReference (toLLVMType (TypeUInt 64)) (A.Name add))
-                                                 (toLLVMType ptrtype) []
-                    return $ A.LocalReference (toLLVMType ptrtype) (A.Name res)
-            in case (fromJust (exTypeOf e1), fromJust (exTypeOf e2)) of
-                (TypePtr _, TypeInt _) -> pointerArith e1 e2 TypeInt
-                (TypePtr _, TypeUInt _) -> pointerArith e1 e2 TypeUInt
-                (TypeInt _, TypePtr _) -> pointerArith e2 e1 TypeInt
-                (TypeUInt _, TypePtr _) -> pointerArith e2 e1 TypeUInt
-                _ -> do
-                    e1op <- genExprArgument e1 >>= flip castOperand t
-                    e2op <- genExprArgument e2 >>= flip castOperand t
-                    label <- 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 []
-                        TypeDouble -> addInstr $ A.FAdd A.NoFastMathFlags e1op e2op []
-                        (TypePtr _) -> throwError $ "Plus '+' operator not defined on pointers"
-                        (TypeFunc _ _) -> throwError $ "Plus '+' operator not defined on function pointers"
-                        (TypeName _) -> undefined
-                        TypeVoid -> undefined
-                    return $ A.LocalReference (toLLVMType t) (A.Name label)
-        Minus -> do
-            e1op <- genExprArgument e1 >>= flip castOperand t
-            e2op <- genExprArgument e2 >>= flip castOperand t
-            label <- 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 []
-                TypeDouble -> addInstr $ A.FSub A.NoFastMathFlags e1op e2op []
-                (TypePtr _) -> throwError $ "Minus '-' operator not defined on pointers"
-                (TypeFunc _ _) -> throwError $ "Minus '-' operator not defined on function pointers"
-                (TypeName _) -> undefined
-                TypeVoid -> undefined
-            return $ A.LocalReference (toLLVMType t) (A.Name label)
+        Plus -> case (fromJust (exTypeOf e1), fromJust (exTypeOf e2)) of
+            (TypePtr _, TypeInt _) -> pointerArith e1 e2 TypeInt
+            (TypePtr _, TypeUInt _) -> pointerArith e1 e2 TypeUInt
+            (TypeInt _, TypePtr _) -> pointerArith e2 e1 TypeInt
+            (TypeUInt _, TypePtr _) -> pointerArith e2 e1 TypeUInt
+            _ -> do
+                e1op <- genExprArgument e1 >>= flip castOperand t
+                e2op <- genExprArgument e2 >>= flip castOperand t
+                label <- 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 []
+                    TypeDouble -> addInstr $ A.FAdd A.NoFastMathFlags e1op e2op []
+                    (TypePtr _) -> undefined  -- Handled above
+                    (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
+            (TypePtr _, it@(TypeUInt _)) -> pointerArith e1 (exneg e2 it) TypeUInt
+            (it@(TypeInt _), TypePtr _) -> pointerArith (exneg e2 it) e1 TypeInt
+            (it@(TypeUInt _), TypePtr _) -> pointerArith (exneg e2 it) e1 TypeUInt
+            _ -> do
+                e1op <- genExprArgument e1 >>= flip castOperand t
+                e2op <- genExprArgument e2 >>= flip castOperand t
+                label <- 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 []
+                    TypeDouble -> addInstr $ A.FSub A.NoFastMathFlags e1op e2op []
+                    (TypePtr _) -> undefined  -- Handled above
+                    (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
diff --git a/nl/string_index.nl b/nl/string_index.nl
index 27df14b..deb4188 100644
--- a/nl/string_index.nl
+++ b/nl/string_index.nl
@@ -1,10 +1,13 @@
 extern func void(i32) putchar;
+extern func u64(ptr(i8)) strlen;
 
 i32 main() {
 	ptr(i8) s = "kaas";
+	ptr(i8) orig = s;
+	s = s + strlen(s) - 1;
 	i32 i = 0;
-	while (*(s+i) != '\x00') {
-		putchar(*(s + i));
+	while (i < strlen(orig)) {
+		putchar(*(s - i));
 		i = i + 1;
 	}
 	putchar('\n');