diff options
| author | Bartosz Nitka <bnitka@fb.com> | 2015-12-02 06:20:55 -0800 |
|---|---|---|
| committer | Bartosz Nitka <bnitka@fb.com> | 2015-12-04 06:06:40 -0800 |
| commit | 5b2b7e338c822c34f86e8bd3ff442a979711d1fe (patch) | |
| tree | 39dabae92cf385731229c6b2320dc24f7ee6e7b7 /testsuite/tests/determinism | |
| parent | 96e67c014e9b8022599bbe19f67d1635f4955ce0 (diff) | |
| download | haskell-5b2b7e338c822c34f86e8bd3ff442a979711d1fe.tar.gz | |
Make callToPats deterministic in SpecConstr
This fixes a non-determinism bug where where depending on the
order of uniques allocated, the specialized workers would have different
order of arguments.
Compare:
```
$s$wgo_s1CN :: Int# -> Int -> Int#
[LclId, Arity=2, Str=DmdType <L,U><L,U>]
$s$wgo_s1CN =
\ (sc_s1CI :: Int#) (sc_s1CJ :: Int) ->
case tagToEnum# @ Bool (<=# sc_s1CI 0#) of _ [Occ=Dead] {
False ->
$wgo_s1BU (Just @ Int (I# (-# sc_s1CI 1#))) (Just @ Int sc_s1CJ);
True -> 0#
}
```
vs
```
$s$wgo_s18mTj :: Int -> Int# -> Int#
[LclId, Arity=2, Str=DmdType <L,U><L,U>]
$s$wgo_s18mTj =
\ (sc_s18mTn :: Int) (sc_s18mTo :: Int#) ->
case tagToEnum# @ Bool (<=# sc_s18mTo 0#) of _ [Occ=Dead] {
False ->
$wgo_s18mUc
(Just @ Int (I# (-# sc_s18mTo 1#))) (Just @ Int sc_s18mTn);
True -> 0#
}
```
Test Plan:
I've added a new testcase
./validate
Reviewers: simonmar, simonpj, austin, goldfire, bgamari
Reviewed By: bgamari
Subscribers: thomie
Differential Revision: https://phabricator.haskell.org/D1508
GHC Trac Issues: #4012
Diffstat (limited to 'testsuite/tests/determinism')
4 files changed, 59 insertions, 0 deletions
diff --git a/testsuite/tests/determinism/simplCore/should_compile/Makefile b/testsuite/tests/determinism/simplCore/should_compile/Makefile new file mode 100644 index 0000000000..4512271217 --- /dev/null +++ b/testsuite/tests/determinism/simplCore/should_compile/Makefile @@ -0,0 +1,13 @@ +TOP=../../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +TEST_HC_OPTS_NO_RECOMP = $(filter-out -fforce-recomp,$(TEST_HC_OPTS)) + +determ006: + $(RM) spec-inline-determ.hi spec-inline-determ.o + '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -O2 spec-inline-determ.hs + $(CP) spec-inline-determ.hi spec-inline-determ.old.hi + $(RM) spec-inline-determ.o + '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -dinitial-unique=16777206 -dunique-increment=-1 -O2 spec-inline-determ.hs + diff spec-inline-determ.hi spec-inline-determ.old.hi diff --git a/testsuite/tests/determinism/simplCore/should_compile/all.T b/testsuite/tests/determinism/simplCore/should_compile/all.T new file mode 100644 index 0000000000..e0d5238bf8 --- /dev/null +++ b/testsuite/tests/determinism/simplCore/should_compile/all.T @@ -0,0 +1,4 @@ +test('determ006', + extra_clean(['spec-inline-determ.o', 'spec-inline-determ.hi', 'spec-inline-determ.normal.hi']), + run_command, + ['$MAKE -s --no-print-directory determ006']) diff --git a/testsuite/tests/determinism/simplCore/should_compile/determ006.stdout b/testsuite/tests/determinism/simplCore/should_compile/determ006.stdout new file mode 100644 index 0000000000..138d4023c5 --- /dev/null +++ b/testsuite/tests/determinism/simplCore/should_compile/determ006.stdout @@ -0,0 +1,2 @@ +[1 of 1] Compiling Roman ( spec-inline-determ.hs, spec-inline-determ.o ) +[1 of 1] Compiling Roman ( spec-inline-determ.hs, spec-inline-determ.o ) diff --git a/testsuite/tests/determinism/simplCore/should_compile/spec-inline-determ.hs b/testsuite/tests/determinism/simplCore/should_compile/spec-inline-determ.hs new file mode 100644 index 0000000000..9bc79018de --- /dev/null +++ b/testsuite/tests/determinism/simplCore/should_compile/spec-inline-determ.hs @@ -0,0 +1,40 @@ +module Roman where + +-- This is a simplified version of simplCore/should_compile/spec-inline.hs +-- +-- It reproduces a problem where workers get specialized in different ways +-- depending on the values of uniques. +-- +-- Compare: +-- +-- $s$wgo_s1CN :: Int# -> Int -> Int# +-- [LclId, Arity=2, Str=DmdType <L,U><L,U>] +-- $s$wgo_s1CN = +-- \ (sc_s1CI :: Int#) (sc_s1CJ :: Int) -> +-- case tagToEnum# @ Bool (<=# sc_s1CI 0#) of _ [Occ=Dead] { +-- False -> +-- $wgo_s1BU (Just @ Int (I# (-# sc_s1CI 1#))) (Just @ Int sc_s1CJ); +-- True -> 0# +-- } +-- +-- vs +-- +-- $s$wgo_s18mTj :: Int -> Int# -> Int# +-- [LclId, Arity=2, Str=DmdType <L,U><L,U>] +-- $s$wgo_s18mTj = +-- \ (sc_s18mTn :: Int) (sc_s18mTo :: Int#) -> +-- case tagToEnum# @ Bool (<=# sc_s18mTo 0#) of _ [Occ=Dead] { +-- False -> +-- $wgo_s18mUc +-- (Just @ Int (I# (-# sc_s18mTo 1#))) (Just @ Int sc_s18mTn); +-- True -> 0# +-- } + +foo :: Int -> Int +foo n = + go (Just n) (Just (6::Int)) + where + go Nothing (Just x) = go (Just 10) (Just x) + go (Just n) (Just x) + | n <= 0 = 0 + | otherwise = go (Just (n-1)) (Just x) |