@@ -20,7 +20,7 @@ import LLVM.General.Target ( TargetMachine
21import LLVM.General.AST.DataLayout
21import LLVM.General.AST.DataLayout
22import qualified LLVM.General.PassManager as PM
22import qualified LLVM.General.PassManager as PM
23−import qualified LLVM.General.Module as M
23+import qualified LLVM.General.Module as MO
24import qualified LLVM.General.AST.IntegerPredicate as IPred
24import qualified LLVM.General.AST.IntegerPredicate as IPred
25import qualified LLVM.General.AST.Linkage as L
25import qualified LLVM.General.AST.Linkage as L
26import qualified LLVM.General.AST.Visibility as V
26import qualified LLVM.General.AST.Visibility as V
@@ -36,9 +36,9 @@ import qualified LLVM.General.CodeGenOpt as CGO
36import Data.List
36import Data.List
37import Data.Maybe
37import Data.Maybe
38import Data.Word
38import Data.Word
39−import Data.Set (Set)
39+import Data.Map (Map)
40−import qualified Data.Set as S
41import qualified Data.Map as M
40import qualified Data.Map as M
41+import qualified Data.Set as S
42import qualified Data.Vector.Unboxed as V
42import qualified Data.Vector.Unboxed as V
43import Control.Applicative
43import Control.Applicative
44import Control.Monad.RWS
44import Control.Monad.RWS
@@ -70,7 +70,7 @@ codegenLLVM defs triple cpu optimize file outty = withContext $ \context -> do
70 withTargetMachine target triple cpu S.empty options R.Default CM.Default CGO.Default $ \tm ->
70 withTargetMachine target triple cpu S.empty options R.Default CM.Default CGO.Default $ \tm ->
71 do layout <- getTargetMachineDataLayout tm
71 do layout <- getTargetMachineDataLayout tm
72 let ast = codegen (Target triple layout) (map snd defs)
72 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 ->
74 do let opts = PM.defaultCuratedPassSetSpec
74 do let opts = PM.defaultCuratedPassSetSpec
75 { PM.optLevel = Just optimize
75 { PM.optLevel = Just optimize
76 , PM.simplifyLibCalls = Just True
76 , PM.simplifyLibCalls = Just True
@@ -85,9 +85,9 @@ codegenLLVM defs triple cpu optimize file outty = withContext $ \context -> do
85failInIO :: ErrorT String IO a -> IO a
85failInIO :: ErrorT String IO a -> IO a
86failInIO = either fail return <=< runErrorT
86failInIO = either fail return <=< runErrorT
88−outputModule :: TargetMachine -> FilePath -> OutputType -> M.Module -> IO ()
88+outputModule :: TargetMachine -> FilePath -> OutputType -> MO.Module -> IO ()
89−outputModule _ file Raw m = failInIO $ M.writeBitcodeToFile file m
89+outputModule _ file Raw m = failInIO $ MO.writeBitcodeToFile file m
90−outputModule tm file Object m = failInIO $ M.writeObjectToFile tm file m
90+outputModule tm file Object m = failInIO $ MO.writeObjectToFile tm file m
91outputModule tm file Executable m = withTmpFile $ \obj -> do
91outputModule tm file Executable m = withTmpFile $ \obj -> do
92 outputModule tm obj Object m
92 outputModule tm obj Object m
93 cc <- getCC
93 cc <- getCC
@@ -266,14 +266,14 @@ conType nargs = StructureType False
268data MGS = MGS { mgsNextGlobalName :: Word
268data MGS = MGS { mgsNextGlobalName :: Word
269− , mgsForeignSyms :: Set String
269+ , mgsForeignSyms :: Map String (FType, [FType])
272type Modgen = RWS Target [Definition] MGS
272type Modgen = RWS Target [Definition] MGS
274initialMGS :: MGS
274initialMGS :: MGS
275initialMGS = MGS { mgsNextGlobalName = 0
275initialMGS = MGS { mgsNextGlobalName = 0
276− , mgsForeignSyms = S.empty
276+ , mgsForeignSyms = M.empty
279cgDef :: SDecl -> Modgen Definition
279cgDef :: SDecl -> Modgen Definition
@@ -317,7 +317,7 @@ data CGS = CGS { nextName :: Word
317 , currentBlockName :: Name
317 , currentBlockName :: Name
318 , instAccum :: [Named Instruction]
318 , instAccum :: [Named Instruction]
319 , lexenv :: Env
319 , lexenv :: Env
320− , foreignSyms :: Set String
320+ , foreignSyms :: Map String (FType, [FType])
323data CGR = CGR { target :: Target
323data CGR = CGR { target :: Target
@@ -810,9 +810,11 @@ addGlobal' ty val = do
810ensureCDecl :: String -> FType -> [FType] -> Codegen Operand
810ensureCDecl :: String -> FType -> [FType] -> Codegen Operand
811ensureCDecl name rty argtys = do
811ensureCDecl name rty argtys = do
812 syms <- gets foreignSyms
812 syms <- gets foreignSyms
813− unless (S.member name syms) $ -- TODO: Perform a runtime check of declared type consistency here
813+ case M.lookup name syms of
814− do addGlobal (ffunDecl name rty argtys)
814+ Nothing -> do addGlobal (ffunDecl name rty argtys)
815− modify $ \s -> s { foreignSyms = S.insert name (foreignSyms s) }
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')
816 return $ ConstantOperand (C.GlobalReference (Name name))
818 return $ ConstantOperand (C.GlobalReference (Name name))
818ffunDecl :: String -> FType -> [FType] -> Global
820ffunDecl :: String -> FType -> [FType] -> Global