module DDC.Llvm.Transform.Calls
(attachCallConvs)
where
import DDC.Llvm.Syntax
attachCallConvs :: Module -> Module
attachCallConvs mm
= let funcs' = map (callsFunction mm) $ modFuncs mm
in mm { modFuncs = funcs' }
callsFunction :: Module -> Function -> Function
callsFunction mm fun
= let blocks' = map (callsBlock mm) $ funBlocks fun
in fun { funBlocks = blocks' }
callsBlock :: Module -> Block -> Block
callsBlock mm block
= let instrs' = fmap (callsInstr mm) $ blockInstrs block
in block { blockInstrs = instrs' }
callsInstr :: Module -> AnnotInstr -> AnnotInstr
callsInstr mm ai@(AnnotInstr i annots)
= case i of
ICall mv ct mcc t n xs ats
-> let Just cc2 = callConvOfName mm n
cc' = mergeCallConvs mcc cc2
in AnnotInstr (ICall mv ct (Just cc') t n xs ats)
annots
_ -> ai
callConvOfName :: Module -> Name -> Maybe CallConv
callConvOfName mm name
| NameGlobal str <- name
, Just cc2 <- lookupCallConv str mm
= Just cc2
| NameLocal _ <- name
= Just CC_Ccc
| otherwise = Nothing
mergeCallConvs :: Maybe CallConv -> CallConv -> CallConv
mergeCallConvs mc cc
= case mc of
Nothing -> cc
Just cc'
| cc == cc' -> cc
| otherwise
-> error $ unlines
[ "DDC.LLVM.Transform.Clean"
, " Not overriding exising calling convention." ]