Simplify: actually create top-level bindings for string literals

compiler/cmm/CmmUtils.hs

@@ -76,7 +76,6 @@ import Cmm
 import BlockId
 import CLabel
 import Outputable
-import Unique
 import UniqSupply
 import DynFlags
 import Util

compiler/simplCore/SimplEnv.hs

@@ -59,6 +59,7 @@ import BasicTypes
 import MonadUtils
 import Outputable
 import Util
+import Literal
 
 import Data.List
 
@@ -366,7 +367,8 @@ data Floats = Floats (OrdList OutBind) FloatFlag
         -- See Note [Simplifier floats]
 
 data FloatFlag
-  = FltLifted   -- All bindings are lifted and lazy
+  = FltLifted   -- All bindings are lifted and lazy *or*
+                --     consist of a single primitive string literal
                 --  Hence ok to float to top level, or recursive
 
   | FltOkSpec   -- All bindings are FltLifted *or*
@@ -429,6 +431,7 @@ unitFloat bind = Floats (unitOL bind) (flag bind)
     flag (Rec {})                = FltLifted
     flag (NonRec bndr rhs)
       | not (isStrictId bndr)    = FltLifted
+      | Lit (MachStr _) <- rhs   = FltLifted  -- String literals can be floated freely
       | exprOkForSpeculation rhs = FltOkSpec  -- Unlifted, and lifted but ok-for-spec (eg HNF)
       | otherwise                = ASSERT2( not (isUnliftedType (idType bndr)), ppr bndr )
                                    FltCareful

compiler/simplCore/Simplify.hs

@@ -625,12 +625,14 @@ so we don't want to turn it into
 because we'll just end up inlining x back, and that makes the
 simplifier loop.  Better not to ANF-ise it at all.
 
-A case in point is literal strings (a MachStr is not regarded as
-trivial):
+Literal strings are an exception.
 
    foo = Ptr "blob"#
 
-We don't want to ANF-ise this.
+We want to turn this into:
+
+   foo1 = "blob"#
+   foo = Ptr foo1
 
 ************************************************************************
 *                                                                      *