X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FdeSugar%2FDsForeign.lhs;h=3614d8d69715bbc4d7c5f4a559e5e3a52e8570ad;hb=b0624daa9057eec25ddf35a9ed3c771b9c5d9c75;hp=b0d3fb0a049feaffe5e75e046ce47194f80fb7f9;hpb=9282daea70e7c3d8023e1d5567dc903260332e97;p=ghc-hetmet.git

diff --git a/ghc/compiler/deSugar/DsForeign.lhs b/ghc/compiler/deSugar/DsForeign.lhs
index b0d3fb0..3614d8d 100644
--- a/ghc/compiler/deSugar/DsForeign.lhs
+++ b/ghc/compiler/deSugar/DsForeign.lhs
@@ -38,7 +38,7 @@ import Type		( unUsgTy, repType,
 			  mkTyVarTy, mkFunTy, splitAppTy, applyTy, funResultTy
 			)
 import PprType		( {- instance Outputable Type -} )
-import PrimOp		( PrimOp(..), CCall(..), CCallTarget(..) )
+import PrimOp		( PrimOp(..), CCall(..), CCallTarget(..), dynamicTarget )
 import Var		( TyVar )
 import TysPrim		( realWorldStatePrimTy, addrPrimTy )
 import TysWiredIn	( unitTy, addrTy, stablePtrTyCon,
@@ -141,14 +141,13 @@ dsFImport fn_id ty may_not_gc ext_name cconv
     mapAndUnzipDs unboxArg (map Var args)	`thenDs` \ (val_args, arg_wrappers) ->
     boxResult io_res_ty				`thenDs` \ (ccall_result_ty, res_wrapper) ->
 
-    (case ext_name of
-       Dynamic       -> getUniqueDs `thenDs` \ u -> 
-			returnDs (DynamicTarget u)
-       ExtName fs _  -> returnDs (StaticTarget fs))	`thenDs` \ lbl ->
-
     getUniqueDs						`thenDs` \ ccall_uniq ->
     getUniqueDs						`thenDs` \ work_uniq ->
     let
+	lbl = case ext_name of
+		Dynamic	     -> dynamicTarget
+	        ExtName fs _ -> StaticTarget fs
+
 	-- Build the worker
 	work_arg_ids  = [v | Var v <- val_args]		-- All guaranteed to be vars
 	worker_ty     = mkForAllTys tvs (mkFunTys (map idType work_arg_ids) ccall_result_ty)