Merge remote branch 'origin/master' into ghc-generics

42 files changed, 883 insertions, 756 deletions

diff --git a/compiler/coreSyn/CoreUnfold.lhs b/compiler/coreSyn/CoreUnfold.lhs
index 5883013a06..051e767d96 100644
--- a/compiler/coreSyn/CoreUnfold.lhs
+++ b/compiler/coreSyn/CoreUnfold.lhs
@@ -64,6 +64,8 @@ import Pair
 import FastTypes
 import FastString
 import Outputable
+import ForeignCall
+
 import Data.Maybe
 \end{code}
 
@@ -273,6 +275,9 @@ Notice that 'x' counts 0, while (f x) counts 2.  That's deliberate: there's
 a function call to account for.  Notice also that constructor applications 
 are very cheap, because exposing them to a caller is so valuable.
 
+[25/5/11] All sizes are now multiplied by 10, except for primops.
+This makes primops look cheap, and seems to be almost unversally
+beneficial.  Done partly as a result of #4978.
 
 Note [Do not inline top-level bottoming functions]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -330,7 +335,7 @@ uncondInline :: Arity -> Int -> Bool
 -- See Note [INLINE for small functions]
 uncondInline arity size 
   | arity == 0 = size == 0
-  | otherwise  = size <= arity + 1
+  | otherwise  = size <= 10 * (arity + 1)
 \end{code}
 
 
@@ -359,19 +364,19 @@ sizeExpr bOMB_OUT_SIZE top_args expr
     size_up (App fun arg)      = size_up arg  `addSizeNSD`
                                  size_up_app fun [arg]
 
-    size_up (Lam b e) | isId b    = lamScrutDiscount (size_up e `addSizeN` 1)
+    size_up (Lam b e) | isId b    = lamScrutDiscount (size_up e `addSizeN` 10)
 		      | otherwise = size_up e
 
     size_up (Let (NonRec binder rhs) body)
       = size_up rhs		`addSizeNSD`
 	size_up body		`addSizeN`
-	(if isUnLiftedType (idType binder) then 0 else 1)
+        (if isUnLiftedType (idType binder) then 0 else 10)
 		-- For the allocation
 		-- If the binder has an unlifted type there is no allocation
 
     size_up (Let (Rec pairs) body)
       = foldr (addSizeNSD . size_up . snd) 
-              (size_up body `addSizeN` length pairs)	-- (length pairs) for the allocation
+              (size_up body `addSizeN` (10 * length pairs))     -- (length pairs) for the allocation
               pairs
 
     size_up (Case (Var v) _ _ alts) 
@@ -388,7 +393,7 @@ sizeExpr bOMB_OUT_SIZE top_args expr
 		-- the case when we are scrutinising an argument variable
 	  alts_size (SizeIs tot tot_disc tot_scrut)  -- Size of all alternatives
 		    (SizeIs max _        _)          -- Size of biggest alternative
-	 	= SizeIs tot (unitBag (v, iBox (_ILIT(2) +# tot -# max)) `unionBags` tot_disc) tot_scrut
+                = SizeIs tot (unitBag (v, iBox (_ILIT(20) +# tot -# max)) `unionBags` tot_disc) tot_scrut
 			-- If the variable is known, we produce a discount that
 			-- will take us back to 'max', the size of the largest alternative
 			-- The 1+ is a little discount for reduced allocation in the caller
@@ -398,15 +403,41 @@ sizeExpr bOMB_OUT_SIZE top_args expr
 
 	  alts_size tot_size _ = tot_size
 
-    size_up (Case e _ _ alts) = size_up e  `addSizeNSD` 
-                                foldr (addAltSize . size_up_alt) sizeZero alts
-	  	-- We don't charge for the case itself
-		-- It's a strict thing, and the price of the call
-		-- is paid by scrut.  Also consider
-		--	case f x of DEFAULT -> e
-		-- This is just ';'!  Don't charge for it.
-		--
-		-- Moreover, we charge one per alternative.
+    size_up (Case e _ _ alts) = size_up e  `addSizeNSD`
+                                foldr (addAltSize . size_up_alt) case_size alts
+      where
+          case_size
+           | is_inline_scrut e, not (lengthExceeds alts 1)  = sizeN (-10)
+           | otherwise = sizeZero
+                -- Normally we don't charge for the case itself, but
+                -- we charge one per alternative (see size_up_alt,
+                -- below) to account for the cost of the info table
+                -- and comparisons.
+                --
+                -- However, in certain cases (see is_inline_scrut
+                -- below), no code is generated for the case unless
+                -- there are multiple alts.  In these cases we
+                -- subtract one, making the first alt free.
+                -- e.g. case x# +# y# of _ -> ...   should cost 1
+                --      case touch# x# of _ -> ...  should cost 0
+                -- (see #4978)
+                --
+                -- I would like to not have the "not (lengthExceeds alts 1)"
+                -- condition above, but without that some programs got worse
+                -- (spectral/hartel/event and spectral/para).  I don't fully
+                -- understand why. (SDM 24/5/11)
+
+                -- unboxed variables, inline primops and unsafe foreign calls
+                -- are all "inline" things:
+          is_inline_scrut (Var v) = isUnLiftedType (idType v)
+          is_inline_scrut scrut
+              | (Var f, _) <- collectArgs scrut
+                = case idDetails f of
+                    FCallId fc  -> not (isSafeForeignCall fc)
+                    PrimOpId op -> not (primOpOutOfLine op)
+                    _other      -> False
+              | otherwise
+                = False
 
     ------------ 
     -- size_up_app is used when there's ONE OR MORE value args
@@ -421,14 +452,14 @@ sizeExpr bOMB_OUT_SIZE top_args expr
     size_up_call :: Id -> [CoreExpr] -> ExprSize
     size_up_call fun val_args
        = case idDetails fun of
-           FCallId _        -> sizeN opt_UF_DearOp
+           FCallId _        -> sizeN (10 * (1 + length val_args))
            DataConWorkId dc -> conSize    dc (length val_args)
            PrimOpId op      -> primOpSize op (length val_args)
 	   ClassOpId _ 	    -> classOpSize top_args val_args
 	   _     	    -> funSize top_args fun (length val_args)
 
     ------------ 
-    size_up_alt (_con, _bndrs, rhs) = size_up rhs `addSizeN` 1
+    size_up_alt (_con, _bndrs, rhs) = size_up rhs `addSizeN` 10
  	-- Don't charge for args, so that wrappers look cheap
 	-- (See comments about wrappers with Case)
 	--
@@ -464,7 +495,7 @@ sizeExpr bOMB_OUT_SIZE top_args expr
 -- | Finds a nominal size of a string literal.
 litSize :: Literal -> Int
 -- Used by CoreUnfold.sizeExpr
-litSize (MachStr str) = 1 + ((lengthFS str + 3) `div` 4)
+litSize (MachStr str) = 10 + 10 * ((lengthFS str + 3) `div` 4)
 	-- If size could be 0 then @f "x"@ might be too small
 	-- [Sept03: make literal strings a bit bigger to avoid fruitless 
 	--  duplication of little strings]
@@ -479,7 +510,7 @@ classOpSize _ []
 classOpSize top_args (arg1 : other_args)
   = SizeIs (iUnbox size) arg_discount (_ILIT(0))
   where
-    size = 2 + length other_args
+    size = 20 + (10 * length other_args)
     -- If the class op is scrutinising a lambda bound dictionary then
     -- give it a discount, to encourage the inlining of this function
     -- The actual discount is rather arbitrarily chosen
@@ -507,8 +538,7 @@ funSize top_args fun n_val_args
     res_discount | idArity fun > n_val_args = opt_UF_FunAppDiscount
     		 | otherwise   	 	    = 0
         -- If the function is partially applied, show a result discount
-
-    size | some_val_args = 1 + n_val_args
+    size | some_val_args = 10 * (1 + n_val_args)
          | otherwise     = 0
 	-- The 1+ is for the function itself
 	-- Add 1 for each non-trivial arg;
@@ -517,16 +547,17 @@ funSize top_args fun n_val_args
 
 conSize :: DataCon -> Int -> ExprSize
 conSize dc n_val_args
-  | n_val_args == 0 = SizeIs (_ILIT(0)) emptyBag (_ILIT(1))	-- Like variables
-
--- See Note [Constructor size]
-  | isUnboxedTupleCon dc = SizeIs (_ILIT(0)) emptyBag (iUnbox n_val_args +# _ILIT(1))
+  | n_val_args == 0 = SizeIs (_ILIT(0)) emptyBag (_ILIT(10))    -- Like variables
 
 -- See Note [Unboxed tuple result discount]
---  | isUnboxedTupleCon dc = SizeIs (_ILIT(0)) emptyBag (_ILIT(0))
+  | isUnboxedTupleCon dc = SizeIs (_ILIT(0)) emptyBag (iUnbox (10 * (1 + n_val_args)))
 
 -- See Note [Constructor size]
-  | otherwise = SizeIs (_ILIT(1)) emptyBag (iUnbox n_val_args +# _ILIT(1))
+  | otherwise = SizeIs (_ILIT(10)) emptyBag (iUnbox (10 * (10 + n_val_args)))
+     -- discont was (10 * (1 + n_val_args)), but it turns out that
+     -- adding a bigger constant here is an unambiguous win.  We
+     -- REALLY like unfolding constructors that get scrutinised.
+     -- [SDM, 25/5/11]
 \end{code}
 
 Note [Constructor size]
@@ -557,23 +588,15 @@ didn't adopt the idea.
 \begin{code}
 primOpSize :: PrimOp -> Int -> ExprSize
 primOpSize op n_val_args
- | not (primOpIsDupable op) = sizeN opt_UF_DearOp
- | not (primOpOutOfLine op) = sizeN 1
-	-- Be very keen to inline simple primops.
-	-- We give a discount of 1 for each arg so that (op# x y z) costs 2.
-	-- We can't make it cost 1, else we'll inline let v = (op# x y z) 
-	-- at every use of v, which is excessive.
-	--
-	-- A good example is:
-	--	let x = +# p q in C {x}
-	-- Even though x get's an occurrence of 'many', its RHS looks cheap,
-	-- and there's a good chance it'll get inlined back into C's RHS. Urgh!
-
- | otherwise = sizeN n_val_args
+ = if primOpOutOfLine op
+      then sizeN (op_size + n_val_args)
+      else sizeN op_size
+ where
+   op_size = primOpCodeSize op
 
 
 buildSize :: ExprSize
-buildSize = SizeIs (_ILIT(0)) emptyBag (_ILIT(4))
+buildSize = SizeIs (_ILIT(0)) emptyBag (_ILIT(40))
 	-- We really want to inline applications of build
 	-- build t (\cn -> e) should cost only the cost of e (because build will be inlined later)
 	-- Indeed, we should add a result_discount becuause build is 
@@ -582,7 +605,7 @@ buildSize = SizeIs (_ILIT(0)) emptyBag (_ILIT(4))
 	-- The "4" is rather arbitrary.
 
 augmentSize :: ExprSize
-augmentSize = SizeIs (_ILIT(0)) emptyBag (_ILIT(4))
+augmentSize = SizeIs (_ILIT(0)) emptyBag (_ILIT(40))
 	-- Ditto (augment t (\cn -> e) ys) should cost only the cost of
 	-- e plus ys. The -2 accounts for the \cn 
 
@@ -714,7 +737,7 @@ certainlyWillInline (CoreUnfolding { uf_is_cheap = is_cheap, uf_arity = n_vals,
       UnfNever      -> False
       UnfWhen {}    -> True
       UnfIfGoodArgs { ug_size = size} 
-                    -> is_cheap && size - (n_vals +1) <= opt_UF_UseThreshold
+                    -> is_cheap && size - (10 * (n_vals +1)) <= opt_UF_UseThreshold
 
 certainlyWillInline _
   = False
@@ -1062,10 +1085,10 @@ computeDiscount n_vals_wanted arg_discounts res_discount arg_infos cont_info
 	--  *efficiency* to be gained (e.g. beta reductions, case reductions) 
 	-- by inlining.
 
-  = 1 		-- Discount of 1 because the result replaces the call
+  = 10          -- Discount of 1 because the result replaces the call
 		-- so we count 1 for the function itself
 
-    + length (take n_vals_wanted arg_infos)
+    + 10 * length (take n_vals_wanted arg_infos)
       	       -- Discount of (un-scaled) 1 for each arg supplied, 
    	       -- because the result replaces the call
 
@@ -1075,13 +1098,13 @@ computeDiscount n_vals_wanted arg_discounts res_discount arg_infos cont_info
     arg_discount = sum (zipWith mk_arg_discount arg_discounts arg_infos)
 
     mk_arg_discount _ 	     TrivArg    = 0 
-    mk_arg_discount _ 	     NonTrivArg = 1   
+    mk_arg_discount _        NonTrivArg = 10
     mk_arg_discount discount ValueArg   = discount 
 
     res_discount' = case cont_info of
 			BoringCtxt  -> 0
 			CaseCtxt    -> res_discount
-			_other      -> 4 `min` res_discount
+                        _other      -> 40 `min` res_discount
 		-- res_discount can be very large when a function returns
 		-- constructors; but we only want to invoke that large discount
 		-- when there's a case continuation.
diff --git a/compiler/coreSyn/CoreUtils.lhs b/compiler/coreSyn/CoreUtils.lhs
index a0a229f6c6..4146b621e1 100644
--- a/compiler/coreSyn/CoreUtils.lhs
+++ b/compiler/coreSyn/CoreUtils.lhs
@@ -589,12 +589,10 @@ exprIsCheap' good_app other_expr 	-- Applications and variables
     go _ _ = False
  
     --------------
-    go_pap args = all exprIsTrivial args
- 	-- For constructor applications and primops, check that all
- 	-- the args are trivial.  We don't want to treat as cheap, say,
- 	-- 	(1:2:3:4:5:[])
- 	-- We'll put up with one constructor application, but not dozens
- 	
+    go_pap args = all (exprIsCheap' good_app) args
+        -- Used to be "all exprIsTrivial args" due to concerns about
+        -- duplicating nested constructor applications, but see #4978.
+
     --------------
     go_primop op args = primOpIsCheap op && all (exprIsCheap' good_app) args
  	-- In principle we should worry about primops
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index f70a1b32b0..b3d9f0cd2a 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -552,7 +552,6 @@ Library
             TcSplice
             Convert
             ByteCodeAsm
-            ByteCodeFFI
             ByteCodeGen
             ByteCodeInstr
             ByteCodeItbls
diff --git a/compiler/ghc.mk b/compiler/ghc.mk
index 2254332eb7..8ed34c3136 100644
--- a/compiler/ghc.mk
+++ b/compiler/ghc.mk
@@ -252,7 +252,7 @@ PRIMOP_BITS = compiler/primop-data-decl.hs-incl        \
               compiler/primop-has-side-effects.hs-incl \
               compiler/primop-out-of-line.hs-incl      \
               compiler/primop-commutable.hs-incl       \
-              compiler/primop-needs-wrapper.hs-incl    \
+              compiler/primop-code-size.hs-incl        \
               compiler/primop-can-fail.hs-incl         \
               compiler/primop-strictness.hs-incl       \
               compiler/primop-primop-info.hs-incl
@@ -278,8 +278,8 @@ compiler/primop-out-of-line.hs-incl: $(PRIMOPS_TXT) $(GENPRIMOP_INPLACE)
 	"$(GENPRIMOP_INPLACE)" --out-of-line        < $< > $@
 compiler/primop-commutable.hs-incl: $(PRIMOPS_TXT) $(GENPRIMOP_INPLACE)
 	"$(GENPRIMOP_INPLACE)" --commutable         < $< > $@
-compiler/primop-needs-wrapper.hs-incl: $(PRIMOPS_TXT) $(GENPRIMOP_INPLACE)
-	"$(GENPRIMOP_INPLACE)" --needs-wrapper      < $< > $@
+compiler/primop-code-size.hs-incl: $(PRIMOPS_TXT) $(GENPRIMOP_INPLACE)
+	"$(GENPRIMOP_INPLACE)" --code-size          < $< > $@
 compiler/primop-can-fail.hs-incl: $(PRIMOPS_TXT) $(GENPRIMOP_INPLACE)
 	"$(GENPRIMOP_INPLACE)" --can-fail           < $< > $@
 compiler/primop-strictness.hs-incl: $(PRIMOPS_TXT) $(GENPRIMOP_INPLACE)
diff --git a/compiler/ghci/ByteCodeFFI.lhs b/compiler/ghci/ByteCodeFFI.lhs
deleted file mode 100644
index 1589fe1bed..0000000000
--- a/compiler/ghci/ByteCodeFFI.lhs
+++ /dev/null
@@ -1,28 +0,0 @@
-%
-% (c) The University of Glasgow 2001-2008
-%
-
-ByteCodeGen: Generate machine-code sequences for foreign import
-
-\begin{code}
-module ByteCodeFFI ( moan64 ) where
-
-import Outputable
-import System.IO
-import System.IO.Unsafe
-
-moan64 :: String -> SDoc -> a
-moan64 msg pp_rep
-   = unsafePerformIO (
-        hPutStrLn stderr (
-        "\nGHCi's bytecode generation machinery can't handle 64-bit\n" ++
-        "code properly yet.  You can work around this for the time being\n" ++
-        "by compiling this module and all those it imports to object code,\n" ++
-        "and re-starting your GHCi session.  The panic below contains information,\n" ++
-        "intended for the GHC implementors, about the exact place where GHC gave up.\n"
-        )
-     )
-     `seq`
-     pprPanic msg pp_rep
-\end{code}
-
diff --git a/compiler/ghci/ByteCodeInstr.lhs b/compiler/ghci/ByteCodeInstr.lhs
index d44a00bc14..49c5488efa 100644
--- a/compiler/ghci/ByteCodeInstr.lhs
+++ b/compiler/ghci/ByteCodeInstr.lhs
@@ -124,7 +124,7 @@ data BCInstr
    | CASEFAIL
    | JMP              LocalLabel
 
-   -- For doing calls to C (via glue code generated by ByteCodeFFI, or libffi)
+   -- For doing calls to C (via glue code generated by libffi)
    | CCALL            Word16    -- stack frame size
                       (Ptr ())  -- addr of the glue code
                       Word16    -- whether or not the call is interruptible
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index d80d2a6394..d9f3246c34 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -274,7 +274,6 @@ data DynFlag
    -- misc opts
    | Opt_Pp
    | Opt_ForceRecomp
-   | Opt_DryRun
    | Opt_ExcessPrecision
    | Opt_EagerBlackHoling
    | Opt_ReadUserPackageConf
@@ -765,9 +764,9 @@ defaultDynFlags mySettings =
         maxSimplIterations      = 4,
         shouldDumpSimplPhase    = Nothing,
         ruleCheck               = Nothing,
-        specConstrThreshold     = Just 200,
+        specConstrThreshold     = Just 2000,
         specConstrCount         = Just 3,
-        liberateCaseThreshold   = Just 200,
+        liberateCaseThreshold   = Just 2000,
         floatLamArgs            = Just 0,	-- Default: float only if no fvs
         strictnessBefore        = [],
 
@@ -876,7 +875,11 @@ languageExtensions Nothing
       -- But NB it's implied by GADTs etc
       -- SLPJ September 2010
     : Opt_NondecreasingIndentation -- This has been on by default for some time
-    : languageExtensions (Just Haskell2010)
+    : delete Opt_DatatypeContexts  -- The Haskell' committee decided to
+                                   -- remove datatype contexts from the
+                                   -- language:
+   -- http://www.haskell.org/pipermail/haskell-prime/2011-January/003335.html
+      (languageExtensions (Just Haskell2010))
 
 languageExtensions (Just Haskell98)
     = [Opt_ImplicitPrelude,
@@ -1152,7 +1155,7 @@ allFlags = map ('-':) $
 --------------- The main flags themselves ------------------
 dynamic_flags :: [Flag (CmdLineP DynFlags)]
 dynamic_flags = [
-    Flag "n"        (NoArg (setDynFlag Opt_DryRun))
+    Flag "n"        (NoArg (addWarn "The -n flag is deprecated and no longer has any effect"))
   , Flag "cpp"      (NoArg (setExtensionFlag Opt_Cpp)) 
   , Flag "F"        (NoArg (setDynFlag Opt_Pp)) 
   , Flag "#include" 
diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs
index 451f78d24e..860464e974 100644
--- a/compiler/main/Packages.lhs
+++ b/compiler/main/Packages.lhs
@@ -56,7 +56,8 @@ import ErrUtils         ( debugTraceMsg, putMsg, Message )
 import Exception
 
 import System.Directory
-import System.FilePath
+import System.FilePath as FilePath
+import qualified System.FilePath.Posix as FilePath.Posix
 import Control.Monad
 import Data.List as List
 import Data.Map (Map)
@@ -246,7 +247,8 @@ readPackageConfig dflags conf_file = do
 
   let
       top_dir = topDir dflags
-      pkg_configs1 = mungePackagePaths top_dir proto_pkg_configs
+      pkgroot = takeDirectory conf_file
+      pkg_configs1 = map (mungePackagePaths top_dir pkgroot) proto_pkg_configs
       pkg_configs2 = maybeHidePackages dflags pkg_configs1
   --
   return pkg_configs2
@@ -258,27 +260,52 @@ maybeHidePackages dflags pkgs
   where
     hide pkg = pkg{ exposed = False }
 
-mungePackagePaths :: String -> [PackageConfig] -> [PackageConfig]
--- Replace the string "$topdir" at the beginning of a path
--- with the current topdir (obtained from the -B option).
-mungePackagePaths top_dir ps = map munge_pkg ps
- where 
-  munge_pkg p = p{ importDirs  = munge_paths (importDirs p),
-		   includeDirs = munge_paths (includeDirs p),
-    		   libraryDirs = munge_paths (libraryDirs p),
-		   frameworkDirs = munge_paths (frameworkDirs p),
-                   haddockInterfaces = munge_paths (haddockInterfaces p),
-	           haddockHTMLs = munge_paths (haddockHTMLs p)
-                    }
-
-  munge_paths = map munge_path
-
-  munge_path p 
-	  | Just p' <- stripPrefix "$topdir"     p =            top_dir ++ p'
-	  | Just p' <- stripPrefix "$httptopdir" p = toHttpPath top_dir ++ p'
-	  | otherwise				    = p
-
-  toHttpPath p = "file:///" ++ p
+mungePackagePaths :: FilePath -> FilePath -> PackageConfig -> PackageConfig
+-- Perform path/URL variable substitution as per the Cabal ${pkgroot} spec
+-- (http://www.haskell.org/pipermail/libraries/2009-May/011772.html)
+-- Paths/URLs can be relative to ${pkgroot} or ${pkgrooturl}.
+-- The "pkgroot" is the directory containing the package database.
+--
+-- Also perform a similar substitution for the older GHC-specific
+-- "$topdir" variable. The "topdir" is the location of the ghc
+-- installation (obtained from the -B option).
+mungePackagePaths top_dir pkgroot pkg =
+    pkg {
+      importDirs  = munge_paths (importDirs pkg),
+      includeDirs = munge_paths (includeDirs pkg),
+      libraryDirs = munge_paths (libraryDirs pkg),
+      frameworkDirs = munge_paths (frameworkDirs pkg),
+      haddockInterfaces = munge_paths (haddockInterfaces pkg),
+      haddockHTMLs = munge_urls (haddockHTMLs pkg)
+    }
+  where 
+    munge_paths = map munge_path
+    munge_urls  = map munge_url
+
+    munge_path p
+      | Just p' <- stripVarPrefix "${pkgroot}" sp = pkgroot </> p'
+      | Just p' <- stripVarPrefix "$topdir"    sp = top_dir </> p'
+      | otherwise                                 = p
+      where
+        sp = splitPath p
+
+    munge_url p
+      | Just p' <- stripVarPrefix "${pkgrooturl}" sp = toUrlPath pkgroot p'
+      | Just p' <- stripVarPrefix "$httptopdir"   sp = toUrlPath top_dir p'
+      | otherwise                                    = p
+      where
+        sp = splitPath p
+
+    toUrlPath r p = "file:///"
+                 -- URLs always use posix style '/' separators:
+                 ++ FilePath.Posix.joinPath (r : FilePath.splitDirectories p)
+
+    stripVarPrefix var (root:path')
+      | Just [sep] <- stripPrefix var root
+      , isPathSeparator sep
+      = Just (joinPath path')
+
+    stripVarPrefix _ _ = Nothing
 
 
 -- -----------------------------------------------------------------------------
diff --git a/compiler/main/StaticFlags.hs b/compiler/main/StaticFlags.hs
index 732224b9f9..f6d0af2665 100644
--- a/compiler/main/StaticFlags.hs
+++ b/compiler/main/StaticFlags.hs
@@ -332,16 +332,16 @@ opt_UF_CreationThreshold, opt_UF_UseThreshold :: Int
 opt_UF_DearOp, opt_UF_FunAppDiscount, opt_UF_DictDiscount :: Int
 opt_UF_KeenessFactor :: Float
 
-opt_UF_CreationThreshold = lookup_def_int "-funfolding-creation-threshold" (45::Int)
-opt_UF_UseThreshold	 = lookup_def_int "-funfolding-use-threshold"	   (6::Int)
-opt_UF_FunAppDiscount	 = lookup_def_int "-funfolding-fun-discount"	   (6::Int)
+opt_UF_CreationThreshold = lookup_def_int "-funfolding-creation-threshold" (450::Int)
+opt_UF_UseThreshold      = lookup_def_int "-funfolding-use-threshold"      (60::Int)
+opt_UF_FunAppDiscount    = lookup_def_int "-funfolding-fun-discount"       (60::Int)
 
-opt_UF_DictDiscount	 = lookup_def_int "-funfolding-dict-discount"	   (3::Int)
+opt_UF_DictDiscount      = lookup_def_int "-funfolding-dict-discount"      (30::Int)
    -- Be fairly keen to inline a fuction if that means
    -- we'll be able to pick the right method from a dictionary
 
 opt_UF_KeenessFactor	 = lookup_def_float "-funfolding-keeness-factor"   (1.5::Float)
-opt_UF_DearOp            = ( 4 :: Int)
+opt_UF_DearOp            = ( 40 :: Int)
 
 
 -- Related to linking
diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs
index 497a938980..9c086cc80b 100644
--- a/compiler/main/SysTools.lhs
+++ b/compiler/main/SysTools.lhs
@@ -788,20 +788,16 @@ data BuildMessage
   | EOF
 
 traceCmd :: DynFlags -> String -> String -> IO () -> IO ()
--- a) trace the command (at two levels of verbosity)
--- b) don't do it at all if dry-run is set
+-- trace the command (at two levels of verbosity)
 traceCmd dflags phase_name cmd_line action
  = do   { let verb = verbosity dflags
         ; showPass dflags phase_name
         ; debugTraceMsg dflags 3 (text cmd_line)
         ; hFlush stderr
 
-           -- Test for -n flag
-        ; unless (dopt Opt_DryRun dflags) $ do {
-
            -- And run it!
         ; action `catchIO` handle_exn verb
-        }}
+        }
   where
     handle_exn _verb exn = do { debugTraceMsg dflags 2 (char '\n')
                               ; debugTraceMsg dflags 2 (ptext (sLit "Failed:") <+> text cmd_line <+> text (show exn))
diff --git a/compiler/prelude/ForeignCall.lhs b/compiler/prelude/ForeignCall.lhs
index a92cabdec0..87bb94a148 100644
--- a/compiler/prelude/ForeignCall.lhs
+++ b/compiler/prelude/ForeignCall.lhs
@@ -13,7 +13,7 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 
 module ForeignCall (
-	ForeignCall(..),
+        ForeignCall(..), isSafeForeignCall,
 	Safety(..), playSafe, playInterruptible,
 
 	CExportSpec(..), CLabelString, isCLabelString, pprCLabelString,
@@ -43,6 +43,9 @@ newtype ForeignCall = CCall CCallSpec
   deriving Eq
   {-! derive: Binary !-}
 
+isSafeForeignCall :: ForeignCall -> Bool
+isSafeForeignCall (CCall (CCallSpec _ _ safe)) = playSafe safe
+
 -- We may need more clues to distinguish foreign calls
 -- but this simple printer will do for now
 instance Outputable ForeignCall where
diff --git a/compiler/prelude/PrimOp.lhs b/compiler/prelude/PrimOp.lhs
index 8c532ffc86..29c5644346 100644
--- a/compiler/prelude/PrimOp.lhs
+++ b/compiler/prelude/PrimOp.lhs
@@ -18,8 +18,8 @@ module PrimOp (
 
 	tagToEnumKey,
 
-	primOpOutOfLine, primOpNeedsWrapper, 
-	primOpOkForSpeculation, primOpIsCheap, primOpIsDupable,
+        primOpOutOfLine, primOpCodeSize,
+        primOpOkForSpeculation, primOpIsCheap,
 
 	getPrimOpResultInfo,  PrimOpResultInfo(..),
 
@@ -363,18 +363,23 @@ primOpIsCheap op = primOpOkForSpeculation op
 -- even if primOpIsCheap sometimes says 'True'.
 \end{code}
 
-primOpIsDupable
-~~~~~~~~~~~~~~~
-primOpIsDupable means that the use of the primop is small enough to
-duplicate into different case branches.  See CoreUtils.exprIsDupable.
+primOpCodeSize
+~~~~~~~~~~~~~~
+Gives an indication of the code size of a primop, for the purposes of
+calculating unfolding sizes; see CoreUnfold.sizeExpr.
 
 \begin{code}
-primOpIsDupable :: PrimOp -> Bool
-	-- See comments with CoreUtils.exprIsDupable
-	-- We say it's dupable it isn't implemented by a C call with a wrapper
-primOpIsDupable op = not (primOpNeedsWrapper op)
-\end{code}
+primOpCodeSize :: PrimOp -> Int
+#include "primop-code-size.hs-incl"
+
+primOpCodeSizeDefault :: Int
+primOpCodeSizeDefault = 1
+  -- CoreUnfold.primOpSize already takes into account primOpOutOfLine
+  -- and adds some further costs for the args in that case.
 
+primOpCodeSizeForeignCall :: Int
+primOpCodeSizeForeignCall = 4
+\end{code}
 
 \begin{code}
 primOpCanFail :: PrimOp -> Bool
@@ -421,14 +426,6 @@ primOpHasSideEffects :: PrimOp -> Bool
 #include "primop-has-side-effects.hs-incl"
 \end{code}
 
-Inline primitive operations that perform calls need wrappers to save
-any live variables that are stored in caller-saves registers.
-
-\begin{code}
-primOpNeedsWrapper :: PrimOp -> Bool
-#include "primop-needs-wrapper.hs-incl"
-\end{code}
-
 \begin{code}
 primOpType :: PrimOp -> Type  -- you may want to use primOpSig instead
 primOpType op
diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp
index 69a12745fb..4dfe0195a9 100644
--- a/compiler/prelude/primops.txt.pp
+++ b/compiler/prelude/primops.txt.pp
@@ -43,7 +43,7 @@ defaults
    has_side_effects = False
    out_of_line      = False
    commutable       = False
-   needs_wrapper    = False
+   code_size        = { primOpCodeSizeDefault }
    can_fail         = False
    strictness       = { \ arity -> mkStrictSig (mkTopDmdType (replicate arity lazyDmd) TopRes) }
 
@@ -155,6 +155,7 @@ primop   CharLtOp  "ltChar#"   Compare   Char# -> Char# -> Bool
 primop   CharLeOp  "leChar#"   Compare   Char# -> Char# -> Bool
 
 primop   OrdOp   "ord#"  GenPrimOp   Char# -> Int#
+   with code_size = 0
 
 ------------------------------------------------------------------------
 section "Int#"
@@ -212,9 +213,12 @@ primop   IntNegOp    "negateInt#"    Monadic   Int# -> Int#
 primop   IntAddCOp   "addIntC#"    GenPrimOp   Int# -> Int# -> (# Int#, Int# #)
 	 {Add with carry.  First member of result is (wrapped) sum; 
           second member is 0 iff no overflow occured.}
+   with code_size = 2
+
 primop   IntSubCOp   "subIntC#"    GenPrimOp   Int# -> Int# -> (# Int#, Int# #)
 	 {Subtract with carry.  First member of result is (wrapped) difference; 
           second member is 0 iff no overflow occured.}
+   with code_size = 2
 
 primop   IntGtOp  ">#"   Compare   Int# -> Int# -> Bool
 primop   IntGeOp  ">=#"   Compare   Int# -> Int# -> Bool
@@ -231,8 +235,11 @@ primop   IntLtOp  "<#"   Compare   Int# -> Int# -> Bool
 primop   IntLeOp  "<=#"   Compare   Int# -> Int# -> Bool
 
 primop   ChrOp   "chr#"   GenPrimOp   Int# -> Char#
+   with code_size = 0
 
 primop   Int2WordOp "int2Word#" GenPrimOp Int# -> Word#
+   with code_size = 0
+
 primop   Int2FloatOp   "int2Float#"      GenPrimOp  Int# -> Float#
 primop   Int2DoubleOp   "int2Double#"          GenPrimOp  Int# -> Double#
 
@@ -286,6 +293,7 @@ primop   SrlOp   "uncheckedShiftRL#"   GenPrimOp   Word# -> Int# -> Word#
           in the range 0 to word size - 1 inclusive.}
 
 primop   Word2IntOp   "word2Int#"   GenPrimOp   Word# -> Int#
+   with code_size = 0
 
 primop   WordGtOp   "gtWord#"   Compare   Word# -> Word# -> Bool
 primop   WordGeOp   "geWord#"   Compare   Word# -> Word# -> Bool
@@ -396,63 +404,72 @@ primop   Double2FloatOp   "double2Float#" GenPrimOp Double# -> Float#
 
 primop   DoubleExpOp   "expDouble#"      Monadic
    Double# -> Double#
-   with needs_wrapper = True
+   with
+   code_size = { primOpCodeSizeForeignCall }
 
 primop   DoubleLogOp   "logDouble#"      Monadic         
    Double# -> Double#
    with
-   needs_wrapper = True
+   code_size = { primOpCodeSizeForeignCall }
    can_fail = True
 
 primop   DoubleSqrtOp   "sqrtDouble#"      Monadic  
    Double# -> Double#
-   with needs_wrapper = True
+   with
+   code_size = { primOpCodeSizeForeignCall }
 
 primop   DoubleSinOp   "sinDouble#"      Monadic          
    Double# -> Double#
-   with needs_wrapper = True
+   with
+   code_size = { primOpCodeSizeForeignCall }
 
 primop   DoubleCosOp   "cosDouble#"      Monadic          
    Double# -> Double#
-   with needs_wrapper = True
+   with
+   code_size = { primOpCodeSizeForeignCall }
 
 primop   DoubleTanOp   "tanDouble#"      Monadic          
    Double# -> Double#
-   with needs_wrapper = True
+   with
+   code_size = { primOpCodeSizeForeignCall }
 
 primop   DoubleAsinOp   "asinDouble#"      Monadic 
    Double# -> Double#
    with
-   needs_wrapper = True
+   code_size = { primOpCodeSizeForeignCall }
    can_fail = True
 
 primop   DoubleAcosOp   "acosDouble#"      Monadic  
    Double# -> Double#
    with
-   needs_wrapper = True
+   code_size = { primOpCodeSizeForeignCall }
    can_fail = True
 
 primop   DoubleAtanOp   "atanDouble#"      Monadic  
    Double# -> Double#
    with
-   needs_wrapper = True
+   code_size = { primOpCodeSizeForeignCall }
 
 primop   DoubleSinhOp   "sinhDouble#"      Monadic  
    Double# -> Double#
-   with needs_wrapper = True
+   with
+   code_size = { primOpCodeSizeForeignCall }
 
 primop   DoubleCoshOp   "coshDouble#"      Monadic  
    Double# -> Double#
-   with needs_wrapper = True
+   with
+   code_size = { primOpCodeSizeForeignCall }
 
 primop   DoubleTanhOp   "tanhDouble#"      Monadic  
    Double# -> Double#
-   with needs_wrapper = True
+   with
+   code_size = { primOpCodeSizeForeignCall }
 
 primop   DoublePowerOp   "**##" Dyadic  
    Double# -> Double# -> Double#
    {Exponentiation.}
-   with needs_wrapper = True
+   with
+   code_size = { primOpCodeSizeForeignCall }
 
 primop   DoubleDecode_2IntOp   "decodeDouble_2Int#" GenPrimOp    
    Double# -> (# Int#, Word#, Word#, Int# #)
@@ -506,58 +523,71 @@ primop   Float2IntOp   "float2Int#"      GenPrimOp  Float# -> Int#
 
 primop   FloatExpOp   "expFloat#"      Monadic          
    Float# -> Float#
-   with needs_wrapper = True
+   with
+   code_size = { primOpCodeSizeForeignCall }
 
 primop   FloatLogOp   "logFloat#"      Monadic          
    Float# -> Float#
-   with needs_wrapper = True
-        can_fail = True
+   with
+   code_size = { primOpCodeSizeForeignCall }
+   can_fail = True
 
 primop   FloatSqrtOp   "sqrtFloat#"      Monadic          
    Float# -> Float#
-   with needs_wrapper = True
+   with
+   code_size = { primOpCodeSizeForeignCall }
 
 primop   FloatSinOp   "sinFloat#"      Monadic          
    Float# -> Float#
-   with needs_wrapper = True
+   with
+   code_size = { primOpCodeSizeForeignCall }
 
 primop   FloatCosOp   "cosFloat#"      Monadic          
    Float# -> Float#
-   with needs_wrapper = True
+   with
+   code_size = { primOpCodeSizeForeignCall }
 
 primop   FloatTanOp   "tanFloat#"      Monadic          
    Float# -> Float#
-   with needs_wrapper = True
+   with
+   code_size = { primOpCodeSizeForeignCall }
 
 primop   FloatAsinOp   "asinFloat#"      Monadic          
    Float# -> Float#
-   with needs_wrapper = True
-        can_fail = True
+   with
+   code_size = { primOpCodeSizeForeignCall }
+   can_fail = True
 
 primop   FloatAcosOp   "acosFloat#"      Monadic          
    Float# -> Float#
-   with needs_wrapper = True
-        can_fail = True
+   with
+   code_size = { primOpCodeSizeForeignCall }
+   can_fail = True
 
 primop   FloatAtanOp   "atanFloat#"      Monadic          
    Float# -> Float#
-   with needs_wrapper = True
+   with
+   code_size = { primOpCodeSizeForeignCall }
 
 primop   FloatSinhOp   "sinhFloat#"      Monadic          
    Float# -> Float#
-   with needs_wrapper = True
+   with
+   code_size = { primOpCodeSizeForeignCall }
 
 primop   FloatCoshOp   "coshFloat#"      Monadic          
    Float# -> Float#
-   with needs_wrapper = True
+   with
+   code_size = { primOpCodeSizeForeignCall }
 
 primop   FloatTanhOp   "tanhFloat#"      Monadic          
    Float# -> Float#
-   with needs_wrapper = True
+   with
+   code_size = { primOpCodeSizeForeignCall }
 
 primop   FloatPowerOp   "powerFloat#"      Dyadic   
    Float# -> Float# -> Float#
-   with needs_wrapper = True
+   with
+   code_size = { primOpCodeSizeForeignCall }
 
 primop   Float2DoubleOp   "float2Double#" GenPrimOp  Float# -> Double#
 
@@ -599,6 +629,7 @@ primop  WriteArrayOp "writeArray#" GenPrimOp
    {Write to specified index of mutable array.}
    with
    has_side_effects = True
+   code_size = 2 -- card update too
 
 primop  SizeofArrayOp "sizeofArray#" GenPrimOp
    Array# a -> Int#
@@ -633,6 +664,7 @@ primop  CopyArrayOp "copyArray#" GenPrimOp
    The two arrays must not be the same array in different states, but this is not checked either.}
   with
   has_side_effects = True
+  code_size = { primOpCodeSizeForeignCall + 4 }
 
 primop  CopyMutableArrayOp "copyMutableArray#" GenPrimOp
   MutableArray# s a -> Int# -> MutableArray# s a -> Int# -> Int# -> State# s -> State# s
@@ -640,6 +672,7 @@ primop  CopyMutableArrayOp "copyMutableArray#" GenPrimOp
    Both arrays must fully contain the specified ranges, but this is not checked.}
   with
   has_side_effects = True
+  code_size = { primOpCodeSizeForeignCall + 4 }
 
 primop  CloneArrayOp "cloneArray#" GenPrimOp
   Array# a -> Int# -> Int# -> Array# a
@@ -647,6 +680,7 @@ primop  CloneArrayOp "cloneArray#" GenPrimOp
    The provided Array# should contain the full subrange specified by the two Int#s, but this is not checked.}
   with
   has_side_effects = True
+  code_size = { primOpCodeSizeForeignCall + 4 }
 
 primop  CloneMutableArrayOp "cloneMutableArray#" GenPrimOp
   MutableArray# s a -> Int# -> Int# -> State# s -> (# State# s, MutableArray# s a #)
@@ -654,6 +688,7 @@ primop  CloneMutableArrayOp "cloneMutableArray#" GenPrimOp
    The provided MutableArray# should contain the full subrange specified by the two Int#s, but this is not checked.}
   with
   has_side_effects = True
+  code_size = { primOpCodeSizeForeignCall + 4 }
 
 primop  FreezeArrayOp "freezeArray#" GenPrimOp
   MutableArray# s a -> Int# -> Int# -> State# s -> (# State# s, Array# a #)
@@ -661,6 +696,7 @@ primop  FreezeArrayOp "freezeArray#" GenPrimOp
    The provided MutableArray# should contain the full subrange specified by the two Int#s, but this is not checked.}
   with
   has_side_effects = True
+  code_size = { primOpCodeSizeForeignCall + 4 }
 
 primop  ThawArrayOp "thawArray#" GenPrimOp
   Array# a -> Int# -> Int# -> State# s -> (# State# s, MutableArray# s a #)
@@ -668,6 +704,7 @@ primop  ThawArrayOp "thawArray#" GenPrimOp
    The provided Array# should contain the full subrange specified by the two Int#s, but this is not checked.}
   with
   has_side_effects = True
+  code_size = { primOpCodeSizeForeignCall + 4 }
 
 ------------------------------------------------------------------------
 section "Byte Arrays"
@@ -931,8 +968,10 @@ primop	 AddrRemOp "remAddr#" GenPrimOp Addr# -> Int# -> Int#
 #if (WORD_SIZE_IN_BITS == 32 || WORD_SIZE_IN_BITS == 64)
 primop   Addr2IntOp  "addr2Int#"     GenPrimOp   Addr# -> Int#
 	{Coerce directly from address to int. Strongly deprecated.}
+   with code_size = 0
 primop   Int2AddrOp   "int2Addr#"    GenPrimOp  Int# -> Addr#
 	{Coerce directly from int to address. Strongly deprecated.}
+   with code_size = 0
 #endif
 
 primop   AddrGtOp  "gtAddr#"   Compare   Addr# -> Addr# -> Bool
@@ -1149,6 +1188,7 @@ primop  WriteMutVarOp "writeMutVar#"  GenPrimOp
    {Write contents of {\tt MutVar\#}.}
    with
    has_side_effects = True
+   code_size = { primOpCodeSizeForeignCall } -- for the write barrier
 
 primop  SameMutVarOp "sameMutVar#" GenPrimOp
    MutVar# s a -> MutVar# s a -> Bool
@@ -1381,7 +1421,6 @@ primop  DelayOp "delay#" GenPrimOp
    Int# -> State# s -> State# s
    {Sleep specified number of microseconds.}
    with
-   needs_wrapper    = True
    has_side_effects = True
    out_of_line      = True
 
@@ -1389,7 +1428,6 @@ primop  WaitReadOp "waitRead#" GenPrimOp
    Int# -> State# s -> State# s
    {Block until input is available on specified file descriptor.}
    with
-   needs_wrapper    = True
    has_side_effects = True
    out_of_line      = True
 
@@ -1397,7 +1435,6 @@ primop  WaitWriteOp "waitWrite#" GenPrimOp
    Int# -> State# s -> State# s
    {Block until output is possible on specified file descriptor.}
    with
-   needs_wrapper    = True
    has_side_effects = True
    out_of_line      = True
 
@@ -1406,7 +1443,6 @@ primop  AsyncReadOp "asyncRead#" GenPrimOp
    Int# -> Int# -> Int# -> Addr# -> State# RealWorld-> (# State# RealWorld, Int#, Int# #)
    {Asynchronously read bytes from specified file descriptor.}
    with
-   needs_wrapper    = True
    has_side_effects = True
    out_of_line      = True
 
@@ -1414,7 +1450,6 @@ primop  AsyncWriteOp "asyncWrite#" GenPrimOp
    Int# -> Int# -> Int# -> Addr# -> State# RealWorld-> (# State# RealWorld, Int#, Int# #)
    {Asynchronously write bytes from specified file descriptor.}
    with
-   needs_wrapper    = True
    has_side_effects = True
    out_of_line      = True
 
@@ -1422,7 +1457,6 @@ primop  AsyncDoProcOp "asyncDoProc#" GenPrimOp
    Addr# -> Addr# -> State# RealWorld-> (# State# RealWorld, Int#, Int# #)
    {Asynchronously perform procedure (first arg), passing it 2nd arg.}
    with
-   needs_wrapper    = True
    has_side_effects = True
    out_of_line      = True
 
@@ -1539,6 +1573,7 @@ primop  FinalizeWeakOp "finalizeWeak#" GenPrimOp
 primop TouchOp "touch#" GenPrimOp
    o -> State# RealWorld -> State# RealWorld
    with
+   code_size = { 0 }
    has_side_effects = True
 
 ------------------------------------------------------------------------
@@ -1558,7 +1593,6 @@ primop  MakeStablePtrOp "makeStablePtr#" GenPrimOp
 primop  DeRefStablePtrOp "deRefStablePtr#" GenPrimOp
    StablePtr# a -> State# RealWorld -> (# State# RealWorld, a #)
    with
-   needs_wrapper    = True
    has_side_effects = True
    out_of_line      = True
 
@@ -1570,7 +1604,6 @@ primop  EqStablePtrOp "eqStablePtr#" GenPrimOp
 primop  MakeStableNameOp "makeStableName#" GenPrimOp
    a -> State# RealWorld -> (# State# RealWorld, StableName# a #)
    with
-   needs_wrapper    = True
    has_side_effects = True
    out_of_line      = True
 
@@ -1598,6 +1631,7 @@ primop  ParOp "par#" GenPrimOp
       -- Note that Par is lazy to avoid that the sparked thing
       -- gets evaluted strictly, which it should *not* be
    has_side_effects = True
+   code_size = { primOpCodeSizeForeignCall }
 
 primop GetSparkOp "getSpark#" GenPrimOp
    State# s -> (# State# s, Int#, a #)
@@ -1687,6 +1721,8 @@ primtype BCO#
 primop   AddrToHValueOp "addrToHValue#" GenPrimOp
    Addr# -> (# a #)
    {Convert an {\tt Addr\#} to a followable type.}
+   with
+   code_size = 0
 
 primop   MkApUpd0_Op "mkApUpd0#" GenPrimOp
    BCO# -> (# a #)
diff --git a/docs/users_guide/flags.xml b/docs/users_guide/flags.xml
index 0faefbb438..bfc28d82cb 100644
--- a/docs/users_guide/flags.xml
+++ b/docs/users_guide/flags.xml
@@ -35,13 +35,7 @@
 	      <entry>mode</entry>
 	      <entry>-</entry>
 	    </row>
-	    <row>
-	      <entry><option>-n</option></entry>
-	      <entry>do a dry run</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
+            <row>
 	      <entry><option>-v</option></entry>
 	      <entry>verbose mode (equivalent to <option>-v3</option>)</entry>
 	      <entry>dynamic</entry>
diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml
index 93f0d3c16e..0f37953d5d 100644
--- a/docs/users_guide/glasgow_exts.xml
+++ b/docs/users_guide/glasgow_exts.xml
@@ -9174,7 +9174,7 @@ allows control over inlining on a per-call-site basis.
 restrains the strictness analyser.
 </para></listitem>
 <listitem><para>
-<ulink url="&libraryGhcPrimLocation;/GHC-Prim.html#v%3AunsafeCoerce%23"><literal>lazy</literal></ulink> 
+<ulink url="&libraryGhcPrimLocation;/GHC-Prim.html#v%3AunsafeCoerce%23"><literal>unsafeCoerce#</literal></ulink> 
 allows you to fool the type checker.
 </para></listitem>
 </itemizedlist>
diff --git a/docs/users_guide/using.xml b/docs/users_guide/using.xml
index 115c290491..df015213d8 100644
--- a/docs/users_guide/using.xml
+++ b/docs/users_guide/using.xml
@@ -783,18 +783,6 @@ ghc -c Foo.hs</screen>
     <variablelist>
       <varlistentry>
 	<term>
-          <option>-n</option>
-          <indexterm><primary><option>-n</option></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>Does a dry-run, i.e. GHC goes through all the motions
-          of compiling as normal, but does not actually run any
-          external commands.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
           <option>-v</option>
           <indexterm><primary><option>-v</option></primary></indexterm>
         </term>
diff --git a/includes/Rts.h b/includes/Rts.h
index 3a6c6f20b9..91ec76d467 100644
--- a/includes/Rts.h
+++ b/includes/Rts.h
@@ -248,9 +248,6 @@ int stg_sig_install (int, int, void *);
    Miscellaneous garbage
    -------------------------------------------------------------------------- */
 
-/* declarations for runtime flags/values */
-#define MAX_RTS_ARGS 32
-
 #ifdef DEBUG
 #define TICK_VAR(arity) \
   extern StgInt SLOW_CALLS_##arity; \
diff --git a/includes/rts/EventLogFormat.h b/includes/rts/EventLogFormat.h
index 16f1c8b545..f3f56c9dd0 100644
--- a/includes/rts/EventLogFormat.h
+++ b/includes/rts/EventLogFormat.h
@@ -112,7 +112,6 @@
 #define EVENT_GC_END              10 /* ()                     */
 #define EVENT_REQUEST_SEQ_GC      11 /* ()                     */
 #define EVENT_REQUEST_PAR_GC      12 /* ()                     */
-/* 13, 14 deprecated */
 #define EVENT_CREATE_SPARK_THREAD 15 /* (spark_thread)         */
 #define EVENT_LOG_MSG             16 /* (message ...)          */
 #define EVENT_STARTUP             17 /* (num_capabilities)     */
@@ -121,39 +120,12 @@
 #define EVENT_GC_IDLE             20 /* () */
 #define EVENT_GC_WORK             21 /* () */
 #define EVENT_GC_DONE             22 /* () */
-/* 23, 24 used by eden */
-#define EVENT_CAPSET_CREATE       25 /* (capset, capset_type)  */
-#define EVENT_CAPSET_DELETE       26 /* (capset)               */
-#define EVENT_CAPSET_ASSIGN_CAP   27 /* (capset, cap)          */
-#define EVENT_CAPSET_REMOVE_CAP   28 /* (capset, cap)          */
-/* the RTS identifier is in the form of "GHC-version rts_way"  */
-#define EVENT_RTS_IDENTIFIER      29 /* (capset, name_version_string) */
-/* the vectors in these events are null separated strings             */
-#define EVENT_PROGRAM_ARGS        30 /* (capset, commandline_vector)  */
-#define EVENT_PROGRAM_ENV         31 /* (capset, environment_vector)  */
-#define EVENT_OSPROCESS_PID       32 /* (capset, pid, parent_pid)     */
 
-
-/* Range 33 - 59 is available for new events */
-
-/* Range 60 - 80 is used by eden for parallel tracing
- * see http://www.mathematik.uni-marburg.de/~eden/
- */
-
-/*
- * The highest event code +1 that ghc itself emits. Note that some event
- * ranges higher than this are reserved but not currently emitted by ghc.
- * This must match the size of the EventDesc[] array in EventLog.c
- */
-#define NUM_EVENT_TAGS            33
+#define NUM_EVENT_TAGS            23
 
 #if 0  /* DEPRECATED EVENTS: */
-/* ghc changed how it handles sparks so these are no longer applicable */
 #define EVENT_CREATE_SPARK        13 /* (cap, thread) */
 #define EVENT_SPARK_TO_THREAD     14 /* (cap, thread, spark_thread) */
-/* these are used by eden but are replaced by new alternatives for ghc */
-#define EVENT_VERSION             23 /* (version_string) */
-#define EVENT_PROGRAM_INVOCATION  24 /* (commandline_string) */
 #endif
 
 /*
@@ -180,13 +152,6 @@
  */
 #define THREAD_SUSPENDED_FOREIGN_CALL 6
 
-/*
- * Capset type values for EVENT_CAPSET_CREATE
- */
-#define CAPSET_TYPE_CUSTOM      1  /* reserved for end-user applications */
-#define CAPSET_TYPE_OSPROCESS   2  /* caps belong to the same OS process */
-#define CAPSET_TYPE_CLOCKDOMAIN 3  /* caps share a local clock/time      */
-
 #ifndef EVENTLOG_CONSTANTS_ONLY
 
 typedef StgWord16 EventTypeNum;
@@ -195,8 +160,6 @@ typedef StgWord32 EventThreadID;
 typedef StgWord16 EventCapNo;
 typedef StgWord16 EventPayloadSize; /* variable-size events */
 typedef StgWord16 EventThreadStatus; /* status for EVENT_STOP_THREAD */
-typedef StgWord32 EventCapsetID;
-typedef StgWord16 EventCapsetType;   /* types for EVENT_CAPSET_CREATE */
 
 #endif
 
diff --git a/includes/rts/Flags.h b/includes/rts/Flags.h
index b4e7b64c4e..42ca671768 100644
--- a/includes/rts/Flags.h
+++ b/includes/rts/Flags.h
@@ -244,7 +244,7 @@ extern RTS_FLAGS RtsFlags;
 extern int     prog_argc;
 extern char  **prog_argv;
 */
-extern int     rts_argc;  /* ditto */
-extern char   *rts_argv[];
+extern int      rts_argc;  /* ditto */
+extern char   **rts_argv;
 
 #endif	/* RTS_FLAGS_H */
diff --git a/includes/rts/storage/GC.h b/includes/rts/storage/GC.h
index bbed2165a2..3c6e6f6e26 100644
--- a/includes/rts/storage/GC.h
+++ b/includes/rts/storage/GC.h
@@ -53,24 +53,32 @@
  *
  * ------------------------------------------------------------------------- */
 
+// A count of blocks needs to store anything up to the size of memory
+// divided by the block size.  The safest thing is therefore to use a
+// type that can store the full range of memory addresses,
+// ie. StgWord.  Note that we have had some tricky int overflows in a
+// couple of cases caused by using ints rather than longs (e.g. #5086)
+
+typedef StgWord memcount;
+
 typedef struct nursery_ {
     bdescr *       blocks;
-    unsigned int   n_blocks;
+    memcount       n_blocks;
 } nursery;
 
 typedef struct generation_ {
     unsigned int   no;			// generation number
 
     bdescr *       blocks;	        // blocks in this gen
-    unsigned int   n_blocks;	        // number of blocks
-    unsigned int   n_words;             // number of used words
+    memcount       n_blocks;            // number of blocks
+    memcount       n_words;             // number of used words
 
     bdescr *       large_objects;	// large objects (doubly linked)
-    unsigned int   n_large_blocks;      // no. of blocks used by large objs
-    unsigned long  n_new_large_words;   // words of new large objects
+    memcount       n_large_blocks;      // no. of blocks used by large objs
+    memcount       n_new_large_words;   // words of new large objects
                                         // (for allocation stats)
 
-    unsigned int   max_blocks;		// max blocks
+    memcount       max_blocks;          // max blocks
 
     StgTSO *       threads;             // threads in this gen
                                         // linked via global_link
@@ -98,11 +106,11 @@ typedef struct generation_ {
     // are copied into the following two fields.  After GC, these blocks
     // are freed.
     bdescr *     old_blocks;	        // bdescr of first from-space block
-    unsigned int n_old_blocks;		// number of blocks in from-space
-    unsigned int live_estimate;         // for sweeping: estimate of live data
+    memcount     n_old_blocks;         // number of blocks in from-space
+    memcount     live_estimate;         // for sweeping: estimate of live data
     
     bdescr *     scavenged_large_objects;  // live large objs after GC (d-link)
-    unsigned int n_scavenged_large_blocks; // size (not count) of above
+    memcount     n_scavenged_large_blocks; // size (not count) of above
 
     bdescr *     bitmap;  		// bitmap for compacting collection
 
diff --git a/rts/Capability.c b/rts/Capability.c
index 9557fcc07f..9091fdde0c 100644
--- a/rts/Capability.c
+++ b/rts/Capability.c
@@ -253,8 +253,6 @@ initCapability( Capability *cap, nat i )
     cap->transaction_tokens = 0;
     cap->context_switch = 0;
     cap->pinned_object_block = NULL;
-
-    traceCapsetAssignCap(CAPSET_OSPROCESS_DEFAULT, i);
 }
 
 /* ---------------------------------------------------------------------------
@@ -268,7 +266,6 @@ initCapability( Capability *cap, nat i )
 void
 initCapabilities( void )
 {
-
 #if defined(THREADED_RTS)
     nat i;
 
@@ -836,7 +833,6 @@ freeCapabilities (void)
 #else
     freeCapability(&MainCapability);
 #endif
-    traceCapsetDelete(CAPSET_OSPROCESS_DEFAULT);
 }
 
 /* ---------------------------------------------------------------------------
diff --git a/rts/RtsFlags.c b/rts/RtsFlags.c
index 14080702bf..9c0ec9e2c9 100644
--- a/rts/RtsFlags.c
+++ b/rts/RtsFlags.c
@@ -33,7 +33,7 @@ int     full_prog_argc = 0;    /* an "int" so as to match normal "argc" */
 char  **full_prog_argv = NULL;
 char   *prog_name = NULL; /* 'basename' of prog_argv[0] */
 int     rts_argc = 0;  /* ditto */
-char   *rts_argv[MAX_RTS_ARGS];
+char  **rts_argv = NULL;
 #if defined(mingw32_HOST_OS)
 // On Windows, we want to use GetCommandLineW rather than argc/argv,
 // but we need to mutate the command line arguments for withProgName and
@@ -73,6 +73,10 @@ static void read_trace_flags(char *arg);
 
 static void errorUsage      (void) GNU_ATTRIBUTE(__noreturn__);
 
+static char *  copyArg  (char *arg);
+static char ** copyArgv (int argc, char *argv[]);
+static void    freeArgv (int argc, char *argv[]);
+
 /* -----------------------------------------------------------------------------
  * Command-line option parsing routines.
  * ---------------------------------------------------------------------------*/
@@ -387,15 +391,11 @@ static void splitRtsFlags(char *s)
 	
 	if (c1 == c2) { break; }
 	
-        if (rts_argc < MAX_RTS_ARGS-1) {
-	    s = stgMallocBytes(c2-c1+1, "RtsFlags.c:splitRtsFlags()");
-	    strncpy(s, c1, c2-c1);
-	    s[c2-c1] = '\0';
-            rts_argv[rts_argc++] = s;
-	} else {
-	    barf("too many RTS arguments (max %d)", MAX_RTS_ARGS-1);
-	}
-	
+        s = stgMallocBytes(c2-c1+1, "RtsFlags.c:splitRtsFlags()");
+        strncpy(s, c1, c2-c1);
+        s[c2-c1] = '\0';
+        rts_argv[rts_argc++] = s;
+
 	c1 = c2;
     } while (*c1 != '\0');
 }
@@ -407,13 +407,13 @@ static void splitRtsFlags(char *s)
      - argv[] is *modified*, any RTS options have been stripped out
      - *argc  contains the new count of arguments in argv[]
 
-     - rts_argv[]  (global) contains the collected RTS args
+     - rts_argv[]  (global) contains a copy of the collected RTS args
      - rts_argc    (global) contains the count of args in rts_argv
 
-     - prog_argv[] (global) contains the non-RTS args (== argv)
+     - prog_argv[] (global) contains a copy of the non-RTS args (== argv)
      - prog_argc   (global) contains the count of args in prog_argv
 
-     - prog_name   (global) contains the basename of argv[0]
+     - prog_name   (global) contains the basename of prog_argv[0]
 
   -------------------------------------------------------------------------- */
 
@@ -430,6 +430,8 @@ void setupRtsFlags (int *argc, char *argv[])
     *argc = 1;
     rts_argc = 0;
 
+    rts_argv = stgCallocBytes(total_arg + 1, sizeof (char *), "setupRtsFlags");
+
     rts_argc0 = rts_argc;
 
     // process arguments from the ghc_rts_opts global variable first.
@@ -481,14 +483,11 @@ void setupRtsFlags (int *argc, char *argv[])
 	else if (strequal("-RTS", argv[arg])) {
 	    mode = PGM;
 	}
-        else if (mode == RTS && rts_argc < MAX_RTS_ARGS-1) {
-            rts_argv[rts_argc++] = argv[arg];
+        else if (mode == RTS) {
+            rts_argv[rts_argc++] = copyArg(argv[arg]);
         }
-        else if (mode == PGM) {
-	    argv[(*argc)++] = argv[arg];
-	}
-	else {
-	  barf("too many RTS arguments (max %d)", MAX_RTS_ARGS-1);
+        else {
+            argv[(*argc)++] = argv[arg];
 	}
     }
     // process remaining program arguments
@@ -1459,6 +1458,41 @@ bad_option(const char *s)
   stg_exit(EXIT_FAILURE);
 }
 
+/* ----------------------------------------------------------------------------
+   Copying and freeing argc/argv
+   ------------------------------------------------------------------------- */
+
+static char * copyArg(char *arg)
+{
+    char *new_arg = stgMallocBytes(strlen(arg) + 1, "copyArg");
+    strcpy(new_arg, arg);
+    return new_arg;
+}
+
+static char ** copyArgv(int argc, char *argv[])
+{
+    int i;
+    char **new_argv;
+
+    new_argv = stgCallocBytes(argc + 1, sizeof (char *), "copyArgv 1");
+    for (i = 0; i < argc; i++) {
+        new_argv[i] = copyArg(argv[i]);
+    }
+    new_argv[argc] = NULL;
+    return new_argv;
+}
+
+static void freeArgv(int argc, char *argv[])
+{
+    int i;
+    if (argv != NULL) {
+        for (i = 0; i < argc; i++) {
+            stgFree(argv[i]);
+        }
+        stgFree(argv);
+    }
+}
+
 /* -----------------------------------------------------------------------------
    Getting/Setting the program's arguments.
 
@@ -1500,10 +1534,29 @@ void
 setProgArgv(int argc, char *argv[])
 {
     prog_argc = argc;
-    prog_argv = argv;
+    prog_argv = copyArgv(argc,argv);
     setProgName(prog_argv);
 }
 
+static void
+freeProgArgv(void)
+{
+    freeArgv(prog_argc,prog_argv);
+    prog_argc = 0;
+    prog_argv = NULL;
+}
+
+/* ----------------------------------------------------------------------------
+   The full argv - a copy of the original program's argc/argv
+   ------------------------------------------------------------------------- */
+
+void
+setFullProgArgv(int argc, char *argv[])
+{
+    full_prog_argc = argc;
+    full_prog_argv = copyArgv(argc,argv);
+}
+
 /* These functions record and recall the full arguments, including the
    +RTS ... -RTS options. The reason for adding them was so that the
    ghc-inplace program can pass /all/ the arguments on to the real ghc. */
@@ -1515,42 +1568,25 @@ getFullProgArgv(int *argc, char **argv[])
 }
 
 void
-setFullProgArgv(int argc, char *argv[])
-{
-    int i;
-    full_prog_argc = argc;
-    full_prog_argv = stgCallocBytes(argc + 1, sizeof (char *),
-                                    "setFullProgArgv 1");
-    for (i = 0; i < argc; i++) {
-        full_prog_argv[i] = stgMallocBytes(strlen(argv[i]) + 1,
-                                           "setFullProgArgv 2");
-        strcpy(full_prog_argv[i], argv[i]);
-    }
-    full_prog_argv[argc] = NULL;
-}
-
-void
 freeFullProgArgv (void)
 {
-    int i;
-
-    if (full_prog_argv != NULL) {
-        for (i = 0; i < full_prog_argc; i++) {
-            stgFree(full_prog_argv[i]);
-        }
-        stgFree(full_prog_argv);
-    }
-
+    freeArgv(full_prog_argc, full_prog_argv);
     full_prog_argc = 0;
     full_prog_argv = NULL;
 }
 
+/* ----------------------------------------------------------------------------
+   The Win32 argv
+   ------------------------------------------------------------------------- */
+
 #if defined(mingw32_HOST_OS)
 void freeWin32ProgArgv (void);
 
 void
 freeWin32ProgArgv (void)
 {
+    freeArgv(win32_prog_argc, win32_prog_argv);
+
     int i;
 
     if (win32_prog_argv != NULL) {
@@ -1594,3 +1630,29 @@ setWin32ProgArgv(int argc, wchar_t *argv[])
     win32_prog_argv[argc] = NULL;
 }
 #endif
+
+/* ----------------------------------------------------------------------------
+   The RTS argv
+   ------------------------------------------------------------------------- */
+
+static void
+freeRtsArgv(void)
+{
+    freeArgv(rts_argc,rts_argv);
+    rts_argc = 0;
+    rts_argv = NULL;
+}
+
+/* ----------------------------------------------------------------------------
+   All argvs
+   ------------------------------------------------------------------------- */
+
+void freeRtsArgs(void)
+{
+#if defined(mingw32_HOST_OS)
+    freeWin32ProgArgv();
+#endif
+    freeFullProgArgv();
+    freeProgArgv();
+    freeRtsArgv();
+}
diff --git a/rts/RtsFlags.h b/rts/RtsFlags.h
index 3ebfef6447..a6bfe0a924 100644
--- a/rts/RtsFlags.h
+++ b/rts/RtsFlags.h
@@ -17,6 +17,7 @@
 void initRtsFlagsDefaults (void);
 void setupRtsFlags        (int *argc, char *argv[]);
 void setProgName          (char *argv[]);
+void freeRtsArgs          (void);
 
 #include "EndPrivate.h"
 
diff --git a/rts/RtsProbes.d b/rts/RtsProbes.d
index bd32fca385..dbc5111e46 100644
--- a/rts/RtsProbes.d
+++ b/rts/RtsProbes.d
@@ -23,8 +23,6 @@
  * typedef uint16_t EventCapNo;
  * typedef uint16_t EventPayloadSize; // variable-size events
  * typedef uint16_t EventThreadStatus;
- * typedef uint32_t EventCapsetID;
- * typedef uint16_t EventCapsetType;  // types for EVENT_CAPSET_CREATE
  */
 
 /* -----------------------------------------------------------------------------
@@ -62,9 +60,5 @@ provider HaskellEvent {
   probe gc__idle (EventCapNo);
   probe gc__work (EventCapNo);
   probe gc__done (EventCapNo);
-  probe capset__create(EventCapsetID, EventCapsetType);
-  probe capset__delete(EventCapsetID);
-  probe capset__assign__cap(EventCapsetID, EventCapNo);
-  probe capset__remove__cap(EventCapsetID, EventCapNo);
 
 };
diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c
index 502906ebed..952e806345 100644
--- a/rts/RtsStartup.c
+++ b/rts/RtsStartup.c
@@ -148,10 +148,6 @@ hs_init(int *argc, char **argv[])
      */
     dtraceEventStartup();
 
-    /* Trace some basic information about the process
-     */
-    traceCapsetDetails(argc, argv);
-
     /* initialise scheduler data structures (needs to be done before
      * initStorage()).
      */
@@ -301,9 +297,6 @@ hs_exit_(rtsBool wait_foreign)
     checkFPUStack();
 #endif
 
-    // Free the full argv storage
-    freeFullProgArgv();
-
 #if defined(THREADED_RTS)
     ioManagerDie();
 #endif
@@ -406,6 +399,8 @@ hs_exit_(rtsBool wait_foreign)
     // heap memory (e.g. by being passed a ByteArray#).
     freeStorage(wait_foreign);
 
+    // Free the various argvs
+    freeRtsArgs();
 }
 
 // The real hs_exit():
diff --git a/rts/Schedule.c b/rts/Schedule.c
index 9b151d7283..9636223836 100644
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -2030,16 +2030,16 @@ exitScheduler (rtsBool wait_foreign USED_IF_THREADS)
     }
     sched_state = SCHED_SHUTTING_DOWN;
 
-    nat i;
-
-    for (i = 0; i < n_capabilities; i++) {
 #if defined(THREADED_RTS)
-        ASSERT(task->incall->tso == NULL);
-        shutdownCapability(&capabilities[i], task, wait_foreign);
-#endif
-        traceCapsetRemoveCap(CAPSET_OSPROCESS_DEFAULT, i);
+    { 
+	nat i;
+	
+	for (i = 0; i < n_capabilities; i++) {
+            ASSERT(task->incall->tso == NULL);
+	    shutdownCapability(&capabilities[i], task, wait_foreign);
+	}
     }
-    traceCapsetDelete(CAPSET_OSPROCESS_DEFAULT);
+#endif
 
     boundTaskExiting(task);
 }
diff --git a/rts/Stats.c b/rts/Stats.c
index 3036ed7265..8366bf47b2 100644
--- a/rts/Stats.c
+++ b/rts/Stats.c
@@ -817,7 +817,7 @@ statDescribeGens(void)
           gen_blocks += gcThreadLiveBlocks(i,g);
       }
 
-      debugBelch("%5d %7d %9d", g, gen->max_blocks, mut);
+      debugBelch("%5d %7ld %9d", g, (lnat)gen->max_blocks, mut);
 
       gen_slop = gen_blocks * BLOCK_SIZE_W - gen_live;
 
diff --git a/rts/Trace.c b/rts/Trace.c
index fb8e9226af..f2f9e81549 100644
--- a/rts/Trace.c
+++ b/rts/Trace.c
@@ -20,10 +20,6 @@
 #include "Threads.h"
 #include "Printer.h"
 
-#ifdef HAVE_UNISTD_H
-#include <unistd.h>
-#endif
-
 #ifdef DEBUG
 // debugging flags, set with +RTS -D<something>
 int DEBUG_sched;
@@ -255,69 +251,6 @@ void traceSchedEvent_ (Capability *cap, EventTypeNum tag,
     }
 }
 
-void traceCapsetModify_ (EventTypeNum tag,
-                         CapsetID capset,
-                         StgWord32 other,
-                         StgWord32 other2)
-{
-#ifdef DEBUG
-    if (RtsFlags.TraceFlags.tracing == TRACE_STDERR) {
-        ACQUIRE_LOCK(&trace_utx);
-
-        tracePreface();
-        switch (tag) {
-        case EVENT_CAPSET_CREATE:   // (capset, capset_type)
-            debugBelch("created capset %d of type %d\n", capset, other);
-            break;
-        case EVENT_CAPSET_DELETE:   // (capset)
-            debugBelch("deleted capset %d\n", capset);
-            break;
-        case EVENT_CAPSET_ASSIGN_CAP:  // (capset, capno)
-            debugBelch("assigned cap %d to capset %d\n", other, capset);
-            break;
-        case EVENT_CAPSET_REMOVE_CAP:  // (capset, capno)
-            debugBelch("removed cap %d from capset %d\n", other, capset);
-            break;
-        }
-        RELEASE_LOCK(&trace_utx);
-    } else
-#endif
-    {
-        if(eventlog_enabled) postCapsetModifyEvent(tag, capset, other, other2);
-    }
-}
-
-extern char **environ;
-
-void traceCapsetDetails_(int *argc, char **argv[]){
-    if(eventlog_enabled){
-        postCapsetModifyEvent(EVENT_OSPROCESS_PID,
-                              CAPSET_OSPROCESS_DEFAULT,
-                              getpid(),
-                              getppid());
-
-        char buf[256];
-        snprintf(buf, sizeof(buf), "GHC-%s %s", ProjectVersion, RtsWay);
-        postCapsetStrEvent(EVENT_RTS_IDENTIFIER,
-                           CAPSET_OSPROCESS_DEFAULT,
-                           buf);
-
-        if(argc != NULL && argv != NULL){
-            postCapsetVecEvent(EVENT_PROGRAM_ARGS,
-                               CAPSET_OSPROCESS_DEFAULT,
-                               *argc,
-                               *argv);
-        }
-
-        int env_len;
-        for( env_len = 0; environ[env_len] != NULL; env_len++);
-        postCapsetVecEvent(EVENT_PROGRAM_ENV,
-                           CAPSET_OSPROCESS_DEFAULT,
-                           env_len,
-                           environ);
-    }
-}
-
 void traceEvent_ (Capability *cap, EventTypeNum tag)
 {
 #ifdef DEBUG
diff --git a/rts/Trace.h b/rts/Trace.h
index 04075ad6e9..620915665b 100644
--- a/rts/Trace.h
+++ b/rts/Trace.h
@@ -31,13 +31,6 @@ void resetTracing (void);
 
 #endif /* TRACING */
 
-typedef StgWord32 CapsetID;
-typedef StgWord16 CapsetType;
-enum CapsetType { CapsetTypeCustom = CAPSET_TYPE_CUSTOM,
-                  CapsetTypeOsProcess = CAPSET_TYPE_OSPROCESS,
-                  CapsetTypeClockdomain = CAPSET_TYPE_CLOCKDOMAIN };
-#define CAPSET_OSPROCESS_DEFAULT 0
-
 // -----------------------------------------------------------------------------
 // Message classes
 // -----------------------------------------------------------------------------
@@ -167,21 +160,6 @@ void traceUserMsg(Capability *cap, char *msg);
 
 void traceThreadStatus_ (StgTSO *tso);
 
-/*
- * Events for describing capability sets in the eventlog
- *
- * Note: unlike other events, these are not conditional on TRACE_sched or
- * similar because they are not "real" events themselves but provide
- * information and context for other "real" events. Other events depend on
- * the capset info events so for simplicity, rather than working out if
- * they're necessary we always emit them. They should be very low volume.
- */
-void traceCapsetModify_ (EventTypeNum tag,
-                         CapsetID capset,
-                         StgWord32 other,
-                         StgWord32 other2);
-
-void traceCapsetDetails_ (int *argc, char **argv[]);
 #else /* !TRACING */
 
 #define traceSchedEvent(cap, tag, tso, other) /* nothing */
@@ -192,8 +170,6 @@ void traceCapsetDetails_ (int *argc, char **argv[]);
 #define debugTrace(class, str, ...) /* nothing */
 #define debugTraceCap(class, cap, str, ...) /* nothing */
 #define traceThreadStatus(class, tso) /* nothing */
-#define traceCapsetModify_(tag, capset, other, other2) /* nothing */
-#define traceCapsetDetails_(argc, argv) /* nothing */
 
 #endif /* TRACING */
 
@@ -250,14 +226,6 @@ void dtraceUserMsgWrapper(Capability *cap, char *msg);
     HASKELLEVENT_GC_WORK(cap)
 #define dtraceGcDone(cap)                               \
     HASKELLEVENT_GC_DONE(cap)
-#define dtraceCapsetCreate(capset, capset_type)         \
-    HASKELLEVENT_CAPSET_CREATE(capset, capset_type)
-#define dtraceCapsetDelete(capset)                      \
-    HASKELLEVENT_CAPSET_DELETE(capset)
-#define dtraceCapsetAssignCap(capset, capno)            \
-    HASKELLEVENT_CAPSET_ASSIGN_CAP(capset, capno)
-#define dtraceCapsetRemoveCap(capset, capno)            \
-    HASKELLEVENT_CAPSET_REMOVE_CAP(capset, capno)
 
 #else /* !defined(DTRACE) */
 
@@ -280,10 +248,6 @@ void dtraceUserMsgWrapper(Capability *cap, char *msg);
 #define dtraceGcIdle(cap)                               /* nothing */
 #define dtraceGcWork(cap)                               /* nothing */
 #define dtraceGcDone(cap)                               /* nothing */
-#define dtraceCapsetCreate(capset, capset_type)         /* nothing */
-#define dtraceCapsetDelete(capset)                      /* nothing */
-#define dtraceCapsetAssignCap(capset, capno)            /* nothing */
-#define dtraceCapsetRemoveCap(capset, capno)            /* nothing */
 
 #endif
 
@@ -441,39 +405,6 @@ INLINE_HEADER void traceEventGcDone(Capability *cap STG_UNUSED)
     dtraceGcDone((EventCapNo)cap->no);
 }
 
-INLINE_HEADER void traceCapsetCreate(CapsetID   capset      STG_UNUSED,
-                                     CapsetType capset_type STG_UNUSED)
-{
-    traceCapsetModify_(EVENT_CAPSET_CREATE, capset, capset_type, 0);
-    dtraceCapsetCreate(capset, capset_type);
-}
-
-INLINE_HEADER void traceCapsetDelete(CapsetID capset STG_UNUSED)
-{
-    traceCapsetModify_(EVENT_CAPSET_DELETE, capset, 0, 0);
-    dtraceCapsetDelete(capset);
-}
-
-INLINE_HEADER void traceCapsetAssignCap(CapsetID capset STG_UNUSED,
-                                        nat      capno  STG_UNUSED)
-{
-    traceCapsetModify_(EVENT_CAPSET_ASSIGN_CAP, capset, capno, 0);
-    dtraceCapsetAssignCap(capset, capno);
-}
-
-INLINE_HEADER void traceCapsetRemoveCap(CapsetID capset STG_UNUSED,
-                                        nat      capno  STG_UNUSED)
-{
-    traceCapsetModify_(EVENT_CAPSET_REMOVE_CAP, capset, capno, 0);
-    dtraceCapsetRemoveCap(capset, capno);
-}
-
-INLINE_HEADER void traceCapsetDetails(int *argc STG_UNUSED, char **argv[] STG_UNUSED)
-{
-    traceCapsetCreate(CAPSET_OSPROCESS_DEFAULT, CapsetTypeOsProcess);
-    traceCapsetDetails_(argc, argv);
-}
-
 #include "EndPrivate.h"
 
 #endif /* TRACE_H */
diff --git a/rts/eventlog/EventLog.c b/rts/eventlog/EventLog.c
index d2e3de35ff..a77c257e1b 100644
--- a/rts/eventlog/EventLog.c
+++ b/rts/eventlog/EventLog.c
@@ -75,15 +75,7 @@ char *EventDesc[] = {
   [EVENT_GC_IDLE]             = "GC idle",
   [EVENT_GC_WORK]             = "GC working",
   [EVENT_GC_DONE]             = "GC done",
-  [EVENT_BLOCK_MARKER]        = "Block marker",
-  [EVENT_CAPSET_CREATE]       = "Create capability set",
-  [EVENT_CAPSET_DELETE]       = "Delete capability set",
-  [EVENT_CAPSET_ASSIGN_CAP]   = "Add capability to capability set",
-  [EVENT_CAPSET_REMOVE_CAP]   = "Remove capability from capability set",
-  [EVENT_RTS_IDENTIFIER]      = "Identify the RTS version",
-  [EVENT_PROGRAM_ARGS]        = "Identify the program arguments",
-  [EVENT_PROGRAM_ENV]         = "Identify the environment variables",
-  [EVENT_OSPROCESS_PID]       = "Identify the process ID of a capability set"
+  [EVENT_BLOCK_MARKER]        = "Block marker"
 };
 
 // Event type. 
@@ -154,12 +146,6 @@ static inline void postThreadID(EventsBuf *eb, EventThreadID id)
 static inline void postCapNo(EventsBuf *eb, EventCapNo no)
 { postWord16(eb,no); }
 
-static inline void postCapsetID(EventsBuf *eb, EventCapsetID id)
-{ postWord32(eb,id); }
-
-static inline void postCapsetType(EventsBuf *eb, EventCapsetType type)
-{ postWord16(eb,type); }
-
 static inline void postPayloadSize(EventsBuf *eb, EventPayloadSize size)
 { postWord16(eb,size); }
 
@@ -273,26 +259,6 @@ initEventLogging(void)
             eventTypes[t].size = sizeof(EventCapNo);
             break;
 
-        case EVENT_CAPSET_CREATE:   // (capset, capset_type)
-            eventTypes[t].size =
-                sizeof(EventCapsetID) + sizeof(EventCapsetType);
-            break;
-
-        case EVENT_CAPSET_DELETE:   // (capset)
-            eventTypes[t].size = sizeof(EventCapsetID);
-            break;
-
-        case EVENT_CAPSET_ASSIGN_CAP:  // (capset, cap)
-        case EVENT_CAPSET_REMOVE_CAP:
-            eventTypes[t].size =
-                sizeof(EventCapsetID) + sizeof(EventCapNo);
-            break;
-
-        case EVENT_OSPROCESS_PID: // (cap, pid, parent pid)
-            eventTypes[t].size =
-                sizeof(EventCapsetID) + 2*sizeof(StgWord32);
-            break;
-
         case EVENT_SHUTDOWN:        // (cap)
         case EVENT_REQUEST_SEQ_GC:  // (cap)
         case EVENT_REQUEST_PAR_GC:  // (cap)
@@ -306,9 +272,6 @@ initEventLogging(void)
 
         case EVENT_LOG_MSG:          // (msg)
         case EVENT_USER_MSG:         // (msg)
-        case EVENT_RTS_IDENTIFIER:   // (capset, str)
-        case EVENT_PROGRAM_ARGS:     // (capset, strvec)
-        case EVENT_PROGRAM_ENV:      // (capset, strvec)
             eventTypes[t].size = 0xffff;
             break;
 
@@ -480,116 +443,6 @@ postSchedEvent (Capability *cap,
     }
 }
 
-void postCapsetModifyEvent (EventTypeNum tag,
-                            EventCapsetID capset,
-                            StgWord32 other,
-                            StgWord32 other2)
-{
-    ACQUIRE_LOCK(&eventBufMutex);
-
-    if (!hasRoomForEvent(&eventBuf, tag)) {
-        // Flush event buffer to make room for new event.
-        printAndClearEventBuf(&eventBuf);
-    }
-
-    postEventHeader(&eventBuf, tag);
-    postCapsetID(&eventBuf, capset);
-
-    switch (tag) {
-    case EVENT_CAPSET_CREATE:   // (capset, capset_type)
-    {
-        postCapsetType(&eventBuf, other /* capset_type */);
-        break;
-    }
-
-    case EVENT_CAPSET_DELETE:   // (capset)
-    {
-        break;
-    }
-
-    case EVENT_CAPSET_ASSIGN_CAP:  // (capset, capno)
-    case EVENT_CAPSET_REMOVE_CAP:  // (capset, capno)
-    {
-        postCapNo(&eventBuf, other /* capno */);
-        break;
-    }
-    case EVENT_OSPROCESS_PID:
-    {
-        postWord32(&eventBuf, other);
-        postWord32(&eventBuf, other2);
-        break;
-    }
-    default:
-        barf("postCapsetModifyEvent: unknown event tag %d", tag);
-    }
-
-    RELEASE_LOCK(&eventBufMutex);
-}
-
-void postCapsetStrEvent (EventTypeNum tag,
-                         EventCapsetID capset,
-                         char *msg)
-{
-    int strsize = strlen(msg);
-    int size = strsize + sizeof(EventCapsetID)
-
-    ACQUIRE_LOCK(&eventBufMutex);
-
-    if (!hasRoomForVariableEvent(&eventBuf, size)){
-        printAndClearEventBuf(&eventBuf);
-
-        if (!hasRoomForVariableEvent(&eventBuf, size)){
-            // Event size exceeds buffer size, bail out:
-            RELEASE_LOCK(&eventBufMutex);
-            return;
-        }
-    }
-
-    postEventHeader(&eventBuf, tag);
-    postPayloadSize(&eventBuf, size);
-    postCapsetID(&eventBuf, capset);
-
-    postBuf(&eventBuf, (StgWord8*) msg, strsize);
-
-    RELEASE_LOCK(&eventBufMutex);
-}
-
-void postCapsetVecEvent (EventTypeNum tag,
-                         EventCapsetID capset,
-                         int argc,
-                         char *argv[])
-{
-    int i, size = sizeof(EventCapsetID);
-
-    for (i = 0; i < argc; i++) {
-        // 1 + strlen to account for the trailing \0, used as separator
-        size += 1 + strlen(argv[i]);
-    }
-
-    ACQUIRE_LOCK(&eventBufMutex);
-
-    if (!hasRoomForVariableEvent(&eventBuf, size)){
-        printAndClearEventBuf(&eventBuf);
-
-        if(!hasRoomForVariableEvent(&eventBuf, size)){
-            // Event size exceeds buffer size, bail out:
-            RELEASE_LOCK(&eventBufMutex);
-            return;
-        }
-    }
-
-    postEventHeader(&eventBuf, tag);
-    postPayloadSize(&eventBuf, size);
-    postCapsetID(&eventBuf, capset);
-
-    for( i = 0; i < argc; i++ ) {
-        // again, 1 + to account for \0
-        postBuf(&eventBuf, (StgWord8*) argv[i], 1 + strlen(argv[i]));
-    }
-
-    RELEASE_LOCK(&eventBufMutex);
-}
-
 void
 postEvent (Capability *cap, EventTypeNum tag)
 {
diff --git a/rts/eventlog/EventLog.h b/rts/eventlog/EventLog.h
index 26a2e944bf..0cfab5c091 100644
--- a/rts/eventlog/EventLog.h
+++ b/rts/eventlog/EventLog.h
@@ -35,29 +35,6 @@ void postSchedEvent(Capability *cap, EventTypeNum tag,
                     StgThreadID id, StgWord info1, StgWord info2);
 
 /*
- * Post a capability set modification event
- */
-void postCapsetModifyEvent (EventTypeNum tag,
-                            EventCapsetID capset,
-                            StgWord32 other,
-                            StgWord32 other2);
-
-/*
- * Post a capability set event with a string payload
- */
-void postCapsetStrEvent (EventTypeNum tag,
-                         EventCapsetID capset,
-                         char *msg);
-
-/*
- * Post a capability set event with several strings payload
- */
-void postCapsetVecEvent (EventTypeNum tag,
-                         EventCapsetID capset,
-                         int argc,
-                         char *msg[]);
-
-/*
  * Post a nullary event.
  */
 void postEvent(Capability *cap, EventTypeNum tag);
@@ -77,12 +54,6 @@ INLINE_HEADER void postSchedEvent (Capability *cap  STG_UNUSED,
                                    StgWord info2    STG_UNUSED)
 { /* nothing */ }
 
-INLINE_HEADER void postCapsetModifyEvent (EventTypeNum tag     STG_UNUSED,
-                                          EventCapsetID capset STG_UNUSED,
-                                          StgWord32 other      STG_UNUSED,
-                                          StgWord32 other2     STG_UNUSED)
-{ /* nothing */ }
-
 INLINE_HEADER void postEvent (Capability *cap  STG_UNUSED,
                               EventTypeNum tag STG_UNUSED)
 { /* nothing */ }
diff --git a/rts/ghc.mk b/rts/ghc.mk
index 38ddbc0d46..a2369452b7 100644
--- a/rts/ghc.mk
+++ b/rts/ghc.mk
@@ -295,7 +295,6 @@ rts/RtsMain_HC_OPTS += -optc-O0
 
 rts/RtsMessages_CC_OPTS += -DProjectVersion=\"$(ProjectVersion)\"
 rts/RtsUtils_CC_OPTS += -DProjectVersion=\"$(ProjectVersion)\"
-rts/Trace_CC_OPTS += -DProjectVersion=\"$(ProjectVersion)\"
 #
 rts/RtsUtils_CC_OPTS += -DHostPlatform=\"$(HOSTPLATFORM)\"
 rts/RtsUtils_CC_OPTS += -DHostArch=\"$(HostArch_CPP)\"
diff --git a/rts/sm/GC.c b/rts/sm/GC.c
index 30361401cc..51eab4e2be 100644
--- a/rts/sm/GC.c
+++ b/rts/sm/GC.c
@@ -408,16 +408,6 @@ GarbageCollect (rtsBool force_major_gc,
 
   // NO MORE EVACUATION AFTER THIS POINT!
 
-  // Two-space collector: free the old to-space.
-  // g0->old_blocks is the old nursery
-  // g0->blocks is to-space from the previous GC
-  if (RtsFlags.GcFlags.generations == 1) {
-      if (g0->blocks != NULL) {
-	  freeChain(g0->blocks);
-	  g0->blocks = NULL;
-      }
-  }
-
   // Finally: compact or sweep the oldest generation.
   if (major_gc && oldest_gen->mark) {
       if (oldest_gen->compact) 
@@ -1257,7 +1247,7 @@ prepare_collected_gen (generation *gen)
 
     // for a compacted generation, we need to allocate the bitmap
     if (gen->mark) {
-        nat bitmap_size; // in bytes
+        lnat bitmap_size; // in bytes
         bdescr *bitmap_bdescr;
         StgWord *bitmap;
 	
diff --git a/utils/fingerprint/fingerprint.py b/utils/fingerprint/fingerprint.py
new file mode 100755
index 0000000000..f04b98ecd4
--- /dev/null
+++ b/utils/fingerprint/fingerprint.py
@@ -0,0 +1,248 @@
+#! /usr/bin/env python
+# Script to create and restore a git fingerprint of the ghc repositories.
+
+from   datetime   import datetime
+from   optparse   import OptionParser
+import os
+import os.path
+import re
+import subprocess
+from   subprocess import PIPE, Popen
+import sys
+
+def main():
+  opts, args = parseopts(sys.argv[1:])
+  opts.action(opts)
+
+def create_action(opts):
+  """Action called for the create commmand"""
+  if opts.fpfile:
+    fp = FingerPrint.read(opts.source)
+  else:
+    fp = fingerprint(opts.source)
+  if len(fp) == 0:
+    error("Got empty fingerprint from source: "+str(opts.source))
+  if opts.output_file:
+    print "Writing fingerprint to: ", opts.output_file
+  fp.write(opts.output)
+
+def restore_action(opts):
+  """Action called for the restore commmand"""
+  def branch_name(filename):
+    return "fingerprint_" + os.path.basename(filename).replace(".", "_")
+  if opts.fpfile:
+    try:
+      fp = FingerPrint.read(opts.source)
+      bn = branch_name(opts.fpfile)
+    except MalformedFingerPrintError:
+      error("Error parsing fingerprint file: "+opts.fpfile)
+    if len(fp) == 0:
+      error("No fingerprint found in fingerprint file: "+opts.fpfile)
+  elif opts.logfile:
+    fp = fingerprint(opts.source)
+    bn = branch_name(opts.logfile)
+    if len(fp) == 0:
+      error("No fingerprint found in build log file: "+opts.logfile)
+  else:
+    error("Must restore from fingerprint or log file")
+  restore(fp, branch_name=bn if opts.branch else None)
+
+def fingerprint(source=None):
+  """Create a new fingerprint of current repositories.
+
+  The source argument is parsed to look for the expected output
+  from a `sync-all` command. If the source is `None` then the
+  `sync-all` command will be run to get the current fingerprint.
+  """
+  if source is None:
+    sync_all = ["./sync-all", "log", "HEAD^..", "--pretty=oneline"]
+    source  = Popen(sync_all, stdout=PIPE).stdout
+
+  lib = ""
+  commits = {}
+  for line in source.readlines():
+    if line.startswith("=="):
+      lib = line.split()[1].rstrip(":")
+      lib = "." if lib == "running" else lib # hack for top ghc repo
+    elif re.match("[abcdef0-9]{40}", line):
+      commit = line[:40]
+      commits[lib] = commit
+  return FingerPrint(commits)
+
+def restore(fp, branch_name=None):
+  """Restore the ghc repos to the commits in the fingerprint
+
+  This function performs a checkout of each commit specifed in
+  the fingerprint. If `branch_name` is not None then a new branch
+  will be created for the top ghc repository. We also add an entry
+  to the git config that sets the remote for the new branch as `origin`
+  so that the `sync-all` command can be used from the branch.
+  """
+  checkout = ["git", "checkout"]
+
+  # run checkout in all subdirs
+  for (subdir, commit) in fp:
+    if subdir != ".":
+      cmd = checkout + [commit]
+      print "==", subdir, " ".join(cmd)
+      if os.path.exists(subdir):
+        rc = subprocess.call(cmd, cwd=subdir)
+        if rc != 0:
+          error("Too many errors, aborting")
+      else:
+        sys.stderr.write("WARNING: "+
+          subdir+" is in fingerprint but missing in working directory\n")
+
+  # special handling for top ghc repo
+  # if we are creating a new branch then also add an entry to the
+  # git config so the sync-all command is happy
+  branch_args = ["-b", branch_name] if branch_name else []
+  rc = subprocess.call(checkout + branch_args + [fp["."]])
+  if (rc == 0) and branch_name:
+    branch_config = "branch."+branch_name+".remote"
+    subprocess.call(["git", "config", "--add", branch_config, "origin"])
+
+actions = {"create" : create_action, "restore" : restore_action}
+def parseopts(argv):
+  """Parse and check the validity of the command line arguments"""
+  usage = "fingerprint ("+"|".join(sorted(actions.keys()))+") [options]"
+  parser = OptionParser(usage=usage)
+
+  parser.add_option("-d", "--dir", dest="dir",
+    help="write output to directory DIR", metavar="DIR")
+
+  parser.add_option("-o", "--output", dest="output",
+    help="write output to file FILE", metavar="FILE")
+
+  parser.add_option("-l", "--from-log", dest="logfile",
+    help="reconstruct fingerprint from build log", metavar="FILE")
+
+  parser.add_option("-f", "--from-fp", dest="fpfile",
+    help="reconstruct fingerprint from fingerprint file", metavar="FILE")
+
+  parser.add_option("-n", "--no-branch",
+    action="store_false", dest="branch", default=True,
+    help="do not create a new branch when restoring fingerprint")
+
+  parser.add_option("-g", "--ghc-dir", dest="ghcdir",
+    help="perform actions in GHC dir", metavar="DIR")
+
+  opts,args = parser.parse_args(argv)
+  return (validate(opts, args, parser), args)
+
+def validate(opts, args, parser):
+  """ Validate and prepare the command line options.
+
+  It performs the following actions:
+    * Check that we have a valid action to perform
+    * Check that we have a valid output destination
+    * Opens the output file if needed
+    * Opens the input  file if needed
+  """
+  # Determine the action
+  try:
+    opts.action = actions[args[0]]
+  except (IndexError, KeyError):
+    error("Must specify a valid action", parser)
+
+  # Inputs
+  if opts.logfile and opts.fpfile:
+    error("Must specify only one of -l and -f")
+
+  opts.source = None
+  if opts.logfile:
+    opts.source = file(opts.logfile, "r")
+  elif opts.fpfile:
+    opts.source = file(opts.fpfile, "r")
+
+  # Outputs
+  if opts.dir:
+    fname = opts.output
+    if fname is None:
+      fname = datetime.today().strftime("%Y-%m%-%d_%H-%M-%S") + ".fp"
+    path = os.path.join(opts.dir, fname)
+    opts.output_file = path
+    opts.output = file(path, "w")
+  elif opts.output:
+    opts.output_file = opts.output
+    opts.output = file(opts.output_file, "w")
+  else:
+    opts.output_file = None
+    opts.output = sys.stdout
+
+  # GHC Directory
+  # As a last step change the directory to the GHC directory specified
+  if opts.ghcdir:
+    os.chdir(opts.ghcdir)
+
+  return opts
+
+def error(msg="fatal error", parser=None, exit=1):
+  """Function that prints error message and exits"""
+  print "ERROR:", msg
+  if parser:
+    parser.print_help()
+  sys.exit(exit)
+
+class MalformedFingerPrintError(Exception):
+  """Exception raised when parsing a bad fingerprint file"""
+  pass
+
+class FingerPrint:
+  """Class representing a fingerprint of all ghc git repos.
+
+  A finger print is represented by a dictionary that maps a
+  directory to a commit. The directory "." is used for the top
+  level ghc repository.
+  """
+  def __init__(self, subcommits = {}):
+    self.commits = subcommits
+
+  def __eq__(self, other):
+    if other.__class__ != self.__class__:
+      raise TypeError
+    return self.commits == other.commits
+
+  def __neq__(self, other):
+    not(self == other)
+
+  def __hash__(self):
+    return hash(str(self))
+
+  def __len__(self):
+    return len(self.commits)
+
+  def __repr__(self):
+    return "FingerPrint(" + repr(self.commits) + ")"
+
+  def __str__(self):
+    s = ""
+    for lib in sorted(self.commits.keys()):
+      commit = self.commits[lib]
+      s += "{0}|{1}\n".format(lib, commit)
+    return s
+
+  def __getitem__(self, item):
+    return self.commits[item]
+
+  def __iter__(self):
+    return self.commits.iteritems()
+
+  def write(self, outh):
+      outh.write(str(self))
+      outh.flush()
+
+  @staticmethod
+  def read(inh):
+    """Read a fingerprint from a fingerprint file"""
+    commits = {}
+    for line in inh.readlines():
+      splits = line.strip().split("|", 1)
+      if len(splits) != 2:
+        raise MalformedFingerPrintError(line)
+      lib, commit = splits
+      commits[lib] = commit
+    return FingerPrint(commits)
+
+if __name__ == "__main__":
+  main()
diff --git a/utils/genprimopcode/Lexer.x b/utils/genprimopcode/Lexer.x
index df710d72b3..6f48c02f8f 100644
--- a/utils/genprimopcode/Lexer.x
+++ b/utils/genprimopcode/Lexer.x
@@ -54,6 +54,7 @@ words :-
     <0>         "thats_all_folks"   { mkT TThatsAllFolks }
     <0>         [a-z][a-zA-Z0-9\#_]* { mkTv TLowerName }
     <0>         [A-Z][a-zA-Z0-9\#_]* { mkTv TUpperName }
+    <0>         [0-9][0-9]*         { mkTv (TInteger . read) }
     <0>         \" [^\"]* \"        { mkTv (TString . tail . init) }
     <in_braces> [^\{\}]+            { mkTv TNoBraces }
     <in_braces> \n                  { mkTv TNoBraces }
diff --git a/utils/genprimopcode/Main.hs b/utils/genprimopcode/Main.hs
index 5b802bccd7..14f08346be 100644
--- a/utils/genprimopcode/Main.hs
+++ b/utils/genprimopcode/Main.hs
@@ -46,13 +46,13 @@ main = getArgs >>= \args ->
                                        "commutable" 
                                        "commutableOp" p_o_specs)
 
-                      "--needs-wrapper" 
+                      "--code-size"
                          -> putStr (gen_switch_from_attribs 
-                                       "needs_wrapper" 
-                                       "primOpNeedsWrapper" p_o_specs)
+                                       "code_size"
+                                       "primOpCodeSize" p_o_specs)
 
-                      "--can-fail" 
-                         -> putStr (gen_switch_from_attribs 
+                      "--can-fail"
+                         -> putStr (gen_switch_from_attribs
                                        "can_fail" 
                                        "primOpCanFail" p_o_specs)
 
@@ -91,7 +91,7 @@ known_args
        "--has-side-effects",
        "--out-of-line",
        "--commutable",
-       "--needs-wrapper",
+       "--code-size",
        "--can-fail",
        "--strictness",
        "--primop-primop-info",
@@ -141,6 +141,7 @@ gen_hs_source (Info defaults entries) =
      where opt (OptionFalse n)	  = n ++ " = False"
            opt (OptionTrue n)	  = n ++ " = True"
 	   opt (OptionString n v) = n ++ " = { " ++ v ++ "}"
+           opt (OptionInteger n v) = n ++ " = " ++ show v
 
 	   hdr s@(Section {})			 = sec s
 	   hdr (PrimOpSpec { name = n })	 = wrapOp n ++ ","
@@ -409,7 +410,8 @@ gen_latex_doc (Info defaults entries)
 	       Just (OptionTrue _) -> if_true
 	       Just (OptionFalse _) -> if_false
 	       Just (OptionString _ _) -> error "String value for boolean option"
-	       Nothing -> ""
+               Just (OptionInteger _ _) -> error "Integer value for boolean option"
+               Nothing -> ""
 	   
 	   mk_strictness o = 
 	     case lookup_attrib "strictness" o of
@@ -550,6 +552,7 @@ gen_switch_from_attribs attrib_name fn_name (Info defaults entries)
 
          getAltRhs (OptionFalse _)    = "False"
          getAltRhs (OptionTrue _)     = "True"
+         getAltRhs (OptionInteger _ i) = show i
          getAltRhs (OptionString _ s) = s
 
          mkAlt po
diff --git a/utils/genprimopcode/Parser.y b/utils/genprimopcode/Parser.y
index b20414d7d2..5773abb4fe 100644
--- a/utils/genprimopcode/Parser.y
+++ b/utils/genprimopcode/Parser.y
@@ -48,6 +48,7 @@ import Syntax
     lowerName       { TLowerName $$ }
     upperName       { TUpperName $$ }
     string          { TString $$ }
+    integer         { TInteger $$ }
     noBraces        { TNoBraces $$ }
 
 %%
@@ -66,6 +67,7 @@ pOption :: { Option }
 pOption : lowerName '=' false               { OptionFalse  $1 }
         | lowerName '=' true                { OptionTrue   $1 }
         | lowerName '=' pStuffBetweenBraces { OptionString $1 $3 }
+        | lowerName '=' integer             { OptionInteger $1 $3 }
 
 pEntries :: { [Entry] }
 pEntries : pEntry pEntries { $1 : $2 }
diff --git a/utils/genprimopcode/ParserM.hs b/utils/genprimopcode/ParserM.hs
index edc300d6cc..a2b39d7a21 100644
--- a/utils/genprimopcode/ParserM.hs
+++ b/utils/genprimopcode/ParserM.hs
@@ -81,6 +81,7 @@ data Token = TEOF
            | TUpperName String
            | TString String
            | TNoBraces String
+           | TInteger Int
     deriving Show
 
 -- Actions
diff --git a/utils/genprimopcode/Syntax.hs b/utils/genprimopcode/Syntax.hs
index 809467020f..5fe4e0b23e 100644
--- a/utils/genprimopcode/Syntax.hs
+++ b/utils/genprimopcode/Syntax.hs
@@ -40,6 +40,7 @@ data Option
    = OptionFalse  String          -- name = False
    | OptionTrue   String          -- name = True
    | OptionString String String   -- name = { ... unparsed stuff ... }
+   | OptionInteger String Int     -- name = <int>
      deriving Show
 
 -- categorises primops
@@ -120,6 +121,7 @@ get_attrib_name :: Option -> String
 get_attrib_name (OptionFalse nm) = nm
 get_attrib_name (OptionTrue nm)  = nm
 get_attrib_name (OptionString nm _) = nm
+get_attrib_name (OptionInteger nm _) = nm
 
 lookup_attrib :: String -> [Option] -> Maybe Option
 lookup_attrib _ [] = Nothing
diff --git a/utils/ghc-cabal/Main.hs b/utils/ghc-cabal/Main.hs
index d64c2240a8..75d1faf9bf 100644
--- a/utils/ghc-cabal/Main.hs
+++ b/utils/ghc-cabal/Main.hs
@@ -296,7 +296,7 @@ generate config_args distdir directory
                                          pd lib lbi clbi
                   final_ipi = installedPkgInfo {
                                   Installed.installedPackageId = ipid,
-                                  Installed.haddockHTMLs = ["../" ++ display (packageId pd)]
+                                  Installed.haddockHTMLs = []
                               }
                   content = Installed.showInstalledPackageInfo final_ipi ++ "\n"
               writeFileAtomic (distdir </> "inplace-pkg-config") (toUTF8 content)
diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs
index 74f761b6d4..4e6b53193a 100644
--- a/utils/ghc-pkg/Main.hs
+++ b/utils/ghc-pkg/Main.hs
@@ -19,7 +19,8 @@ import Distribution.ParseUtils
 import Distribution.Package hiding (depends)
 import Distribution.Text
 import Distribution.Version
-import System.FilePath
+import System.FilePath as FilePath
+import qualified System.FilePath.Posix as FilePath.Posix
 import System.Cmd       ( rawSystem )
 import System.Directory ( getAppUserDataDirectory, createDirectoryIfMissing,
                           getModificationTime )
@@ -34,7 +35,8 @@ import Data.Maybe
 import Data.Char ( isSpace, toLower )
 import Control.Monad
 import System.Directory ( doesDirectoryExist, getDirectoryContents,
-                          doesFileExist, renameFile, removeFile )
+                          doesFileExist, renameFile, removeFile,
+                          getCurrentDirectory )
 import System.Exit ( exitWith, ExitCode(..) )
 import System.Environment ( getArgs, getProgName, getEnv )
 import System.IO
@@ -101,6 +103,9 @@ data Flag
   | FlagForce
   | FlagForceFiles
   | FlagAutoGHCiLibs
+  | FlagExpandEnvVars
+  | FlagExpandPkgroot
+  | FlagNoExpandPkgroot
   | FlagSimpleOutput
   | FlagNamesOnly
   | FlagIgnoreCase
@@ -126,6 +131,12 @@ flags = [
          "ignore missing directories and libraries only",
   Option ['g'] ["auto-ghci-libs"] (NoArg FlagAutoGHCiLibs)
         "automatically build libs for GHCi (with register)",
+  Option [] ["expand-env-vars"] (NoArg FlagExpandEnvVars)
+        "expand environment variables (${name}-style) in input package descriptions",
+  Option [] ["expand-pkgroot"] (NoArg FlagExpandPkgroot)
+        "expand ${pkgroot}-relative paths to absolute in output package descriptions",
+  Option [] ["no-expand-pkgroot"] (NoArg FlagNoExpandPkgroot)
+        "preserve ${pkgroot}-relative paths in output package descriptions",
   Option ['?'] ["help"] (NoArg FlagHelp)
         "display this help and exit",
   Option ['V'] ["version"] (NoArg FlagVersion)
@@ -274,6 +285,12 @@ runit verbosity cli nonopts = do
           | FlagForceFiles `elem` cli   = ForceFiles
           | otherwise                   = NoForce
         auto_ghci_libs = FlagAutoGHCiLibs `elem` cli
+        expand_env_vars= FlagExpandEnvVars `elem` cli
+        mexpand_pkgroot= foldl' accumExpandPkgroot Nothing cli
+          where accumExpandPkgroot _ FlagExpandPkgroot   = Just True
+                accumExpandPkgroot _ FlagNoExpandPkgroot = Just False
+                accumExpandPkgroot x _                   = x
+                
         splitFields fields = unfoldr splitComma (',':fields)
           where splitComma "" = Nothing
                 splitComma fs = Just $ break (==',') (tail fs)
@@ -313,9 +330,11 @@ runit verbosity cli nonopts = do
     ["init", filename] ->
         initPackageDB filename verbosity cli
     ["register", filename] ->
-        registerPackage filename verbosity cli auto_ghci_libs False force
+        registerPackage filename verbosity cli
+                        auto_ghci_libs expand_env_vars False force
     ["update", filename] ->
-        registerPackage filename verbosity cli auto_ghci_libs True force
+        registerPackage filename verbosity cli
+                        auto_ghci_libs expand_env_vars True force
     ["unregister", pkgid_str] -> do
         pkgid <- readGlobPkgId pkgid_str
         unregisterPackage pkgid verbosity cli force
@@ -340,23 +359,24 @@ runit verbosity cli nonopts = do
     ["latest", pkgid_str] -> do
         pkgid <- readGlobPkgId pkgid_str
         latestPackage verbosity cli pkgid
-    ["describe", pkgid_str] ->
-        case substringCheck pkgid_str of
-          Nothing -> do pkgid <- readGlobPkgId pkgid_str
-                        describePackage verbosity cli (Id pkgid)
-          Just m -> describePackage verbosity cli (Substring pkgid_str m)
-    ["field", pkgid_str, fields] ->
-        case substringCheck pkgid_str of
-          Nothing -> do pkgid <- readGlobPkgId pkgid_str
-                        describeField verbosity cli (Id pkgid) 
-                                      (splitFields fields)
-          Just m -> describeField verbosity cli (Substring pkgid_str m)
-                                      (splitFields fields)
+    ["describe", pkgid_str] -> do
+        pkgarg <- case substringCheck pkgid_str of
+          Nothing -> liftM Id (readGlobPkgId pkgid_str)
+          Just m  -> return (Substring pkgid_str m)
+        describePackage verbosity cli pkgarg (fromMaybe False mexpand_pkgroot)
+        
+    ["field", pkgid_str, fields] -> do
+        pkgarg <- case substringCheck pkgid_str of
+          Nothing -> liftM Id (readGlobPkgId pkgid_str)
+          Just m  -> return (Substring pkgid_str m)
+        describeField verbosity cli pkgarg
+                      (splitFields fields) (fromMaybe True mexpand_pkgroot)
+
     ["check"] -> do
         checkConsistency verbosity cli
 
     ["dump"] -> do
-        dumpPackages verbosity cli
+        dumpPackages verbosity cli (fromMaybe False mexpand_pkgroot)
 
     ["recache"] -> do
         recache verbosity cli
@@ -402,8 +422,16 @@ globVersion = Version{ versionBranch=[], versionTags=["*"] }
 --      list, describe, field
 
 data PackageDB 
-  = PackageDB { location :: FilePath,
-                packages :: [InstalledPackageInfo] }
+  = PackageDB {
+      location, locationAbsolute :: !FilePath,
+      -- We need both possibly-relative and definately-absolute package
+      -- db locations. This is because the relative location is used as
+      -- an identifier for the db, so it is important we do not modify it.
+      -- On the other hand we need the absolute path in a few places
+      -- particularly in relation to the ${pkgroot} stuff.
+      
+      packages :: [InstalledPackageInfo]
+    }
 
 type PackageDBStack = [PackageDB]
         -- A stack of package databases.  Convention: head is the topmost
@@ -415,6 +443,7 @@ allPackagesInStack = concatMap packages
 getPkgDatabases :: Verbosity
                 -> Bool    -- we are modifying, not reading
                 -> Bool    -- read caches, if available
+                -> Bool    -- expand vars, like ${pkgroot} and $topdir
                 -> [Flag]
                 -> IO (PackageDBStack, 
                           -- the real package DB stack: [global,user] ++ 
@@ -427,7 +456,7 @@ getPkgDatabases :: Verbosity
                           -- is used as the list of package DBs for
                           -- commands that just read the DB, such as 'list'.
 
-getPkgDatabases verbosity modify use_cache my_flags = do
+getPkgDatabases verbosity modify use_cache expand_vars my_flags = do
   -- first we determine the location of the global package config.  On Windows,
   -- this is found relative to the ghc-pkg.exe binary, whereas on Unix the
   -- location is passed to the binary using the --global-config flag by the
@@ -445,6 +474,12 @@ getPkgDatabases verbosity modify use_cache my_flags = do
                        Just path -> return path
         fs -> return (last fs)
 
+  -- The value of the $topdir variable used in some package descriptions
+  -- Note that the way we calculate this is slightly different to how it
+  -- is done in ghc itself. We rely on the convention that the global
+  -- package db lives in ghc's libdir.
+  top_dir <- absolutePath (takeDirectory global_conf)
+
   let no_user_db = FlagNoUserDb `elem` my_flags
 
   -- get the location of the user package database, and create it if necessary
@@ -513,7 +548,11 @@ getPkgDatabases verbosity modify use_cache my_flags = do
         | null db_flags = Just virt_global_conf
         | otherwise     = Just (last db_flags)
 
-  db_stack <- mapM (readParseDatabase verbosity mb_user_conf use_cache) final_stack
+  db_stack  <- sequence
+    [ do db <- readParseDatabase verbosity mb_user_conf use_cache db_path
+         if expand_vars then return (mungePackageDBPaths top_dir db)
+                        else return db
+    | db_path <- final_stack ]
 
   let flag_db_stack = [ db | db_name <- flag_db_names,
                         db <- db_stack, location db == db_name ]
@@ -539,13 +578,13 @@ readParseDatabase :: Verbosity
 readParseDatabase verbosity mb_user_conf use_cache path
   -- the user database (only) is allowed to be non-existent
   | Just (user_conf,False) <- mb_user_conf, path == user_conf
-  = return PackageDB { location = path, packages = [] }
+  = mkPackageDB []
   | otherwise
   = do e <- tryIO $ getDirectoryContents path
        case e of
          Left _   -> do
               pkgs <- parseMultiPackageConf verbosity path
-              return PackageDB{ location = path, packages = pkgs }              
+              mkPackageDB pkgs
          Right fs
            | not use_cache -> ignore_cache
            | otherwise -> do
@@ -563,7 +602,7 @@ readParseDatabase verbosity mb_user_conf use_cache path
                         putStrLn ("using cache: " ++ cache)
                      pkgs <- myReadBinPackageDB cache
                      let pkgs' = map convertPackageInfoIn pkgs
-                     return PackageDB { location = path, packages = pkgs' }
+                     mkPackageDB pkgs'
                   | otherwise -> do
                      when (verbosity >= Normal) $ do
                         warn ("WARNING: cache is out of date: " ++ cache)
@@ -574,7 +613,15 @@ readParseDatabase verbosity mb_user_conf use_cache path
                      let confs = filter (".conf" `isSuffixOf`) fs
                      pkgs <- mapM (parseSingletonPackageConf verbosity) $
                                    map (path </>) confs
-                     return PackageDB { location = path, packages = pkgs }
+                     mkPackageDB pkgs
+  where
+    mkPackageDB pkgs = do
+      path_abs <- absolutePath path
+      return PackageDB {
+        location = path,
+        locationAbsolute = path_abs,
+        packages = pkgs
+      }
 
 -- read the package.cache file strictly, to work around a problem with
 -- bytestring 0.9.0.x (fixed in 0.9.1.x) where the file wasn't closed
@@ -600,11 +647,69 @@ parseMultiPackageConf verbosity file = do
 parseSingletonPackageConf :: Verbosity -> FilePath -> IO InstalledPackageInfo
 parseSingletonPackageConf verbosity file = do
   when (verbosity > Normal) $ putStrLn ("reading package config: " ++ file)
-  readUTF8File file >>= parsePackageInfo
+  readUTF8File file >>= fmap fst . parsePackageInfo
 
 cachefilename :: FilePath
 cachefilename = "package.cache"
 
+mungePackageDBPaths :: FilePath -> PackageDB -> PackageDB
+mungePackageDBPaths top_dir db@PackageDB { packages = pkgs } =
+    db { packages = map (mungePackagePaths top_dir pkgroot) pkgs }
+  where
+    pkgroot = takeDirectory (locationAbsolute db)    
+    -- It so happens that for both styles of package db ("package.conf"
+    -- files and "package.conf.d" dirs) the pkgroot is the parent directory
+    -- ${pkgroot}/package.conf  or  ${pkgroot}/package.conf.d/
+
+mungePackagePaths :: FilePath -> FilePath
+                  -> InstalledPackageInfo -> InstalledPackageInfo
+-- Perform path/URL variable substitution as per the Cabal ${pkgroot} spec
+-- (http://www.haskell.org/pipermail/libraries/2009-May/011772.html)
+-- Paths/URLs can be relative to ${pkgroot} or ${pkgrooturl}.
+-- The "pkgroot" is the directory containing the package database.
+--
+-- Also perform a similar substitution for the older GHC-specific
+-- "$topdir" variable. The "topdir" is the location of the ghc
+-- installation (obtained from the -B option).
+mungePackagePaths top_dir pkgroot pkg =
+    pkg {
+      importDirs  = munge_paths (importDirs pkg),
+      includeDirs = munge_paths (includeDirs pkg),
+      libraryDirs = munge_paths (libraryDirs pkg),
+      frameworkDirs = munge_paths (frameworkDirs pkg),
+      haddockInterfaces = munge_paths (haddockInterfaces pkg),
+      haddockHTMLs = munge_urls (haddockHTMLs pkg)
+    }
+  where
+    munge_paths = map munge_path
+    munge_urls  = map munge_url
+
+    munge_path p
+      | Just p' <- stripVarPrefix "${pkgroot}" sp = pkgroot </> p'
+      | Just p' <- stripVarPrefix "$topdir"    sp = top_dir </> p'
+      | otherwise                                 = p
+      where
+        sp = splitPath p
+
+    munge_url p
+      | Just p' <- stripVarPrefix "${pkgrooturl}" sp = toUrlPath pkgroot p'
+      | Just p' <- stripVarPrefix "$httptopdir"   sp = toUrlPath top_dir p'
+      | otherwise                                    = p
+      where
+        sp = splitPath p
+
+    toUrlPath r p = "file:///"
+                 -- URLs always use posix style '/' separators:
+                 ++ FilePath.Posix.joinPath (r : FilePath.splitDirectories p)
+
+    stripVarPrefix var (root:path')
+      | Just [sep] <- stripPrefix var root
+      , isPathSeparator sep
+      = Just (joinPath path')
+
+    stripVarPrefix _ _ = Nothing
+
+
 -- -----------------------------------------------------------------------------
 -- Creating a new package DB
 
@@ -615,7 +720,11 @@ initPackageDB filename verbosity _flags = do
   when b1 eexist
   b2 <- doesDirectoryExist filename
   when b2 eexist
-  changeDB verbosity [] PackageDB{ location = filename, packages = [] }
+  filename_abs <- absolutePath filename
+  changeDB verbosity [] PackageDB {
+                          location = filename, locationAbsolute = filename_abs,
+                          packages = []
+                        }
 
 -- -----------------------------------------------------------------------------
 -- Registering
@@ -624,17 +733,21 @@ registerPackage :: FilePath
                 -> Verbosity
                 -> [Flag]
                 -> Bool              -- auto_ghci_libs
+                -> Bool              -- expand_env_vars
                 -> Bool              -- update
                 -> Force
                 -> IO ()
-registerPackage input verbosity my_flags auto_ghci_libs update force = do
+registerPackage input verbosity my_flags auto_ghci_libs expand_env_vars update force = do
   (db_stack, Just to_modify, _flag_dbs) <- 
-      getPkgDatabases verbosity True True my_flags
+      getPkgDatabases verbosity True True False{-expand vars-} my_flags
 
   let
         db_to_operate_on = my_head "register" $
                            filter ((== to_modify).location) db_stack
   --
+  when (auto_ghci_libs && verbosity >= Silent) $
+    warn "Warning: --auto-ghci-libs is deprecated and will be removed in GHC 7.4"
+  --
   s <-
     case input of
       "-" -> do
@@ -648,16 +761,26 @@ registerPackage input verbosity my_flags auto_ghci_libs update force = do
             putStr ("Reading package info from " ++ show f ++ " ... ")
         readUTF8File f
 
-  expanded <- expandEnvVars s force
+  expanded <- if expand_env_vars then expandEnvVars s force
+                                 else return s
 
-  pkg <- parsePackageInfo expanded
+  (pkg, ws) <- parsePackageInfo expanded
   when (verbosity >= Normal) $
       putStrLn "done."
 
+  -- report any warnings from the parse phase
+  _ <- reportValidateErrors [] ws
+         (display (sourcePackageId pkg) ++ ": Warning: ") Nothing
+
+  -- validate the expanded pkg, but register the unexpanded
+  pkgroot <- absolutePath (takeDirectory to_modify)
+  let top_dir = takeDirectory (location (last db_stack))
+      pkg_expanded = mungePackagePaths top_dir pkgroot pkg
+
   let truncated_stack = dropWhile ((/= to_modify).location) db_stack
   -- truncate the stack for validation, because we don't allow
   -- packages lower in the stack to refer to those higher up.
-  validatePackageConfig pkg truncated_stack auto_ghci_libs update force
+  validatePackageConfig pkg_expanded truncated_stack auto_ghci_libs update force
   let 
      removes = [ RemovePackage p
                | p <- packages db_to_operate_on,
@@ -667,10 +790,13 @@ registerPackage input verbosity my_flags auto_ghci_libs update force = do
 
 parsePackageInfo
         :: String
-        -> IO InstalledPackageInfo
+        -> IO (InstalledPackageInfo, [ValidateWarning])
 parsePackageInfo str =
   case parseInstalledPackageInfo str of
-    ParseOk _warns ok -> return ok
+    ParseOk warnings ok -> return (ok, ws)
+      where
+        ws = [ msg | PWarning msg <- warnings
+                   , not ("Unrecognized field pkgroot" `isPrefixOf` msg) ]
     ParseFailed err -> case locatedErrorMsg err of
                            (Nothing, s) -> die s
                            (Just l, s) -> die (show l ++ ": " ++ s)
@@ -750,7 +876,7 @@ modifyPackage
   -> IO ()
 modifyPackage fn pkgid verbosity my_flags force = do
   (db_stack, Just _to_modify, _flag_dbs) <- 
-      getPkgDatabases verbosity True{-modify-} True{-use cache-} my_flags
+      getPkgDatabases verbosity True{-modify-} True{-use cache-} False{-expand vars-} my_flags
 
   (db, ps) <- fmap head $ findPackagesByDB db_stack (Id pkgid)
   let 
@@ -778,7 +904,7 @@ modifyPackage fn pkgid verbosity my_flags force = do
 recache :: Verbosity -> [Flag] -> IO ()
 recache verbosity my_flags = do
   (db_stack, Just to_modify, _flag_dbs) <- 
-     getPkgDatabases verbosity True{-modify-} False{-no cache-} my_flags
+     getPkgDatabases verbosity True{-modify-} False{-no cache-} False{-expand vars-} my_flags
   let
         db_to_operate_on = my_head "recache" $
                            filter ((== to_modify).location) db_stack
@@ -794,7 +920,7 @@ listPackages ::  Verbosity -> [Flag] -> Maybe PackageArg
 listPackages verbosity my_flags mPackageName mModuleName = do
   let simple_output = FlagSimpleOutput `elem` my_flags
   (db_stack, _, flag_db_stack) <- 
-     getPkgDatabases verbosity False True{-use cache-} my_flags
+     getPkgDatabases verbosity False True{-use cache-} False{-expand vars-} my_flags
 
   let db_stack_filtered -- if a package is given, filter out all other packages
         | Just this <- mPackageName =
@@ -887,7 +1013,7 @@ simplePackageList my_flags pkgs = do
 showPackageDot :: Verbosity -> [Flag] -> IO ()
 showPackageDot verbosity myflags = do
   (_, _, flag_db_stack) <- 
-      getPkgDatabases verbosity False True{-use cache-} myflags
+      getPkgDatabases verbosity False True{-use cache-} False{-expand vars-} myflags
 
   let all_pkgs = allPackagesInStack flag_db_stack
       ipix  = PackageIndex.fromList all_pkgs
@@ -909,7 +1035,7 @@ showPackageDot verbosity myflags = do
 latestPackage ::  Verbosity -> [Flag] -> PackageIdentifier -> IO ()
 latestPackage verbosity my_flags pkgid = do
   (_, _, flag_db_stack) <- 
-     getPkgDatabases verbosity False True{-use cache-} my_flags
+     getPkgDatabases verbosity False True{-use cache-} False{-expand vars-} my_flags
 
   ps <- findPackages flag_db_stack (Id pkgid)
   show_pkg (sortBy compPkgIdVer (map sourcePackageId ps))
@@ -920,24 +1046,33 @@ latestPackage verbosity my_flags pkgid = do
 -- -----------------------------------------------------------------------------
 -- Describe
 
-describePackage :: Verbosity -> [Flag] -> PackageArg -> IO ()
-describePackage verbosity my_flags pkgarg = do
+describePackage :: Verbosity -> [Flag] -> PackageArg -> Bool -> IO ()
+describePackage verbosity my_flags pkgarg expand_pkgroot = do
   (_, _, flag_db_stack) <- 
-      getPkgDatabases verbosity False True{-use cache-} my_flags
-  ps <- findPackages flag_db_stack pkgarg
-  doDump ps
+      getPkgDatabases verbosity False True{-use cache-} expand_pkgroot my_flags
+  dbs <- findPackagesByDB flag_db_stack pkgarg
+  doDump expand_pkgroot [ (pkg, locationAbsolute db)
+                        | (db, pkgs) <- dbs, pkg <- pkgs ]
 
-dumpPackages :: Verbosity -> [Flag] -> IO ()
-dumpPackages verbosity my_flags = do
+dumpPackages :: Verbosity -> [Flag] -> Bool -> IO ()
+dumpPackages verbosity my_flags expand_pkgroot = do
   (_, _, flag_db_stack) <- 
-     getPkgDatabases verbosity False True{-use cache-} my_flags
-  doDump (allPackagesInStack flag_db_stack)
+     getPkgDatabases verbosity False True{-use cache-} expand_pkgroot my_flags
+  doDump expand_pkgroot [ (pkg, locationAbsolute db)
+                        | db <- flag_db_stack, pkg <- packages db ]
 
-doDump :: [InstalledPackageInfo] -> IO ()
-doDump pkgs = do
+doDump :: Bool -> [(InstalledPackageInfo, FilePath)] -> IO ()
+doDump expand_pkgroot pkgs = do
   -- fix the encoding to UTF-8, since this is an interchange format
   hSetEncoding stdout utf8
-  mapM_ putStrLn . intersperse "---" . map showInstalledPackageInfo $ pkgs
+  putStrLn $
+    intercalate "---\n"
+    [ if expand_pkgroot
+        then showInstalledPackageInfo pkg
+        else showInstalledPackageInfo pkg ++ pkgrootField
+    | (pkg, pkgloc) <- pkgs
+    , let pkgroot      = takeDirectory pkgloc
+          pkgrootField = "pkgroot: " ++ pkgroot ++ "\n" ]
 
 -- PackageId is can have globVersion for the version
 findPackages :: PackageDBStack -> PackageArg -> IO [InstalledPackageInfo]
@@ -976,14 +1111,13 @@ compPkgIdVer p1 p2 = pkgVersion p1 `compare` pkgVersion p2
 -- -----------------------------------------------------------------------------
 -- Field
 
-describeField :: Verbosity -> [Flag] -> PackageArg -> [String] -> IO ()
-describeField verbosity my_flags pkgarg fields = do
+describeField :: Verbosity -> [Flag] -> PackageArg -> [String] -> Bool -> IO ()
+describeField verbosity my_flags pkgarg fields expand_pkgroot = do
   (_, _, flag_db_stack) <- 
-      getPkgDatabases verbosity False True{-use cache-} my_flags
+      getPkgDatabases verbosity False True{-use cache-} expand_pkgroot my_flags
   fns <- toFields fields
   ps <- findPackages flag_db_stack pkgarg
-  let top_dir = takeDirectory (location (last flag_db_stack))
-  mapM_ (selectFields fns) (mungePackagePaths top_dir ps)
+  mapM_ (selectFields fns) ps
   where toFields [] = return []
         toFields (f:fs) = case toField f of
             Nothing -> die ("unknown field: " ++ f)
@@ -991,35 +1125,6 @@ describeField verbosity my_flags pkgarg fields = do
                           return (fn:fns)
         selectFields fns info = mapM_ (\fn->putStrLn (fn info)) fns
 
-mungePackagePaths :: String -> [InstalledPackageInfo] -> [InstalledPackageInfo]
--- Replace the strings "$topdir" and "$httptopdir" at the beginning of a path
--- with the current topdir (obtained from the -B option).
-mungePackagePaths top_dir ps = map munge_pkg ps
-  where
-  munge_pkg p = p{ importDirs        = munge_paths (importDirs p),
-                   includeDirs       = munge_paths (includeDirs p),
-                   libraryDirs       = munge_paths (libraryDirs p),
-                   frameworkDirs     = munge_paths (frameworkDirs p),
-                   haddockInterfaces = munge_paths (haddockInterfaces p),
-                   haddockHTMLs      = munge_paths (haddockHTMLs p)
-                 }
-
-  munge_paths = map munge_path
-
-  munge_path p
-   | Just p' <- maybePrefixMatch "$topdir"     p =            top_dir ++ p'
-   | Just p' <- maybePrefixMatch "$httptopdir" p = toHttpPath top_dir ++ p'
-   | otherwise                               = p
-
-  toHttpPath p = "file:///" ++ p
-
-maybePrefixMatch :: String -> String -> Maybe String
-maybePrefixMatch []    rest = Just rest
-maybePrefixMatch (_:_) []   = Nothing
-maybePrefixMatch (p:pat) (r:rest)
-  | p == r    = maybePrefixMatch pat rest
-  | otherwise = Nothing
-
 toField :: String -> Maybe (InstalledPackageInfo -> String)
 -- backwards compatibility:
 toField "import_dirs"     = Just $ strList . importDirs
@@ -1045,7 +1150,8 @@ strList = show
 
 checkConsistency :: Verbosity -> [Flag] -> IO ()
 checkConsistency verbosity my_flags = do
-  (db_stack, _, _) <- getPkgDatabases verbosity True True{-use cache-} my_flags
+  (db_stack, _, _) <- 
+         getPkgDatabases verbosity True True{-use cache-} True{-expand vars-} my_flags
          -- check behaves like modify for the purposes of deciding which
          -- databases to use, because ordering is important.
 
@@ -1218,6 +1324,9 @@ checkPackageConfig pkg db_stack auto_ghci_libs update = do
   mapM_ (checkDir False "import-dirs")  (importDirs pkg)
   mapM_ (checkDir True  "library-dirs") (libraryDirs pkg)
   mapM_ (checkDir True  "include-dirs") (includeDirs pkg)
+  mapM_ (checkDir True  "framework-dirs") (frameworkDirs pkg)
+  mapM_ (checkFile   True "haddock-interfaces") (haddockInterfaces pkg)
+  mapM_ (checkDirURL True "haddock-html")       (haddockHTMLs pkg)
   checkModules pkg
   mapM_ (checkHSLib (libraryDirs pkg) auto_ghci_libs) (hsLibraries pkg)
   -- ToDo: check these somehow?
@@ -1269,19 +1378,34 @@ checkDuplicates db_stack pkg update = do
         "Package " ++ display pkgid ++
         " overlaps with: " ++ unwords (map display dups)
 
+checkDir, checkFile, checkDirURL :: Bool -> String -> FilePath -> Validate ()
+checkDir  = checkPath False True
+checkFile = checkPath False False
+checkDirURL = checkPath True True
+
+checkPath :: Bool -> Bool -> Bool -> String -> FilePath -> Validate ()
+checkPath url_ok is_dir warn_only thisfield d
+ | url_ok && ("http://"  `isPrefixOf` d
+           || "https://" `isPrefixOf` d) = return ()
+
+ | url_ok
+ , Just d' <- stripPrefix "file://" d
+ = checkPath False is_dir warn_only thisfield d'
+
+   -- Note: we don't check for $topdir/${pkgroot} here. We rely on these
+   -- variables having been expanded already, see mungePackagePaths.
 
-checkDir :: Bool -> String -> String -> Validate ()
-checkDir warn_only thisfield d
- | "$topdir"     `isPrefixOf` d = return ()
- | "$httptopdir" `isPrefixOf` d = return ()
-        -- can't check these, because we don't know what $(http)topdir is
  | isRelative d = verror ForceFiles $
-                     thisfield ++ ": " ++ d ++ " is a relative path"
+                     thisfield ++ ": " ++ d ++ " is a relative path which "
+                  ++ "makes no sense (as there is nothing for it to be "
+                  ++ "relative to). You can make paths relative to the "
+                  ++ "package database itself by using ${pkgroot}."
         -- relative paths don't make any sense; #4134
  | otherwise = do
-   there <- liftIO $ doesDirectoryExist d
+   there <- liftIO $ if is_dir then doesDirectoryExist d else doesFileExist d
    when (not there) $
-       let msg = thisfield ++ ": " ++ d ++ " doesn't exist or isn't a directory"
+       let msg = thisfield ++ ": " ++ d ++ " doesn't exist or isn't a "
+                                        ++ if is_dir then "directory" else "file"
        in
        if warn_only 
           then vwarn msg
@@ -1320,10 +1444,7 @@ doesFileExistOnPath file path = go path
                        if b then return (Just p) else go ps
 
 doesFileExistIn :: String -> String -> IO Bool
-doesFileExistIn lib d
- | "$topdir"     `isPrefixOf` d = return True
- | "$httptopdir" `isPrefixOf` d = return True
- | otherwise                = doesFileExist (d </> lib)
+doesFileExistIn lib d = doesFileExist (d </> lib)
 
 checkModules :: InstalledPackageInfo -> Validate ()
 checkModules pkg = do
@@ -1416,6 +1537,8 @@ expandEnvVars str0 force = go str0 ""
         = go str (c:acc)
 
    lookupEnvVar :: String -> IO String
+   lookupEnvVar "pkgroot"    = return "${pkgroot}"    -- these two are special,
+   lookupEnvVar "pkgrooturl" = return "${pkgrooturl}" -- we don't expand them
    lookupEnvVar nm =
         catchIO (System.Environment.getEnv nm)
            (\ _ -> do dieOrForceAll force ("Unable to expand variable " ++
@@ -1629,3 +1752,6 @@ removeFileSafe :: FilePath -> IO ()
 removeFileSafe fn =
   removeFile fn `catchIO` \ e ->
     when (not $ isDoesNotExistError e) $ ioError e
+
+absolutePath :: FilePath -> IO FilePath
+absolutePath path = return . normalise . (</> path) =<< getCurrentDirectory
diff --git a/validate b/validate
index b1ae14ffec..3ca888fba1 100755
--- a/validate
+++ b/validate
@@ -86,6 +86,21 @@ $make -j$threads ValidateHpc=$hpc ValidateSlow=$slow
 $make binary-dist-prep
 $make test_bindist TEST_PREP=YES
 
+#
+# Install the mtl package into the bindist, because it is used by some
+# tests.  It isn't essential that we do this (the failing tests will
+# be treated as expected failures), but we get a bit more test
+# coverage, and also verify that we can install a package into the
+# bindist with Cabal.
+#
+bindistdir="bindisttest/install dir"
+cd libraries/mtl
+"$thisdir/$bindistdir/bin/runhaskell" Setup.hs configure --with-ghc="$thisdir/$bindistdir/bin/ghc" --global --builddir=dist-bindist --prefix="$thisdir/$bindistdir"
+"$thisdir/$bindistdir/bin/runhaskell" Setup.hs build  --builddir=dist-bindist
+"$thisdir/$bindistdir/bin/runhaskell" Setup.hs install  --builddir=dist-bindist
+"$thisdir/$bindistdir/bin/runhaskell" Setup.hs clean  --builddir=dist-bindist
+cd $thisdir
+
 fi # testsuite-only
 
 if [ "$hpc" = YES ]