Commit a6e13d50 authored by Simon Peyton Jones's avatar Simon Peyton Jones

Make exprIsConApp_maybe work better for literals strings

There are two things here

* Use exprIsLiteral_maybe to "look through" a variable bound
  to a literal string.

* Add CONLIKE to the NOINLINE pragma for unpackCString# and
  unpackCStringUtf8#

See Trac #13317, Trac #10844, and
Note [exprIsConApp_maybe on literal strings] in CoreSubst

I did a nofib run and got essentially zero change except for one
2.2% improvement in allocation for 'pretty'.
parent c88b7c9a
......@@ -1378,7 +1378,7 @@ However e might not *look* as if
Note [exprIsConApp_maybe on literal strings]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
See #9400.
See #9400 and #13317.
Conceptually, a string literal "abc" is just ('a':'b':'c':[]), but in Core
they are represented as unpackCString# "abc"# by MkCore.mkStringExprFS, or
......@@ -1394,6 +1394,13 @@ We need to be careful about UTF8 strings here. ""# contains a ByteString, so
we must parse it back into a FastString to split off the first character.
That way we can treat unpackCString# and unpackCStringUtf8# in the same way.
We must also be caeful about
lvl = "foo"#
...(unpackCString# lvl)...
to ensure that we see through the let-binding for 'lvl'. Hence the
(exprIsLiteral_maybe .. arg) in the guard before the call to
dealWithStringLiteral.
Note [Push coercions in exprIsConApp_maybe]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
In Trac #13025 I found a case where we had
......@@ -1460,9 +1467,11 @@ exprIsConApp_maybe (in_scope, id_unf) expr
, let in_scope' = extendInScopeSetSet in_scope (exprFreeVars rhs)
= go (Left in_scope') rhs cont
| (fun `hasKey` unpackCStringIdKey)
|| (fun `hasKey` unpackCStringUtf8IdKey)
, [Lit (MachStr str)] <- args
-- See Note [exprIsConApp_maybe on literal strings]
| (fun `hasKey` unpackCStringIdKey) ||
(fun `hasKey` unpackCStringUtf8IdKey)
, [arg] <- args
, Just (MachStr str) <- exprIsLiteral_maybe (in_scope, id_unf) arg
= dealWithStringLiteral fun str co
where
unfolding = id_unf fun
......
......@@ -34,9 +34,8 @@ import GHC.Prim
-- stuff uses Strings in the representation, so to give representations for
-- ghc-prim types we need unpackCString#
{-
Note [Inlining unpackCString#]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
{- Note [Inlining unpackCString#]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
There's really no point in ever inlining things like unpackCString# as the loop
doesn't specialise in an interesting way and we can't deforest the list
constructors (we'd want to use unpackFoldrCString# for this). Moreover, it's
......@@ -57,10 +56,22 @@ to match unpackCString#,
* stream fusion rules; e.g. in the `text` library,
unstream (S.map safe (S.streamList (GHC.unpackCString# a)))
= unpackCString# a
Moreover, we want to make it CONLIKE, so that:
* the rules in PrelRules will fire when the string is let-bound.
E.g. the eqString rule in PrelRules
eqString (unpackCString# (Lit s1)) (unpackCString# (Lit s2) = s1==s2
* exprIsConApp_maybe will see the string when we ahve
let x = unpackCString# "foo"#
...(case x of algs)...
All of this goes for unpackCStringUtf8# too.
-}
unpackCString# :: Addr# -> [Char]
{-# NOINLINE unpackCString# #-}
{-# NOINLINE CONLIKE unpackCString# #-}
unpackCString# addr
= unpack 0#
where
......@@ -110,7 +121,7 @@ unpackFoldrCString# addr f z
-- There's really no point in inlining this for the same reasons as
-- unpackCString. See Note [Inlining unpackCString#] above for details.
unpackCStringUtf8# :: Addr# -> [Char]
{-# NOINLINE unpackCStringUtf8# #-}
{-# NOINLINE CONLIKE unpackCStringUtf8# #-}
unpackCStringUtf8# addr
= unpack 0#
where
......
......@@ -15,6 +15,10 @@ T9509:
# Grep output should show a SPEC rule firing
# The unfolding use threshold is to prevent foo inlining before it is specialised
T13317:
$(RM) -f T13317.o T13317.hi
'$(TEST_HC)' $(TEST_HC_OPTS) $(T8832_WORDSIZE_OPTS) -O -c -ddump-simpl-stats T13317.hs | grep 'KnownBranch'
T8832:
$(RM) -f T8832.o T8832.hi
'$(TEST_HC)' $(TEST_HC_OPTS) $(T8832_WORDSIZE_OPTS) -O -c -ddump-simpl T8832.hs | grep '^[a-zA-Z0-9]\+ ='
......
{-# LANGUAGE MagicHash #-}
module T13317 where
import GHC.Base
f x = let x = "foo"#
y1 = unpackCString# x
y2 = unpackCString# x
in
(y1, case y2 of
'f' : _ -> True
_ -> False
)
-- This case-expression should simplify
-- yeilding a KnownBranch simplifier tick
......@@ -10,7 +10,7 @@
==================== Grand total simplifier statistics ====================
Total ticks: 54
Total ticks: 55
15 PreInlineUnconditionally
1 n
......@@ -40,7 +40,7 @@ Total ticks: 54
1 fold/build
1 unpack
1 unpack-list
4 LetFloatFromLet 4
5 LetFloatFromLet 5
25 BetaReduction
1 a
1 c
......
......@@ -240,3 +240,7 @@ test('str-rules',
run_command,
['$MAKE -s --no-print-directory str-rules'])
test('T13170', only_ways(['optasm']), compile, ['-dcore-lint'])
test('T13317',
normal,
run_command,
['$MAKE -s --no-print-directory T13317'])
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment