Lift constructor tag allocation out of a loop

Before this change, for each constructor that we want
to allocate a tag for we would traverse a list of all
the constructors in a datatype to determine which tag
a constructor should get.

This is obviously quadratic and for datatypes with 10k
constructors it actually makes a big difference.

This change implements the plan outlined by @simonpj in
https://mail.haskell.org/pipermail/ghc-devs/2017-October/014974.html
which is basically about using a map and constructing it outside the
loop.

One place where things got a bit awkward was TysWiredIn.hs,
it would have been possible to just assign the tags by hand, but
that seemed error-prone to me, so I decided to go through a map
there as well.

Test Plan:
./validate
On a file with 10k constructors
Before:
   8,130,522,344 bytes allocated in the heap
  Total   time    3.682s  (  3.920s elapsed)
After:
   4,133,478,744 bytes allocated in the heap
  Total   time    2.509s  (  2.750s elapsed)

Reviewers: simonpj, bgamari

Reviewed By: simonpj

Subscribers: goldfire, rwbarton, thomie, simonmar, carter, simonpj

GHC Trac Issues: #14657

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

2 files changed, 37 insertions, 0 deletions

diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T
index 61b61ae78a..bd038a2407 100644
--- a/testsuite/tests/perf/compiler/all.T
+++ b/testsuite/tests/perf/compiler/all.T
@@ -1154,6 +1154,18 @@ test('MultiLayerModules',
      multimod_compile,
      ['MultiLayerModules', '-v0'])
 
+test('ManyConstructors',
+     [ compiler_stats_num_field('bytes allocated',
+          [(wordsize(64), 4246959352, 10),
+          # initial:    8130527160
+          # 2018-01-05: 4246959352  Lift constructor tag allocation out of a loop
+          ]),
+       pre_cmd('./genManyConstructors'),
+       extra_files(['genManyConstructors']),
+     ],
+     multimod_compile,
+     ['ManyConstructors', '-v0'])
+
 test('T13701',
      [ compiler_stats_num_field('bytes allocated',
           [(platform('x86_64-apple-darwin'), 2217187888, 10),
diff --git a/testsuite/tests/perf/compiler/genManyConstructors b/testsuite/tests/perf/compiler/genManyConstructors
new file mode 100755
index 0000000000..ec4abdced7
--- /dev/null
+++ b/testsuite/tests/perf/compiler/genManyConstructors
@@ -0,0 +1,25 @@
+SIZE=10000
+MODULE=ManyConstructors
+
+# Generates a module with a large number of constructors that looks
+# like this:
+#
+#   module ManyConstructors where
+#
+#   data A10000 = A0
+#     | A00001
+#     | A00002
+#     ...
+#     | A10000
+#
+# The point of this test is to check if we don't regress on #14657 reintroducing
+# some code that's quadratic in the number of constructors in a data type.
+# NB. This is not that artificial, I've seen data types of this size
+# in the wild.
+
+echo "module $MODULE where" > $MODULE.hs
+echo >> $MODULE.hs
+echo "data A$SIZE = A0" >> $MODULE.hs
+for i in $(seq -w 1 $SIZE); do
+  echo "  | A$i" >> $MODULE.hs
+done