summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--check.hs2
-rw-r--r--codegen.hs42
-rw-r--r--nl/test_string.nl7
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;
}
generated by cgit v1.2.3-70-g09d2 (git 2.51.0) at 2025-11-04 05:27:02 +0100