.gitignore

 # -----------------------------------------------------------------------------
 # generic generated file patterns
 
+Thumbs.db
+.DS_Store
+
 *~
 #*#
 *.bak
@@ -233,4 +236,4 @@ _darcs/
 /utils/unlit/unlit
 
 
-/extra-gcc-opts
+/extra-gcc-opts
\ No newline at end of file

ANNOUNCE

 
-   ==============================================================
-    The (Interactive) Glasgow Haskell Compiler -- version 6.10.1
-   ==============================================================
+   =============================================================
+    The (Interactive) Glasgow Haskell Compiler -- version 7.2.1
+   =============================================================
 
 The GHC Team is pleased to announce a new major release of GHC. There
 have been a number of significant changes since the last major release,
 including:
 
- * Some new language features have been implemented:
-   * Record syntax: wild-card patterns, punning, and field disambiguation
-   * Generalised quasi-quotes
-   * Generalised list comprehensions
-   * View patterns
+<TODO: release note highlights>
 
- * Type families have been completely re-implemented
 
- * Now comes with Haddock 2, which supports all GHC extensions
+Full release notes are here:
 
- * Parallel garbage collection
-
- * Base provides extensible exceptions
-
- * The GHC API is easier to use
-
- * External core (output only) now works again
-
- * Data Parallel Haskell (DPH) comes as part of GHC
-
-The full release notes are here:
-
-  http://haskell.org/ghc/docs/6.10.1/html/users_guide/release-6-10-1.html
+  http://www.haskell.org/ghc/docs/7.2.1/html/users_guide/release-7-2-1.html
 
 How to get it
 ~~~~~~~~~~~~~

Makefile

@@ -110,9 +110,9 @@ endif
 
 .PHONY: test
 test:
-	$(MAKE) -C testsuite/tests/ghc-regress CLEANUP=1 OUTPUT_SUMMARY=../../../testsuite_summary.txt fast
+	$(MAKE) -C testsuite/tests CLEANUP=1 OUTPUT_SUMMARY=../../testsuite_summary.txt fast
 
 .PHONY: fulltest
 fulltest:
-	$(MAKE) -C testsuite/tests/ghc-regress CLEANUP=1 OUTPUT_SUMMARY=../../../testsuite_summary.txt
+	$(MAKE) -C testsuite/tests CLEANUP=1 OUTPUT_SUMMARY=../../testsuite_summary.txt
 

aclocal.m4

@@ -1523,6 +1523,9 @@ AC_DEFUN([GHC_CONVERT_VENDOR],[
   pc|gentoo) # like i686-pc-linux-gnu and i686-gentoo-freebsd8
     $2="unknown"
     ;;
+  softfloat) # like armv5tel-softfloat-linux-gnueabi
+    $2="unknown"
+    ;;
   *)
     #pass thru by default
     $2="$1"

boot

@@ -174,7 +174,7 @@ sub boot_pkgs {
                     or die "Opening $package/ghc.mk failed: $!";
                 print GHCMK "${package}_PACKAGE = ${pkg}\n";
                 print GHCMK "${package}_dist-install_GROUP = libraries\n";
-                print GHCMK "\$(if \$(filter ${dir},\$(STAGE0_PACKAGES)),\$(eval \$(call build-package,${package},dist-boot,0)))\n";
+                print GHCMK "\$(if \$(filter ${dir},\$(PACKAGES_STAGE0)),\$(eval \$(call build-package,${package},dist-boot,0)))\n";
                 print GHCMK "\$(eval \$(call build-package,${package},dist-install,\$(if \$(filter ${dir},\$(STAGE2_PACKAGES)),2,1)))\n";
                 close GHCMK
                     or die "Closing $package/ghc.mk failed: $!";

compiler/basicTypes/BasicTypes.lhs

@@ -19,7 +19,9 @@ types that
 module BasicTypes(
 	Version, bumpVersion, initialVersion,
 
-	Arity, 
+	Arity,
+	
+	Alignment,
 
         FunctionOrData(..),
 	
@@ -45,8 +47,8 @@ module BasicTypes(
 	TupCon(..), tupleParens,
 
 	OccInfo(..), seqOccInfo, zapFragileOcc, isOneOcc, 
-	isDeadOcc, isLoopBreaker, isNonRuleLoopBreaker, isNoOcc,
-        nonRuleLoopBreaker,
+	isDeadOcc, isStrongLoopBreaker, isWeakLoopBreaker, isNoOcc,
+        strongLoopBreaker, weakLoopBreaker, 
 
 	InsideLam, insideLam, notInsideLam,
 	OneBranch, oneBranch, notOneBranch,
@@ -94,6 +96,16 @@ import Data.Function (on)
 type Arity = Int
 \end{code}
 
+%************************************************************************
+%*									*
+\subsection[Alignment]{Alignment}
+%*									*
+%************************************************************************
+
+\begin{code}
+type Alignment = Int -- align to next N-byte boundary (N must be a power of 2).
+\end{code}
+
 %************************************************************************
 %*									*
 \subsection[FunctionOrData]{FunctionOrData}
@@ -444,24 +456,20 @@ data OccInfo
   -- | This identifier breaks a loop of mutually recursive functions. The field
   -- marks whether it is only a loop breaker due to a reference in a rule
   | IAmALoopBreaker	-- Note [LoopBreaker OccInfo]
-	!RulesOnly	-- True <=> This is a weak or rules-only loop breaker
-			--  	    See OccurAnal Note [Weak loop breakers]
+	!RulesOnly
 
 type RulesOnly = Bool
 \end{code}
 
 Note [LoopBreaker OccInfo]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~
-An OccInfo of (IAmLoopBreaker False) is used by the occurrence 
-analyser in two ways:
-  (a) to mark loop-breakers in a group of recursive 
-      definitions (hence the name)
-  (b) to mark binders that must not be inlined in this phase
-      (perhaps it has a NOINLINE pragma)
-Things with (IAmLoopBreaker False) do not get an unfolding 
-pinned on to them, so they are completely opaque.
+   IAmALoopBreaker True  <=> A "weak" or rules-only loop breaker
+   		   	     Do not preInlineUnconditionally
+
+   IAmALoopBreaker False <=> A "strong" loop breaker
+                             Do not inline at all
 
-See OccurAnal Note [Weak loop breakers] for (IAmLoopBreaker True).
+See OccurAnal Note [Weak loop breakers]
 
 
 \begin{code}
@@ -492,16 +500,17 @@ oneBranch, notOneBranch :: OneBranch
 oneBranch    = True
 notOneBranch = False
 
-isLoopBreaker :: OccInfo -> Bool
-isLoopBreaker (IAmALoopBreaker _) = True
-isLoopBreaker _                   = False
+strongLoopBreaker, weakLoopBreaker :: OccInfo
+strongLoopBreaker = IAmALoopBreaker False
+weakLoopBreaker   = IAmALoopBreaker True
 
-isNonRuleLoopBreaker :: OccInfo -> Bool
-isNonRuleLoopBreaker (IAmALoopBreaker False) = True   -- Loop-breaker that breaks a non-rule cycle
-isNonRuleLoopBreaker _                       = False
+isWeakLoopBreaker :: OccInfo -> Bool
+isWeakLoopBreaker (IAmALoopBreaker _) = True
+isWeakLoopBreaker _                   = False
 
-nonRuleLoopBreaker :: OccInfo
-nonRuleLoopBreaker = IAmALoopBreaker False
+isStrongLoopBreaker :: OccInfo -> Bool
+isStrongLoopBreaker (IAmALoopBreaker False) = True   -- Loop-breaker that breaks a non-rule cycle
+isStrongLoopBreaker _                       = False
 
 isDeadOcc :: OccInfo -> Bool
 isDeadOcc IAmDead = True

compiler/basicTypes/DataCon.lhs

@@ -56,6 +56,7 @@ import FastString
 import Module
 
 import qualified Data.Data as Data
+import qualified Data.Typeable
 import Data.Char
 import Data.Word
 \end{code}
@@ -374,6 +375,7 @@ data DataCon
 				-- Used for Template Haskell and 'deriving' only
 				-- The actual fixity is stored elsewhere
   }
+  deriving Data.Typeable.Typeable
 
 -- | Contains the Ids of the data constructor functions
 data DataConIds
@@ -456,9 +458,6 @@ instance Outputable DataCon where
 instance Show DataCon where
     showsPrec p con = showsPrecSDoc p (ppr con)
 
-instance Data.Typeable DataCon where
-    typeOf _ = Data.mkTyConApp (Data.mkTyCon "DataCon") []
-
 instance Data.Data DataCon where
     -- don't traverse?
     toConstr _   = abstractConstr "DataCon"

compiler/basicTypes/Id.lhs

@@ -508,8 +508,8 @@ isStrictId id
 idUnfolding :: Id -> Unfolding
 -- Do not expose the unfolding of a loop breaker!
 idUnfolding id 
-  | isNonRuleLoopBreaker (occInfo info) = NoUnfolding
-  | otherwise                           = unfoldingInfo info
+  | isStrongLoopBreaker (occInfo info) = NoUnfolding
+  | otherwise                          = unfoldingInfo info
   where
     info = idInfo id
 

compiler/basicTypes/IdInfo.lhs

@@ -38,7 +38,7 @@ module IdInfo (
 
 	-- ** The OccInfo type
 	OccInfo(..),
-	isDeadOcc, isLoopBreaker,
+	isDeadOcc, isStrongLoopBreaker, isWeakLoopBreaker,
 	occInfo, setOccInfo,
 
 	InsideLam, OneBranch,

compiler/basicTypes/MkId.lhs

@@ -584,7 +584,7 @@ mkProductBox arg_ids ty
     result_expr
       | isNewTyCon tycon && not (isRecursiveTyCon tycon) 
       = wrap (mkProductBox arg_ids (newTyConInstRhs tycon tycon_args))
-      | otherwise = mkConApp pack_con (map Type tycon_args ++ map Var arg_ids)
+      | otherwise = mkConApp pack_con (map Type tycon_args ++ varsToCoreExprs arg_ids)
 
     wrap expr = wrapNewTypeBody tycon tycon_args expr
 

compiler/basicTypes/NameSet.lhs

@@ -34,9 +34,6 @@ module NameSet (
 
 import Name
 import UniqSet
-import Util
-
-import Data.Data
 \end{code}
 
 %************************************************************************
@@ -48,20 +45,7 @@ import Data.Data
 \begin{code}
 type NameSet = UniqSet Name
 
--- TODO: These Data/Typeable instances look very dubious. Surely either
--- UniqFM should have the instances, or this should be a newtype?
-
-nameSetTc :: TyCon
-nameSetTc = mkTyCon "NameSet"
-instance Typeable NameSet where { typeOf _ = mkTyConApp nameSetTc [] }
-
-instance Data NameSet where
-  gfoldl k z s = z mkNameSet `k` nameSetToList s -- traverse abstractly
-  toConstr _   = abstractConstr "NameSet"
-  gunfold _ _  = error "gunfold"
-  dataTypeOf _ = mkNoRepType "NameSet"
-
-emptyNameSet	   :: NameSet
+emptyNameSet       :: NameSet
 unitNameSet	   :: Name -> NameSet
 addListToNameSet   :: NameSet -> [Name] -> NameSet
 addOneToNameSet    :: NameSet -> Name -> NameSet

compiler/basicTypes/VarEnv.lhs

@@ -35,8 +35,10 @@ module VarEnv (
 	RnEnv2, 
 	
 	-- ** Operations on RnEnv2s
-	mkRnEnv2, rnBndr2, rnBndrs2, rnOccL, rnOccR, inRnEnvL, inRnEnvR,
+	mkRnEnv2, rnBndr2, rnBndrs2,
+	rnOccL, rnOccR, inRnEnvL, inRnEnvR, rnOccL_maybe, rnOccR_maybe,
         rnBndrL, rnBndrR, nukeRnEnvL, nukeRnEnvR,
+        delBndrL, delBndrR, delBndrsL, delBndrsR,
         addRnInScopeSet,
         rnEtaL, rnEtaR,
 	rnInScope, rnInScopeSet, lookupRnInScope,
@@ -283,11 +285,24 @@ rnEtaR (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bR
   where
     new_b = uniqAway in_scope bR
 
+delBndrL, delBndrR :: RnEnv2 -> Var -> RnEnv2
+delBndrL rn@(RV2 { envL = env, in_scope = in_scope }) v = rn { envL = env `delVarEnv` v, in_scope = in_scope `extendInScopeSet` v }
+delBndrR rn@(RV2 { envR = env, in_scope = in_scope }) v = rn { envR = env `delVarEnv` v, in_scope = in_scope `extendInScopeSet` v }
+
+delBndrsL, delBndrsR :: RnEnv2 -> [Var] -> RnEnv2
+delBndrsL rn@(RV2 { envL = env, in_scope = in_scope }) v = rn { envL = env `delVarEnvList` v, in_scope = in_scope `extendInScopeSetList` v }
+delBndrsR rn@(RV2 { envR = env, in_scope = in_scope }) v = rn { envR = env `delVarEnvList` v, in_scope = in_scope `extendInScopeSetList` v }
+
 rnOccL, rnOccR :: RnEnv2 -> Var -> Var
 -- ^ Look up the renaming of an occurrence in the left or right term
 rnOccL (RV2 { envL = env }) v = lookupVarEnv env v `orElse` v
 rnOccR (RV2 { envR = env }) v = lookupVarEnv env v `orElse` v
 
+rnOccL_maybe, rnOccR_maybe :: RnEnv2 -> Var -> Maybe Var
+-- ^ Look up the renaming of an occurrence in the left or right term
+rnOccL_maybe (RV2 { envL = env }) v = lookupVarEnv env v
+rnOccR_maybe (RV2 { envR = env }) v = lookupVarEnv env v
+
 inRnEnvL, inRnEnvR :: RnEnv2 -> Var -> Bool
 -- ^ Tells whether a variable is locally bound
 inRnEnvL (RV2 { envL = env }) v = v `elemVarEnv` env
@@ -360,7 +375,7 @@ filterVarEnv_Directly :: (Unique -> a -> Bool) -> VarEnv a -> VarEnv a
 restrictVarEnv    :: VarEnv a -> VarSet -> VarEnv a
 delVarEnvList     :: VarEnv a -> [Var] -> VarEnv a
 delVarEnv	  :: VarEnv a -> Var -> VarEnv a
-minusVarEnv       :: VarEnv a -> VarEnv a -> VarEnv a
+minusVarEnv       :: VarEnv a -> VarEnv b -> VarEnv a
 intersectsVarEnv  :: VarEnv a -> VarEnv a -> Bool
 plusVarEnv_C	  :: (a -> a -> a) -> VarEnv a -> VarEnv a -> VarEnv a
 mapVarEnv	  :: (a -> b) -> VarEnv a -> VarEnv b

compiler/cmm/CLabel.hs

@@ -100,6 +100,7 @@ module CLabel (
 
         hasCAF,
 	infoLblToEntryLbl, entryLblToInfoLbl, cvtToClosureLbl, cvtToSRTLbl,
+	localiseLabel,
 	needsCDecl, isAsmTemp, maybeAsmTemp, externallyVisibleCLabel,
         isMathFun,
  	isCFunctionLabel, isGcPtrLabel, labelDynamic,
@@ -278,11 +279,14 @@ pprDebugCLabel lbl
 	_		-> ppr lbl <> (parens $ text "other CLabel)")
 
 
+-- True if a local IdLabel that we won't mark as exported
+type IsLocal = Bool
+
 data IdLabelInfo
   = Closure		-- ^ Label for closure
   | SRT                 -- ^ Static reference table
-  | InfoTable		-- ^ Info tables for closures; always read-only
-  | Entry		-- ^ Entry point
+  | InfoTable IsLocal	-- ^ Info tables for closures; always read-only
+  | Entry IsLocal	-- ^ Entry point
   | Slow		-- ^ Slow entry point
 
   | RednCounts		-- ^ Label of place to keep Ticky-ticky  info for this Id
@@ -356,13 +360,13 @@ mkRednCountsLabel     	name c 	= IdLabel name  c RednCounts
 
 -- These have local & (possibly) external variants:
 mkLocalClosureLabel	name c 	= IdLabel name  c Closure
-mkLocalInfoTableLabel  	name c 	= IdLabel name  c InfoTable
-mkLocalEntryLabel	name c 	= IdLabel name  c Entry
+mkLocalInfoTableLabel  	name c 	= IdLabel name  c (InfoTable True)
+mkLocalEntryLabel	name c 	= IdLabel name  c (Entry True)
 mkLocalClosureTableLabel name c = IdLabel name  c ClosureTable
 
 mkClosureLabel name         c     = IdLabel name c Closure
-mkInfoTableLabel name       c     = IdLabel name c InfoTable
-mkEntryLabel name           c     = IdLabel name c Entry
+mkInfoTableLabel name       c     = IdLabel name c (InfoTable False)
+mkEntryLabel name           c     = IdLabel name c (Entry False)
 mkClosureTableLabel name    c     = IdLabel name c ClosureTable
 mkLocalConInfoTableLabel    c con = IdLabel con c ConInfoTable
 mkLocalConEntryLabel	    c con = IdLabel con c ConEntry
@@ -498,7 +502,7 @@ mkPlainModuleInitLabel mod	= PlainModuleInitLabel mod
 -- Converting between info labels and entry/ret labels.
 
 infoLblToEntryLbl :: CLabel -> CLabel 
-infoLblToEntryLbl (IdLabel n c InfoTable)	= IdLabel n c Entry
+infoLblToEntryLbl (IdLabel n c (InfoTable lcl))	= IdLabel n c (Entry lcl)
 infoLblToEntryLbl (IdLabel n c ConInfoTable)	= IdLabel n c ConEntry
 infoLblToEntryLbl (IdLabel n c StaticInfoTable)	= IdLabel n c StaticConEntry
 infoLblToEntryLbl (CaseLabel n CaseReturnInfo)	= CaseLabel n CaseReturnPt
@@ -509,7 +513,7 @@ infoLblToEntryLbl _
 
 
 entryLblToInfoLbl :: CLabel -> CLabel 
-entryLblToInfoLbl (IdLabel n c Entry)		= IdLabel n c InfoTable
+entryLblToInfoLbl (IdLabel n c (Entry lcl))	= IdLabel n c (InfoTable lcl)
 entryLblToInfoLbl (IdLabel n c ConEntry)	= IdLabel n c ConInfoTable
 entryLblToInfoLbl (IdLabel n c StaticConEntry)	= IdLabel n c StaticInfoTable
 entryLblToInfoLbl (CaseLabel n CaseReturnPt)	= CaseLabel n CaseReturnInfo
@@ -519,8 +523,8 @@ entryLblToInfoLbl l
 	= pprPanic "CLabel.entryLblToInfoLbl" (pprCLabel l)
 
 
-cvtToClosureLbl   (IdLabel n c InfoTable)	= IdLabel n c Closure
-cvtToClosureLbl   (IdLabel n c Entry)		= IdLabel n c Closure
+cvtToClosureLbl   (IdLabel n c (InfoTable _))	= IdLabel n c Closure
+cvtToClosureLbl   (IdLabel n c (Entry _))	= IdLabel n c Closure
 cvtToClosureLbl   (IdLabel n c ConEntry)	= IdLabel n c Closure
 cvtToClosureLbl   (IdLabel n c RednCounts)	= IdLabel n c Closure
 cvtToClosureLbl l@(IdLabel n c Closure)		= l
@@ -528,13 +532,18 @@ cvtToClosureLbl l
 	= pprPanic "cvtToClosureLbl" (pprCLabel l)
 
 
-cvtToSRTLbl   (IdLabel n c InfoTable)		= mkSRTLabel n c
-cvtToSRTLbl   (IdLabel n c Entry)		= mkSRTLabel n c
+cvtToSRTLbl   (IdLabel n c (InfoTable _))	= mkSRTLabel n c
+cvtToSRTLbl   (IdLabel n c (Entry _))		= mkSRTLabel n c
 cvtToSRTLbl   (IdLabel n c ConEntry)		= mkSRTLabel n c
 cvtToSRTLbl l@(IdLabel n c Closure)		= mkSRTLabel n c
 cvtToSRTLbl l 
 	= pprPanic "cvtToSRTLbl" (pprCLabel l)
 
+localiseLabel :: CLabel -> CLabel
+localiseLabel (IdLabel n c (Entry _))     = IdLabel n c (Entry True)
+localiseLabel (IdLabel n c (InfoTable _)) = IdLabel n c (InfoTable True)
+localiseLabel l = l
+
 
 -- -----------------------------------------------------------------------------
 -- Does a CLabel refer to a CAF?
@@ -691,7 +700,7 @@ externallyVisibleCLabel (PlainModuleInitLabel _)= True
 externallyVisibleCLabel (RtsLabel _)            = True
 externallyVisibleCLabel (CmmLabel _ _ _)	= True
 externallyVisibleCLabel (ForeignLabel{})	= True
-externallyVisibleCLabel (IdLabel name _ _)	= isExternalName name
+externallyVisibleCLabel (IdLabel name _ info)	= isExternalName name && externallyVisibleIdLabel info
 externallyVisibleCLabel (CC_Label _)		= True
 externallyVisibleCLabel (CCS_Label _)		= True
 externallyVisibleCLabel (DynamicLinkerLabel _ _)  = False
@@ -699,6 +708,12 @@ externallyVisibleCLabel (HpcTicksLabel _)	= True
 externallyVisibleCLabel (LargeBitmapLabel _)    = False
 externallyVisibleCLabel (LargeSRTLabel _)	= False
 
+externallyVisibleIdLabel :: IdLabelInfo -> Bool
+externallyVisibleIdLabel SRT             = False
+externallyVisibleIdLabel (Entry lcl)     = not lcl
+externallyVisibleIdLabel (InfoTable lcl) = not lcl
+externallyVisibleIdLabel _               = True
+
 -- -----------------------------------------------------------------------------
 -- Finding the "type" of a CLabel 
 
@@ -744,7 +759,7 @@ labelType _                                     = DataLabel
 
 idInfoLabelType info =
   case info of
-    InfoTable  	  -> DataLabel
+    InfoTable _   -> DataLabel
     Closure    	  -> GcPtrLabel
     ConInfoTable  -> DataLabel
     StaticInfoTable -> DataLabel
@@ -847,6 +862,8 @@ entry.
 
 instance Outputable CLabel where
   ppr = pprCLabel
+instance PlatformOutputable CLabel where
+  pprPlatform _ = pprCLabel
 
 pprCLabel :: CLabel -> SDoc
 
@@ -980,8 +997,8 @@ ppIdFlavor x = pp_cSEP <>
 	       (case x of
 		       Closure	    	-> ptext (sLit "closure")
 		       SRT		-> ptext (sLit "srt")
-		       InfoTable    	-> ptext (sLit "info")
-		       Entry	    	-> ptext (sLit "entry")
+		       InfoTable _	-> ptext (sLit "info")
+		       Entry _	    	-> ptext (sLit "entry")
 		       Slow	    	-> ptext (sLit "slow")
 		       RednCounts	-> ptext (sLit "ct")
 		       ConEntry	    	-> ptext (sLit "con_entry")

compiler/cmm/Cmm.hs

@@ -53,8 +53,8 @@ type CmmBwdRewrite f = BwdRewrite FuelUniqSM CmmNode f
 
 data CmmStackInfo = StackInfo {arg_space :: ByteOff, updfr_space :: Maybe ByteOff}
 data CmmTopInfo   = TopInfo {info_tbl :: CmmInfoTable, stack_info :: CmmStackInfo}
-type Cmm          = GenCmm    CmmStatic CmmTopInfo CmmGraph
-type CmmTop       = GenCmmTop CmmStatic CmmTopInfo CmmGraph
+type Cmm          = GenCmm    CmmStatics CmmTopInfo CmmGraph
+type CmmTop       = GenCmmTop CmmStatics CmmTopInfo CmmGraph
 
 -------------------------------------------------
 -- Manipulating CmmGraphs

compiler/cmm/CmmBuildInfoTables.hs

@@ -238,7 +238,7 @@ addCAF caf srt =
     where last  = next_elt srt
 
 srtToData :: TopSRT -> Cmm
-srtToData srt = Cmm [CmmData RelocatableReadOnlyData (CmmDataLabel (lbl srt) : tbl)]
+srtToData srt = Cmm [CmmData RelocatableReadOnlyData (Statics (lbl srt) tbl)]
     where tbl = map (CmmStaticLit . CmmLabel) (reverse (rev_elts srt))
 
 -- Once we have found the CAFs, we need to do two things:
@@ -317,7 +317,7 @@ to_SRT top_srt off len bmp
   = do id <- getUniqueM
        let srt_desc_lbl = mkLargeSRTLabel id
            tbl = CmmData RelocatableReadOnlyData $
-                   CmmDataLabel srt_desc_lbl : map CmmStaticLit
+                   Statics srt_desc_lbl $ map CmmStaticLit
                      ( cmmLabelOffW top_srt off
                      : mkWordCLit (fromIntegral len)
                      : map mkWordCLit bmp)
@@ -336,7 +336,7 @@ localCAFInfo :: CAFEnv -> CmmTop -> Maybe (CLabel, CAFSet)
 localCAFInfo _      (CmmData _ _) = Nothing
 localCAFInfo cafEnv (CmmProc top_info top_l (CmmGraph {g_entry=entry})) =
   case info_tbl top_info of
-    CmmInfoTable False _ _ _ ->
+    CmmInfoTable _ False _ _ _ ->
       Just (cvtToClosureLbl top_l,
             expectJust "maybeBindCAFs" $ mapLookup entry cafEnv)
     _ -> Nothing
@@ -397,8 +397,8 @@ updInfo toVars toSrt (CmmProc top_info top_l g) =
 updInfo _ _ t = t
 
 updInfoTbl :: (StackLayout -> StackLayout) -> (C_SRT -> C_SRT) -> CmmInfoTable -> CmmInfoTable
-updInfoTbl toVars toSrt (CmmInfoTable s p t typeinfo)
-  = CmmInfoTable s p t typeinfo'
+updInfoTbl toVars toSrt (CmmInfoTable l s p t typeinfo)
+  = CmmInfoTable l s p t typeinfo'
     where typeinfo' = case typeinfo of
             t@(ConstrInfo _ _ _)    -> t
             (FunInfo    c s a d e)  -> FunInfo c (toSrt s) a d e

compiler/cmm/CmmCvt.hs

@@ -13,6 +13,7 @@ import CmmExpr
 import MkGraph
 import qualified OldCmm as Old
 import OldPprCmm ()
+import Platform
 
 import Compiler.Hoopl hiding ((<*>), mkLabel, mkBranch)
 import Control.Monad
@@ -21,23 +22,23 @@ import Maybes
 import Outputable
 import UniqSupply
 
-cmmToZgraph :: Old.Cmm -> UniqSM Cmm
-cmmOfZgraph :: Cmm     -> Old.Cmm
+cmmToZgraph :: Platform -> Old.Cmm -> UniqSM Cmm
+cmmOfZgraph :: Cmm -> Old.Cmm
 
-cmmToZgraph (Cmm tops) = liftM Cmm $ mapM mapTop tops
+cmmToZgraph platform (Cmm tops) = liftM Cmm $ mapM mapTop tops
   where mapTop (CmmProc (Old.CmmInfo _ _ info_tbl) l g) =
-          do (stack_info, g) <- toZgraph (showSDoc $ ppr l) g
+          do (stack_info, g) <- toZgraph platform (showSDoc $ ppr l) g
              return $ CmmProc (TopInfo {info_tbl=info_tbl, stack_info=stack_info}) l g
         mapTop (CmmData s ds) = return $ CmmData s ds
 cmmOfZgraph (Cmm tops) = Cmm $ map mapTop tops
   where mapTop (CmmProc h l g) = CmmProc (Old.CmmInfo Nothing Nothing (info_tbl h)) l (ofZgraph g)
         mapTop (CmmData s ds) = CmmData s ds
 
-toZgraph :: String -> Old.ListGraph Old.CmmStmt -> UniqSM (CmmStackInfo, CmmGraph)
-toZgraph _ (Old.ListGraph []) =
+toZgraph :: Platform -> String -> Old.ListGraph Old.CmmStmt -> UniqSM (CmmStackInfo, CmmGraph)
+toZgraph _ _ (Old.ListGraph []) =
   do g <- lgraphOfAGraph emptyAGraph
      return (StackInfo {arg_space=0, updfr_space=Nothing}, g)
-toZgraph fun_name g@(Old.ListGraph (Old.BasicBlock id ss : other_blocks)) = 
+toZgraph platform fun_name g@(Old.ListGraph (Old.BasicBlock id ss : other_blocks)) =
            let (offset, entry) = mkCallEntry NativeNodeCall [] in
            do g <- labelAGraph id $
                      entry <*> mkStmts ss <*> foldr addBlock emptyAGraph other_blocks
@@ -64,7 +65,7 @@ toZgraph fun_name g@(Old.ListGraph (Old.BasicBlock id ss : other_blocks)) =
         mkStmts (last : []) = mkLast last
         mkStmts []          = bad "fell off end"
         mkStmts (_ : _ : _) = bad "last node not at end"
-        bad msg = pprPanic (msg ++ " in function " ++ fun_name) (ppr g)
+        bad msg = pprPanic (msg ++ " in function " ++ fun_name) (pprPlatform platform g)
         mkLast (Old.CmmCall (Old.CmmCallee f conv) []     args _ Old.CmmNeverReturns) =
             mkFinalCall f conv (map Old.hintlessCmm args) updfr_sz
         mkLast (Old.CmmCall (Old.CmmPrim {}) _ _ _ Old.CmmNeverReturns) =

compiler/cmm/CmmDecl.hs

@@ -11,7 +11,7 @@ module CmmDecl (
         CmmInfoTable(..), HasStaticClosure, ClosureTypeInfo(..), ConstrDescription,
         ProfilingInfo(..), ClosureTypeTag,
         CmmActual, CmmFormal, ForeignHint(..),
-        CmmStatic(..), Section(..),
+        CmmStatics(..), CmmStatic(..), Section(..),
   ) where
 
 #include "HsVersions.h"
@@ -55,19 +55,12 @@ newtype GenCmm d h g = Cmm [GenCmmTop d h g]
 data GenCmmTop d h g
   = CmmProc     -- A procedure
      h                 -- Extra header such as the info table
-     CLabel            -- Used to generate both info & entry labels
+     CLabel            -- Used to generate both info & entry labels (though the info table label is in 'h' in RawCmmTop)
      g                 -- Control-flow graph for the procedure's code
 
   | CmmData     -- Static data
         Section
-        [d]
-
-
--- A basic block containing a single label, at the beginning.
--- The list of basic blocks in a top-level code block may be re-ordered.
--- Fall-through is not allowed: there must be an explicit jump at the
--- end of each basic block, but the code generator might rearrange basic
--- blocks in order to turn some jumps into fallthroughs.
+        d
 
 
 -----------------------------------------------------------------------------
@@ -77,12 +70,16 @@ data GenCmmTop d h g
 -- Info table as a haskell data type
 data CmmInfoTable
   = CmmInfoTable
+      LocalInfoTable
       HasStaticClosure
       ProfilingInfo
       ClosureTypeTag -- Int
       ClosureTypeInfo
   | CmmNonInfoTable   -- Procedure doesn't need an info table
 
+-- | If the table is local, we don't export its identifier even if the corresponding Id is exported.
+-- It's always safe to say 'False' here, but it might save symbols to say 'True'
+type LocalInfoTable = Bool
 type HasStaticClosure = Bool
 
 -- TODO: The GC target shouldn't really be part of CmmInfo
@@ -139,10 +136,7 @@ data CmmStatic
         -- a literal value, size given by cmmLitRep of the literal.
   | CmmUninitialised Int
         -- uninitialised data, N bytes long
-  | CmmAlign Int
-        -- align to next N-byte boundary (N must be a power of 2).
-  | CmmDataLabel CLabel
-        -- label the current position in this section.
   | CmmString [Word8]
         -- string of 8-bit values only, not zero terminated.
 
+data CmmStatics = Statics CLabel {- Label of statics -} [CmmStatic] {- The static data itself -}

compiler/cmm/CmmInfo.hs

@@ -28,7 +28,7 @@ import Data.Bits
 
 -- When we split at proc points, we need an empty info table.
 emptyContInfoTable :: CmmInfoTable
-emptyContInfoTable = CmmInfoTable False (ProfilingInfo zero zero) rET_SMALL
+emptyContInfoTable = CmmInfoTable False False (ProfilingInfo zero zero) rET_SMALL
                                   (ContInfo [] NoC_SRT)
     where zero = CmmInt 0 wordWidth
 
@@ -78,10 +78,10 @@ mkInfoTable _    (CmmData sec dat) = [CmmData sec dat]
 mkInfoTable uniq (CmmProc (CmmInfo _ _ info) entry_label blocks) =
     case info of
       -- Code without an info table.  Easy.
-      CmmNonInfoTable -> [CmmProc [] entry_label blocks]
+      CmmNonInfoTable -> [CmmProc Nothing entry_label blocks]
 
-      CmmInfoTable _ (ProfilingInfo ty_prof cl_prof) type_tag type_info ->
-          let info_label = entryLblToInfoLbl entry_label
+      CmmInfoTable is_local _ (ProfilingInfo ty_prof cl_prof) type_tag type_info ->
+          let info_label = (if is_local then localiseLabel else id) $ entryLblToInfoLbl entry_label
               ty_prof'   = makeRelativeRefTo info_label ty_prof
               cl_prof'   = makeRelativeRefTo info_label cl_prof
           in case type_info of
@@ -153,7 +153,7 @@ mkInfoTableAndCode :: CLabel
                    -> [RawCmmTop]
 mkInfoTableAndCode info_lbl std_info extra_bits entry_lbl blocks
   | tablesNextToCode 	-- Reverse the extra_bits; and emit the top-level proc
-  = [CmmProc (map CmmStaticLit (reverse extra_bits ++ std_info))
+  = [CmmProc (Just (Statics info_lbl $ map CmmStaticLit (reverse extra_bits ++ std_info)))
              entry_lbl blocks]
 
   | ListGraph [] <- blocks -- No code; only the info table is significant
@@ -163,7 +163,7 @@ mkInfoTableAndCode info_lbl std_info extra_bits entry_lbl blocks
 
   | otherwise	-- Separately emit info table (with the function entry 
   =		-- point as first entry) and the entry code 
-    [CmmProc [] entry_lbl blocks,
+    [CmmProc Nothing entry_lbl blocks,
      mkDataLits info_lbl (CmmLabel entry_lbl : std_info ++ extra_bits)]
 
 mkSRTLit :: CLabel

compiler/cmm/CmmLint.hs

@@ -23,6 +23,7 @@ import Outputable
 import OldPprCmm()
 import Constants
 import FastString
+import Platform
 
 import Data.Maybe
 
@@ -30,21 +31,22 @@ import Data.Maybe
 -- Exported entry points:
 
 cmmLint :: (Outputable d, Outputable h)
-	=> GenCmm d h (ListGraph CmmStmt) -> Maybe SDoc
-cmmLint (Cmm tops) = runCmmLint (mapM_ lintCmmTop) tops
+        => Platform -> GenCmm d h (ListGraph CmmStmt) -> Maybe SDoc
+cmmLint platform (Cmm tops) = runCmmLint platform (mapM_ lintCmmTop) tops
 
 cmmLintTop :: (Outputable d, Outputable h)
-	   => GenCmmTop d h (ListGraph CmmStmt) -> Maybe SDoc
-cmmLintTop top = runCmmLint lintCmmTop top
+           => Platform -> GenCmmTop d h (ListGraph CmmStmt) -> Maybe SDoc
+cmmLintTop platform top = runCmmLint platform lintCmmTop top
 
-runCmmLint :: Outputable a => (a -> CmmLint b) -> a -> Maybe SDoc
-runCmmLint l p = 
+runCmmLint :: PlatformOutputable a
+           => Platform -> (a -> CmmLint b) -> a -> Maybe SDoc
+runCmmLint platform l p =
    case unCL (l p) of
-	Left err -> Just (vcat [ptext $ sLit ("Cmm lint error:"),
-				nest 2 err,
-				ptext $ sLit ("Program was:"),
-				nest 2 (ppr p)])
-  	Right _  -> Nothing
+   Left err -> Just (vcat [ptext $ sLit ("Cmm lint error:"),
+                           nest 2 err,
+                           ptext $ sLit ("Program was:"),
+                           nest 2 (pprPlatform platform p)])
+   Right _  -> Nothing
 
 lintCmmTop :: (GenCmmTop h i (ListGraph CmmStmt)) -> CmmLint ()
 lintCmmTop (CmmProc _ lbl (ListGraph blocks))

compiler/cmm/CmmMachOp.hs

@@ -30,31 +30,13 @@ import Outputable
 --              MachOp
 -----------------------------------------------------------------------------
 
-{-
-Implementation notes:
-
-It might suffice to keep just a width, without distinguishing between
-floating and integer types.  However, keeping the distinction will
-help the native code generator to assign registers more easily.
--}
-
-
 {- |
 Machine-level primops; ones which we can reasonably delegate to the
-native code generators to handle.  Basically contains C's primops
-and no others.
-
-Nomenclature: all ops indicate width and signedness, where
-appropriate.  Widths: 8\/16\/32\/64 means the given size, obviously.
-Nat means the operation works on STG word sized objects.
-Signedness: S means signed, U means unsigned.  For operations where
-signedness is irrelevant or makes no difference (for example
-integer add), the signedness component is omitted.
-
-An exception: NatP is a ptr-typed native word.  From the point of
-view of the native code generators this distinction is irrelevant,
-but the C code generator sometimes needs this info to emit the
-right casts.
+native code generators to handle.
+
+Most operations are parameterised by the 'Width' that they operate on.
+Some operations have separate signed and unsigned versions, and float
+and integer versions.
 -}
 
 data MachOp