diff options
| -rw-r--r-- | ast.hs | 4 | ||||
| -rw-r--r-- | check.hs | 2 | ||||
| -rw-r--r-- | codegen.hs | 14 | ||||
| -rw-r--r-- | main.hs | 4 | ||||
| -rw-r--r-- | nl/string_index.nl | 37 | ||||
| -rw-r--r-- | parser.hs | 8 |
6 files changed, 59 insertions, 10 deletions
@@ -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] @@ -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 @@ -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 @@ -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; } @@ -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 |