Commit ed4cd6d4 authored by simonm's avatar simonm

[project @ 1999-01-26 11:12:41 by simonm]

- Add Stable Names

- Stable pointers and stable names are now both provided by the
  "Stable" module in ghc/lib/exts.  Documentation is updated, and Foriegn
  still exports the stable pointer operations for backwards compatibility.
parent b311f131
......@@ -1244,6 +1244,7 @@ pprUnionTag FloatRep = char 'f'
pprUnionTag DoubleRep = panic "pprUnionTag:Double?"
pprUnionTag StablePtrRep = char 'i'
pprUnionTag StableNameRep = char 'p'
pprUnionTag WeakPtrRep = char 'p'
pprUnionTag ForeignObjRep = char 'p'
......
......@@ -160,8 +160,9 @@ module Unique (
stablePtrDataConKey,
stablePtrPrimTyConKey,
stablePtrTyConKey,
stateDataConKey,
stateTyConKey,
stableNameDataConKey,
stableNamePrimTyConKey,
stableNameTyConKey,
statePrimTyConKey,
typeConKey,
......@@ -517,8 +518,9 @@ rationalTyConKey = mkPreludeTyConUnique 31
realWorldTyConKey = mkPreludeTyConUnique 32
stablePtrPrimTyConKey = mkPreludeTyConUnique 33
stablePtrTyConKey = mkPreludeTyConUnique 34
stateTyConKey = mkPreludeTyConUnique 50
statePrimTyConKey = mkPreludeTyConUnique 51
statePrimTyConKey = mkPreludeTyConUnique 35
stableNamePrimTyConKey = mkPreludeTyConUnique 50
stableNameTyConKey = mkPreludeTyConUnique 51
mutableByteArrayTyConKey = mkPreludeTyConUnique 52
mutVarPrimTyConKey = mkPreludeTyConUnique 53
ioTyConKey = mkPreludeTyConUnique 55
......@@ -562,7 +564,7 @@ foreignObjDataConKey = mkPreludeDataConUnique 13
nilDataConKey = mkPreludeDataConUnique 14
ratioDataConKey = mkPreludeDataConUnique 15
stablePtrDataConKey = mkPreludeDataConUnique 16
stateDataConKey = mkPreludeDataConUnique 33
stableNameDataConKey = mkPreludeDataConUnique 17
trueDataConKey = mkPreludeDataConUnique 34
wordDataConKey = mkPreludeDataConUnique 35
word8DataConKey = mkPreludeDataConUnique 36
......
......@@ -21,8 +21,13 @@ import OrdList ( OrdList )
import PrimOp ( commutableOp, PrimOp(..) )
import RegAllocInfo ( mkMRegsState, MRegsState )
import Stix ( StixTree(..), StixReg(..) )
import PrimRep ( isFloatingRep )
import UniqSupply ( returnUs, thenUs, mapUs, initUs, UniqSM, UniqSupply )
import UniqFM ( UniqFM, emptyUFM, addToUFM, lookupUFM )
import Outputable
import GlaExts (trace) --tmp
#include "nativeGen/NCG.h"
\end{code}
The 96/03 native-code generator has machine-independent and
......@@ -85,7 +90,14 @@ runNCG absC
let
stix = map (map genericOpt) treelists
in
#if i386_TARGET_ARCH
let
stix' = map floatFix stix
in
codeGen stix'
#else
codeGen stix
#endif
\end{code}
@codeGen@ is the top-level code-generation function:
......@@ -282,3 +294,64 @@ Anything else is just too hard.
\begin{code}
primOpt op args = StPrim op args
\end{code}
-----------------------------------------------------------------------------
Fix up floating point operations for x86.
The problem is that the code generator can't handle the weird register
naming scheme for floating point registers on the x86, so we have to
deal with memory-resident floating point values wherever possible.
We therefore can't stand references to floating-point kinded temporary
variables, and try to translate them into memory addresses wherever
possible.
\begin{code}
floatFix :: [StixTree] -> [StixTree]
floatFix trees = fltFix emptyUFM trees
fltFix :: UniqFM StixTree -- mapping tmp vars to memory locations
-> [StixTree]
-> [StixTree]
fltFix locs [] = []
-- The case we're interested in: loading a temporary from a memory
-- address. Eliminate the instruction and replace all future references
-- to the temporary with the memory address.
fltFix locs ((StAssign rep (StReg (StixTemp uq _)) loc) : trees)
| isFloatingRep rep = trace "found one" $ fltFix (addToUFM locs uq loc) trees
fltFix locs ((StAssign rep src dst) : trees)
= StAssign rep (fltFix1 locs src) (fltFix1 locs dst) : fltFix locs trees
fltFix locs (tree : trees)
= fltFix1 locs tree : fltFix locs trees
fltFix1 :: UniqFM StixTree -> StixTree -> StixTree
fltFix1 locs r@(StReg (StixTemp uq rep))
| isFloatingRep rep = case lookupUFM locs uq of
Nothing -> panic "fltFix1"
Just tree -> trace "substed" $ tree
fltFix1 locs (StIndex rep l r) =
StIndex rep (fltFix1 locs l) (fltFix1 locs r)
fltFix1 locs (StInd rep tree) =
StInd rep (fltFix1 locs tree)
fltFix1 locs (StAssign rep dst src) = panic "fltFix1: StAssign"
fltFix1 locs (StJump tree) = StJump (fltFix1 locs tree)
fltFix1 locs (StCondJump label tree) =
StCondJump label (fltFix1 locs tree)
fltFix1 locs (StPrim op trees) =
StPrim op (map (fltFix1 locs) trees)
fltFix1 locs (StCall f conv rep trees) =
StCall f conv rep (map (fltFix1 locs) trees)
fltFix1 locs tree = tree
\end{code}
......@@ -171,6 +171,7 @@ prim_tycons
, mutVarPrimTyCon
, realWorldTyCon
, stablePtrPrimTyCon
, stableNamePrimTyCon
, statePrimTyCon
, threadIdPrimTyCon
, wordPrimTyCon
......@@ -459,9 +460,9 @@ byteArrayTyCon_RDR = tcQual (pREL_ARR, SLIT("ByteArray"))
mutableByteArrayTyCon_RDR = tcQual (pREL_ARR, SLIT("MutableByteArray"))
foreignObjTyCon_RDR = tcQual (pREL_IO_BASE, SLIT("ForeignObj"))
stablePtrTyCon_RDR = tcQual (pREL_FOREIGN, SLIT("StablePtr"))
deRefStablePtr_RDR = varQual (pREL_FOREIGN, SLIT("deRefStablePtr"))
makeStablePtr_RDR = varQual (pREL_FOREIGN, SLIT("makeStablePtr"))
stablePtrTyCon_RDR = tcQual (pREL_STABLE, SLIT("StablePtr"))
deRefStablePtr_RDR = varQual (pREL_STABLE, SLIT("deRefStablePtr"))
makeStablePtr_RDR = varQual (pREL_STABLE, SLIT("makeStablePtr"))
eqClass_RDR = tcQual (pREL_BASE, SLIT("Eq"))
ordClass_RDR = tcQual (pREL_BASE, SLIT("Ord"))
......
......@@ -17,6 +17,7 @@ module PrelMods
pREL_GHC, pRELUDE, mONAD, rATIO, iX, mAIN, pREL_MAIN, pREL_ERR,
pREL_BASE, pREL_NUM, pREL_LIST, pREL_TUP, pREL_ADDR, pREL_READ,
pREL_PACK, pREL_CONC, pREL_IO_BASE, pREL_ST, pREL_ARR, pREL_FOREIGN,
pREL_STABLE,
iNT, wORD
) where
......@@ -31,7 +32,8 @@ import Panic ( panic )
\begin{code}
pREL_GHC, pRELUDE, mONAD, rATIO, iX, mAIN, pREL_MAIN, pREL_ERR :: Module
pREL_BASE, pREL_NUM, pREL_LIST, pREL_TUP, pREL_ADDR, pREL_READ :: Module
pREL_PACK, pREL_CONC, pREL_IO_BASE, pREL_ST, pREL_ARR, pREL_FOREIGN :: Module
pREL_PACK, pREL_CONC, pREL_IO_BASE, pREL_ST, pREL_ARR :: Module
pREL_FOREIGN, pREL_STABLE :: Module
pRELUDE = mkModule "Prelude"
......@@ -47,6 +49,7 @@ pREL_IO_BASE = mkModule "PrelIOBase"
pREL_ST = mkModule "PrelST"
pREL_ARR = mkModule "PrelArr"
pREL_FOREIGN = mkModule "PrelForeign"
pREL_STABLE = mkModule "PrelStable"
pREL_ADDR = mkModule "PrelAddr"
pREL_ERR = mkModule "PrelErr"
......
......@@ -173,6 +173,10 @@ data PrimOp
| MkWeakOp
| DeRefWeakOp
| MakeStableNameOp
| EqStableNameOp
| StableNameToIntOp
| MakeStablePtrOp
| DeRefStablePtrOp
| EqStablePtrOp
......@@ -496,32 +500,35 @@ tagOf_PrimOp MakeForeignObjOp = ILIT(201)
tagOf_PrimOp WriteForeignObjOp = ILIT(202)
tagOf_PrimOp MkWeakOp = ILIT(203)
tagOf_PrimOp DeRefWeakOp = ILIT(204)
tagOf_PrimOp MakeStablePtrOp = ILIT(205)
tagOf_PrimOp DeRefStablePtrOp = ILIT(206)
tagOf_PrimOp EqStablePtrOp = ILIT(207)
tagOf_PrimOp (CCallOp _ _ _ _) = ILIT(208)
tagOf_PrimOp ReallyUnsafePtrEqualityOp = ILIT(209)
tagOf_PrimOp SeqOp = ILIT(210)
tagOf_PrimOp ParOp = ILIT(211)
tagOf_PrimOp ForkOp = ILIT(212)
tagOf_PrimOp KillThreadOp = ILIT(213)
tagOf_PrimOp DelayOp = ILIT(214)
tagOf_PrimOp WaitReadOp = ILIT(215)
tagOf_PrimOp WaitWriteOp = ILIT(216)
tagOf_PrimOp ParGlobalOp = ILIT(217)
tagOf_PrimOp ParLocalOp = ILIT(218)
tagOf_PrimOp ParAtOp = ILIT(219)
tagOf_PrimOp ParAtAbsOp = ILIT(220)
tagOf_PrimOp ParAtRelOp = ILIT(221)
tagOf_PrimOp ParAtForNowOp = ILIT(222)
tagOf_PrimOp CopyableOp = ILIT(223)
tagOf_PrimOp NoFollowOp = ILIT(224)
tagOf_PrimOp NewMutVarOp = ILIT(225)
tagOf_PrimOp ReadMutVarOp = ILIT(226)
tagOf_PrimOp WriteMutVarOp = ILIT(227)
tagOf_PrimOp SameMutVarOp = ILIT(228)
tagOf_PrimOp CatchOp = ILIT(229)
tagOf_PrimOp RaiseOp = ILIT(230)
tagOf_PrimOp MakeStableNameOp = ILIT(205)
tagOf_PrimOp EqStableNameOp = ILIT(206)
tagOf_PrimOp StableNameToIntOp = ILIT(207)
tagOf_PrimOp MakeStablePtrOp = ILIT(208)
tagOf_PrimOp DeRefStablePtrOp = ILIT(209)
tagOf_PrimOp EqStablePtrOp = ILIT(210)
tagOf_PrimOp (CCallOp _ _ _ _) = ILIT(211)
tagOf_PrimOp ReallyUnsafePtrEqualityOp = ILIT(212)
tagOf_PrimOp SeqOp = ILIT(213)
tagOf_PrimOp ParOp = ILIT(214)
tagOf_PrimOp ForkOp = ILIT(215)
tagOf_PrimOp KillThreadOp = ILIT(216)
tagOf_PrimOp DelayOp = ILIT(217)
tagOf_PrimOp WaitReadOp = ILIT(218)
tagOf_PrimOp WaitWriteOp = ILIT(219)
tagOf_PrimOp ParGlobalOp = ILIT(220)
tagOf_PrimOp ParLocalOp = ILIT(221)
tagOf_PrimOp ParAtOp = ILIT(222)
tagOf_PrimOp ParAtAbsOp = ILIT(223)
tagOf_PrimOp ParAtRelOp = ILIT(224)
tagOf_PrimOp ParAtForNowOp = ILIT(225)
tagOf_PrimOp CopyableOp = ILIT(226)
tagOf_PrimOp NoFollowOp = ILIT(227)
tagOf_PrimOp NewMutVarOp = ILIT(228)
tagOf_PrimOp ReadMutVarOp = ILIT(229)
tagOf_PrimOp WriteMutVarOp = ILIT(230)
tagOf_PrimOp SameMutVarOp = ILIT(231)
tagOf_PrimOp CatchOp = ILIT(232)
tagOf_PrimOp RaiseOp = ILIT(233)
tagOf_PrimOp op = pprPanic# "tagOf_PrimOp: pattern-match" (ppr op)
--panic# "tagOf_PrimOp: pattern-match"
......@@ -758,6 +765,9 @@ allThePrimOps
WriteForeignObjOp,
MkWeakOp,
DeRefWeakOp,
MakeStableNameOp,
EqStableNameOp,
StableNameToIntOp,
MakeStablePtrOp,
DeRefStablePtrOp,
EqStablePtrOp,
......@@ -874,6 +884,7 @@ primOpStrictness CatchOp = ([wwLazy, wwLazy], False)
primOpStrictness RaiseOp = ([wwLazy], True) -- NB: True => result is bottom
primOpStrictness MkWeakOp = ([wwLazy, wwLazy, wwLazy, wwPrim], False)
primOpStrictness MakeStableNameOp = ([wwLazy, wwPrim], False)
primOpStrictness MakeStablePtrOp = ([wwLazy, wwPrim], False)
-- The rest all have primitive-typed arguments
......@@ -1580,39 +1591,63 @@ primOpInfo DeRefWeakOp
%************************************************************************
%* *
\subsubsection[PrimOp-stable-pointers]{PrimOpInfo for ``stable pointers''}
\subsubsection[PrimOp-stable-pointers]{PrimOpInfo for stable pointers and stable names}
%* *
%************************************************************************
A {\em stable pointer} is an index into a table of pointers into the
heap. Since the garbage collector is told about stable pointers, it
is safe to pass a stable pointer to external systems such as C
A {\em stable name/pointer} is an index into a table of stable name
entries. Since the garbage collector is told about stable pointers,
it is safe to pass a stable pointer to external systems such as C
routines.
Here's what the operations and types are supposed to be (from
state-interface document).
\begin{verbatim}
makeStablePtr# :: a -> State# _RealWorld -> (# State# _RealWorld, a #)
freeStablePtr# :: StablePtr# a -> State# _RealWorld -> State# _RealWorld
deRefStablePtr# :: StablePtr# a -> State# _RealWorld -> (# State# _RealWorld, a #)
makeStablePtr# :: a -> State# RealWorld -> (# State# RealWorld, a #)
freeStablePtr :: StablePtr# a -> State# RealWorld -> State# RealWorld
deRefStablePtr# :: StablePtr# a -> State# RealWorld -> (# State# RealWorld, a #)
eqStablePtr# :: StablePtr# a -> StablePtr# a -> Int#
\end{verbatim}
It may seem a bit surprising that @makeStablePtr#@ is a @PrimIO@
It may seem a bit surprising that @makeStablePtr#@ is a @IO@
operation since it doesn't (directly) involve IO operations. The
reason is that if some optimisation pass decided to duplicate calls to
@makeStablePtr#@ and we only pass one of the stable pointers over, a
massive space leak can result. Putting it into the PrimIO monad
massive space leak can result. Putting it into the IO monad
prevents this. (Another reason for putting them in a monad is to
ensure correct sequencing wrt the side-effecting @freeStablePtr#@
ensure correct sequencing wrt the side-effecting @freeStablePtr@
operation.)
An important property of stable pointers is that if you call
makeStablePtr# twice on the same object you get the same stable
pointer back.
Note that we can implement @freeStablePtr#@ using @_ccall_@ (and,
besides, it's not likely to be used from Haskell) so it's not a
primop.
Question: Why @_RealWorld@ - won't any instance of @_ST@ do the job? [ADR]
Question: Why @RealWorld@ - won't any instance of @_ST@ do the job? [ADR]
Stable Names
~~~~~~~~~~~~
A stable name is like a stable pointer, but with three important differences:
(a) You can't deRef one to get back to the original object.
(b) You can convert one to an Int.
(c) You don't need to 'freeStableName'
The existence of a stable name doesn't guarantee to keep the object it
points to alive (unlike a stable pointer), hence (a).
Invariants:
(a) makeStableName always returns the same value for a given
object (same as stable pointers).
(b) if two stable names are equal, it implies that the objects
from which they were created were the same.
(c) stableNameToInt always returns the same Int for a given
stable name.
\begin{code}
primOpInfo MakeStablePtrOp
......@@ -1630,6 +1665,22 @@ primOpInfo EqStablePtrOp
= mkGenPrimOp SLIT("eqStablePtr#") [alphaTyVar, betaTyVar]
[mkStablePtrPrimTy alphaTy, mkStablePtrPrimTy betaTy]
intPrimTy
primOpInfo MakeStableNameOp
= mkGenPrimOp SLIT("makeStableName#") [alphaTyVar]
[alphaTy, realWorldStatePrimTy]
(unboxedPair [realWorldStatePrimTy,
mkTyConApp stableNamePrimTyCon [alphaTy]])
primOpInfo EqStableNameOp
= mkGenPrimOp SLIT("eqStableName#") [alphaTyVar, betaTyVar]
[mkStableNamePrimTy alphaTy, mkStableNamePrimTy betaTy]
intPrimTy
primOpInfo StableNameToIntOp
= mkGenPrimOp SLIT("stableNameToInt#") [alphaTyVar]
[mkStableNamePrimTy alphaTy]
intPrimTy
\end{code}
%************************************************************************
......@@ -1772,8 +1823,8 @@ primOpOutOfLine op
DoubleDecodeOp -> True
MkWeakOp -> True
DeRefWeakOp -> True
MakeStableNameOp -> True
MakeForeignObjOp -> True
MakeStablePtrOp -> True
NewMutVarOp -> True
NewMVarOp -> True
ForkOp -> True
......@@ -1854,6 +1905,7 @@ primOpHasSideEffects WriteForeignObjOp = True
primOpHasSideEffects MkWeakOp = True
primOpHasSideEffects DeRefWeakOp = True
primOpHasSideEffects MakeStablePtrOp = True
primOpHasSideEffects MakeStableNameOp = True
primOpHasSideEffects EqStablePtrOp = True -- SOF
primOpHasSideEffects DeRefStablePtrOp = True -- ??? JSM & ADR
......@@ -1914,7 +1966,7 @@ primOpNeedsWrapper DoubleTanhOp = True
primOpNeedsWrapper DoublePowerOp = True
primOpNeedsWrapper DoubleEncodeOp = True
primOpNeedsWrapper MakeStablePtrOp = True
primOpNeedsWrapper MakeStableNameOp = True
primOpNeedsWrapper DeRefStablePtrOp = True
primOpNeedsWrapper DelayOp = True
......
......@@ -62,6 +62,12 @@ data PrimRep
-- there's some documentation gain from having
-- it special? [ADR]
| StableNameRep -- A stable name is a real heap object, unpointed,
-- with one field containing an index into the
-- stable pointer table. It has to be a heap
-- object so the garbage collector can track these
-- objects and reclaim stable pointer entries.
| ThreadIdRep -- Really a pointer to a TSO
| ArrayRep -- Primitive array of Haskell pointers
......@@ -105,6 +111,7 @@ isFollowableRep ArrayRep = True -- all heap objects:
isFollowableRep ByteArrayRep = True -- ''
isFollowableRep WeakPtrRep = True -- ''
isFollowableRep ForeignObjRep = True -- ''
isFollowableRep StableNameRep = True -- ''
isFollowableRep ThreadIdRep = True -- pointer to a TSO
isFollowableRep other = False
......@@ -179,6 +186,7 @@ getPrimRepSizeInBytes pr =
WeakPtrRep -> 4
ForeignObjRep -> 4
StablePtrRep -> 4
StableNameRep -> 4
ArrayRep -> 4
ByteArrayRep -> 4
_ -> panic "getPrimRepSize: ouch - this wasn't supposed to happen!"
......@@ -217,6 +225,7 @@ showPrimRep DoubleRep = "StgDouble"
showPrimRep ArrayRep = "P_" -- see comment below
showPrimRep ByteArrayRep = "StgByteArray"
showPrimRep StablePtrRep = "StgStablePtr"
showPrimRep StableNameRep = "P_"
showPrimRep ThreadIdRep = "StgTSO*"
showPrimRep WeakPtrRep = "P_"
showPrimRep ForeignObjRep = "StgAddr"
......@@ -233,6 +242,7 @@ primRepString DoubleRep = "Double"
primRepString WeakPtrRep = "Weak"
primRepString ForeignObjRep = "ForeignObj"
primRepString StablePtrRep = "StablePtr"
primRepString StableNameRep = "StableName"
primRepString other = pprPanic "primRepString" (ppr other)
showPrimRepToUser pr = primRepString pr
......
......@@ -30,6 +30,7 @@ module TysPrim(
mVarPrimTyCon, mkMVarPrimTy,
stablePtrPrimTyCon, mkStablePtrPrimTy,
stableNamePrimTyCon, mkStableNamePrimTy,
weakPrimTyCon, mkWeakPrimTy,
foreignObjPrimTyCon, foreignObjPrimTy,
threadIdPrimTyCon, threadIdPrimTy,
......@@ -215,6 +216,18 @@ stablePtrPrimTyCon = pcPrimTyCon stablePtrPrimTyConKey SLIT("StablePtr#") 1 Stab
mkStablePtrPrimTy ty = mkTyConApp stablePtrPrimTyCon [ty]
\end{code}
%************************************************************************
%* *
\subsection[TysPrim-stable-names]{The stable-name type}
%* *
%************************************************************************
\begin{code}
stableNamePrimTyCon = pcPrimTyCon stableNamePrimTyConKey SLIT("StableName#") 1 StableNameRep
mkStableNamePrimTy ty = mkTyConApp stableNamePrimTyCon [ty]
\end{code}
%************************************************************************
%* *
\subsection[TysPrim-foreign-objs]{The ``foreign object'' type}
......
......@@ -61,10 +61,6 @@ module TysWiredIn (
unboxedTupleTyCon, unboxedTupleCon,
unboxedPairTyCon, unboxedPairDataCon,
stateDataCon,
stateTyCon,
realWorldStateTy,
stablePtrTyCon,
stringTy,
trueDataCon,
......@@ -382,23 +378,13 @@ doubleTyCon = pcNonRecDataTyCon doubleTyConKey pREL_BASE SLIT("Double") [] [doub
doubleDataCon = pcDataCon doubleDataConKey pREL_BASE SLIT("D#") [] [] [doublePrimTy] doubleTyCon
\end{code}
\begin{code}
mkStateTy ty = mkTyConApp stateTyCon [ty]
realWorldStateTy = mkStateTy realWorldTy -- a common use
stateTyCon = pcNonRecDataTyCon stateTyConKey pREL_ST SLIT("State") alpha_tyvar [stateDataCon]
stateDataCon
= pcDataCon stateDataConKey pREL_ST SLIT("S#")
alpha_tyvar [] [mkStatePrimTy alphaTy] stateTyCon
\end{code}
\begin{code}
stablePtrTyCon
= pcNonRecDataTyCon stablePtrTyConKey pREL_FOREIGN SLIT("StablePtr")
= pcNonRecDataTyCon stablePtrTyConKey pREL_STABLE SLIT("StablePtr")
alpha_tyvar [stablePtrDataCon]
where
stablePtrDataCon
= pcDataCon stablePtrDataConKey pREL_FOREIGN SLIT("StablePtr")
= pcDataCon stablePtrDataConKey pREL_STABLE SLIT("StablePtr")
alpha_tyvar [] [mkStablePtrPrimTy alphaTy] stablePtrTyCon
\end{code}
......@@ -460,7 +446,8 @@ primArgTyConKeys
, wordTyConKey, word8TyConKey, word16TyConKey, word32TyConKey, word64TyConKey
, floatTyConKey, doubleTyConKey
, addrTyConKey, charTyConKey, foreignObjTyConKey
, stablePtrTyConKey, byteArrayTyConKey, mutableByteArrayTyConKey
, stablePtrTyConKey
, byteArrayTyConKey, mutableByteArrayTyConKey
]
-- types that can be passed from the outside world into Haskell.
......
......@@ -941,8 +941,8 @@ okToInline sw_chkr in_scope id form guidance cont
IWantToBeINLINEd -> True
ICanSafelyBeINLINEd inside_lam one_branch
-> (small_enough || one_branch) &&
((whnf && some_benefit) || not_inside_lam)
-> (small_enough || one_branch) && some_benefit &&
(whnf || not_inside_lam)
where
not_inside_lam = case inside_lam of {InsideLam -> False; other -> True}
......
......@@ -322,6 +322,7 @@ maybeTyConSingleCon (AlgTyCon {dataCons = [c]}) = Just c
maybeTyConSingleCon (AlgTyCon {}) = Nothing
maybeTyConSingleCon (TupleTyCon {dataCon = con}) = Just con
maybeTyConSingleCon (PrimTyCon {}) = Nothing
maybeTyConSingleCon other = panic (showSDoc (ppr other))
\end{code}
\begin{code}
......
<sect> <idx/Foreign/
<sect> <idx/Foreign/
<label id="sec:Foreign">
<p>
This module provides two types to better allow the Haskell world to
share its data with the outside world (and vice versa), <em/foreign
objects/ and <em/stable pointers/:
This module provides the <tt/ForeignObj/ type, which is a Haskell
reference to an object in the outside world. Foreign objects are
boxed versions of <tt/Addr#/, the only reason for their existence is
so that they can be used with finalisers (see Section <ref
id="foreign-finalisers" name="Finalisation for foreign objects">).
<tscreen><verb>
module Foreign where
data ForeignObj -- abstract, instance of: Eq
makeForeignObj :: Addr{-object-} -> Addr{-finaliser-} -> IO ForeignObj
makeForeignObj :: Addr{-object-} -> IO ForeignObj
writeForeignObj :: ForeignObj -> Addr{-new value-} -> IO ()
data StablePtr a -- abstract, instance of: Eq.
makeStablePtr :: a -> IO (StablePtr a)
deRefStablePtr :: StablePtr a -> IO a
freeStablePtr :: StablePtr a -> IO ()
</verb> </tscreen>
<itemize>
<item>The <tt/ForeignObj/ type provides foreign objects, encapsulated
references to values outside the Haskell heap. Foreign objects are
finalised by the garbage collector when they become dead. The
finaliser to use is given as second argument to <tt/makeForeignOj/,
and is currently a function pointer to a C function with
the following signature
<tscreen><verb>
void finaliseFO(void* obj);
</verb></tscreen>
The finaliser is passed the reference to the external object (i.e.,
the first argument to <tt/makeForeignObj/.)
<item>
The <tt/writeForeignObj/ lets you overwrite the encapsulated foreign
reference with another.
<item>
Stable pointers allow you to hand out references to Haskell heap
objects to the outside world. <bf/ToDo:/ <em/say more./
</itemize>
In addition to the above, the following operations for indexing via
a <tt/ForeignObj/ are also, mirrored on the same operations provided
over <tt/Addr/s:
......
......@@ -230,6 +230,7 @@ keys they refer to directly or indirectly.
<sect1>Finalisation for foreign objects
<label id="foreign-finalisers">
<p>
A foreign object is some data that lives outside the Haskell heap, for
......@@ -250,15 +251,14 @@ references to its key and trigger the finaliser despite the fact that
the program still holds the <tt/Addr#/ and intends to use it.
To avoid this somewhat subtle race condition, we use another type of
foreign address, called <tt/ForeignObj/. Historical note:
<tt/ForeignObj/ is identical to the old <tt/ForeignObj/ except that it
no longer supports finalisation - that's provided by the weak
foreign address, called <tt/ForeignObj/ (see Section <ref
id="sec:Foreign" name="Foreign">). Historical note: <tt/ForeignObj/
is identical to the old <tt/ForeignObj/ except that it no longer
supports finalisation - that's provided by the weak
pointer/finalisation mechanism above.
A <tt/ForeignObj/ is basically an address, but the <tt/ForeignObj/
itself is a heap-resident object and can therefore be watched by weak
pointers. A <tt/ForeignObj/ can be passed to C functions (in which
case the C function gets a straightforward pointer), but it cannot be
decomposed into an <tt/Addr#/. Operations on <tt/ForeignObj/ are
provided by the <tt/Foreign/ module (see Section <ref name="Foreign"
id="sec:Foreign">).
decomposed into an <tt/Addr#/.
......@@ -13,6 +13,7 @@
<!ENTITY numexts SYSTEM "NumExts.sgml">
<!ENTITY pretty SYSTEM "Pretty.sgml">
<!ENTITY st SYSTEM "ST.sgml">
<!ENTITY stable SYSTEM "Stable.sgml">
<!ENTITY weak SYSTEM "Weak.sgml">
<!ENTITY word SYSTEM "Word.sgml">
]>
......@@ -83,14 +84,15 @@ the form <tt/getXContents/, e.g., <tt/Channel.getChanContents/ and
&dynamic
&exception
&foreign
&getopt
&glaexts
&ioexts
&int
&numexts
&pretty
&getopt
&st
&stable
<sect> <idx/LazyST/
<label id="sec:LazyST">
......
/* ----------------------------------------------------------------------------
* $Id: ClosureTypes.h,v 1.5 1999/01/15 17:57:03 simonm Exp $
* $Id: ClosureTypes.h,v 1.6 1999/01/26 11:12:55 simonm Exp $
*
* Closure Type Constants
*
......@@ -55,9 +55,10 @@
#define MUT_VAR 49
#define WEAK 40
#define FOREIGN 41
#define TSO 42
#define BLOCKED_FETCH 43
#define FETCH_ME 44
#define EVACUATED 45
#define STABLE_NAME 42