@@ -20,7 +20,7 @@ import LLVM.General.Target ( TargetMachine
2020 )
2121import LLVM.General.AST.DataLayout
2222import qualified LLVM.General.PassManager as PM
23−import qualified LLVM.General.Module as M
23+import qualified LLVM.General.Module as MO
2424import qualified LLVM.General.AST.IntegerPredicate as IPred
2525import qualified LLVM.General.AST.Linkage as L
2626import qualified LLVM.General.AST.Visibility as V
@@ -36,9 +36,9 @@ import qualified LLVM.General.CodeGenOpt as CGO
3636import Data.List
3737import Data.Maybe
3838import Data.Word
39−import Data.Set (Set)
40−import qualified Data.Set as S
39+import Data.Map (Map)
4140import qualified Data.Map as M
41+import qualified Data.Set as S
4242import qualified Data.Vector.Unboxed as V
4343import Control.Applicative
4444import Control.Monad.RWS
@@ -70,7 +70,7 @@ codegenLLVM defs triple cpu optimize file outty = withContext $ \context -> do
7070 withTargetMachine target triple cpu S.empty options R.Default CM.Default CGO.Default $ \tm ->
7171 do layout <- getTargetMachineDataLayout tm
7272 let ast = codegen (Target triple layout) (map snd defs)
73− result <- runErrorT . M.withModuleFromAST context ast $ \m ->
73+ result <- runErrorT . MO.withModuleFromAST context ast $ \m ->
7474 do let opts = PM.defaultCuratedPassSetSpec
7575 { PM.optLevel = Just optimize
7676 , PM.simplifyLibCalls = Just True
@@ -85,9 +85,9 @@ codegenLLVM defs triple cpu optimize file outty = withContext $ \context -> do
8585failInIO :: ErrorT String IO a -> IO a
8686failInIO = either fail return <=< runErrorT
8787
88−outputModule :: TargetMachine -> FilePath -> OutputType -> M.Module -> IO ()
89−outputModule _ file Raw m = failInIO $ M.writeBitcodeToFile file m
90−outputModule tm file Object m = failInIO $ M.writeObjectToFile tm file m
88+outputModule :: TargetMachine -> FilePath -> OutputType -> MO.Module -> IO ()
89+outputModule _ file Raw m = failInIO $ MO.writeBitcodeToFile file m
90+outputModule tm file Object m = failInIO $ MO.writeObjectToFile tm file m
9191outputModule tm file Executable m = withTmpFile $ \obj -> do
9292 outputModule tm obj Object m
9393 cc <- getCC
@@ -266,14 +266,14 @@ conType nargs = StructureType False
266266 ]
267267
268268data MGS = MGS { mgsNextGlobalName :: Word
269− , mgsForeignSyms :: Set String
269+ , mgsForeignSyms :: Map String (FType, [FType])
270270 }
271271
272272type Modgen = RWS Target [Definition] MGS
273273
274274initialMGS :: MGS
275275initialMGS = MGS { mgsNextGlobalName = 0
276− , mgsForeignSyms = S.empty
276+ , mgsForeignSyms = M.empty
277277 }
278278
279279cgDef :: SDecl -> Modgen Definition
@@ -317,7 +317,7 @@ data CGS = CGS { nextName :: Word
317317 , currentBlockName :: Name
318318 , instAccum :: [Named Instruction]
319319 , lexenv :: Env
320− , foreignSyms :: Set String
320+ , foreignSyms :: Map String (FType, [FType])
321321 }
322322
323323data CGR = CGR { target :: Target
@@ -810,9 +810,11 @@ addGlobal' ty val = do
810810ensureCDecl :: String -> FType -> [FType] -> Codegen Operand
811811ensureCDecl name rty argtys = do
812812 syms <- gets foreignSyms
813− unless (S.member name syms) $ -- TODO: Perform a runtime check of declared type consistency here
814− do addGlobal (ffunDecl name rty argtys)
815− modify $ \s -> s { foreignSyms = S.insert name (foreignSyms s) }
813+ case M.lookup name syms of
814+ Nothing -> do addGlobal (ffunDecl name rty argtys)
815+ modify $ \s -> s { foreignSyms = M.insert name (rty, argtys) (foreignSyms s) }
816+ Just (rty', argtys') -> unless (rty == rty' && argtys == argtys') . fail $
817+ "Mismatched type declarations for foreign symbol \"" ++ name ++ "\": " ++ show (rty, argtys) ++ " vs " ++ show (rty', argtys')
816818 return $ ConstantOperand (C.GlobalReference (Name name))
817819
818820ffunDecl :: String -> FType -> [FType] -> Global