projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
[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
b0d3fb0
..
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 -} )
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,
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) ->
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
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)
-- 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)