New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Show: Activate literal rewrite rules in simplifier phase 1 #129

merged 5 commits into from Aug 11, 2015
File filter...
Filter file types
Jump to file or symbol
Failed to load files and symbols.
+77 −6
Diff settings


Just for now

Copy path View file
@@ -50,19 +50,19 @@ unpackCString# :: Addr# -> Text
unpackCString# addr# = unstream (S.streamCString# addr#)
{-# NOINLINE unpackCString# #-}

{-# RULES "TEXT literal" forall a.
{-# RULES "TEXT literal" [1] forall a.
unstream ( safe (S.streamList (GHC.unpackCString# a)))
= unpackCString# a #-}

{-# RULES "TEXT literal UTF8" forall a.
{-# RULES "TEXT literal UTF8" [1] forall a.
unstream ( safe (S.streamList (GHC.unpackCStringUtf8# a)))
= unpackCString# a #-}

{-# RULES "TEXT empty literal"
{-# RULES "TEXT empty literal" [1]
unstream ( safe (S.streamList []))
= empty_ #-}

{-# RULES "TEXT singleton literal" forall a.
{-# RULES "TEXT singleton literal" [1] forall a.
unstream ( safe (S.streamList [a]))
= singleton_ a #-}

Copy path View file
@@ -1,3 +1,19 @@

* Bug fix: As it turns out, moving the literal rewrite rules to simplifier
phase 2 does not prevent competition with the `unpack` rule, which is
also active in this phase. Unfortunately this was hidden due to a silly
test environment mistake. Moving literal rules back to phase 1 finally
fixes GHC Trac #10528 correctly.

* Bug fix: Run literal rewrite rules in simplifier phase 2.
The behavior of the simplifier changed in GHC 7.10.2,
causing these rules to fail to fire, leading to poor code generation
and long compilation times. See
[GHC Trac #10528](

* Expose unpackCString#, which you should never use.
Copy path View file
@@ -0,0 +1,21 @@
{-# LANGUAGE OverloadedStrings #-}

module LiteralRuleTest where

import Data.Text (Text)

-- This should produce 8 firings of the "TEXT literal" rule
strings :: [Text]
strings = [ "abstime", "aclitem", "bit", "bool", "box", "bpchar", "bytea", "char" ]

-- This should produce 7 firings of the "TEXT literal UTF8" rule
utf8Strings :: [Text]
utf8Strings = [ "\0abstime", "\0aclitem", "\xfefe bit", "\0bool", "\0box", "\0bpchar", "\0bytea" ]

-- This should produce 4 firings of the "TEXT empty literal" rule
empties :: [Text]
empties = [ "", "", "", "" ]

-- This should produce 5 firings of the "TEXT empty literal" rule
--singletons :: [Text]
--singletons = [ "a", "b", "c", "d", "e" ]
Copy path View file
@@ -1,5 +1,10 @@
count = 1000

all: coverage literal-rule-test


coverage: build coverage/hpc_index.html

build: text-test-data
@@ -32,4 +37,4 @@ coverage/hpc_index.html: coverage/coverage.tix
rm -rf dist coverage .hpc

.PHONY: build coverage
.PHONY: build coverage all literal-rule-test
Copy path View file
@@ -0,0 +1,29 @@
#!/bin/bash -e


function check_firings() {
build="ghc -O -ddump-rule-firings LiteralRuleTest.hs"
build="$build -i.. -I../include -DMIN_VERSION_bytestring(a,b,c)=1"
touch LiteralRuleTest.hs
echo -n "Want to see $expected firings of rule $rule... " >&2
firings=$($build 2>&1 | grep "Rule fired: $rule\$" | wc -l)
rm -f LiteralRuleTest.{o.hi}

if [ $firings != $expected ]; then
echo "failed, saw $firings" >&2
echo "pass" >&2

check_firings "TEXT literal" 8
check_firings "TEXT literal UTF8" 7
check_firings "TEXT empty literal" 4
# This is broken at the moment. "TEXT literal" rule fires instead.
#check_firings "TEXT singleton literal" 5

exit $failed
Copy path View file
@@ -1,5 +1,5 @@
name: text
synopsis: An efficient packed Unicode text type.
ProTip! Use n and p to navigate between commits in a pull request.