Trim the demand for recursive product types

Ticket #18304 showed that we need to be very careful
when exploring the demand (esp usage demand) on recursive
product types.

This patch solves the problem by trimming the demand on such types --
in effect, a form of "widening".

See the Note [Trimming a demand to a type] in DmdAnal, which explains
how I did this by piggy-backing on an existing mechansim for trimming
demands becuase of GADTs.  The significant payload of this patch is
very small indeed:

* Make GHC.Core.Opt.WorkWrap.Utils.typeShape use RecTcChecker to
  avoid looking through recursive types.

But on the way

* I found that ae_rec_tc was entirely inoperative and did nothing.
  So I removed it altogether from DmdAnal.

* I moved some code around in DmdAnal and Demand.
  (There are no actual changes in dmdFix.)

* I changed the API of DmsAnal.dmdAnalRhsLetDown to return
  a StrictSig rather than a decorated Id

* I removed the dead function peelTsFuns from Demand

Performance effects:

Nofib: 0.0% changes.  Not surprising, because they don't
       use recursive products

Perf tests

T12227:
  1% increase in compiler allocation, becuase $cto gets w/w'd.
  It did not w/w before because it takes a deeply nested
  argument, so the worker gets too many args, so we abandon w/w
  altogether (see GHC.Core.Opt.WorkWrap.Utils.isWorkerSmallEnough)

  With this patch we trim the demands.  That is not strictly
  necessary (since these Generic type constructors are like
  tuples -- they can't cause a loop) but the net result is that
  we now w/w $cto which is fine.

UniqLoop:
  16% decrease in /runtime/ allocation. The UniqSupply is a
  recursive product, so currently we abandon all strictness on
  'churn'.  With this patch 'churn' gets useful strictness, and
  we w/w it.  Hooray

Metric Decrease:
    UniqLoop

Metric Increase:
    T12227

2 files changed, 73 insertions, 0 deletions

diff --git a/testsuite/tests/perf/compiler/T18304.hs b/testsuite/tests/perf/compiler/T18304.hs
new file mode 100644
index 0000000000..5902f52355
--- /dev/null
+++ b/testsuite/tests/perf/compiler/T18304.hs
@@ -0,0 +1,67 @@
+{-# LANGUAGE RecordWildCards, PatternGuards #-}
+{-# OPTIONS_GHC -Wunused-binds #-}
+
+module Text.HTML.TagSoup.Specification
+    (dat, Out(..) )
+where
+
+-- Code taken from the tagsoup library, which is BSD-3-licensed.
+
+import Data.Char (isAlpha, isAlphaNum, isDigit, toLower)
+
+data TypeTag = TypeNormal -- <foo
+             | TypeXml    -- <?foo
+             | TypeDecl   -- <!foo
+             | TypeScript -- <script
+               deriving Eq
+
+
+type Parser = S -> [Out]
+
+-- 8.2.4.1 Data state
+dat :: S -> [Out]
+dat S{..} = tagName TypeXml tl
+
+-- 8.2.4.5 Tag name state
+tagName :: TypeTag -> S -> [Out]
+tagName typ S{..} = case hd of
+    'a' -> beforeAttName typ tl
+
+-- 8.2.4.6 Before attribute name state
+beforeAttName :: TypeTag -> S -> [Out]
+beforeAttName typ S{..} = case hd of
+    _ | hd `elem` "=" -> beforeAttValue typ s -- NEIL
+
+-- 8.2.4.9 Before attribute value state
+beforeAttValue :: TypeTag -> S -> [Out]
+beforeAttValue typ S{..} = case hd of
+    'a' -> beforeAttValue typ tl
+    '&' -> attValueUnquoted typ s
+
+-- 8.2.4.12 Attribute value (unquoted) state
+attValueUnquoted :: TypeTag -> Parser
+attValueUnquoted typ S{..} = case hd of
+    '?' -> neilXmlTagClose tl
+    'a' -> beforeAttName typ tl
+    'b' -> attValueUnquoted typ tl
+
+-- seen "?", expecting ">"
+neilXmlTagClose :: S -> [Out]
+neilXmlTagClose S{..} = case hd of
+    '>' -> dat tl
+    _ -> beforeAttName TypeXml s
+
+-----
+-- Text.HTML.TagSoup.Implementation
+-----
+
+data Out = SomeOut
+
+
+data S = S
+    { s :: S
+    , tl :: S
+    ,hd :: Char
+    ,eof :: Bool
+    }
+
diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T
index 912a172c85..611d8b4390 100644
--- a/testsuite/tests/perf/compiler/all.T
+++ b/testsuite/tests/perf/compiler/all.T
@@ -358,3 +358,9 @@ test('T16190',
       ['T16190.hs', '-v0'])
 
 test('T16473', normal, makefile_test, ['T16473'])
+
+test ('T18304',
+      [ collect_compiler_stats('bytes allocated',2)
+      ],
+      compile,
+      ['-v0 -O'])