From 238d16ef9e183275ab00a72ed61a280501b9bcad Mon Sep 17 00:00:00 2001 From: tomsmeding Date: Wed, 1 Feb 2017 13:06:20 +0100 Subject: More operators and less function pointers --- check.hs | 2 ++ codegen.hs | 42 +++++++++++++++++++++++++++++++----------- nl/test_string.nl | 7 +++---- 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; } -- cgit v1.2.3-54-g00ecf