Add array indexing (not writing yet, though...)HEADmaster

6 files changed, 59 insertions, 10 deletions

diff --git a/ast.hs b/ast.hs
index 480b133..64761bf 100644
--- a/ast.hs
+++ b/ast.hs
@@ -49,6 +49,7 @@ data BinaryOperator
     = Plus | Minus | Times | Divide | Modulo
     | Equal | Unequal | Greater | Less | GEqual | LEqual
     | BoolAnd | BoolOr
+    | Index
   deriving (Show, Eq)
 
 data UnaryOperator
@@ -151,6 +152,7 @@ instance PShow BinaryOperator where
     pshow LEqual = "<="
     pshow BoolAnd = "&&"
     pshow BoolOr = "||"
+    pshow Index = "[~]"
 
 instance PShow UnaryOperator where
     pshow Negate = "-"
@@ -163,6 +165,8 @@ instance PShow Expression where
     pshow (ExLit lit Nothing) = pshow lit
     pshow (ExLit lit (Just t)) = concat ["(", pshow lit, " :: ", pshow t, ")"]
     pshow (ExCast t ex) = concat ["cast(", pshow t, ")(", pshow ex, ")"]
+    pshow (ExBinOp Index a b Nothing) = concat ["(", pshow a, ")[", pshow b, "]"]
+    pshow (ExBinOp Index a b (Just t)) = concat ["((", pshow a, ")[", pshow b, "] :: ", pshow t, ")"]
     pshow (ExBinOp op a b Nothing) = concat ["(", pshow a, " ", pshow op, " ", pshow b, ")"]
     pshow (ExBinOp op a b (Just t)) = concat ["(", pshow a, " ", pshow op, " ", pshow b, " :: ", pshow t, ")"]
     pshow (ExUnOp op a Nothing) = concat [pshow op, pshow a]
diff --git a/check.hs b/check.hs
index dbbcfd8..18842f6 100644
--- a/check.hs
+++ b/check.hs
@@ -240,6 +240,8 @@ 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 Index (TypePtr t) (TypeInt _) = Just t
+resultTypeBO Index (TypePtr t) (TypeUInt _) = Just t
 resultTypeBO _ (TypePtr _) _ = Nothing
 resultTypeBO _ _ (TypePtr _) = Nothing
 
diff --git a/codegen.hs b/codegen.hs
index ae02506..ef63c52 100644
--- a/codegen.hs
+++ b/codegen.hs
@@ -139,7 +139,7 @@ setGlobalFunction name label t = do
     state $ \s -> ((), s {globalFunctions = Map.insert name (t, label) $ globalFunctions s})
 
 lookupVar :: Name -> CGMonad (Type, LLName)
-lookupVar name | trace ("Looking up var " ++ name) False = undefined
+lookupVar name | trace ("Looking up local var " ++ name) False = undefined
 lookupVar name = do
     obj <- get
     let locfound = Map.lookup name $ variables obj
@@ -198,13 +198,13 @@ codegen :: Program  -- Program to compile
         -> String   -- File name of source
         -> Error A.Module
 codegen prog name fname = do
-    (defs, st) <- runCGMonad $ do
+    (defs, _) <- runCGMonad $ do
                     defs <- generateDefs prog
                     -- traceShow defs $ return ()
                     -- liftM stringLiterals get >>= flip traceShow (return ())
                     return defs
 
-    traceShow st $ return ()
+    -- traceShow st $ return ()
 
     return $ A.defaultModule {
             A.moduleName = name,
@@ -429,6 +429,7 @@ genExpression (ExCast t e) = do
         (t1, t2) | isSomeInt t1 && isSomeInt t2 -> case intSize t1 < intSize t2 of
             True -> makeLocRef t $ addInstr $ A.SExt eop dstllvm []
             False -> makeLocRef t $ addInstr $ A.Trunc eop dstllvm []
+        (TypePtr _, t2@(TypePtr _)) -> makeLocRef t2 $ addInstr $ A.BitCast eop (toLLVMType t2) []
         _ -> undefined
 genExpression (ExBinOp bo e1 e2 (Just t)) = do
     case bo of
@@ -623,6 +624,8 @@ genExpression (ExBinOp bo e1 e2 (Just t)) = do
             reslabel <- addInstr $ A.Phi A.i1 [(A.ConstantOperand (A.C.Int 1 1), A.Name firstbb),
                                                (A.LocalReference A.i1 (A.Name label2), A.Name bb2)] []
             return $ A.LocalReference A.i1 (A.Name reslabel)
+        Index -> do
+            genExpression $ ExUnOp Dereference (ExBinOp Plus e1 e2 (Just $ TypePtr t)) (Just t)
 genExpression (ExUnOp uo e1 (Just t)) = do
     e1op <- genExprArgument e1
     case uo of
@@ -664,6 +667,7 @@ genExprArgument expr = case expr of
 
 literalToOperand :: Literal -> Type -> CGMonad A.Operand
 literalToOperand (LitInt i) (TypeInt sz) = return $ A.ConstantOperand (A.C.Int (fromIntegral sz) i)
+literalToOperand (LitUInt i) (TypeUInt sz) = return $ A.ConstantOperand (A.C.Int (fromIntegral sz) i)
 literalToOperand (LitFloat f) TypeFloat = return $ A.ConstantOperand (A.C.Float (A.F.Single (realToFrac f)))
 literalToOperand (LitFloat f) TypeDouble = return $ A.ConstantOperand (A.C.Float (A.F.Double f))
 literalToOperand (LitVar n) t = do
@@ -702,6 +706,10 @@ castOperand orig@(A.ConstantOperand (A.C.Int s1 val)) t2@(TypeInt s2)
     | fromIntegral s1 == s2 = return orig
     | fromIntegral s1 < s2 = return $ A.ConstantOperand (A.C.Int (fromIntegral s2) val)
     | fromIntegral s1 > s2 = throwError $ "Integer " ++ show val ++ " too large for type '" ++ pshow t2 ++ "'"
+castOperand orig@(A.ConstantOperand (A.C.Int s1 val)) t2@(TypeUInt s2)
+    | fromIntegral s1 == s2 = return orig
+    | fromIntegral s1 < s2 = return $ A.ConstantOperand (A.C.Int (fromIntegral s2) val)
+    | fromIntegral s1 > s2 = throwError $ "Integer " ++ show val ++ " too large for type '" ++ pshow t2 ++ "'"
 castOperand (A.ConstantOperand (A.C.Int _ val)) TypeFloat = do
     return $ A.ConstantOperand (A.C.Float (A.F.Single (fromIntegral val)))
 castOperand (A.ConstantOperand (A.C.Int _ val)) TypeDouble = do
diff --git a/main.hs b/main.hs
index ca953a8..c7961ab 100644
--- a/main.hs
+++ b/main.hs
@@ -53,8 +53,8 @@ main = do
     putStrLn $ pshow checked
 
     llvmMod <- either die return $ codegen checked "Module" fname
-    putStrLn "Module:"
-    print llvmMod
+    -- putStrLn "Module:"
+    -- print llvmMod
 
     putStrLn "Calling withContext:"
     General.withContext $ \context -> do
diff --git a/nl/string_index.nl b/nl/string_index.nl
index deb4188..55bbc08 100644
--- a/nl/string_index.nl
+++ b/nl/string_index.nl
@@ -1,15 +1,44 @@
 extern func void(i32) putchar;
 extern func u64(ptr(i8)) strlen;
+extern func ptr(i8)(u64) malloc;
+
+void printnum(i32 n) {
+	if (n < 0) {
+		putchar('-');
+		n = -n;
+	}
+	if (n == 0) {
+		putchar('0');
+		return;
+	}
+	while (n > 0) {
+		putchar('0' + n % 10);
+		n = n / 10;
+	}
+}
 
 i32 main() {
 	ptr(i8) s = "kaas";
-	ptr(i8) orig = s;
-	s = s + strlen(s) - 1;
 	i32 i = 0;
-	while (i < strlen(orig)) {
-		putchar(*(s - i));
+	while (i < cast(i32)(strlen(s))) {
+		putchar(s[i]);
 		i = i + 1;
 	}
 	putchar('\n');
+
+	/*ptr(i32) arr = cast(ptr(i32))(malloc(4U*16U));
+	arr[0] = 1;
+	arr[1] = 1;
+	i32 i = 2;
+	while (i < 16) {
+		arr[i] = arr[i-2] + arr[i-1];
+		i = i + 1;
+	}
+	i = 0;
+	while (i < 16) {
+		printnum(arr[i]);
+		putchar(' ');
+	}
+	putchar('\n');*/
 	return 0;
 }
diff --git a/parser.hs b/parser.hs
index 942c63c..40da1ca 100644
--- a/parser.hs
+++ b/parser.hs
@@ -111,7 +111,13 @@ pExCast = do
     return $ ExCast t e
 
 pExLit :: Parser Expression
-pExLit = (exLit_ <$> pLiteral) <|> pParenExpr
+pExLit = do
+    litex <- (exLit_ <$> pLiteral) <|> pParenExpr
+    option litex $ do
+        symbol "["
+        arg <- pExpression
+        symbol "]"
+        return $ exBinOp_ Index litex arg
 
 pParenExpr :: Parser Expression
 pParenExpr = do