Make abstractVars deterministic in SetLevel

This fixes a non-determinism bug where depending on the order
of uniques allocated, the type variables would be in a different order
when abstracted for the purpose of lifting out an expression.

Test Plan:
I've added a new testcase that reproduces the problem
./validate

Reviewers: simonmar, austin, bgamari, simonpj

Reviewed By: simonpj

Subscribers: nomeata, thomie

Differential Revision: https://phabricator.haskell.org/D1504

GHC Trac Issues: #4012

4 files changed, 71 insertions, 0 deletions

diff --git a/testsuite/tests/determinism/typecheck/A.hs b/testsuite/tests/determinism/typecheck/A.hs
new file mode 100644
index 0000000000..50b3ab1db2
--- /dev/null
+++ b/testsuite/tests/determinism/typecheck/A.hs
@@ -0,0 +1,52 @@
+module A (
+  ) where
+
+-- This reproduces the issue where type variables would be lifted out in
+-- different orders. Compare:
+--
+-- lvl =
+--   \ (@ (c :: * -> *)) (@ (t :: * -> *)) ->
+--     undefined
+--     @ ((forall d. Data d => c (t d))
+--        -> Maybe (c Node))
+--     (some Callstack thing)
+--
+-- $cdataCast1 =
+--   \ (@ (c :: * -> *)) (@ (t :: * -> *)) _ [Occ=Dead] ->
+--     lvl @ c @ t
+--
+-- vs
+--
+-- lvl =
+--   \ (@ (t :: * -> *)) (@ (c :: * -> *)) ->
+--     undefined
+--     @ ((forall d. Data d => c (t d))
+--        -> Maybe (c Node))
+--     (some Callstack thing)
+--
+-- $cdataCast1 =
+--   \ (@ (c :: * -> *)) (@ (t :: * -> *)) _ [Occ=Dead] ->
+--     lvl @ t @ c
+
+import Data.Data
+
+data Node = Node (Maybe Int) [Node]
+
+instance Data Node where
+
+  gfoldl = gfoldl
+  gunfold = gunfold
+  toConstr = toConstr
+  dataTypeOf = dataTypeOf
+
+  dataCast1 = undefined
+  dataCast2 = dataCast2
+
+  gmapT = gmapT
+  gmapQl = gmapQl
+  gmapQr = gmapQr
+  gmapQ = gmapQ
+  gmapQi = gmapQi
+  gmapM = gmapM
+  gmapMp = gmapMp
+  gmapMo = gmapMo
diff --git a/testsuite/tests/determinism/typecheck/Makefile b/testsuite/tests/determinism/typecheck/Makefile
new file mode 100644
index 0000000000..f95bfc55bf
--- /dev/null
+++ b/testsuite/tests/determinism/typecheck/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))
+
+determ005:
+	$(RM) A.hi A.o
+	'$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -O A.hs
+	$(CP) A.hi A.old.hi
+	$(RM) A.o
+	'$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -dinitial-unique=16777206 -dunique-increment=-1 -O A.hs
+	diff A.hi A.old.hi
diff --git a/testsuite/tests/determinism/typecheck/all.T b/testsuite/tests/determinism/typecheck/all.T
new file mode 100644
index 0000000000..5696cefdfa
--- /dev/null
+++ b/testsuite/tests/determinism/typecheck/all.T
@@ -0,0 +1,4 @@
+test('determ005',
+     extra_clean(['A.o', 'A.hi', 'A.normal.hi']),
+     run_command,
+     ['$MAKE -s --no-print-directory determ005'])
diff --git a/testsuite/tests/determinism/typecheck/determ005.stdout b/testsuite/tests/determinism/typecheck/determ005.stdout
new file mode 100644
index 0000000000..60c2bc368d
--- /dev/null
+++ b/testsuite/tests/determinism/typecheck/determ005.stdout
@@ -0,0 +1,2 @@
+[1 of 1] Compiling A                ( A.hs, A.o )
+[1 of 1] Compiling A                ( A.hs, A.o )