X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FdeSugar%2FDsForeign.lhs;h=4b2c1de26fc7a0540f44aee387f7bf47693cc264;hb=79d7a7c0d17b51dfb2bb06d758b6e556550862ba;hp=77aa4120ceec8f4e43c1be60a201c759c6ba93e4;hpb=1f5e55804b97d2b9a77207d568d602ba88d8855d;p=ghc-hetmet.git

diff --git a/ghc/compiler/deSugar/DsForeign.lhs b/ghc/compiler/deSugar/DsForeign.lhs
index 77aa412..4b2c1de 100644
--- a/ghc/compiler/deSugar/DsForeign.lhs
+++ b/ghc/compiler/deSugar/DsForeign.lhs
@@ -16,9 +16,10 @@ 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 MachOp		( machRepByteWidth )
+import SMRep		( argMachRep, primRepToCgRep )
 import CoreUtils	( exprType, mkInlineMe )
 import Id		( Id, idType, idName, mkSysLocal, setInlinePragma )
 import Literal		( Literal(..) )
@@ -35,17 +36,16 @@ import BasicTypes       ( Boxity(..) )
 import HscTypes		( ForeignStubs(..) )
 import ForeignCall	( ForeignCall(..), CCallSpec(..), 
 			  Safety(..), playSafe,
-			  CExportSpec(..),
+			  CExportSpec(..), CLabelString,
 			  CCallConv(..), ccallConvToInt,
 			  ccallConvAttribute
 			)
-import CStrings		( CLabelString )
 import TysWiredIn	( unitTy, tupleTyCon )
 import TysPrim		( addrPrimTy, mkStablePtrPrimTy, alphaTy )
-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
@@ -68,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, [])
@@ -76,10 +76,10 @@ 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)
+	  (L loc (ForeignImport id _ spec depr))
     = traceIf (text "fi start" <+> ppr id)	`thenDs` \ _ ->
-      dsFImport id spec	           `thenDs` \ (bs, h, c, mbhd) -> 
-      warnDepr depr loc		   `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)
@@ -88,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` \_              ->
@@ -389,7 +389,7 @@ dsFExportDynamic id cconv
 	-- (probably in the RTS.) 
       adjustor	 = FSLIT("createAdjustor")
       
-      sz_args	 = sum (map (getPrimRepSizeInBytes . typePrimRep) stub_args)
+      sz_args	 = sum (map (machRepByteWidth.argMachRep.primRepToCgRep.typePrimRep) stub_args)
       mb_sz_args = case cconv of
 		      StdCallConv -> Just sz_args
 		      _ 	  -> Nothing