X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FdeSugar%2FDsForeign.lhs;h=05dcb05221ee9649f71a56e643fb188c79b378f0;hb=32beaa8d5849022120095258e6392673b0a208a5;hp=22c8569aaeeecf431f76d5cd8d63d53adb4e4abe;hpb=2129fa6fc4afd7f7b0c767f8c0c14b9ab5508ec2;p=ghc-hetmet.git

diff --git a/ghc/compiler/deSugar/DsForeign.lhs b/ghc/compiler/deSugar/DsForeign.lhs
index 22c8569..05dcb05 100644
--- a/ghc/compiler/deSugar/DsForeign.lhs
+++ b/ghc/compiler/deSugar/DsForeign.lhs
@@ -9,15 +9,15 @@ Expanding out @foreign import@ and @foreign export@ declarations.
 module DsForeign ( dsForeigns ) where
 
 #include "HsVersions.h"
+import TcRnMonad	-- temp
 
 import CoreSyn
 
 import DsCCall		( dsCCall, mkFCall, boxResult, unboxArg, resultWrapper )
 import DsMonad
 
-import HsSyn		( ForeignDecl(..), ForeignExport(..),
+import HsSyn		( ForeignDecl(..), ForeignExport(..), LForeignDecl,
 			  ForeignImport(..), CImportSpec(..) )
-import TcHsSyn		( TypecheckedForeignDecl )
 import CoreUtils	( exprType, mkInlineMe )
 import Id		( Id, idType, idName, mkSysLocal, setInlinePragma )
 import Literal		( Literal(..) )
@@ -45,6 +45,7 @@ import PrimRep          ( getPrimRepSizeInBytes )
 import PrelNames	( hasKey, ioTyConKey, stablePtrTyConName, newStablePtrName, bindIOName,
 			  checkDotnetResName )
 import BasicTypes	( Activation( NeverActive ) )
+import SrcLoc		( Located(..), unLoc )
 import Outputable
 import Maybe 		( fromJust )
 import FastString
@@ -67,7 +68,7 @@ so we reuse the desugaring code in @DsCCall@ to deal with these.
 type Binding = (Id, CoreExpr)	-- No rec/nonrec structure;
 				-- the occurrence analyser will sort it all out
 
-dsForeigns :: [TypecheckedForeignDecl] 
+dsForeigns :: [LForeignDecl Id] 
 	   -> DsM (ForeignStubs, [Binding])
 dsForeigns [] 
   = returnDs (NoStubs, [])
@@ -75,9 +76,11 @@ dsForeigns fos
   = foldlDs combine (ForeignStubs empty empty [] [], []) 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, mbhd) -> 
+	  (L loc (ForeignImport id _ spec depr))
+    = traceIf (text "fi start" <+> ppr id)	`thenDs` \ _ ->
+      dsFImport (unLoc id) spec	           `thenDs` \ (bs, h, c, mbhd) -> 
       warnDepr depr loc		   `thenDs` \ _                ->
+      traceIf (text "fi end" <+> ppr id)	`thenDs` \ _ ->
       returnDs (ForeignStubs (h $$ acc_h)
       			     (c $$ acc_c)
 			     (addH mbhd acc_hdrs)
@@ -85,7 +88,7 @@ dsForeigns fos
 		bs ++ acc_f)
 
   combine (ForeignStubs acc_h acc_c acc_hdrs acc_feb, acc_f) 
-	  (ForeignExport id _ (CExport (CExportStatic ext_nm cconv)) depr loc)
+	  (L loc (ForeignExport (L _ id) _ (CExport (CExportStatic ext_nm cconv)) depr))
     = dsFExport id (idType id) 
 		ext_nm cconv False                 `thenDs` \(h, c, _) ->
       warnDepr depr loc				   `thenDs` \_              ->
@@ -99,8 +102,8 @@ dsForeigns fos
 
   warnDepr False _   = returnDs ()
   warnDepr True  loc = dsWarn (loc, msg)
-   where
-    msg = ptext SLIT("foreign declaration uses deprecated non-standard syntax")
+     where
+       msg = ptext SLIT("foreign declaration uses deprecated non-standard syntax")
 \end{code}
 
 
@@ -234,8 +237,8 @@ dsFCall fn_id fcall no_hdrs
     topConDs					     `thenDs` \ topCon -> 
     boxResult maybe_arg_ids augment topCon io_res_ty `thenDs` \ (ccall_result_ty, res_wrapper) ->
 
-    getUniqueDs					`thenDs` \ ccall_uniq ->
-    getUniqueDs					`thenDs` \ work_uniq ->
+    newUnique					`thenDs` \ ccall_uniq ->
+    newUnique					`thenDs` \ work_uniq ->
     let
 	-- Build the worker
 	worker_ty     = mkForAllTys tvs (mkFunTys (map idType work_arg_ids) ccall_result_ty)
@@ -290,7 +293,7 @@ dsFExport :: Id			-- Either the exported Id,
 dsFExport fn_id ty ext_name cconv isDyn
    = 
      let
-        (tvs,sans_foralls)		= tcSplitForAllTys ty
+        (_tvs,sans_foralls)		= tcSplitForAllTys ty
         (fe_arg_tys', orig_res_ty)	= tcSplitFunTys sans_foralls
 	-- We must use tcSplits here, because we want to see 
 	-- the (IO t) in the corner of the type!