From: sof <unknown>
Date: Sat, 22 Mar 2003 06:28:58 +0000 (+0000)
Subject: [project @ 2003-03-22 06:28:58 by sof]
X-Git-Tag: Approx_11550_changesets_converted~1048
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=e62b2b1e50cd10982da28e1802460cda797898be;p=ghc-hetmet.git

[project @ 2003-03-22 06:28:58 by sof]
dsForeigns: common up header files
---

diff --git a/ghc/compiler/deSugar/DsForeign.lhs b/ghc/compiler/deSugar/DsForeign.lhs
index b2ad06b..676519e 100644
--- a/ghc/compiler/deSugar/DsForeign.lhs
+++ b/ghc/compiler/deSugar/DsForeign.lhs
@@ -73,9 +73,12 @@ dsForeigns fos
  where
   combine (ForeignStubs acc_h acc_c acc_hdrs acc_feb, acc_f) 
 	  (ForeignImport id _ spec depr loc)
-    = dsFImport id spec	           `thenDs` \(bs, h, c, hd) -> 
-      warnDepr depr loc				   `thenDs` \_              ->
-      returnDs (ForeignStubs (h $$ acc_h) (c $$ acc_c) (hd ++ acc_hdrs) acc_feb, 
+    = dsFImport id spec	           `thenDs` \ (bs, h, c, mbhd) -> 
+      warnDepr depr loc		   `thenDs` \ _                ->
+      returnDs (ForeignStubs (h $$ acc_h)
+      			     (c $$ acc_c)
+			     (addH mbhd acc_hdrs)
+			     acc_feb, 
 		bs ++ acc_f)
 
   combine (ForeignStubs acc_h acc_c acc_hdrs acc_feb, acc_f) 
@@ -86,6 +89,11 @@ dsForeigns fos
       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
+
   warnDepr False _   = returnDs ()
   warnDepr True  loc = dsWarn (loc, msg)
    where
@@ -120,10 +128,10 @@ because it exposes the boxing to the call site.
 \begin{code}
 dsFImport :: Id
 	  -> ForeignImport
-	  -> DsM ([Binding], SDoc, SDoc, [FastString])
+	  -> DsM ([Binding], SDoc, SDoc, Maybe FastString)
 dsFImport id (CImport cconv safety header lib spec)
   = dsCImport id spec cconv safety no_hdrs	  `thenDs` \(ids, h, c) ->
-    returnDs (ids, h, c, if no_hdrs then [] else [header])
+    returnDs (ids, h, c, if no_hdrs then Nothing else Just header)
   where
     no_hdrs = nullFastString header
 
@@ -132,7 +140,7 @@ dsFImport id (CImport cconv safety header lib spec)
   --	    support such calls yet; if `nullFastString lib', the value was not given
 dsFImport id (DNImport spec)
   = dsFCall id (DNCall spec) True {- No headers -} `thenDs` \(ids, h, c) ->
-    returnDs (ids, h, c, [])
+    returnDs (ids, h, c, Nothing)
 
 dsCImport :: Id
 	  -> CImportSpec