diff options
| -rw-r--r-- | codegen.hs | 41 | ||||
| -rw-r--r-- | nl/test_string.nl | 3 |
2 files changed, 30 insertions, 14 deletions
@@ -14,7 +14,8 @@ import qualified LLVM.General.AST.Float as A.F -- import qualified LLVM.General.AST.Operand as A -- import qualified LLVM.General.AST.Name as A -- import qualified LLVM.General.AST.Instruction as A -import qualified LLVM.General.AST.IntegerPredicate as A +import qualified LLVM.General.AST.IntegerPredicate as A.IP +import qualified LLVM.General.AST.FloatingPointPredicate as A.FPP import qualified LLVM.General.AST.Linkage as A.L -- import qualified LLVM.General.AST.Visibility as A.V import qualified LLVM.General.AST as A @@ -427,21 +428,25 @@ genExpression (ExBinOp bo e1 e2 (Just t)) = do return $ A.LocalReference (toLLVMType t) (A.Name label) Equal -> do sharedType <- commonTypeM (fromJust (exTypeOf e1)) (fromJust (exTypeOf e2)) - -- trace ("Shared type for Equal of " ++ pshow e1 ++ " and " ++ pshow e2 ++ " is: " ++ pshow sharedType) - -- $ return () e1op' <- castOperand e1op sharedType e2op' <- castOperand e2op sharedType label <- case sharedType of - (TypeInt _) -> addInstr $ A.ICmp A.EQ e1op' e2op' [] - _ -> undefined + (TypeInt _) -> addInstr $ A.ICmp A.IP.EQ e1op' e2op' [] + (TypeUInt _) -> addInstr $ A.ICmp A.IP.EQ e1op' e2op' [] + 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' [] + TypeVoid -> undefined return $ A.LocalReference (A.IntegerType 1) (A.Name label) Greater -> do sharedType <- commonTypeM (fromJust (exTypeOf e1)) (fromJust (exTypeOf e2)) e1op' <- castOperand e1op sharedType e2op' <- castOperand e2op sharedType label <- case sharedType of - (TypeInt _) -> addInstr $ A.ICmp A.SGT e1op' e2op' [] - (TypeUInt _) -> addInstr $ A.ICmp A.UGT e1op' e2op' [] + (TypeInt _) -> addInstr $ A.ICmp A.IP.SGT e1op' e2op' [] + (TypeUInt _) -> addInstr $ A.ICmp A.IP.UGT e1op' e2op' [] _ -> undefined return $ A.LocalReference (A.IntegerType 1) (A.Name label) Less -> do @@ -449,8 +454,8 @@ genExpression (ExBinOp bo e1 e2 (Just t)) = do e1op' <- castOperand e1op sharedType e2op' <- castOperand e2op sharedType label <- case sharedType of - (TypeInt _) -> addInstr $ A.ICmp A.SLT e1op' e2op' [] - (TypeUInt _) -> addInstr $ A.ICmp A.ULT e1op' e2op' [] + (TypeInt _) -> addInstr $ A.ICmp A.IP.SLT e1op' e2op' [] + (TypeUInt _) -> addInstr $ A.ICmp A.IP.ULT e1op' e2op' [] _ -> undefined return $ A.LocalReference (A.IntegerType 1) (A.Name label) GEqual -> do @@ -458,8 +463,8 @@ genExpression (ExBinOp bo e1 e2 (Just t)) = do e1op' <- castOperand e1op sharedType e2op' <- castOperand e2op sharedType label <- case sharedType of - (TypeInt _) -> addInstr $ A.ICmp A.SGE e1op' e2op' [] - (TypeUInt _) -> addInstr $ A.ICmp A.UGE e1op' e2op' [] + (TypeInt _) -> addInstr $ A.ICmp A.IP.SGE e1op' e2op' [] + (TypeUInt _) -> addInstr $ A.ICmp A.IP.UGE e1op' e2op' [] _ -> undefined return $ A.LocalReference (A.IntegerType 1) (A.Name label) LEqual -> do @@ -467,8 +472,8 @@ genExpression (ExBinOp bo e1 e2 (Just t)) = do e1op' <- castOperand e1op sharedType e2op' <- castOperand e2op sharedType label <- case sharedType of - (TypeInt _) -> addInstr $ A.ICmp A.SLE e1op' e2op' [] - (TypeUInt _) -> addInstr $ A.ICmp A.ULE e1op' e2op' [] + (TypeInt _) -> addInstr $ A.ICmp A.IP.SLE e1op' e2op' [] + (TypeUInt _) -> addInstr $ A.ICmp A.IP.ULE e1op' e2op' [] _ -> undefined return $ A.LocalReference (A.IntegerType 1) (A.Name label) BoolOr -> do @@ -558,13 +563,17 @@ 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) + | toLLVMType rt2 == rt1 && all (uncurry (==)) (zip at1 (map toLLVMType at2)) = return orig + | otherwise = throwError $ "Cannot implicitly cast between '" ++ show orig + ++ "' and '" ++ pshow t2 ++ "'" castOperand orig t2 = throwError $ "Cast from '" ++ show orig ++ "' to type '" ++ pshow t2 ++ "' not implemented" castToBool :: A.Operand -> CGMonad A.Operand castToBool orig@(A.LocalReference (A.IntegerType 1) _) = return orig castToBool orig@(A.LocalReference (A.IntegerType s1) _) = do - label <- addInstr $ A.ICmp A.NE orig (A.ConstantOperand (A.C.Int s1 0)) [] + label <- addInstr $ A.ICmp A.IP.NE orig (A.ConstantOperand (A.C.Int s1 0)) [] return $ A.LocalReference (A.IntegerType 1) (A.Name label) castToBool (A.ConstantOperand (A.C.Int _ val)) = return $ A.ConstantOperand (A.C.Int 1 (if val == 0 then 1 else 0)) @@ -587,6 +596,10 @@ commonType (TypeInt _) TypeDouble = Just TypeDouble commonType TypeFloat TypeDouble = Just TypeDouble commonType TypeDouble TypeFloat = Just TypeDouble +commonType t@(TypeFunc rt1 at1) (TypeFunc rt2 at2) + | rt1 == rt2 && at1 == at2 = Just t + | otherwise = Nothing + commonType _ _ = Nothing commonTypeM :: Type -> Type -> CGMonad Type diff --git a/nl/test_string.nl b/nl/test_string.nl index d120b48..c70b395 100644 --- a/nl/test_string.nl +++ b/nl/test_string.nl @@ -11,6 +11,9 @@ 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'); return 0; } |