[commit: ghc] wip/T14068: Prefix the loopification name with $l (9245c4b)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/T14068
Link       : http://ghc.haskell.org/trac/ghc/changeset/9245c4bbc2156b3b84f253c97cc2ee8bd8b7dd98/ghc

>---------------------------------------------------------------

commit 9245c4bbc2156b3b84f253c97cc2ee8bd8b7dd98
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Mon Mar 19 15:19:16 2018 -0400

    Prefix the loopification name with $l


>---------------------------------------------------------------

9245c4bbc2156b3b84f253c97cc2ee8bd8b7dd98
 compiler/basicTypes/Id.hs      | 6 +++++-
 compiler/basicTypes/OccName.hs | 5 +++--
 compiler/coreSyn/CoreOpt.hs    | 2 +-
 3 files changed, 9 insertions(+), 4 deletions(-)

diff --git a/compiler/basicTypes/Id.hs b/compiler/basicTypes/Id.hs
index fbece0e..629f85f 100644
--- a/compiler/basicTypes/Id.hs
+++ b/compiler/basicTypes/Id.hs
@@ -40,7 +40,7 @@ module Id (
         mkSysLocal, mkSysLocalM, mkSysLocalOrCoVar, mkSysLocalOrCoVarM,
         mkUserLocal, mkUserLocalOrCoVar,
         mkTemplateLocals, mkTemplateLocalsNum, mkTemplateLocal,
-        mkWorkerId,
+        mkWorkerId, mkLoopId,
 
         -- ** Taking an Id apart
         idName, idType, idUnique, idInfo, idDetails,
@@ -347,6 +347,10 @@ mkWorkerId :: Unique -> Id -> Type -> Id
 mkWorkerId uniq unwrkr ty
   = mkLocalIdOrCoVar (mkDerivedInternalName mkWorkerOcc uniq (getName unwrkr)) ty
 
+mkLoopId :: Id -> Id
+mkLoopId i
+  = mkLocalIdOrCoVar (mkDerivedInternalName mkLoopOcc (getUnique i) (getName i)) (idType i)
+
 -- | Create a /template local/: a family of system local 'Id's in bijection with @Int at s, typically used in unfoldings
 mkTemplateLocal :: Int -> Type -> Id
 mkTemplateLocal i ty = mkSysLocalOrCoVar (fsLit "v") (mkBuiltinUnique i) ty
diff --git a/compiler/basicTypes/OccName.hs b/compiler/basicTypes/OccName.hs
index f6a66fd..f95b608 100644
--- a/compiler/basicTypes/OccName.hs
+++ b/compiler/basicTypes/OccName.hs
@@ -61,7 +61,7 @@ module OccName (
         mkNewTyCoOcc, mkClassOpAuxOcc,
         mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc,
         mkClassDataConOcc, mkDictOcc, mkIPOcc,
-        mkSpecOcc, mkForeignExportOcc, mkRepEqOcc,
+        mkSpecOcc, mkLoopOcc, mkForeignExportOcc, mkRepEqOcc,
         mkGenR, mkGen1R,
         mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc,
         mkSuperDictSelOcc, mkSuperDictAuxOcc,
@@ -615,7 +615,7 @@ mkDataConWrapperOcc, mkWorkerOcc,
         mkMatcherOcc, mkBuilderOcc,
         mkDefaultMethodOcc,
         mkClassDataConOcc, mkDictOcc,
-        mkIPOcc, mkSpecOcc, mkForeignExportOcc, mkRepEqOcc,
+        mkIPOcc, mkSpecOcc, mkLoopOcc, mkForeignExportOcc, mkRepEqOcc,
         mkGenR, mkGen1R,
         mkDataConWorkerOcc, mkNewTyCoOcc,
         mkInstTyCoOcc, mkEqPredCoOcc, mkClassOpAuxOcc,
@@ -633,6 +633,7 @@ mkClassOpAuxOcc     = mk_simple_deriv varName  "$c"
 mkDictOcc           = mk_simple_deriv varName  "$d"
 mkIPOcc             = mk_simple_deriv varName  "$i"
 mkSpecOcc           = mk_simple_deriv varName  "$s"
+mkLoopOcc           = mk_simple_deriv varName  "$l"
 mkForeignExportOcc  = mk_simple_deriv varName  "$f"
 mkRepEqOcc          = mk_simple_deriv tvName   "$r"   -- In RULES involving Coercible
 mkClassDataConOcc   = mk_simple_deriv dataName "C:"     -- Data con for a class
diff --git a/compiler/coreSyn/CoreOpt.hs b/compiler/coreSyn/CoreOpt.hs
index 57812e4..7012d5b 100644
--- a/compiler/coreSyn/CoreOpt.hs
+++ b/compiler/coreSyn/CoreOpt.hs
@@ -673,7 +673,7 @@ loopificationJoinPointBinding_maybe bndr rhs
         join_bndr = (`asJoinId` join_arity) $
                      (`setIdOccInfo` occ') $
                      zapFragileIdInfo $
-                     localiseId $
+                     mkLoopId $
                      bndr
         -- RULES etc stay with bindr'
         bndr' = zapIdTailCallInfo bndr