diff options
| -rw-r--r-- | codegen.hs | 50 | ||||
| -rw-r--r-- | simple.nl | 8 |
2 files changed, 57 insertions, 1 deletions
@@ -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 @@ -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; } |