Ticket #7206: cheap-build-ghc.patch

File cheap-build-ghc.patch, 4.2 KB (added by simonpj, 2 years ago)

Patch for GHC itself

  • compiler/prelude/PrelNames.lhs

    commit 32001815b8ccae586a3334779d1c00b948f29329
    Author: Simon Peyton Jones <[email protected]>
    Date:   Fri Jan 18 17:38:27 2013 +0000
    
        Make cheapBuild behave just like build
    
    	Modified compiler/prelude/PrelNames.lhs
    diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs
    index 1d3a7f9..e1f6a18 100644
    a b basicKnownKeyNames 
    235235 
    236236        -- List operations 
    237237        concatName, filterName, mapName, 
    238         zipName, foldrName, buildName, augmentName, appendName, 
     238        zipName, foldrName, buildName, cheapBuildName, augmentName, appendName, 
    239239 
    240240        dollarName,         -- The ($) apply function 
    241241 
    groupWithName = varQual gHC_EXTS (fsLit "groupWith") groupWithIdKey 
    811811 
    812812-- Random PrelBase functions 
    813813fromStringName, otherwiseIdName, foldrName, buildName, augmentName, 
    814     mapName, appendName, assertName, 
     814    cheapBuildName, mapName, appendName, assertName, 
    815815    breakpointName, breakpointCondName, breakpointAutoName, 
    816816    dollarName, opaqueTyConName :: Name 
    817817fromStringName = methName dATA_STRING (fsLit "fromString") fromStringClassOpKey 
    818818otherwiseIdName   = varQual gHC_BASE (fsLit "otherwise")  otherwiseIdKey 
    819819foldrName         = varQual gHC_BASE (fsLit "foldr")      foldrIdKey 
    820820buildName         = varQual gHC_BASE (fsLit "build")      buildIdKey 
     821cheapBuildName    = varQual gHC_BASE (fsLit "cheapBuild") cheapBuildIdKey 
    821822augmentName       = varQual gHC_BASE (fsLit "augment")    augmentIdKey 
    822823mapName           = varQual gHC_BASE (fsLit "map")        mapIdKey 
    823824appendName        = varQual gHC_BASE (fsLit "++")         appendIdKey 
    integerGmpJDataConKey = mkPreludeDataConUnique 31 
    14881489 
    14891490\begin{code} 
    14901491wildCardKey, absentErrorIdKey, augmentIdKey, appendIdKey, 
    1491     buildIdKey, errorIdKey, foldrIdKey, recSelErrorIdKey, 
     1492    buildIdKey, cheapBuildIdKey, errorIdKey, foldrIdKey, recSelErrorIdKey, 
    14921493    seqIdKey, irrefutPatErrorIdKey, eqStringIdKey, 
    14931494    noMethodBindingErrorIdKey, nonExhaustiveGuardsErrorIdKey, 
    14941495    runtimeErrorIdKey, patErrorIdKey, 
    unpackCStringUtf8IdKey = mkPreludeMiscIdUnique 17 
    15161517unpackCStringAppendIdKey      = mkPreludeMiscIdUnique 18 
    15171518unpackCStringFoldrIdKey       = mkPreludeMiscIdUnique 19 
    15181519unpackCStringIdKey            = mkPreludeMiscIdUnique 20 
     1520cheapBuildIdKey               = mkPreludeMiscIdUnique 21 
    15191521 
    15201522unsafeCoerceIdKey, concatIdKey, filterIdKey, zipIdKey, bindIOIdKey, 
    15211523    returnIOIdKey, newStablePtrIdKey, 
  • compiler/simplCore/OccurAnal.lhs

    	Modified compiler/simplCore/OccurAnal.lhs
    diff --git a/compiler/simplCore/OccurAnal.lhs b/compiler/simplCore/OccurAnal.lhs
    index db652c3..e2f2845 100644
    a b import Var 
    3434 
    3535import Maybes           ( orElse ) 
    3636import Digraph          ( SCC(..), stronglyConnCompFromEdgedVerticesR ) 
    37 import PrelNames        ( buildIdKey, foldrIdKey, runSTRepIdKey, augmentIdKey ) 
     37import PrelNames        ( buildIdKey, cheapBuildIdKey, foldrIdKey, runSTRepIdKey, augmentIdKey ) 
    3838import Unique 
    3939import UniqFM 
    4040import Util 
    occAnalApp env (Var fun, args) 
    13301330           -- Simplify.prepareRhs 
    13311331 
    13321332                -- Hack for build, fold, runST 
    1333     args_stuff  | fun_uniq == buildIdKey    = appSpecial env 2 [True,True]  args 
    1334                 | fun_uniq == augmentIdKey  = appSpecial env 2 [True,True]  args 
    1335                 | fun_uniq == foldrIdKey    = appSpecial env 3 [False,True] args 
    1336                 | fun_uniq == runSTRepIdKey = appSpecial env 2 [True]       args 
     1333    args_stuff  | fun_uniq == buildIdKey      = appSpecial env 2 [True,True]  args 
     1334                | fun_uniq == cheapBuildIdKey = appSpecial env 2 [True,True]  args 
     1335                | fun_uniq == augmentIdKey    = appSpecial env 2 [True,True]  args 
     1336                | fun_uniq == foldrIdKey      = appSpecial env 3 [False,True] args 
     1337                | fun_uniq == runSTRepIdKey   = appSpecial env 2 [True]       args 
    13371338                        -- (foldr k z xs) may call k many times, but it never 
    13381339                        -- shares a partial application of k; hence [False,True] 
    13391340                        -- This means we can optimise