Commit d7d4132c authored by simonmar's avatar simonmar
Browse files

[project @ 2000-07-11 15:57:11 by simonmar]

use MachLabel rather than MachLitLit for compiling foreign label and
foreign export dynamic.
parent 301c9e60
...@@ -14,18 +14,15 @@ import CoreSyn ...@@ -14,18 +14,15 @@ import CoreSyn
import DsCCall ( dsCCall, mkCCall, boxResult, unboxArg ) import DsCCall ( dsCCall, mkCCall, boxResult, unboxArg )
import DsMonad import DsMonad
import DsUtils
import HsSyn ( ExtName(..), ForeignDecl(..), isDynamicExtName, ForKind(..) ) import HsSyn ( ExtName(..), ForeignDecl(..), isDynamicExtName, ForKind(..) )
import HsDecls ( extNameStatic ) import HsDecls ( extNameStatic )
import CallConv import CallConv
import TcHsSyn ( TypecheckedForeignDecl ) import TcHsSyn ( TypecheckedForeignDecl )
import CoreUtils ( exprType, mkInlineMe ) import CoreUtils ( exprType, mkInlineMe )
import DataCon ( DataCon, dataConWrapId ) import Id ( Id, idType, idName, mkVanillaId, mkSysLocal,
import Id ( Id, idType, idName, mkWildId, mkVanillaId, mkSysLocal,
setInlinePragma ) setInlinePragma )
import IdInfo ( neverInlinePrag ) import IdInfo ( neverInlinePrag )
import MkId ( mkWorkerId )
import Literal ( Literal(..) ) import Literal ( Literal(..) )
import Module ( Module, moduleUserString ) import Module ( Module, moduleUserString )
import Name ( mkGlobalName, nameModule, nameOccName, getOccString, import Name ( mkGlobalName, nameModule, nameOccName, getOccString,
...@@ -37,10 +34,8 @@ import Type ( unUsgTy, repType, ...@@ -37,10 +34,8 @@ import Type ( unUsgTy, repType,
Type, mkFunTys, mkForAllTys, mkTyConApp, Type, mkFunTys, mkForAllTys, mkTyConApp,
mkTyVarTy, mkFunTy, splitAppTy, applyTy, funResultTy mkTyVarTy, mkFunTy, splitAppTy, applyTy, funResultTy
) )
import PprType ( {- instance Outputable Type -} ) import PrimOp ( PrimOp(..), CCall(..),
import PrimOp ( PrimOp(..), CCall(..), CCallTarget(..), dynamicTarget ) CCallTarget(..), dynamicTarget )
import Var ( TyVar )
import TysPrim ( realWorldStatePrimTy, addrPrimTy )
import TysWiredIn ( unitTy, addrTy, stablePtrTyCon, import TysWiredIn ( unitTy, addrTy, stablePtrTyCon,
addrDataCon addrDataCon
) )
...@@ -48,7 +43,6 @@ import Unique ( Uniquable(..), hasKey, ...@@ -48,7 +43,6 @@ import Unique ( Uniquable(..), hasKey,
ioTyConKey, deRefStablePtrIdKey, returnIOIdKey, ioTyConKey, deRefStablePtrIdKey, returnIOIdKey,
bindIOIdKey, makeStablePtrIdKey bindIOIdKey, makeStablePtrIdKey
) )
import Maybes ( maybeToBool )
import Outputable import Outputable
\end{code} \end{code}
...@@ -170,9 +164,8 @@ Foreign labels ...@@ -170,9 +164,8 @@ Foreign labels
dsFLabel :: Id -> ExtName -> DsM CoreBind dsFLabel :: Id -> ExtName -> DsM CoreBind
dsFLabel nm ext_name = returnDs (NonRec nm fo_rhs) dsFLabel nm ext_name = returnDs (NonRec nm fo_rhs)
where where
fo_rhs = mkConApp addrDataCon [mkLit (MachLitLit addr addrPrimTy)] fo_rhs = mkConApp addrDataCon [mkLit (MachLabel enm)]
enm = extNameStatic ext_name enm = extNameStatic ext_name
addr = SLIT("(&") _APPEND_ enm _APPEND_ SLIT(")")
\end{code} \end{code}
The function that does most of the work for `@foreign export@' declarations. The function that does most of the work for `@foreign export@' declarations.
...@@ -358,7 +351,7 @@ dsFExportDynamic i ty mod_name ext_name cconv = ...@@ -358,7 +351,7 @@ dsFExportDynamic i ty mod_name ext_name cconv =
-} -}
adj_args = [ mkIntLitInt (callConvToInt cconv) adj_args = [ mkIntLitInt (callConvToInt cconv)
, Var stbl_value , Var stbl_value
, mkLit (MachLitLit (_PK_ fe_nm) addrPrimTy) , mkLit (MachLabel (_PK_ fe_nm))
] ]
-- name of external entry point providing these services. -- name of external entry point providing these services.
-- (probably in the RTS.) -- (probably in the RTS.)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment