[project @ 2000-06-30 13:11:07 by simonpj]

[ghc-hetmet.git] / ghc / compiler / deSugar / DsForeign.lhs

diff --git a/ghc/compiler/deSugar/DsForeign.lhs b/ghc/compiler/deSugar/DsForeign.lhs
index f6b7cb6..3614d8d 100644 (file)
--- 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)
@@ -171,8 +170,9 @@ Foreign labels
 dsFLabel :: Id -> ExtName -> DsM CoreBind
 dsFLabel nm ext_name = returnDs (NonRec nm fo_rhs)
   where
-   fo_rhs = mkConApp addrDataCon [mkLit (MachLitLit enm addrPrimTy)]
+   fo_rhs = mkConApp addrDataCon [mkLit (MachLitLit addr addrPrimTy)]
    enm    = extNameStatic ext_name
+   addr   = SLIT("(&") _APPEND_ enm _APPEND_ SLIT(")")
 \end{code}
 
 The function that does most of the work for `@foreign export@' declarations.