If and while working

2 files changed, 57 insertions, 1 deletions

diff --git a/codegen.hs b/codegen.hs
index 59adb0b..3461f64 100644
--- a/codegen.hs
+++ b/codegen.hs
@@ -11,6 +11,7 @@ import qualified LLVM.General.AST.Constant as A.C
 -- 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 as A
 import Debug.Trace
 
@@ -254,7 +255,23 @@ genSingle (StReturn expr) _ = do
     oper' <- castOperand oper rettype
     setTerminator $ A.Ret (Just oper') []
     return bb
-genSingle _ _ = undefined
+genSingle (StIf cexpr st1 st2) following = do
+    stbb1 <- genSingle st1 following
+    stbb2 <- genSingle st2 following
+    cbb <- newBlock
+    coper <- genExpression cexpr
+    coper' <- castToBool coper
+    setTerminator $ A.CondBr coper' (A.Name stbb1) (A.Name stbb2) []
+    return cbb
+genSingle (StWhile cexpr st) following = do
+    cbb <- newBlock
+    loopbb <- newBlockJump cbb
+    stbb <- genSingle st loopbb
+    changeBlock cbb
+    coper <- genExpression cexpr
+    coper' <- castToBool coper
+    setTerminator $ A.CondBr coper' (A.Name stbb) (A.Name following) []
+    return cbb
 
 genExpression :: Expression -> CGMonad A.Operand
 genExpression (ExLit lit (Just t)) = literalToOperand lit t
@@ -284,6 +301,23 @@ genExpression (ExBinOp bo e1 e2 (Just t)) = do
                 (TypePtr _) -> addInstr $ A.Sub False False e1op' e2op' []
                 (TypeName _) -> undefined
             return $ A.LocalReference (toLLVMType t) (A.Name label)
+        Equal -> do
+            sharedType <- commonType (fromJust (exTypeOf e1)) (fromJust (exTypeOf e2))
+            e1op' <- castOperand e1op sharedType
+            e2op' <- castOperand e2op sharedType
+            label <- case sharedType of
+                (TypeInt _) -> addInstr $ A.ICmp A.EQ e1op' e2op' []
+                _ -> undefined
+            return $ A.LocalReference (A.IntegerType 1) (A.Name label)
+        Less -> do
+            sharedType <- commonType (fromJust (exTypeOf e1)) (fromJust (exTypeOf e2))
+            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' []
+                _ -> undefined
+            return $ A.LocalReference (A.IntegerType 1) (A.Name label)
         _ -> throwError $ "Binary operator " ++ pshow bo ++ " not implemented"
 genExpression ex = throwError $ "Expression '" ++ pshow ex ++ "' not implemented"
 
@@ -321,6 +355,20 @@ castOperand orig@(A.ConstantOperand (A.C.GlobalReference (A.IntegerType s1) _))
                                           ++ "' to '" ++ 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)) []
+    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))
+castToBool _ = undefined
+
+commonType :: Type -> Type -> CGMonad Type
+commonType (TypeInt s1) (TypeInt s2) = return $ TypeInt (max s1 s2)
+commonType _ _ = undefined
+
 
 cleanupTrampolines :: CGMonad ()
 cleanupTrampolines = do
diff --git a/simple.nl b/simple.nl
index 8a8180a..699fec2 100644
--- a/simple.nl
+++ b/simple.nl
@@ -8,5 +8,13 @@ int main(i32 argc, ptr(ptr(i8)) argv) {
 	int i = 40;
 	//i = g_var + 2 + 3;
 	int a = i + 2;
+	if (a == 41) {
+		return 10;
+	} else {
+		a = 20;
+	}
+	while (a < 42) {
+		a = a + 1;
+	}
 	return a;
 }