Merge branch 'master' of http://darcs.haskell.org/ghc

README.md

@@ -62,9 +62,14 @@ dblatex.
 
     $ perl boot
     $ ./configure
-    $ make
+    $ make         # can also say 'make -jX' for X number of jobs
     $ make install
 
+(NB: **Do you have multiple cores? Be sure to tell that to `make`!** This can
+save you hours of build time depending on your system configuration, and is
+almost always a win regardless of how many cores you have. As a simple rule,
+you should have about N+1 jobs, where `N` is the amount of cores you have.)
+
 The `perl boot` step is only necessary if this is a tree checked out
 from git.  For source distributions downloaded from [GHC's web site] [1],
 this step has already been performed.

aclocal.m4

@@ -201,7 +201,7 @@ AC_DEFUN([FPTOOLS_SET_HASKELL_PLATFORM_VARS],
 
     checkVendor() {
         case [$]1 in
-        dec|unknown|hp|apple|next|sun|sgi|ibm|montavista)
+        dec|unknown|hp|apple|next|sun|sgi|ibm|montavista|portbld)
             ;;
         *)
             echo "Unknown vendor [$]1"
@@ -863,7 +863,7 @@ AC_SUBST(HappyVersion)
 
 dnl
 dnl Check for Alex and version.  If we're building GHC, then we need
-dnl at least Alex version 2.0.1.
+dnl at least Alex version 2.1.1.
 dnl
 AC_DEFUN([FPTOOLS_ALEX],
 [
@@ -879,12 +879,17 @@ else
 fi;
 changequote([, ])dnl
 ])
+FP_COMPARE_VERSIONS([$fptools_cv_alex_version],[-ge],[3.0],
+  [Alex3=YES],[Alex3=NO])
 if test ! -f compiler/cmm/CmmLex.hs || test ! -f compiler/parser/Lexer.hs
 then
     FP_COMPARE_VERSIONS([$fptools_cv_alex_version],[-lt],[2.1.0],
       [AC_MSG_ERROR([Alex version 2.1.0 or later is required to compile GHC.])])[]
-    FP_COMPARE_VERSIONS([$fptools_cv_alex_version],[-ge],[3.0],
-      [Alex3=YES],[Alex3=NO])
+fi
+if test ! -f utils/haddock/src/Haddock/Lex.hs
+then
+    FP_COMPARE_VERSIONS([$fptools_cv_alex_version],[-lt],[3.0],
+      [AC_MSG_ERROR([Alex version 3.0 or later is required to compile Haddock.])])[]
 fi
 AlexVersion=$fptools_cv_alex_version;
 AC_SUBST(AlexVersion)
@@ -998,6 +1003,38 @@ AC_SUBST([LdHasNoCompactUnwind])
 ])# FP_PROG_LD_NO_COMPACT_UNWIND
 
 
+# FP_PROG_LD_FILELIST
+# -------------------
+
+# Sets the output variable LdHasFilelist to YES if ld supports
+# -filelist, or NO otherwise.
+AC_DEFUN([FP_PROG_LD_FILELIST],
+[
+AC_CACHE_CHECK([whether ld understands -filelist], [fp_cv_ld_has_filelist],
+[
+    echo 'int foo() { return 0; }' > conftest1.c
+    echo 'int bar() { return 0; }' > conftest2.c
+    ${CC-cc} -c conftest1.c
+    ${CC-cc} -c conftest2.c
+    echo conftest1.o  > conftest.o-files
+    echo conftest2.o >> conftest.o-files
+    if ${LdCmd} -r -filelist conftest.o-files -o conftest.o > /dev/null 2>&1
+    then
+        fp_cv_ld_has_filelist=yes
+    else
+        fp_cv_ld_has_filelist=no
+    fi
+    rm -rf conftest*
+])
+if test "$fp_cv_ld_has_filelist" = yes; then
+    LdHasFilelist=YES
+else
+    LdHasFilelist=NO
+fi
+AC_SUBST([LdHasFilelist])
+])# FP_PROG_LD_FILELIST
+
+
 # FP_PROG_AR
 # ----------
 # Sets fp_prog_ar to a (non-Cygwin) path to ar. Exits if no ar can be found

boot

@@ -58,7 +58,7 @@ sub sanity_check_tree {
         if (/^#/) {
             # Comment; do nothing
         }
-        elsif (/^([a-zA-Z0-9\/.-]+) +([^ ]+) +[^ ]+ +[^ ]+$/) {
+        elsif (/^([a-zA-Z0-9\/.-]+) +([^ ]+) +[^ ]+$/) {
             $dir = $1;
             $tag = $2;
 

compiler/HsVersions.h

@@ -24,7 +24,6 @@ you will screw up the layout where they are used in case expressions!
 
 /* Global variables may not work in other Haskell implementations,
  * but we need them currently! so the conditional on GLASGOW won't do. */
-#ifndef __HADDOCK__
 #if defined(__GLASGOW_HASKELL__) || !defined(__GLASGOW_HASKELL__)
 #define GLOBAL_VAR(name,value,ty)  \
 {-# NOINLINE name #-};             \
@@ -36,15 +35,6 @@ name = Util.global (value);
 name :: IORef (ty);                 \
 name = Util.globalM (value);
 #endif
-#else /* __HADDOCK__ */
-#define GLOBAL_VAR(name,value,ty)  \
-name :: IORef (ty);                \
-name = Util.global (value);
-
-#define GLOBAL_VAR_M(name,value,ty) \
-name :: IORef (ty);                 \
-name = Util.globalM (value);
-#endif
 
 #define ASSERT(e)      if debugIsOn && not (e) then (assertPanic __FILE__ __LINE__) else
 #define ASSERT2(e,msg) if debugIsOn && not (e) then (assertPprPanic __FILE__ __LINE__ (msg)) else

compiler/basicTypes/Demand.lhs

@@ -161,10 +161,6 @@ seqStrDmdList :: [StrDmd] -> ()
 seqStrDmdList [] = ()
 seqStrDmdList (d:ds) = seqStrDmd d `seq` seqStrDmdList ds
 
-isStrict :: StrDmd -> Bool
-isStrict Lazy = False
-isStrict _    = True
-
 -- Splitting polymorphic demands
 splitStrProdDmd :: Int -> StrDmd -> [StrDmd]
 splitStrProdDmd n Lazy         = replicate n Lazy
@@ -376,7 +372,11 @@ seqDemandList [] = ()
 seqDemandList (d:ds) = seqDemand d `seq` seqDemandList ds
 
 isStrictDmd :: Demand -> Bool
-isStrictDmd (JD {strd = x}) = isStrict x
+-- See Note [Strict demands]
+isStrictDmd (JD {absd = Abs})  = False
+isStrictDmd (JD {strd = Lazy}) = False
+isStrictDmd _                  = True
+
 
 isUsedDmd :: Demand -> Bool
 isUsedDmd (JD {absd = x}) = isUsed x
@@ -400,6 +400,25 @@ defer (JD {absd = a}) = mkJointDmd strTop a
 -- use (JD {strd = d}) = mkJointDmd d top
 \end{code}
 
+Note [Strict demands]
+~~~~~~~~~~~~~~~~~~~~~
+isStrictDmd returns true only of demands that are 
+   both strict
+   and  used
+In particular, it is False for <HyperStr, Abs>, which can and does
+arise in, say (Trac #7319)
+   f x = raise# <some exception>
+Then 'x' is not used, so f gets strictness <HyperStr,Abs> -> .
+Now the w/w generates
+   fx = let x <HyperStr,Abs> = absentError "unused"
+        in raise <some exception>
+At this point we really don't want to convert to
+   fx = case absentError "unused" of x -> raise <some exception>
+Since the program is going to diverge, this swaps one error for another,
+but it's really a bad idea to *ever* evaluate an absent argument.
+In Trac #7319 we get
+   T7319.exe: Oops!  Entered absent arg w_s1Hd{v} [lid] [base:GHC.Base.String{tc 36u}]
+
 Note [Dealing with call demands]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Call demands are constructed and deconstructed coherently for

compiler/cmm/Bitmap.hs

@@ -1,23 +1,16 @@
 --
 -- (c) The University of Glasgow 2003-2006
--- 
+--
 
 -- Functions for constructing bitmaps, which are used in various
 -- places in generated code (stack frame liveness masks, function
 -- argument liveness masks, SRT bitmaps).
 
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
-module Bitmap ( 
-	Bitmap, mkBitmap,
-	intsToBitmap, intsToReverseBitmap,
-	mAX_SMALL_BITMAP_SIZE,
-	seqBitmap,
+module Bitmap (
+        Bitmap, mkBitmap,
+        intsToBitmap, intsToReverseBitmap,
+        mAX_SMALL_BITMAP_SIZE,
+        seqBitmap,
   ) where
 
 #include "HsVersions.h"
@@ -53,8 +46,8 @@ chunkToBitmap dflags chunk =
 intsToBitmap :: DynFlags -> Int -> [Int] -> Bitmap
 intsToBitmap dflags size slots{- must be sorted -}
   | size <= 0 = []
-  | otherwise = 
-    (foldr (.|.) (toStgWord dflags 0) (map (toStgWord dflags 1 `shiftL`) these)) : 
+  | otherwise =
+    (foldr (.|.) (toStgWord dflags 0) (map (toStgWord dflags 1 `shiftL`) these)) :
         intsToBitmap dflags (size - wORD_SIZE_IN_BITS dflags)
              (map (\x -> x - wORD_SIZE_IN_BITS dflags) rest)
    where (these,rest) = span (< wORD_SIZE_IN_BITS dflags) slots
@@ -67,7 +60,7 @@ intsToBitmap dflags size slots{- must be sorted -}
 intsToReverseBitmap :: DynFlags -> Int -> [Int] -> Bitmap
 intsToReverseBitmap dflags size slots{- must be sorted -}
   | size <= 0 = []
-  | otherwise = 
+  | otherwise =
     (foldr xor (toStgWord dflags init) (map (toStgWord dflags 1 `shiftL`) these)) :
         intsToReverseBitmap dflags (size - wORD_SIZE_IN_BITS dflags)
              (map (\x -> x - wORD_SIZE_IN_BITS dflags) rest)

compiler/cmm/CLabel.hs

@@ -61,7 +61,7 @@ module CLabel (
         mkCAFBlackHoleInfoTableLabel,
         mkCAFBlackHoleEntryLabel,
         mkRtsPrimOpLabel,
-        mkRtsSlowTickyCtrLabel,
+        mkRtsSlowFastTickyCtrLabel,
 
         mkSelectorInfoLabel,
         mkSelectorEntryLabel,
@@ -99,7 +99,7 @@ module CLabel (
         isCFunctionLabel, isGcPtrLabel, labelDynamic,
 
         -- * Conversions
-        toClosureLbl, toSlowEntryLbl, toEntryLbl, toInfoLbl, toRednCountsLbl,
+        toClosureLbl, toSlowEntryLbl, toEntryLbl, toInfoLbl, toRednCountsLbl, hasHaskellName,
 
         pprCLabel
     ) where
@@ -313,7 +313,7 @@ data RtsLabelInfo
 
   | RtsPrimOp PrimOp
   | RtsApFast     FastString    -- ^ _fast versions of generic apply
-  | RtsSlowTickyCtr String
+  | RtsSlowFastTickyCtr String
 
   deriving (Eq, Ord)
   -- NOTE: Eq on LitString compares the pointer only, so this isn't
@@ -356,9 +356,10 @@ mkTopSRTLabel     :: Unique -> CLabel
 mkTopSRTLabel u = SRTLabel u
 
 mkSRTLabel        :: Name -> CafInfo -> CLabel
-mkRednCountsLabel :: Name -> CafInfo -> CLabel
+mkRednCountsLabel :: Name -> CLabel
 mkSRTLabel              name c  = IdLabel name  c SRT
-mkRednCountsLabel       name c  = IdLabel name  c RednCounts
+mkRednCountsLabel       name    =
+  IdLabel name NoCafRefs RednCounts  -- Note [ticky for LNE]
 
 -- These have local & (possibly) external variants:
 mkLocalClosureLabel      :: Name -> CafInfo -> CLabel
@@ -503,8 +504,8 @@ mkCCSLabel          ccs         = CCS_Label ccs
 mkRtsApFastLabel :: FastString -> CLabel
 mkRtsApFastLabel str = RtsLabel (RtsApFast str)
 
-mkRtsSlowTickyCtrLabel :: String -> CLabel
-mkRtsSlowTickyCtrLabel pat = RtsLabel (RtsSlowTickyCtr pat)
+mkRtsSlowFastTickyCtrLabel :: String -> CLabel
+mkRtsSlowFastTickyCtrLabel pat = RtsLabel (RtsSlowFastTickyCtr pat)
 
 
 -- Constructing Code Coverage Labels
@@ -549,10 +550,6 @@ toSlowEntryLbl :: CLabel -> CLabel
 toSlowEntryLbl (IdLabel n c _) = IdLabel n c Slow
 toSlowEntryLbl l = pprPanic "toSlowEntryLbl" (ppr l)
 
-toRednCountsLbl :: CLabel -> CLabel
-toRednCountsLbl (IdLabel n c _) = IdLabel n c RednCounts
-toRednCountsLbl l = pprPanic "toRednCountsLbl" (ppr l)
-
 toEntryLbl :: CLabel -> CLabel
 toEntryLbl (IdLabel n c LocalInfoTable)  = IdLabel n c LocalEntry
 toEntryLbl (IdLabel n c ConInfoTable)    = IdLabel n c ConEntry
@@ -574,12 +571,38 @@ toInfoLbl (CmmLabel m str CmmEntry)    = CmmLabel m str CmmInfo
 toInfoLbl (CmmLabel m str CmmRet)      = CmmLabel m str CmmRetInfo
 toInfoLbl l = pprPanic "CLabel.toInfoLbl" (ppr l)
 
+toRednCountsLbl :: CLabel -> Maybe CLabel
+toRednCountsLbl = fmap mkRednCountsLabel . hasHaskellName
+
+hasHaskellName :: CLabel -> Maybe Name
+hasHaskellName (IdLabel n _ _) = Just n
+hasHaskellName _               = Nothing
+
 -- -----------------------------------------------------------------------------
--- Does a CLabel refer to a CAF?
+-- Does a CLabel's referent itself refer to a CAF?
 hasCAF :: CLabel -> Bool
+hasCAF (IdLabel _ _ RednCounts) = False -- Note [ticky for LNE]
 hasCAF (IdLabel _ MayHaveCafRefs _) = True
 hasCAF _                            = False
 
+-- Note [ticky for LNE]
+-- ~~~~~~~~~~~~~~~~~~~~~
+
+-- Until 14 Feb 2013, every ticky counter was associated with a
+-- closure. Thus, ticky labels used IdLabel. It is odd that
+-- CmmBuildInfoTables.cafTransfers would consider such a ticky label
+-- reason to add the name to the CAFEnv (and thus eventually the SRT),
+-- but it was harmless because the ticky was only used if the closure
+-- was also.
+--
+-- Since we now have ticky counters for LNEs, it is no longer the case
+-- that every ticky counter has an actual closure. So I changed the
+-- generation of ticky counters' CLabels to not result in their
+-- associated id ending up in the SRT.
+--
+-- NB IdLabel is still appropriate for ticky ids (as opposed to
+-- CmmLabel) because the LNE's counter is still related to an .hs Id,
+-- that Id just isn't for a proper closure.
 
 -- -----------------------------------------------------------------------------
 -- Does a CLabel need declaring before use or not?
@@ -1051,8 +1074,8 @@ pprCLbl (CmmLabel _ fs CmmClosure)
 pprCLbl (RtsLabel (RtsPrimOp primop))
   = ptext (sLit "stg_") <> ppr primop
 
-pprCLbl (RtsLabel (RtsSlowTickyCtr pat))
-  = ptext (sLit "SLOW_CALL_") <> text pat <> ptext (sLit "_ctr")
+pprCLbl (RtsLabel (RtsSlowFastTickyCtr pat))
+  = ptext (sLit "SLOW_CALL_fast_") <> text pat <> ptext (sLit "_ctr")
 
 pprCLbl (ForeignLabel str _ _ _)
   = ftext str

compiler/cmm/Cmm.hs

@@ -1,6 +1,5 @@
 -- Cmm representations using Hoopl's Graph CmmNode e x.
 {-# LANGUAGE GADTs #-}
-{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
 
 module Cmm (
      -- * Cmm top-level datatypes

compiler/cmm/CmmBuildInfoTables.hs

@@ -1,10 +1,4 @@
 {-# LANGUAGE GADTs, NoMonoLocalBinds #-}
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
 
 -- Norman likes local bindings
 -- If this module lives on I'd like to get rid of the NoMonoLocalBinds
@@ -164,7 +158,7 @@ srtToData srt = [CmmData RelocatableReadOnlyData (Statics (lbl srt) tbl)]
 -- 1. Build a table of all the CAFs used in the procedure.
 -- 2. Compute the C_SRT describing the subset of CAFs live at each procpoint.
 --
--- When building the local view of the SRT, we first make sure that all the CAFs are 
+-- When building the local view of the SRT, we first make sure that all the CAFs are
 -- in the SRT. Then, if the number of CAFs is small enough to fit in a bitmap,
 -- we make sure they're all close enough to the bottom of the table that the
 -- bitmap will be able to cover all of them.
@@ -240,7 +234,7 @@ to_SRT dflags top_srt off len bmp
        return (Just tbl, C_SRT srt_desc_lbl 0 (srtEscape dflags))
   | otherwise
   = return (Nothing, C_SRT top_srt off (toStgHalfWord dflags (fromStgWord (head bmp))))
-	-- The fromIntegral converts to StgHalfWord
+        -- The fromIntegral converts to StgHalfWord
 
 -- Gather CAF info for a procedure, but only if the procedure
 -- doesn't have a static closure.