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