[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.

ghc/compiler/absCSyn/PprAbsC.lhs

@@ -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'
 

ghc/compiler/basicTypes/Unique.lhs

@@ -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

ghc/compiler/nativeGen/AsmCodeGen.lhs

@@ -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}

ghc/compiler/prelude/PrelInfo.lhs

@@ -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"))

ghc/compiler/prelude/PrelMods.lhs

@@ -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"
 

ghc/compiler/prelude/PrimOp.lhs

@@ -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

ghc/compiler/prelude/PrimRep.lhs

@@ -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

ghc/compiler/prelude/TysPrim.lhs

@@ -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}

ghc/compiler/prelude/TysWiredIn.lhs

@@ -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.

ghc/compiler/simplCore/Simplify.lhs

@@ -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}

ghc/compiler/types/TyCon.lhs

@@ -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}

ghc/docs/libraries/Foreign.sgml

-    <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:

ghc/docs/libraries/Weak.sgml

@@ -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#/.

ghc/docs/libraries/libs.sgml

@@ -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