diff options
| author | Andrew Martin <andrew.thaddeus@gmail.com> | 2019-11-13 11:20:05 -0500 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-05-23 13:37:01 -0400 |
| commit | 49301ad6226d9a83d110bee8c419615dd94f5ded (patch) | |
| tree | 907c00e2c81d1f2025ad569cedf2bc39833bcb07 /testsuite/tests/primops | |
| parent | d830bbc9921bcc59164a0a18f0e0874ae4ce226e (diff) | |
| download | haskell-49301ad6226d9a83d110bee8c419615dd94f5ded.tar.gz | |
Implement cstringLength# and FinalPtr
This function and its accompanying rule resolve issue #5218.
A future PR to the bytestring library will make the internal
Data.ByteString.Internal.unsafePackAddress compute string length
with cstringLength#. This will improve the status quo because it is
eligible for constant folding.
Additionally, introduce a new data constructor to ForeignPtrContents
named FinalPtr. This additional data constructor, when used in the
IsString instance for ByteString, leads to more Core-to-Core
optimization opportunities, fewer runtime allocations, and smaller
binaries.
Also, this commit re-exports all the functions from GHC.CString
(including cstringLength#) in GHC.Exts. It also adds a new test
driver. This test driver is used to perform substring matches on Core
that is dumped after all the simplifier passes. In this commit, it is
used to check that constant folding of cstringLength# works.
Diffstat (limited to 'testsuite/tests/primops')
6 files changed, 51 insertions, 0 deletions
diff --git a/testsuite/tests/primops/should_gen_core/CStringLength_core.hs b/testsuite/tests/primops/should_gen_core/CStringLength_core.hs new file mode 100644 index 0000000000..98d33d5f51 --- /dev/null +++ b/testsuite/tests/primops/should_gen_core/CStringLength_core.hs @@ -0,0 +1,11 @@ +{-# language MagicHash #-} + +module CStringLengthCore + ( ozymandias + ) where + +import GHC.Exts + +ozymandias :: Int +ozymandias = + I# (cstringLength# "I met a traveller from an antique land"#) diff --git a/testsuite/tests/primops/should_gen_core/CStringLength_core.substr-simpl b/testsuite/tests/primops/should_gen_core/CStringLength_core.substr-simpl new file mode 100644 index 0000000000..4b33d6629d --- /dev/null +++ b/testsuite/tests/primops/should_gen_core/CStringLength_core.substr-simpl @@ -0,0 +1 @@ +I# 38# diff --git a/testsuite/tests/primops/should_gen_core/all.T b/testsuite/tests/primops/should_gen_core/all.T new file mode 100644 index 0000000000..d66255d8a1 --- /dev/null +++ b/testsuite/tests/primops/should_gen_core/all.T @@ -0,0 +1 @@ +test('CStringLength_core', normal, compile_grep_core, ['']) diff --git a/testsuite/tests/primops/should_run/CStringLength.hs b/testsuite/tests/primops/should_run/CStringLength.hs new file mode 100644 index 0000000000..b580e61934 --- /dev/null +++ b/testsuite/tests/primops/should_run/CStringLength.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} + +import GHC.Exts + +main :: IO () +main = do + putStr "A: " + print $ + I# (cstringLength# "hello_world"#) + == + naiveStrlen "hello_world"# 0 + putStr "B: " + print $ + I# (cstringLength# "aaaaaaaaaaaaa\x00b"#) + == + naiveStrlen "aaaaaaaaaaaaa\x00b"# 0 + putStr "C: " + print $ + I# (cstringLength# "cccccccccccccccccc\x00b"#) + == + naiveStrlen "cccccccccccccccccc\x00b"# 0 + putStr "D: " + print $ + I# (cstringLength# "araña\NULb"#) + == + naiveStrlen "araña\NULb"# 0 + +naiveStrlen :: Addr# -> Int -> Int +naiveStrlen addr !n = case indexWord8OffAddr# addr 0# of + 0## -> n + _ -> naiveStrlen (plusAddr# addr 1#) (n + 1) diff --git a/testsuite/tests/primops/should_run/CStringLength.stdout b/testsuite/tests/primops/should_run/CStringLength.stdout new file mode 100644 index 0000000000..9413913c01 --- /dev/null +++ b/testsuite/tests/primops/should_run/CStringLength.stdout @@ -0,0 +1,4 @@ +A: True +B: True +C: True +D: True diff --git a/testsuite/tests/primops/should_run/all.T b/testsuite/tests/primops/should_run/all.T index 16579207fa..952145fd49 100644 --- a/testsuite/tests/primops/should_run/all.T +++ b/testsuite/tests/primops/should_run/all.T @@ -29,3 +29,4 @@ test('CmpWord16', normal, compile_and_run, ['']) test('ShrinkSmallMutableArrayA', normal, compile_and_run, ['']) test('ShrinkSmallMutableArrayB', normal, compile_and_run, ['']) test('T14664', normal, compile_and_run, ['']) +test('CStringLength', normal, compile_and_run, ['-O2']) |