Refactoring only: remove [Id] field from ForeignStubs

We used to pass the list of top-level foreign exported bindings to the
code generator so that it could create StablePtrs for them in the
stginit code.  Now we don't use stginit unless profiling, and the
StablePtrs are generated by C functions marked with
attribute((constructor)).  This patch removes various bits associated
with the old way of doing things, which were previously left in place
in case we wanted to switch back, I presume.  Also I refactored
dsForeigns to clean it up a bit.

5 files changed, 50 insertions, 56 deletions

diff --git a/compiler/codeGen/CodeGen.lhs b/compiler/codeGen/CodeGen.lhs
index 64ee9e4c4b..eaaae2c165 100644
--- a/compiler/codeGen/CodeGen.lhs
+++ b/compiler/codeGen/CodeGen.lhs
@@ -57,14 +57,13 @@ import Panic
 codeGen :: DynFlags
 	-> Module
 	-> [TyCon]
-	-> ForeignStubs
 	-> [Module]		-- directly-imported modules
 	-> CollectedCCs		-- (Local/global) cost-centres needing declaring/registering.
 	-> [(StgBinding,[(Id,[Id])])]	-- Bindings to convert, with SRTs
 	-> HpcInfo
 	-> IO [Cmm]		-- Output
 
-codeGen dflags this_mod data_tycons foreign_stubs imported_mods 
+codeGen dflags this_mod data_tycons imported_mods 
 	cost_centre_info stg_binds hpc_info
   = do	
   { showPass dflags "CodeGen"
@@ -79,7 +78,7 @@ codeGen dflags this_mod data_tycons foreign_stubs imported_mods
 		; cmm_tycons <- mapM cgTyCon data_tycons
 		; cmm_init   <- getCmm (mkModuleInit way cost_centre_info 
 					     this_mod main_mod
-				  	     foreign_stubs imported_mods hpc_info)
+				  	     imported_mods hpc_info)
 		; return (cmm_binds ++ concat cmm_tycons ++ [cmm_init])
 		}
 		-- Put datatype_stuff after code_stuff, because the
@@ -141,11 +140,10 @@ mkModuleInit
 	-> CollectedCCs         -- cost centre info
 	-> Module
 	-> Module		-- name of the Main module
-	-> ForeignStubs
 	-> [Module]
 	-> HpcInfo
 	-> Code
-mkModuleInit way cost_centre_info this_mod main_mod foreign_stubs imported_mods hpc_info
+mkModuleInit way cost_centre_info this_mod main_mod imported_mods hpc_info
   = do	{ -- Allocate the static boolean that records if this
           -- module has been registered already
 	  emitData Data [CmmDataLabel moduleRegdLabel, 
diff --git a/compiler/deSugar/DsForeign.lhs b/compiler/deSugar/DsForeign.lhs
index 10e072e0d3..ea264abd04 100644
--- a/compiler/deSugar/DsForeign.lhs
+++ b/compiler/deSugar/DsForeign.lhs
@@ -40,6 +40,7 @@ import Outputable
 import FastString
 
 import Data.Maybe
+import Data.List
 \end{code}
 
 Desugaring of @foreign@ declarations is naturally split up into
@@ -64,32 +65,31 @@ dsForeigns :: [LForeignDecl Id]
 dsForeigns [] 
   = returnDs (NoStubs, [])
 dsForeigns fos
-  = foldlDs combine (ForeignStubs empty empty [] [], []) fos
- where
-  combine stubs (L loc decl) = putSrcSpanDs loc (combine1 stubs decl)
-
-  combine1 (ForeignStubs acc_h acc_c acc_hdrs acc_feb, acc_f) 
-	   (ForeignImport id _ spec)
+  = do 
+    fives <- mapM do_ldecl fos
+    let
+        (hs, cs, hdrs, idss, bindss) = unzip5 fives
+        fe_ids = concat idss
+        fe_init_code = map foreignExportInitialiser fe_ids
+    --
+    return (ForeignStubs 
+             (vcat hs)
+             (vcat cs $$ vcat fe_init_code)
+             (nub (concat hdrs)),
+           (concat bindss))
+  where
+   do_ldecl (L loc decl) = putSrcSpanDs loc (do_decl decl)
+            
+   do_decl (ForeignImport id _ spec)
     = traceIf (text "fi start" <+> ppr id)	`thenDs` \ _ ->
       dsFImport (unLoc id) spec	                `thenDs` \ (bs, h, c, mbhd) -> 
       traceIf (text "fi end" <+> ppr id)	`thenDs` \ _ ->
-      returnDs (ForeignStubs (h $$ acc_h)
-      			     (c $$ acc_c)
-			     (addH mbhd acc_hdrs)
-			     acc_feb, 
-		bs ++ acc_f)
-
-  combine1 (ForeignStubs acc_h acc_c acc_hdrs acc_feb, acc_f) 
-	   (ForeignExport (L _ id) _ (CExport (CExportStatic ext_nm cconv)))
+      returnDs (h, c, maybeToList mbhd, [], bs)
+
+   do_decl (ForeignExport (L _ id) _ (CExport (CExportStatic ext_nm cconv)))
     = dsFExport id (idType id) 
 		ext_nm cconv False                 `thenDs` \(h, c, _, _) ->
-      returnDs (ForeignStubs (h $$ acc_h) (c $$ acc_c) acc_hdrs (id:acc_feb), 
-		acc_f)
-
-  addH Nothing  ls = ls
-  addH (Just e) ls
-   | e `elem` ls = ls
-   | otherwise   = e:ls
+      returnDs (h, c, [], [id], [])
 \end{code}
 
 
@@ -505,28 +505,6 @@ mkFExportCBits c_nm maybe_target arg_htys res_hty is_IO_res_ty cc
           Just hs_fn -> text "extern StgClosure " <> ppr hs_fn <> text "_closure" <> semi
 
    
-   -- Initialise foreign exports by registering a stable pointer from an
-   -- __attribute__((constructor)) function.
-   -- The alternative is to do this from stginit functions generated in
-   -- codeGen/CodeGen.lhs; however, stginit functions have a negative impact
-   -- on binary sizes and link times because the static linker will think that
-   -- all modules that are imported directly or indirectly are actually used by
-   -- the program.
-   -- (this is bad for big umbrella modules like Graphics.Rendering.OpenGL)
-
-  initialiser
-     = case maybe_target of
-          Nothing -> empty
-          Just hs_fn ->
-            vcat
-             [ text "static void stginit_export_" <> ppr hs_fn
-                  <> text "() __attribute__((constructor));"
-             , text "static void stginit_export_" <> ppr hs_fn <> text "()"
-             , braces (text "getStablePtr"
-                <> parens (text "(StgPtr) &" <> ppr hs_fn <> text "_closure")
-                <> semi)
-             ]
-
   -- finally, the whole darn thing
   c_bits =
     space $$
@@ -559,8 +537,28 @@ mkFExportCBits c_nm maybe_target arg_htys res_hty is_IO_res_ty cc
      ,   if res_hty_is_unit then empty
             else text "return cret;"
      , rbrace
-     ] $$
-    initialiser
+     ]
+
+
+foreignExportInitialiser :: Id -> SDoc
+foreignExportInitialiser hs_fn =
+   -- Initialise foreign exports by registering a stable pointer from an
+   -- __attribute__((constructor)) function.
+   -- The alternative is to do this from stginit functions generated in
+   -- codeGen/CodeGen.lhs; however, stginit functions have a negative impact
+   -- on binary sizes and link times because the static linker will think that
+   -- all modules that are imported directly or indirectly are actually used by
+   -- the program.
+   -- (this is bad for big umbrella modules like Graphics.Rendering.OpenGL)
+   vcat
+    [ text "static void stginit_export_" <> ppr hs_fn
+         <> text "() __attribute__((constructor));"
+    , text "static void stginit_export_" <> ppr hs_fn <> text "()"
+    , braces (text "getStablePtr"
+       <> parens (text "(StgPtr) &" <> ppr hs_fn <> text "_closure")
+       <> semi)
+    ]
+
 
 -- NB. the calculation here isn't strictly speaking correct.
 -- We have a primitive Haskell type (eg. Int#, Double#), and
diff --git a/compiler/main/CodeOutput.lhs b/compiler/main/CodeOutput.lhs
index b155a35ccf..25a10f6fe5 100644
--- a/compiler/main/CodeOutput.lhs
+++ b/compiler/main/CodeOutput.lhs
@@ -124,8 +124,8 @@ outputC dflags filenm mod location flat_absC
        
 	   ffi_decl_headers 
 	      = case foreign_stubs of
-		  NoStubs 		  -> []
-		  ForeignStubs _ _ fdhs _ -> map unpackFS (nub fdhs)
+		  NoStubs 		-> []
+		  ForeignStubs _ _ fdhs -> map unpackFS (nub fdhs)
 			-- Remove duplicates, because distinct foreign import decls
 			-- may cite the same #include.  Order doesn't matter.
 
@@ -217,7 +217,7 @@ outputForeignStubs dflags mod location stubs
 	stub_h_exists <- doesFileExist stub_h
 	return (stub_h_exists, stub_c_exists)
 
-  | ForeignStubs h_code c_code _ _ <- stubs
+  | ForeignStubs h_code c_code _ <- stubs
   = do
 	let
 	    stub_c_output_d = pprCode CStyle c_code
diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs
index 346e8043ea..a9c9a1501d 100644
--- a/compiler/main/HscMain.lhs
+++ b/compiler/main/HscMain.lhs
@@ -601,7 +601,7 @@ hscCompile cgguts
          ------------------  Code generation ------------------
          abstractC <- {-# SCC "CodeGen" #-}
                       codeGen dflags this_mod data_tycons
-                              foreign_stubs dir_imps cost_centre_info
+                              dir_imps cost_centre_info
                               stg_binds hpc_info
          ------------------  Convert to CPS --------------------
          --continuationC <- cmmCPS dflags abstractC >>= cmmToRawCmm
diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
index acb47c5221..cb5022e368 100644
--- a/compiler/main/HscTypes.lhs
+++ b/compiler/main/HscTypes.lhs
@@ -608,8 +608,6 @@ data ForeignStubs = NoStubs
                                         -- 	"foreign exported" functions
 			[FastString] 	-- Headers that need to be included
 				        -- 	into C code generated for this module
-			[Id]		-- Foreign-exported binders
-					-- 	we have to generate code to register these
 
 \end{code}