diff options
Diffstat (limited to 'codegen.hs')
-rw-r--r-- | codegen.hs | 31 |
1 files changed, 27 insertions, 4 deletions
@@ -254,7 +254,7 @@ genFunctions (Program decs) = liftM (mapMaybe id) $ mapM gen decs allBlocks = Map.empty, variables = Map.empty }) - firstbb <- genFunctionBlock body args + firstbb <- genFunctionBlock body (rettype, name) args cleanupTrampolines blockmap <- liftM allBlocks get let bbs' = map snd $ filter (\x -> fst x /= firstbb) $ Map.toList blockmap @@ -269,8 +269,8 @@ genFunctions (Program decs) = liftM (mapMaybe id) $ mapM gen decs -genFunctionBlock :: Block -> [(Type,Name)] -> CGMonad LLName -genFunctionBlock bl args = do +genFunctionBlock :: Block -> (Type, Name) -> [(Type, Name)] -> CGMonad LLName +genFunctionBlock bl (rettype, fname) args = do firstbb <- newBlock let prepArg :: (Type,Name) -> CGMonad () prepArg (t,n) = do @@ -282,15 +282,24 @@ genFunctionBlock bl args = do sequence_ $ map prepArg args termbb <- newBlock - setTerminator $ A.Unreachable [] + setTerminator $ if rettype == TypeVoid then A.Ret Nothing [] else A.Unreachable [] bodybb <- genBlock bl termbb changeBlock firstbb setTerminator $ A.Br (A.Name bodybb) [] + + if rettype /= TypeVoid + then whenM (bbIsReferenced termbb) $ throwError $ + "Control reaches end of non-void function '" ++ fname ++ "'" + else return () + if length args > 0 then return firstbb else return bodybb +whenM :: (Monad m) => m Bool -> m a -> m () +whenM cond value = cond >>= \c -> if c then void value else return () + genBlock :: Block -> LLName -- name of BasicBlock following this Block -> CGMonad LLName -- name of first BasicBlock @@ -628,6 +637,20 @@ cleanupTrampolines = do | otherwise = A.Name x changeName _ _ (A.UnName _) = undefined +bbIsReferenced :: LLName -> CGMonad Bool +bbIsReferenced bb = do + bbs <- liftM allBlocks get + return $ any checkBlock bbs + where + checkBlock :: A.BasicBlock -> Bool + checkBlock (A.BasicBlock name instrs (_ A.:= term)) = checkBlock (A.BasicBlock name instrs (A.Do term)) + checkBlock (A.BasicBlock _ _ (A.Do term)) = case term of + (A.Ret _ _) -> False + (A.CondBr _ (A.Name d1) (A.Name d2) _) -> d1 == bb || d2 == bb + (A.Br (A.Name d) _) -> d == bb + (A.Unreachable _) -> False + _ -> undefined + toLLVMType :: Type -> A.Type toLLVMType (TypeInt s) = A.IntegerType $ fromIntegral s |