diff --git a/HTML/deepseq-bounded.html b/HTML/deepseq-bounded.html
new file mode 100644
--- /dev/null
+++ b/HTML/deepseq-bounded.html
@@ -0,0 +1,597 @@
+<!DOCTYPE html>
+<html>
+<head>
+<title>Bounded DeepSeq</title>
+<link rel="stylesheet" href="style.css" />
+</head>
+<body>
+
+<div class="main">
+
+<!--
+<p>
+<br />
+<span class="red">Hyperlinks aren't set up yet.</span>
+<p>
+<span class="red">The introductory part, at least, needs a rewrite!</span>
+<p>
+<span class="red">Also, am I going to stay with this convention of having the download links take up the first section of every such posting?</span>
+<p>
+<span class="red">The PatAlg section needs updating; which should probably wait until done these new ideas (Seqable, the P* PatNode's, the S* PatNode's).</span>
+-->
+
+<h2 style="margin-top: 50px;">Bounded Forcing</h2>
+
+<!--
+<h3>Download</h3>
+
+Here's <a href="deepseq-bounded-1.3.0.2.tar.gz">full source</a> (BSD3-licensed, Cabal sdist) for:
+<ul>
+<li>building the library
+<li>building the testbench corresponding to the examples in this post.
+</ul>
+
+<p>
+
+On Hackage: <a href="http://hackage.haskell.org/package/deepseq-bounded">deepseq-bounded</a>
+
+-->
+
+<!--div>
+<p>
+<Haddock API <a href="api/html/deepseq-bounded/index.html">here</a>.
+</div-->
+
+The <a href="http://hackage.haskell.org/package/deepseq-bounded">deepseq-bounded</a> package provides two means of forcing a Haskell expression to an arbitrary but bounded depth, <tt>deepseqn</tt> and <tt>deepseqp</tt>.
+As compared with plain <tt>seq</tt> (incremental forcing) and the beloved <tt>deepseq</tt> (full forcing), the bounded versions bridge the gap between these extremes.
+<p>
+Artificially forcing evaluation can be useful to relieve space leak, measure and tune performance, influence exception behaviour, make lazy I/O happen in a timely manner, and assure threads don't accidentally pass unevaluated computations to other threads ("time leak").
+Bounded forcing (what this package offers) is necessary to work with streams, and other "infinite" datastructures, where plain <tt>rnf</tt>/<tt>deepseq</tt>/<tt>force</tt> will diverge.
+<p>
+<a id="dig03s" class="dig-toggle-show" href='javascript:toggle("dig03");' style="margin-left: 0px;">Show</a>
+<div id="dig03" class="digression" style="margin-left: 0px;">
+<a id="dig03h" class="dig-toggle-hide" href='javascript:toggle("dig03");'>Hide</a><p>
+My particular motivation for <tt>deepseq-bounded</tt> is to support tool building for space leak characterisation (and provisional alleviation).
+Readers interested in those aspects might like to have a look at <a href="http://hackage.haskell.org/package/seqaid">seqaid</a> and <a href="http://hackage.haskell.org/package/leaky">leaky</a>.
+Space leak is still an Achilles' heel of Haskell, they're often fatally severe, and can be as hard to debug as anything you see in other languages.
+With the present tools in use, it's fair to say Haskell space leak is more difficult to diagnose than pointer bugs in C/C++, being perhaps on a par with concurrent programming bugs (probably the most difficult class of bugs in all of contemporary computing).
+People talk about strict-by-default Haskell in the future, but it remains there, and anyway, lazyness has its charm and strengths and is attractive to many.
+</div>
+
+<p>
+The bounded forcing functions also have theoretical interest, spanning the <tt>seq</tt> / <tt>deepseq</tt> axis.
+They can be considered in a broader context of, for instance, strictness analysis and evaluation transformers.
+
+<h3>Library Design Overview</h3>
+
+Following the tradition of the <a href="http://hackage.haskell.org/package/deepseq">deepseq</a> package, the <tt>NFDataN</tt> module contains a class <tt>NFDataN</tt>, with a method called <tt>rnfn</tt>, instances of which do the work of forcing bounded evaluation.
+Additional functions <tt>deepseqn</tt> and <tt>forcen</tt> are provided, like in <tt>NFData</tt>.
+<tt>NFDataP</tt> also follows this design.
+<p>
+The <tt>NFDataN</tt> module is straightforward; the familiar method and functions of <tt>DeepSeq</tt> have an '<tt>n</tt>' appended to their names, and take an integer first argument which is the minimum depth, in levels of recursion of constructor applications, to which to force evaluation.
+<pre>
+rnfn      :: NFDataN a =&gt; Int -&gt; a -&gt; ()
+deepseqn  :: NFDataN a =&gt; Int -&gt; a -&gt; b -&gt; b
+forcen    :: NFDataN a =&gt; Int -&gt; a -&gt; a
+</pre>
+<p>
+It is important to note that this is a <em>minimum</em> bound only, since (for example) the runtime system may have speculatively evaluated more of the value already.
+Such behaviour is deliberately unspecified, platform dependent, and outside of our control.
+Also note likewise that, as per <tt>DeepSeq</tt>, no guarantees are made about order of evaluation in the above method and functions.
+<p>
+With <tt>NFDataP</tt>, the extent of evaluation is determined by a value of <tt>Pattern</tt> type.
+One feature of <tt>NFDataP</tt> is the ability to <a href="#order">control order</a> of evaluation.
+<p>
+Usually a user of this library will prefer to compile their patterns from a string in the embedded pattern DSL, but the <tt>Pattern</tt> constructors can be worked with directly.
+
+<p>
+<a id="dig04s" class="dig-toggle-show" href='javascript:toggle("dig04");' style="margin-left: 0px;">Show</a>
+<div id="dig04" class="digression" style="margin-left: 0px;">
+<a id="dig04h" class="dig-toggle-hide" href='javascript:toggle("dig04");'>Hide</a><p>
+<pre style="width: 800px;">
+rnfp      :: NFDataP a =&gt; Pattern -&gt; a -&gt; ()
+deepseqp_ :: NFDataP a =&gt; Pattern -&gt; a -&gt; b -&gt; b
+forcep_   :: NFDataP a =&gt; Pattern -&gt; a -&gt; a
+
+data Pattern = Node PatNode [Pattern]
+data PatNode = WR | WS | WW | ...
+
+deepseqp  :: NFDataP a =&gt; String -&gt; a -&gt; b -&gt; b
+forcep    :: NFDataP a =&gt; String -&gt; a -&gt; a
+
+deepseqp = deepseqp_ . compilePat 
+forcep   = forcep_ . compilePat 
+
+compilePat :: String -&gt; Pattern
+</pre>
+</div>
+
+<p>
+More examples are given further down this page, but here is one example to illustrate the use of <tt>NFDataP</tt>.
+There is no essential dependence on <tt>rnf</tt> (from <tt>DeepSeq</tt>), but it is available as <tt>*</tt> and helps to concoct an example.
+
+<pre>
+  expr = (   undefined :: SomeType
+           , ( someValueWantToForce, [2,4..] )
+           , anotherValueWantToForce
+         )
+
+
+  forcep ".{#.{*#}*}" expr
+
+= forcep_ ( compilePat ".{#.{*#}*}" ) expr
+
+= forcep_ (Node WR [Node WI [],Node WR [Node WW [],Node WI []],Node WW []]) expr
+</pre>
+
+<p>
+which can be translated as
+
+<pre>
+= let someval = someValueWeWantToForce
+      another = anotherValueWeWantToForce
+  in
+        rnf someval
+  `seq` rnf another
+  `seq` expr
+</pre>
+
+<p>
+<div class="digression" style="padding-bottom: 0px;">
+This final translation is actually not quite correct &mdash; <tt>forcep</tt> forces the spine of the paths from <tt>expr</tt> to the substructures we want to hammer with <tt>rnf</tt>, but this translation does not.
+In particular, the pair constructor <tt>(,)</tt> for <tt>( someValueWantToForce, [2,4..] )</tt> is forced by <tt>forcep</tt>, but not by this translation.
+<p>
+This has no semantic impact, because it only concerns interior nodes, never leaves, and bottoms are always leaves.
+It may burn a few more cycles to force paths, but it always produces the same value as the translation, given the same inputs.
+</div>
+
+<p>
+The pattern <tt>".{#.{*#}*}"</tt> will match any ternary constructor, ignoring the first subexpression, completely forcing the third, and recursively matching subpattern <tt>".{*#}"</tt> on the middle subexpression.
+
+<p>
+
+It's worth emphasising that pattern-matching requires forcing constructors along the way.
+That is to say, every node in the path from the root to a node being pattern-matched is already forced.
+So the shape of these forcing functions is always a rooted tree, with the root node corresponding to the outermost redex of the expression being forced.
+
+<h3>Formally</h3>
+
+<!--span class="red">Is this correct only relative to an arbitrary but fixed value?</span-->
+
+<p>
+In general, the behaviour can be formalised
+<!-- &sc; &sccue; -->
+<!-- &#8827; &#8829; -->
+<pre>
+        b &gt; a  &rArr;                forcen b  &#8827;  forcen a    -- (strict) monotonicity
+                  &or;  &forall; c &gt; b .  forcen c  =  forcen a    -- convergence
+</pre>
+<p>
+and
+<pre>
+  patB &sup; patA  &rArr;                      forcep patB  &#8827;  forcep patA
+                  &or;  &forall; patC &sup; patB .  forcep patC  =  forcep patB
+</pre>
+<p>
+where <tt>f &#8827; g</tt> says "<tt>f</tt> causes deeper evaluation than <tt>g</tt>".
+
+<p>
+Only strict monotonicity is interesting, since non-decreasing monotonicity <tt>&#8829;</tt> is axiomatic:
+you cannot unevaluate anything (push thunks back on the heap?...).
+
+<h3>Parallelism</h3>
+
+Varieties of <tt>PatNode</tt> to trigger <tt>Control.Parallel.par</tt> parallel evaluation are of interest.
+This is supported by the new <tt>PR</tt>, <tt>PN</tt> and <tt>PW</tt> <tt>PatNode</tt> constructors.
+In the DSL such nodes are represented by preceding them with an <tt>=</tt> character.
+This is new work and not yet completely implemented, but it's very straightforward.
+
+<p>
+So, revisiting our example
+
+<pre>
+  expr = (   undefined :: SomeType
+           , ( someValueWantToForce, [2,4..] )
+           , anotherValueWantToForce
+         )
+
+
+  forcep ".{#.{=*#}*}" expr
+
+= forcep_ ( compilePat ".{#.{=*#}*}" ) expr
+
+= forcep_ (Node WR [Node WI [],Node WR [Node PW [],Node WI []],Node WW []]) expr
+</pre>
+
+<p>
+which translates approximately as
+
+<a id="order"></a>
+<pre>
+= let someval = someValueWeWantToForce
+      another = anotherValueWeWantToForce
+  in
+        rnf someval
+  `par` rnf another   -- note `par` (not `seq`)
+  `seq` expr
+</pre>
+
+<p>
+In particular, <tt>rnf someval</tt> will be sparked in parallel with the remainder of the forcing (<tt>rnf another</tt>).
+
+<h3>Controlling Evaluation Order</h3>
+
+We've noted that <tt>seq</tt> makes no guarantees about order of evaluation of its arguments.
+This is concisely explained in the <a href="http://hackage.haskell.org/package/parallel-3.2.0.5/docs/Control-Parallel.html">Control.Parallel</a> API document.
+Plain <tt>seq</tt> is strict in its second argument, so the evaluation semantics for <tt>x `seq` y</tt> amount to no guarantees at all about the order in which <tt>x</tt> and <tt>y</tt> are evaluated.
+Evaluation of <tt>x</tt> and <tt>y</tt> is probably interleaved, in general.
+
+<p>
+In the previous section, we saw how to force parallel evaluation in <tt>NFDataP</tt> using <tt>par</tt> from <tt>Control.Parallel</tt>.
+It is also possible to enforce sequencing of computations by leveraging the other primitive of <tt>Control.Parallel</tt>, namely <tt>pseq</tt>:
+
+<pre>
+pseq x y = x `seq` lazy y
+</pre>
+<p>
+where <a href="http://hackage.haskell.org/package/base-4.7.0.1/docs/GHC-Exts.html#v:lazy"><tt>lazy</tt></a> is a GHC primitve that prevents strictness of the second argument.
+In fact <tt>lazy</tt> is one of just two definitions living in the internal module <tt>GHC.Magic</tt> in the GHC source (the other is <tt>inline</tt>).
+Quoting from the source in <a href="http://hackage.haskell.org/package/base/docs/src/GHC-Conc-Sync.html#pseq">base</a>
+
+<pre>
+-- The reason for the strange "lazy" call is that
+-- it fools the compiler into thinking that pseq  and par are non-strict in
+-- their second argument (even if it inlines pseq at the call site).
+-- If it thinks pseq is strict in "y", then it often evaluates
+-- "y" before "x", which is totally wrong.
+</pre>
+
+<h3 id="fusion">Fusion</h3>
+
+Little has been done so far to tune performance.
+
+<p>
+Several fusion rules are in effect.
+For <tt>NFDataN</tt> we have
+<pre>
+  {-# RULES
+    "rnfn/composition"
+      forall n1 n2 x.  (.) (rnfn n2) (rnfn n1) x = rnfn (max n1 n2) x
+        #-}
+</pre>
+<p>
+and for <tt>NFDataP</tt> we have
+<pre>
+  {-# RULES
+    "rnfp/composition"
+      forall p1 p2 x.  (.) (rnfp p2) (rnfp p1) x = rnfp ( unionPat [p1, p2] ) x
+        #-}
+</pre>
+
+<p>
+Other rules are probably possible (considering <a href="#patalg">PatAlg</a>), and may have been implemented since the last time this section was updated.
+
+<p>
+Unfortunately I get GHC warnings for all my rules, such as
+<pre>
+   Rule "forcen/composition" may never fire
+     because `.' might inline first
+   Probable fix: add an INLINE[n] or NOINLINE[n] pragma on `.'
+</pre>
+<p>
+and it's not clear to me how to put an <tt>INLINE</tt> pragma
+on base composition.
+<p>
+<a id="dig01s" class="dig-toggle-show" href='javascript:toggle("dig01");' style="margin-left: 0px;">Show</a>
+<div id="dig01" class="digression" style="margin-left: 0px;">
+<a id="dig01h" class="dig-toggle-hide" href='javascript:toggle("dig01");'>Hide</a><p>
+There haven't been many cases of pattern composition coming up so far, except those deliberately written for the tests.
+Also, given the amount of pattern-matching required by unionPat, it's far from certain that this rule will improve performance.
+If the union could be computed once at compile-time (for static patterns only, of course) it would make a lot more sense.
+This could be useful, since <tt>seqaid</tt> is going to output optimised, static patterns for ancillary use in subsequent builds.
+But then seqaid might as well also compute and output the union itself.
+</div>
+
+<p>
+Optimisations will get more attention in the next round of development.
+
+<!-- hide/show
+<h3>Fusion, and Misguided Digression on Order of Evaluation</h3>
+
+<div class="outdated">
+<div class="red">
+LATER YET: Actually, check out Control.Parallel ( par, pseq ) which
+were designed exactly to extend seq to give stronger guarantees
+about order of evaluation.
+</div><div class="red">
+LATER: I think what follows is not right; we cannot control order of evaluation so easily...
+So can relax about this, and add a fusion rule to combine the patterns (using NFDataP.unionPat).
+
+<pre style="background-color: transparent;">
+  {-# RULES
+    "rnfp/composition"  forall p1 p2 x.  (.) (rnfp p2) (rnfp p1) x = rnfp ( unionPat [p1, p2] ) x
+      #-}
+</pre>
+</div>
+<p>
+Another thing which distinguishes NFDataP from NFDataN (and NFData) is that we can now control order of evaluation, in case that matters.
+This we do by composing applications:
+<pre>
+-- Note that patA and patB must intersect on (,), both matching ".",
+-- in order for the subpatterns to get applied.
+( forcep patA . forcep patB ) ( value :: (A, B) )
+</pre>
+<p>
+This will first force B (to the extent matched by patB), and then force A (to extent of patA).
+The net effect does not depend or the order, provided no subexpression is undefined or non-terminating.
+<p>
+Controlling order of evaluation this way is probably a bit fragile, since the compiler may reorder things through optimisation, but &mdash; as composition does not normally commute in general &mdash; the reordering that would hurt us is unlikely to be performed.
+<p>
+It might actually be nice to get GHC to recognise opportunities for re-ordering, since the potential for optimisation is likely more important than controlling evaluation order! Perhaps this is possible with the GHC RULES pragma, but care would have to be taken to assure confluent rewriting (or at least bounding the number of recursive rule applications), which is a problem faced with most uses of GHC RULES.
+</div>
+-->
+
+<h3 id="generic-deriving">Generic Deriving is Supported</h3>
+
+The <tt>GNFDataN</tt> and <tt>GNFDataP</tt> classes support automatic derivation of instances of <tt>NFDataN</tt> and <tt>NFDataP</tt> for arbitrary types, <span style="white-space: nowrap;">using SOP (<a href="http://hackage.haskell.org/package/generics-sop">generics-sop</a></span></tt>), a relatively new generics library.
+Latterly, <tt>Seqable</tt> supports all types via SOP, and there is no <tt>Seqable</tt> class, only generic functions.
+This is an attractive alternative to wrestling with divers classes and constraints &mdash; one need only worry about one class constraint (Generics.SOP.Generic), instances of which are readily derived.
+
+<!--<tt>GNFDataN</tt> has been implemented in two ways, once using standard <tt>GHC.Generics</tt> (analogously to <a href="http://hackage.haskell.org/package/deepseq-generics">deepseq-generics</a> package), and then again using 
+By default (in the <tt>.cabal</tt> file), SOP is used.
+(However, the only implementation of <tt>GNFDataP</tt> is using SOP.)-->
+
+<!-- Standard generic deriving using <tt>GHC.Generics</tt> is well-documented at <a href="">deepseq-generics</a>, and illustrated in the test suite of this package.
+With it, there is one minor glitch still, but the correspondence of the depth parameter to actual depth in the structure is almost exact.-->
+
+<p>
+Strict monotonicity is assured, until convergence to full evaluation (for finite values).
+With <tt>GNFDataN</tt>, increasing the depth parameter will strictly increase the amount of forced evaluation, in a level-by-level manner within the shape of the value.
+Likewise, with <tt>GNFDataP</tt>, extending the pattern shape within the term shape will strictly increase the forcing.
+<p>
+<!--As for <tt>GNFDataP</tt>, only an SOP generics implementation is provided.
+(It seems unlikely that <tt>GHC.Generics</tt> will suffice, as they explicitly state that nesting shape is unspecified and prone to optimising rewrites.)-->
+
+<p>
+
+To derive instances of <tt>NFDataN</tt> only, you can do:
+
+<pre>
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilies #-}
+
+import Generics.SOP.TH
+import Control.DeepSeq.Bounded ( NFDataN(..), grnfn )
+
+data TA = A1 TB | A2
+instance NFDataN TA where rnfn = grnfn
+
+data TB = B1 Int TA
+instance NFDataN TB where rnfn = grnfn
+
+deriveGeneric ''TA
+deriveGeneric ''TB
+</pre>
+
+<p>
+<a id="dig02s" class="dig-toggle-show" href='javascript:toggle("dig02");' style="margin-left: 0px;">Show</a>
+<div id="dig02" class="digression" style="margin-left: 0px;">
+<a id="dig02h" class="dig-toggle-hide" href='javascript:toggle("dig02");'>Hide</a><p>
+To derive instances of <tt>NFDataP</tt> for a data type (which requires also instances of superclasses <tt>NFDataN</tt> and of <tt>NFData</tt>), the incantation is:
+
+<pre>
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+
+import Generics.SOP.TH
+import Control.DeepSeq.Bounded ( NFDataN(..), grnfn, NFDataP(..), grnfp )
+import Control.DeepSeq.Generics ( NFData(..), genericRnf )
+import GHC.Generics ( Generic )    -- for deriving NFData
+import Data.Typeable ( Typeable )  -- for name-constrained pattern nodes
+
+data TA = A1 TB | A2 deriving ( Show, Generic, Typeable )
+instance NFData  TA where rnf  = genericRnf
+instance NFDataN TA where rnfn = grnfn
+instance NFDataP TA where rnfp = grnfp
+
+data TB = B1 Int TA deriving ( Show, Generic, Typeable )
+instance NFData  TB where rnf  = genericRnf
+instance NFDataN TB where rnfn = grnfn
+instance NFDataP TB where rnfp = grnfp
+
+deriveGeneric ''TA
+deriveGeneric ''TB
+</pre>
+</div>
+
+<p>
+Note that mutually-recursive data types require all their <tt>deriveGeneric</tt> calls to come below their collective definitions.
+<p>
+SOP also offers an alternative approach to automatic instance derivation, piggybacking on <tt>GHC.Generics</tt>, in case Template Haskell is unacceptable in your application.
+<p>
+It might be worth noting that the <a href="http://hackage.haskell.org/package/seqaid">seqaid</a> package provides a mechanism for completely automating this process.
+However, it depends on use of a preprocessor, and was deemed inappropriate for this core library.
+
+<h3 id="patalg">Pattern Algebra</h3>
+
+In the course of developing <tt>NFDataP</tt>, several utility functions were written for creating, modifying and combining patterns.
+They've been collected in the <tt>PatAlg</tt> module.
+
+<pre>
+  module Control.DeepSeq.Bounded.PatAlg
+
+  import Control.DeepSeq.Bounded.Pattern
+
+
+  <b>Basic operations on Patterns</b>
+
+  <span style="font-size: 95%;"><em>-- Compute the union of a list of </em>Pattern<em>s.</em></span>
+  <b style="color: #333;">unionPats :: [ Pattern ] -&gt; Pattern</b>
+
+  <span style="font-size: 95%;"><em>-- Compute the intersection of a list of </em>Pattern<em>s.</em></span>
+  <b style="color: #333;">intersectPats :: [ Pattern ] -&gt; Pattern</b>
+
+  <span style="font-size: 95%;"><em>-- Return </em>True<em> if the first pattern matches the second
+  -- (and </em>False<em> otherwise).  Note that matching does not imply
+  -- spanning. Equality </em>(==)<em> or </em>flip isSubPatOf<em> will
+  -- work there, depending on your intentions.</em></span>
+  <b style="color: #333;">isSubPatOf :: Pattern -&gt; Pattern -&gt; Bool</b>
+
+
+  <b>Operations for obtaining and modifying Patterns based on a term</b>
+
+  <span style="font-size: 95%;"><em>-- Obtain a lazy pattern, matching the shape of
+  -- an arbitrary term (value expression).
+  -- Interior nodes will be </em>WR<em>, and leaves will be </em>WS<em>.</em></span>
+  <b style="color: #333;">mkPat :: forall d. Data d =&gt; d -&gt; Pattern</b>
+
+  <span style="font-size: 95%;"><em>-- Obtain a lazy pattern, matching the shape of
+  -- an arbitrary term, but only down to at most depth </em>n<em>.
+  -- Interior nodes will be </em>WR<em>.  Leaf nodes will be </em>WS<em> if they
+  -- were leaves in the host value; otherwise they will be </em>WR<em>.
+  -- Satisfies </em>forcep . mkPatN n = forcen n<em>.</em></span>
+  <b style="color: #333;">mkPatN :: forall d. Data d =&gt; Int -&gt; d -&gt; Pattern</b>
+
+  <span style="font-size: 95%;"><em>-- Grow all leaves by one level within the shape of the provided value.</em></span>
+  <b style="color: #333;">growPat :: forall d. Data d =&gt; Pattern -&gt; d -&gt; Pattern</b>
+
+
+  <b>Operations for obtaining subpatterns (in the 'isSubPatOf' sense)</b>
+
+  <span style="font-size: 95%;"><em>-- Given an integer depth and a pattern, truncate the pattern to
+  -- extend to at most this requested depth.</em></span>
+  <b style="color: #333;">truncatePat :: Int -&gt; Pattern -&gt; Pattern</b>
+
+  <span style="font-size: 95%;"><em>-- Elide all leaves which have no non-leaf sibling.
+  -- We want the pattern to still match the same value, only less of it.
+  -- Merely eliding all leaves would, in most cases, cause match failure,
+  -- so we have to be a bit more subtle.</em></span>
+  <b style="color: #333;">shrinkPat :: Pattern -&gt; Pattern</b>
+
+
+  <b>Operations for the direct construction and perturbation of Patterns</b>
+
+  <span style="font-size: 95%;"><em>-- There is no Nil in the Pattern type, but a single </em>WI<em> node as
+  -- empty pattern is a dependable way to assure the empty pattern
+  -- never forces anything.</em></span>
+  <b style="color: #333;">emptyPat :: Pattern</b>
+
+  <span style="font-size: 95%;"><em>-- This creates a new </em>WR<em> node, the common root. The argument patterns
+  -- become the children of the root (order is preserved).</em></span>
+  <b style="color: #333;">liftPats :: [ Pattern ] -&gt; Pattern</b>
+
+  <span style="font-size: 95%;"><em>-- Introduce siblings at a node (interior or leaf) of the target.
+  -- The first argument is target, the second is a path, and the
+  -- third is a list of subpatterns for insertion, along with the
+  -- indices of the child before which to insert.</em></span>
+  <b style="color: #333;">splicePats :: Pattern -&gt; [Int] -&gt; [ (Int, Pattern) ] -&gt; Pattern</b>
+
+  <span style="font-size: 95%;"><em>-- Elide siblings at a node (interior or leaf) of the target.
+  -- The first argument is target, the second is a path, and the
+  -- third is a list of child indices for elision.</em></span>
+  <b style="color: #333;">elidePats :: Pattern -&gt; [Int] -&gt; [Int] -&gt; Pattern</b>
+
+  <span style="font-size: 95%;"><em>-- Select a leaf at random, and elide it.  In order to achieve fairness,
+  -- the node probabilities are weighted by nodes in branch.  The path
+  -- arg can "focus" the stochastic erosion to only consider leaves
+  -- beneath a given node.</em></span>
+  <b style="color: #333;">erodePat :: StdGen -&gt; [Int] -&gt; Pattern -&gt; (Pattern, StdGen)</b>
+</pre>
+
+<h3>Examples</h3>
+
+More examples can be browsed in the <a href="tests.html">testing output</a>.
+Here we only touch on a few particulars.
+
+<!--
+
+<p>
+The following abbreviation is used frequently in the examples:
+
+<pre>
+__ = undefined
+</pre>
+
+<p>
+Also, suppose the following data types have NFDataP instances (refer to the <a href="#generic-deriving">Generic Deriving</a> section above).
+
+<pre>
+data TA =   A1
+          | A2 (TB Complex,Int)
+          | A3 TA Bool (TB String)
+
+data TB a =   B1
+            | B2 [a]
+            | B3 [TA]
+</pre>
+
+-->
+
+<p>
+First, note that we can handle infinite values, unlike <tt>deepseq</tt>.
+
+<pre>
+     force $ take 5 [1,2..]   -- [1,2,3,4,5]
+     take 5 $ force [1,2..]   -- &lt;&lt; nonterminates &gt;&gt;
+
+     forcen 100 $ take 5 [1,2..]   -- [1,2,3,4,5]
+     take 5 $ forcen 100 [1,2..]   -- [1,2,3,4,5]
+</pre>
+
+<p>
+Oops, never finished this section...
+And that's a pretty silly example, although it illustrates the distinction.
+Best to refer to the tests for examples, or just play around.
+Will try to toss in a few more scraps...
+
+<p>
+Here is the result of iterating <tt>shrinkPat</tt> on a test pattern.
+
+<pre>
+".{.{#.{*.{.*3}}}.{..{*1.{..{##}}}}}"
+".{.{#.{*5.{#*2}}}.{#.{#.{##}}}}"
+".{.{#.{*4.{#.}}}.{#.{##}}}"
+".{.{#.{*3.{##}}}.{##}}"
+".{.{#.{*2#}}#}"
+".{.{#.{.#}}#}"
+".{.{#.{##}}#}"
+".{.{##}#}"
+".{##}"
+"#"
+"#"
+</pre>
+
+<div class="footer" style="margin-top: 50px;">
+Andrew Seniuk
+<br>
+July 13, 2014
+<br>
+<tt>rasfar@gmail.com</tt>
+</div>
+
+</div>
+
+<script language="javascript">
+function toggle(id1){
+  var ele_s = document.getElementById(id1+"s");
+  var ele_h = document.getElementById(id1+"h");
+  var ele = document.getElementById(id1);
+  if( ele.style.display == "inline-block" ){
+    ele.style.display = "none";
+    ele_s.style.display = "inline-block";
+    ele_h.style.display = "none";
+  }else{
+    ele.style.display = "inline-block";
+    ele_s.style.display = "none";
+    ele_h.style.display = "block";
+  }
+}
+</script>
+
+</body>
+</html>
+
diff --git a/HTML/index.html b/HTML/index.html
new file mode 100644
--- /dev/null
+++ b/HTML/index.html
@@ -0,0 +1,16 @@
+<!DOCTYPE html>
+<html>
+<head>
+<title>Bounded DeepSeq</title>
+</head>
+<body>
+
+<!--div style="color: #F33; margin-top: 40px; font-size: 16pt;">
+(Notes to self.)
+</div-->
+
+<script>document.location = "deepseq-bounded.html";</script>
+
+</body>
+</html>
+
diff --git a/HTML/style-old.css b/HTML/style-old.css
new file mode 100644
--- /dev/null
+++ b/HTML/style-old.css
@@ -0,0 +1,24 @@
+pre { font-size: 12pt; margin-left: 20px; padding-left: 10px; padding-right: 10px; padding-top: 10px; padding-bottom: 10px; background-color: #DDD; }
+tt { padding-left: 2px; padding-right: 2px; font-size: 85%; background-color: rgba(220,220,220,0.5); }
+tt.virgin { padding-left: 0px; padding-right: 0px; font-size: 85%; background-color: transparent; }
+/* Works, but not nicely:
+red { color: #f00; }
+*/
+.red { color: #f00; }
+div.outdated { display: inline-block; padding-left: 2px; padding-right: 2px; padding-top: 2px; font-size: 11pt; background-color: #EEC; }
+div.digression { display: inline-block; padding: 8px 8px 8px 8px; font-size: 11pt; background-color: #EDD; }
+a { text-decoration: none; }
+div.main { font-size: 18pt; margin-left: 10px; margin-right: 100px; margin-bottom: 40px; }
+h2 { margin-top: 30px; color: #444; }
+h3 { margin-top: 30px; color: #222; }
+h4 { margin-top: 40px; color: #111; }
+div.footer { font-size: 12pt; margin-top: 30px; }
+/*
+table.table { text-align: top; vertical-align: top; }
+table.table > tr { text-align: top; vertical-align: top; }
+table.table > tr > td { text-align: top; vertical-align: top; }
+*/
+/* table { border-collapse: collapse; } */
+tr { text-align: top; vertical-align: top; }
+td { text-align: top; vertical-align: top; padding-left: 8px; padding-top: 16px; }
+li { margin-top: 4px; }
diff --git a/HTML/style.css b/HTML/style.css
new file mode 100644
--- /dev/null
+++ b/HTML/style.css
@@ -0,0 +1,27 @@
+pre { font-size: 12pt; margin-left: 20px; padding-left: 10px; padding-right: 10px; padding-top: 10px; padding-bottom: 10px; background-color: #DDD; }
+tt { padding-left: 2px; padding-right: 2px; font-size: 85%; background-color: rgba(220,220,220,0.5); }
+tt.virgin { padding-left: 0px; padding-right: 0px; font-size: 85%; background-color: transparent; }
+/* Works, but not nicely:
+red { color: #f00; }
+*/
+.red { color: #f00; }
+div.outdated { display: inline-block; padding-left: 2px; padding-right: 2px; padding-top: 2px; font-size: 80%; background-color: #EEC; }
+div.digression { display: none; padding: 8px 8px 8px 8px; font-size: 80%; background-color: #EDD; }
+div.digression-closed { display: inline-block; padding: 8px 8px 8px 8px; font-size: 80%; background-color: #EDD; }
+.dig-toggle-show { outline: 0; text-decoration: none; color: #33E; display: inline-block; padding: 8px 8px 8px 8px; font-size: 11pt; background-color: #EDD; }
+.dig-toggle-hide { outline: 0; text-decoration: none; color: #33E; display: inline-block; padding: 0px 0px 4px 0px; font-size: 11pt; background-color: #EDD; }
+a { text-decoration: none; }
+div.main { font-size: 18pt; margin-left: 10px; margin-right: 100px; margin-bottom: 40px; }
+h2 { margin-top: 30px; color: #777; }
+h3 { margin-top: 30px; color: #444; }
+h4 { margin-top: 40px; color: #222; }
+div.footer { font-size: 12pt; margin-top: 30px; }
+/*
+table.table { text-align: top; vertical-align: top; }
+table.table > tr { text-align: top; vertical-align: top; }
+table.table > tr > td { text-align: top; vertical-align: top; }
+*/
+/* table { border-collapse: collapse; } */
+tr { text-align: top; vertical-align: top; }
+td { text-align: top; vertical-align: top; padding-left: 8px; padding-top: 16px; }
+li { margin-top: 4px; }
diff --git a/HTML/tests.html b/HTML/tests.html
new file mode 100644
--- /dev/null
+++ b/HTML/tests.html
@@ -0,0 +1,1645 @@
+<html>
+<head></head>
+<body>
+<pre>
+kadath:script&gt; cabal repl
+Preprocessing library deepseq-bounded-0.5.0...
+In-place registering deepseq-bounded-0.5.0...
+Preprocessing test suite 'deepseq-bounded-tests' for deepseq-bounded-0.5.0...
+GHCi, version 7.8.3: http://www.haskell.org/ghc/  :? for help
+Loading package ghc-prim ... linking ... done.
+Loading package integer-gmp ... linking ... done.
+ ...
+Ok, modules loaded: Main, Tests, Blah, Bottom, Foo, FooG.
+*Main&gt; main
+Running tests for deepseq-bounded...
+Cases: 1  Tried: 0  Errors: 0  Failures: 0
+
+Testing.
+
+Pattern                       Compiles to
+*                             Node WW []
+#                             Node WI []
+.                             Node WS []
+.{}                           Node WR []
+.{*}                          Node WR [Node WW []]
+.{**}                         Node WR [Node WW [],Node WW []]
+.{.*}                         Node WR [Node WS [],Node WW []]
+.{#.}                         Node WR [Node WI [],Node WS []]
+compilePat-"{": warning: # with subpattern
+.{#{#}}                       Node WR [Node WI []]
+.{.{#}}                       Node WR [Node WR [Node WI []]]
+.{*#*#*#**#*#*}               Node WR [Node WW [],Node WI [],Node WW [],Node WI [],Node WW [],Node WI [],Node WW [],Node WW [],Node WI [],Node WW [],Node WI [],Node WW []]
+compilePat-"{": warning: * with subpattern
+.{*#.{*#.{*#}*}*{#*}#*}       Node WR [Node WW [],Node WI [],Node WR [Node WW [],Node WI [],Node WR [Node WW [],Node WI []],Node WW []],Node WW [],Node WI [],Node WW []]
+.{*#.{*#.{*#}*}*#*}           Node WR [Node WW [],Node WI [],Node WR [Node WW [],Node WI [],Node WR [Node WW [],Node WI []],Node WW []],Node WW [],Node WI [],Node WW []]
+.{.*.{*23*}}                  Node WR [Node WS [],Node WW [],Node WR [Node (WN 23) [],Node WW []]]
+.{.=*.{=*23*}}                Node WR [Node WS [],Node PW [],Node WR [Node (PN 23) [],Node WW []]]
+===================================================
+exp = (3.4, [5,__,7], __) :: (Float, [Int], Bool)
+get (_,xs,_) = show $ (xs!!2)
+? = get $ forcep patstr exp
+===================================================
+patstr                   = 
+showPat.compilePat       = compilePat: empty pattern (syntax error)
+---------------------------------------------------
+patstr                   = .##
+showPat.compilePat       = compilePat: disconnected pattern (not rooted)
+Perhaps you used parentheses instead of braces?
+---------------------------------------------------
+patstr                   = .{.##}
+showPat.compilePat       = .{.##}
+expected value           = 7
+actual value             = 7
+---------------------------------------------------
+patstr                   = .{.{}#{}#{}}
+expected value           = 7 (but "# with subpattern" warning)
+showPat.compilePat       = .{.{}##}
+actual value             = 7
+---------------------------------------------------
+patstr                   = *
+showPat.compilePat       = *
+expected value           = Prelude.undefined
+actual value             = Prelude.undefined
+---------------------------------------------------
+patstr                   = .{***}
+showPat.compilePat       = .{***}
+expected value           = Prelude.undefined
+actual value             = Prelude.undefined
+---------------------------------------------------
+patstr                   = .{###}
+showPat.compilePat       = .{###}
+expected value           = 7
+actual value             = 7
+---------------------------------------------------
+patstr                   = .{*##}
+showPat.compilePat       = .{*##}
+expected value           = 7
+actual value             = 7
+---------------------------------------------------
+patstr                   = .{**#}
+showPat.compilePat       = .{**#}
+expected value           = Prelude.undefined
+actual value             = Prelude.undefined
+---------------------------------------------------
+patstr                   = .{##*}
+showPat.compilePat       = .{##*}
+expected value           = Prelude.undefined
+actual value             = Prelude.undefined
+---------------------------------------------------
+patstr                   = .{..{*#*}#}
+expected value           = 7 (but with pattern-match failure warning)
+showPat.compilePat       = .{..{*#*}#}
+actual value             = 7
+---------------------------------------------------
+patstr                   = .{..{*###}#}
+expected value           = 7 (but with pattern-match failure warning)
+showPat.compilePat       = .{..{*###}#}
+actual value             = 7
+---------------------------------------------------
+patstr                   = .{..{*####}#}
+expected value           = 7 (but with pattern-match failure warning)
+showPat.compilePat       = .{..{*####}#}
+actual value             = 7
+---------------------------------------------------
+patstr                   = .{..{*####}.}
+expected value           = Prelude.undefined (but with pattern-match failure warning)
+showPat.compilePat       = .{..{*####}.}
+actual value             = Prelude.undefined
+---------------------------------------------------
+patstr                   = .{..{*#}*}
+showPat.compilePat       = .{..{*#}*}
+expected value           = Prelude.undefined
+actual value             = Prelude.undefined
+---------------------------------------------------
+patstr                   = .{..{*#}#}
+showPat.compilePat       = .{..{*#}#}
+expected value           = 7
+actual value             = 7
+---------------------------------------------------
+patstr                   = .{..{*.{#*}}#}
+showPat.compilePat       = .{..{*.{#*}}#}
+expected value           = 7
+actual value             = 7
+---------------------------------------------------
+patstr                   = .{..{*.{*#}}#}
+showPat.compilePat       = .{..{*.{*#}}#}
+expected value           = Prelude.undefined
+actual value             = Prelude.undefined
+---------------------------------------------------
+patstr                   = .{..{.{..{#*}}}#}
+expected value           = 7 (but with pattern-match failure warning)
+showPat.compilePat       = .{..{.{..{#*}}}#}
+actual value             = 7
+---------------------------------------------------
+patstr                   = .{#.{..{..{#*}}}#}
+showPat.compilePat       = .{#.{..{..{#*}}}#}
+expected value           = Prelude.undefined
+actual value             = Prelude.undefined
+---------------------------------------------------
+patstr                   = .{..{..{#.{..}}}#}
+showPat.compilePat       = .{..{..{#.{..}}}#}
+expected value           = 7
+actual value             = 7
+---------------------------------------------------
+patstr                   = .{..{..{#*}}#}
+showPat.compilePat       = .{..{..{#*}}#}
+expected value           = 7
+actual value             = 7
+---------------------------------------------------
+patstr                   = .{*.{*.{#*}}#}
+showPat.compilePat       = .{*.{*.{#*}}#}
+expected value           = 7
+actual value             = 7
+---------------------------------------------------
+patstr                   = .{##*}
+showPat.compilePat       = .{##*}
+expected value           = Prelude.undefined
+actual value             = Prelude.undefined
+---------------------------------------------------
+patstr                   = .{*#*}
+showPat.compilePat       = .{*#*}
+expected value           = Prelude.undefined
+actual value             = Prelude.undefined
+---------------------------------------------------
+patstr                   = .:Tuple3{*.{*.{#*}}#}
+showPat.compilePat       = .:Tuple3{*.{*.{#*}}#}
+expected value           = 7
+actual value             = 7
+---------------------------------------------------
+patstr                   = .:(,,){*.{*.{#*}}#}
+showPat.compilePat       = .:(,,){*.{*.{#*}}#}
+expected value           = 7
+actual value             = 7
+---------------------------------------------------
+patstr                   = .:(,,){*.{*.{.*}}#}
+showPat.compilePat       = .:(,,){*.{*.{.*}}#}
+expected value           = Prelude.undefined
+actual value             = Prelude.undefined
+---------------------------------------------------
+patstr                   = .:Bool{***}
+showPat.compilePat       = .:Bool{***}
+expected value           = 7
+actual value             = 7
+---------------------------------------------------
+patstr                   = *:Bool
+showPat.compilePat       = *:Bool
+expected value           = 7
+actual value             = 7
+---------------------------------------------------
+patstr                   = *:(,,)
+showPat.compilePat       = *:(,,)
+expected value           = Prelude.undefined
+actual value             = Prelude.undefined
+---------------------------------------------------
+patstr                   = .{*#.}
+showPat.compilePat       = .{*#.}
+expected value           = Prelude.undefined
+actual value             = Prelude.undefined
+---------------------------------------------------
+patstr                   = .{*#.:Bool}
+showPat.compilePat       = .{*#.:Bool{}}
+expected value           = Prelude.undefined
+actual value             = Prelude.undefined
+---------------------------------------------------
+patstr                   = .{*#.:Bool{}}
+showPat.compilePat       = .{*#.:Bool{}}
+expected value           = Prelude.undefined
+actual value             = Prelude.undefined
+---------------------------------------------------
+patstr                   = .{*#.:Int{}}
+showPat.compilePat       = .{*#.:Int{}}
+expected value           = 7
+actual value             = 7
+---------------------------------------------------
+patstr                   = .{*#.:(,){}}
+showPat.compilePat       = .{*#.:(,){}}
+expected value           = 7
+actual value             = 7
+---------------------------------------------------
+patstr                   = .{*#.:Int }
+showPat.compilePat       = .{*#.:Int{}}
+expected value           = 7
+actual value             = 7
+---------------------------------------------------
+patstr                   = .{*#.:Int'}
+showPat.compilePat       = .{*#.:Int'{}}
+expected value           = 7
+actual value             = 7
+---------------------------------------------------
+patstr                   = .{*##:Bool}
+showPat.compilePat       = .{*##:Bool}
+expected value           = 7
+actual value             = 7
+---------------------------------------------------
+patstr                   = .{*##:Int}
+showPat.compilePat       = .{*##:Int}
+expected value           = Prelude.undefined
+actual value             = Prelude.undefined
+---------------------------------------------------
+patstr                   = .{*##:(,)}
+showPat.compilePat       = .{*##:(,)}
+expected value           = Prelude.undefined
+actual value             = Prelude.undefined
+---------------------------------------------------
+patstr                   = .{*##:Bool{}}
+showPat.compilePat       = compilePat-"{": warning: # with subpattern
+.{*##:Bool}
+expected value           = 7
+compilePat-"{": warning: # with subpattern
+actual value             = 7
+---------------------------------------------------
+patstr                   = .{*##:Int{}}
+showPat.compilePat       = compilePat-"{": warning: # with subpattern
+.{*##:Int}
+expected value           = Prelude.undefined
+compilePat-"{": warning: # with subpattern
+actual value             = Prelude.undefined
+---------------------------------------------------
+patstr                   = .{*##:(,){}}
+showPat.compilePat       = compilePat-"{": warning: # with subpattern
+.{*##:(,)}
+expected value           = Prelude.undefined
+compilePat-"{": warning: # with subpattern
+actual value             = Prelude.undefined
+---------------------------------------------------
+patstr                   = .{**2#}
+showPat.compilePat       = .{**2#}
+expected value           = 7
+actual value             = 7
+---------------------------------------------------
+patstr                   = .{**3#}
+showPat.compilePat       = .{**3#}
+expected value           = Prelude.undefined
+actual value             = Prelude.undefined
+---------------------------------------------------
+patstr                   = .{*#:G2{}#}
+showPat.compilePat       = compilePat-"{": warning: # with subpattern
+.{*#:G2#}
+expected value           = 7
+compilePat-"{": warning: # with subpattern
+actual value             = 7
+---------------------------------------------------
+patstr                   = .{*#:Int{}#}
+showPat.compilePat       = compilePat-"{": warning: # with subpattern
+.{*#:Int#}
+expected value           = 7
+compilePat-"{": warning: # with subpattern
+actual value             = 7
+--------------------------------------------------
+===================================================
+exp = (G1, G2 5 __ 7, __) :: (TG, TG, Bool)
+get (_,(G2 _ _ n),_) = n
+? = get $ forcep patstr exp
+===================================================
+patstr                   = 
+showPat.compilePat       = compilePat: empty pattern (syntax error)
+---------------------------------------------------
+patstr                   = .{*#:G2{}#}
+showPat.compilePat       = compilePat-"{": warning: # with subpattern
+.{*#:G2#}
+expected value           = 7
+compilePat-"{": warning: # with subpattern
+actual value             = 7
+---------------------------------------------------
+patstr                   = .{*#:Int{}#}
+showPat.compilePat       = compilePat-"{": warning: # with subpattern
+.{*#:Int#}
+expected value           = 7
+compilePat-"{": warning: # with subpattern
+actual value             = 7
+--------------------------------------------------
+===================================================
+exp = G2 5 __ 7 :: TG
+get (G2 _ _ n) = n
+? = get $ forcep patstr exp
+===================================================
+patstr                   = ..
+showPat.compilePat       = compilePat: disconnected pattern (not rooted)
+Perhaps you used parentheses instead of braces?
+---------------------------------------------------
+patstr                   = *
+showPat.compilePat       = *
+expected value           = Prelude.undefined
+actual value             = Prelude.undefined
+---------------------------------------------------
+patstr                   = *0
+showPat.compilePat       = *0
+expected value           = 7
+actual value             = 7
+---------------------------------------------------
+patstr                   = *1
+showPat.compilePat       = *1
+expected value           = 7
+actual value             = 7
+---------------------------------------------------
+patstr                   = *2
+showPat.compilePat       = *2
+expected value           = Prelude.undefined
+actual value             = Prelude.undefined
+---------------------------------------------------
+patstr                   = *3
+showPat.compilePat       = *3
+expected value           = Prelude.undefined
+actual value             = Prelude.undefined
+---------------------------------------------------
+patstr                   = .{.#.}
+showPat.compilePat       = .{.#.}
+expected value           = 7
+actual value             = 7
+---------------------------------------------------
+patstr                   = .{...}
+showPat.compilePat       = .{...}
+expected value           = Prelude.undefined
+actual value             = Prelude.undefined
+---------------------------------------------------
+patstr                   = *:TG
+showPat.compilePat       = *:TG
+expected value           = 7
+actual value             = 7
+---------------------------------------------------
+patstr                   = *:G1
+showPat.compilePat       = *:G1
+expected value           = 7
+actual value             = 7
+---------------------------------------------------
+patstr                   = *:G2
+showPat.compilePat       = *:G2
+expected value           = Prelude.undefined
+actual value             = 7
+---------------------------------------------------
+patstr                   = *:G1{..}
+showPat.compilePat       = compilePat-"{": warning: * with subpattern
+*:G1
+expected value           = 7
+compilePat-"{": warning: * with subpattern
+actual value             = 7
+---------------------------------------------------
+patstr                   = *:G1{...}
+showPat.compilePat       = compilePat-"{": warning: * with subpattern
+*:G1
+expected value           = 7
+compilePat-"{": warning: * with subpattern
+actual value             = 7
+---------------------------------------------------
+patstr                   = *:G2{..}
+showPat.compilePat       = compilePat-"{": warning: * with subpattern
+*:G2
+expected value           = Prelude.undefined
+compilePat-"{": warning: * with subpattern
+actual value             = 7
+---------------------------------------------------
+patstr                   = *:G2{...}
+showPat.compilePat       = compilePat-"{": warning: * with subpattern
+*:G2
+expected value           = Prelude.undefined
+compilePat-"{": warning: * with subpattern
+actual value             = 7
+---------------------------------------------------
+patstr                   = #:G1
+showPat.compilePat       = #:G1
+expected value           = 7
+actual value             = 7
+---------------------------------------------------
+patstr                   = #:G2
+showPat.compilePat       = #:G2
+expected value           = 7
+actual value             = 7
+---------------------------------------------------
+patstr                   = #:G1{..}
+showPat.compilePat       = compilePat-"{": warning: # with subpattern
+#:G1
+expected value           = 7
+compilePat-"{": warning: # with subpattern
+actual value             = 7
+---------------------------------------------------
+patstr                   = #:G1{...}
+showPat.compilePat       = compilePat-"{": warning: # with subpattern
+#:G1
+expected value           = 7
+compilePat-"{": warning: # with subpattern
+actual value             = 7
+---------------------------------------------------
+patstr                   = #:G2{..}
+showPat.compilePat       = compilePat-"{": warning: # with subpattern
+#:G2
+expected value           = 7
+compilePat-"{": warning: # with subpattern
+actual value             = 7
+---------------------------------------------------
+patstr                   = #:G2{...}
+showPat.compilePat       = compilePat-"{": warning: # with subpattern
+#:G2
+expected value           = 7
+compilePat-"{": warning: # with subpattern
+actual value             = 7
+---------------------------------------------------
+patstr                   = .:G1{..}
+showPat.compilePat       = .:G1{..}
+expected value           = 7
+actual value             = 7
+---------------------------------------------------
+patstr                   = .:G1{...}
+showPat.compilePat       = .:G1{...}
+expected value           = 7
+actual value             = 7
+---------------------------------------------------
+patstr                   = .:G2{..}
+showPat.compilePat       = .:G2{..}
+expected value           = 7
+actual value             = 7
+---------------------------------------------------
+patstr                   = .:G2{...}
+showPat.compilePat       = .:G2{...}
+expected value           = Prelude.undefined
+actual value             = Prelude.undefined
+--------------------------------------------------
+===================================================
+exp = J2 (1, J4 (J3, K3 __ (J1 4.5))) False
+get = (J2 (_, J4 (_, K3 _ (J1 f))) _) = show f
+? = get $ forcep patstr exp
+===================================================
+patstr                   = 
+showPat.compilePat       = compilePat: empty pattern (syntax error)
+---------------------------------------------------
+patstr                   = .{.{..{.{..{..{.}}}}}.}
+showPat.compilePat       = .{.{..{.{..{..{.}}}}}.}
+expected value           = Prelude.undefined
+actual value             = Prelude.undefined
+---------------------------------------------------
+patstr                   = .{.{..{.{#.{..{.}}}}}#}
+showPat.compilePat       = .{.{..{.{#.{..{.}}}}}#}
+expected value           = 4.5
+actual value             = 4.5
+--------------------------------------------------
+===================================================
+exp = J2 (1, J4 (__, K2)) False
+get ~_ = show 1  -- seems to suffice?!?...
+? = get $ forcep patstr exp
+===================================================
+patstr                   = 
+showPat.compilePat       = compilePat: empty pattern (syntax error)
+---------------------------------------------------
+patstr                   = .{.{..{.{..}}}.}
+showPat.compilePat       = .{.{..{.{..}}}.}
+expected value           = Prelude.undefined
+actual value             = Prelude.undefined
+---------------------------------------------------
+patstr                   = .{.{..{.{#.}}}.}
+showPat.compilePat       = .{.{..{.{#.}}}.}
+expected value           = 1
+actual value             = 1
+---------------------------------------------------
+patstr                   = .{.{..{#{..}}}.}
+showPat.compilePat       = .{.{..{#}}.}
+expected value           = 1
+actual value             = 1
+---------------------------------------------------
+patstr                   = .{.{.#{.{..}}}.}
+showPat.compilePat       = .{.{.#}.}
+expected value           = 1
+actual value             = 1
+--------------------------------------------------
+===================================================
+exp = J4 (__, K2)
+get ~_ = show 1  -- seems to suffice?!?...
+? = get $ forcep patstr exp
+===================================================
+patstr                   = 
+showPat.compilePat       = compilePat: empty pattern (syntax error)
+---------------------------------------------------
+patstr                   = .{.{..}}
+showPat.compilePat       = .{.{..}}
+expected value           = Prelude.undefined
+actual value             = Prelude.undefined
+---------------------------------------------------
+patstr                   = .{.{#.}}
+showPat.compilePat       = .{.{#.}}
+expected value           = 1
+actual value             = 1
+---------------------------------------------------
+patstr                   = .{#{..}}
+showPat.compilePat       = .{#}
+expected value           = 1
+actual value             = 1
+---------------------------------------------------
+patstr                   = #{.{..}}
+showPat.compilePat       = #
+expected value           = 1
+actual value             = 1
+--------------------------------------------------
+===================================================
+exp = (__, K2)
+get ~_ = show 1  -- seems to suffice?!?...
+? = get $ forcep patstr exp
+===================================================
+patstr                   = 
+showPat.compilePat       = compilePat: empty pattern (syntax error)
+---------------------------------------------------
+patstr                   = .{..}
+showPat.compilePat       = .{..}
+expected value           = Prelude.undefined
+actual value             = Prelude.undefined
+---------------------------------------------------
+patstr                   = .{#.}
+showPat.compilePat       = .{#.}
+expected value           = 1
+actual value             = 1
+---------------------------------------------------
+patstr                   = #{..}
+showPat.compilePat       = #
+expected value           = 1
+actual value             = 1
+--------------------------------------------------
+===================================================
+exp = __ :: TJ
+get ~_ = show 1  -- seems to suffice?!?...
+? = get $ forcep patstr exp
+===================================================
+patstr                   = 
+showPat.compilePat       = compilePat: empty pattern (syntax error)
+---------------------------------------------------
+patstr                   = .
+showPat.compilePat       = .
+expected value           = Prelude.undefined
+actual value             = Prelude.undefined
+---------------------------------------------------
+patstr                   = #
+showPat.compilePat       = #
+expected value           = 1
+actual value             = Prelude.undefined
+--------------------------------------------------
+===================================================
+exp = (K5 (__::TJ))
+get ~_ = show 1  -- seems to suffice?!?...
+? = get $ forcep patstr exp
+===================================================
+patstr                   = 
+showPat.compilePat       = compilePat: empty pattern (syntax error)
+---------------------------------------------------
+patstr                   = .
+showPat.compilePat       = .
+expected value           = okay
+actual value             = okay
+---------------------------------------------------
+patstr                   = .{#}
+showPat.compilePat       = .{#}
+expected value           = okay
+actual value             = okay
+---------------------------------------------------
+patstr                   = .{.}
+showPat.compilePat       = .{.}
+expected value           = Prelude.undefined
+actual value             = Prelude.undefined
+---------------------------------------------------
+patstr                   = #
+showPat.compilePat       = #
+expected value           = okay
+actual value             = okay
+--------------------------------------------------
+===================================================
+exp = K3 (__::TK) J3
+get ~_ = show 1  -- seems to suffice?!?...
+? = get $ forcep patstr exp
+===================================================
+patstr                   = 
+showPat.compilePat       = compilePat: empty pattern (syntax error)
+---------------------------------------------------
+patstr                   = .
+showPat.compilePat       = .
+expected value           = okay
+actual value             = okay
+---------------------------------------------------
+patstr                   = .{#.}
+showPat.compilePat       = .{#.}
+expected value           = okay
+actual value             = okay
+---------------------------------------------------
+patstr                   = .{.#}
+showPat.compilePat       = .{.#}
+expected value           = Prelude.undefined
+actual value             = Prelude.undefined
+---------------------------------------------------
+patstr                   = .{..}
+showPat.compilePat       = .{..}
+expected value           = Prelude.undefined
+actual value             = Prelude.undefined
+---------------------------------------------------
+patstr                   = #
+showPat.compilePat       = #
+expected value           = okay
+actual value             = okay
+--------------------------------------------------
+===================================================
+exp = L1 5.6 (M1 __)
+get (L1 f (M1 _)) = show f
+? = get $ forcep patstr exp
+===================================================
+patstr                   = 
+showPat.compilePat       = compilePat: empty pattern (syntax error)
+---------------------------------------------------
+patstr                   = #
+showPat.compilePat       = #
+expected value           = 5.6
+actual value             = 5.6
+---------------------------------------------------
+patstr                   = #{..}
+expected value           = 5.6 (but "# with subpattern" warning)
+showPat.compilePat       = #
+actual value             = 5.6
+---------------------------------------------------
+patstr                   = .{..}
+showPat.compilePat       = .{..}
+expected value           = 5.6
+actual value             = 5.6
+---------------------------------------------------
+patstr                   = .{.{.}.}
+showPat.compilePat       = .{.{.}.}
+expected value           = Prelude.undefined
+actual value             = Prelude.undefined
+---------------------------------------------------
+patstr                   = .{.{#}.}
+showPat.compilePat       = .{.{#}.}
+expected value           = 5.6
+actual value             = 5.6
+--------------------------------------------------
+===================================================
+exp = K3 __ (J1 4.5)
+get = (K3 _ (J1 f)) = show f
+? = get $ forcep patstr exp
+===================================================
+patstr                   = 
+showPat.compilePat       = compilePat: empty pattern (syntax error)
+---------------------------------------------------
+patstr                   = .{..{.}}
+showPat.compilePat       = .{..{.}}
+expected value           = Prelude.undefined
+actual value             = Prelude.undefined
+---------------------------------------------------
+patstr                   = .{##}
+showPat.compilePat       = .{##}
+expected value           = 4.5
+actual value             = 4.5
+---------------------------------------------------
+patstr                   = .{#.}
+showPat.compilePat       = .{#.}
+expected value           = 4.5
+actual value             = 4.5
+---------------------------------------------------
+patstr                   = .{#.{#}}
+showPat.compilePat       = .{#.{#}}
+expected value           = 4.5
+actual value             = 4.5
+---------------------------------------------------
+patstr                   = .{#.{.}}
+showPat.compilePat       = .{#.{.}}
+expected value           = 4.5
+actual value             = 4.5
+---------------------------------------------------
+patstr                   = .{.#{.}}
+showPat.compilePat       = .{.#}
+expected value           = Prelude.undefined
+actual value             = Prelude.undefined
+---------------------------------------------------
+patstr                   = .{.#{#}}
+showPat.compilePat       = .{.#}
+expected value           = Prelude.undefined
+actual value             = Prelude.undefined
+---------------------------------------------------
+patstr                   = .{##{#}}
+showPat.compilePat       = .{##}
+expected value           = 4.5
+actual value             = 4.5
+---------------------------------------------------
+patstr                   = #{##{#}}
+showPat.compilePat       = #
+expected value           = 4.5
+actual value             = 4.5
+--------------------------------------------------
+===================================================
+exp = (3.4, [5,__,7], __) :: (Float, [Int], Bool)
+get (_,xs,_) = show $ (xs!!2)
+? = get $ ( forcep patstr2 . forcep patstr1 ) exp
+? = get $! ( forcep_ ( unionPats [ pat1, pat2 ] ) ) exp
+(Results were more interesting with a previous semantics...).
+===================================================
+patstr1                     = .
+patstr2                     = .
+patstrU                     = .
+showPat.compilePat patstr1  = .
+showPat.compilePat patstr2  = .
+showPat.compilePat patstrU  = .
+expected value              = 7
+actual value                = 7
+actual value                = 7
+---------------------------------------------------
+patstr1                     = .
+patstr2                     = *
+patstrU                     = *
+showPat.compilePat patstr1  = .
+showPat.compilePat patstr2  = *
+showPat.compilePat patstrU  = *
+expected value              = Prelude.undefined
+actual value                = Prelude.undefined
+---------------------------------------------------
+patstr1                     = *
+patstr2                     = .
+patstrU                     = *
+showPat.compilePat patstr1  = *
+showPat.compilePat patstr2  = .
+showPat.compilePat patstrU  = *
+expected value              = Prelude.undefined
+actual value                = Prelude.undefined
+---------------------------------------------------
+patstr1                     = *
+patstr2                     = *
+patstrU                     = *
+showPat.compilePat patstr1  = *
+showPat.compilePat patstr2  = *
+showPat.compilePat patstrU  = *
+expected value              = Prelude.undefined
+actual value                = Prelude.undefined
+---------------------------------------------------
+patstr1                     = .{...}
+patstr2                     = .{*..}
+patstrU                     = .{*..}
+showPat.compilePat patstr1  = .{...}
+showPat.compilePat patstr2  = .{*..}
+showPat.compilePat patstrU  = .{*..}
+expected value              = Prelude.undefined
+actual value                = Prelude.undefined
+---------------------------------------------------
+patstr1                     = .{*..}
+patstr2                     = .{..*}
+patstrU                     = .{*.*}
+showPat.compilePat patstr1  = .{*..}
+showPat.compilePat patstr2  = .{..*}
+showPat.compilePat patstrU  = .{*.*}
+expected value              = Prelude.undefined
+actual value                = Prelude.undefined
+---------------------------------------------------
+patstr1                     = .{.*#}
+patstr2                     = .{.#.}
+patstrU                     = .{.*.}
+showPat.compilePat patstr1  = .{.*#}
+showPat.compilePat patstr2  = .{.#.}
+showPat.compilePat patstrU  = .{.*.}
+expected value              = Prelude.undefined
+actual value                = Prelude.undefined
+--------------------------------------------------
+===================================================
+Testing splicePats.
+---------------------------------------------------
+target       .
+path         []
+isibs        [(0,"*")]
+result       .{*}
+---------------------------------------------------
+target       .{}
+path         []
+isibs        [(0,"*")]
+result       .{*}
+---------------------------------------------------
+target       .
+path         [0]
+isibs        [(0,"*")]
+result       splicePats: path escapes target (depth)
+---------------------------------------------------
+target       .{..}
+path         []
+isibs        [(0,"*")]
+result       .{*..}
+---------------------------------------------------
+target       .{..}
+path         [0]
+isibs        [(0,"*")]
+result       .{.{*}.}
+---------------------------------------------------
+target       .{..}
+path         [2]
+isibs        [(0,"*")]
+result       splicePats: path escapes target (breadth)
+---------------------------------------------------
+target       .{..}
+path         []
+isibs        [(0,"*"),(0,"#")]
+result       .{*#..}
+---------------------------------------------------
+target       .{..}
+path         []
+isibs        [(0,"*"),(1,"#")]
+result       .{*.#.}
+---------------------------------------------------
+target       .{..}
+path         []
+isibs        [(1,"#"),(0,"*")]
+result       .{*.#.}
+---------------------------------------------------
+target       .{..}
+path         []
+isibs        [(0,"*"),(2,"#")]
+result       .{*..#}
+---------------------------------------------------
+target       .{..}
+path         []
+isibs        [(2,"*"),(2,"#"),(2,"#")]
+result       .{..*##}
+---------------------------------------------------
+target       .{..}
+path         []
+isibs        [(-1,"*")]
+result       .{..*}
+---------------------------------------------------
+target       .{..}
+path         []
+isibs        [(0,"*")]
+result       .{*..}
+---------------------------------------------------
+target       .{..}
+path         []
+isibs        [(1,"*")]
+result       .{.*.}
+---------------------------------------------------
+target       .{..}
+path         []
+isibs        [(2,"*")]
+result       .{..*}
+---------------------------------------------------
+target       .{..}
+path         []
+isibs        [(3,"*")]
+result       splicePats: sibling indices must not exceed the number of existing children
+---------------------------------------------------
+target       .{..{..}.}
+path         [1]
+isibs        [(0,"*")]
+result       .{..{*..}.}
+---------------------------------------------------
+target       .{..{..}.}
+path         [1]
+isibs        [(0,"*3"),(1,"#"),(2,"*")]
+result       .{..{*3.#.*}.}
+---------------------------------------------------
+target       .{..{..}.}
+path         [1,0]
+isibs        [(0,"*"),(0,"#")]
+result       .{..{.{*#}.}.}
+---------------------------------------------------
+target       .{.{...}.{.{}.}.}
+path         [1]
+isibs        [(0,"*"),(0,"#")]
+result       .{.{...}.{*#.{}.}.}
+---------------------------------------------------
+target       .{.{...}.{.{}.}.}
+path         [1,0]
+isibs        [(0,"*"),(0,"#")]
+result       .{.{...}.{.{*#}.}.}
+---------------------------------------------------
+target       .{.{###}.{.{}#}#}
+path         [1,0]
+isibs        [(0,"*"),(0,"#")]
+result       .{.{###}.{.{*#}#}#}
+---------------------------------------------------
+target       .{.:(,,){###}.{.{}#}#}
+path         [1,0]
+isibs        [(0,"*"),(0,"#")]
+result       .{.:(,,){###}.{.{*#}#}#}
+===================================================
+Testing elidePats.
+---------------------------------------------------
+target       .{.{..}..{.}}
+path         []
+isibs        [0]
+result       .{..{.}}
+---------------------------------------------------
+target       .{.{..}..{.}}
+path         [0]
+isibs        [0]
+result       .{.{.}..{.}}
+---------------------------------------------------
+target       .{.{..}..{.}}
+path         [1]
+isibs        [0]
+result       elidePats: (2) path escapes target: [0]
+---------------------------------------------------
+target       .{.{..}..{.}}
+path         [1]
+isibs        [1]
+result       elidePats: sibling indices must not exceed the number of existing children
+===================================================
+Testing erodePat.
+---------------------------------------------------
+target       .{.{..}..{.}}
+stdgen       1355035016 2147483398
+path         []
+result       .{.{.#}..{.}}
+---------------------------------------------------
+target       .{.{..}..{.}}
+stdgen       164232961 367188984
+path         []
+result       .{.{.#}..{.}}
+---------------------------------------------------
+target       .{.{..}..{.}}
+stdgen       23844443 223185073
+path         []
+result       .{.{..}..{#}}
+---------------------------------------------------
+target       .{.{..}..{.}}
+stdgen       1900020236 1632766708
+path         []
+result       .{.{..}..{#}}
+---------------------------------------------------
+target       .{.{..}..{.}}
+stdgen       1186277707 709377745
+path         []
+result       .{.{..}#.{.}}
+---------------------------------------------------
+===================================================
+Testing miscellaneous PatAlg functions...
+---------------------------------------------------
+unionPats test already done test13-1!
+---------------------------------------------------
+Testing      intersectPats [patA, patB]
+patA         .{...}
+patB         .{.#}
+result       intersection: node arity disparity!
+.{#.}
+---------------------------------------------------
+Testing      isSubPatOf patA patB
+patA         .
+patB         .
+as expected  True
+---------------------------------------------------
+Testing      isSubPatOf patA patB
+patA         #
+patB         #
+as expected  True
+---------------------------------------------------
+Testing      isSubPatOf patA patB
+patA         *
+patB         *
+as expected  True
+---------------------------------------------------
+Testing      isSubPatOf patA patB
+patA         .
+patB         .{}
+as expected  True
+---------------------------------------------------
+Testing      isSubPatOf patA patB
+patA         .{}
+patB         .
+as expected  False
+---------------------------------------------------
+Testing      isSubPatOf patA patB
+patA         .{}
+patB         .{.}
+intersection: node arity disparity!
+as expected  False
+---------------------------------------------------
+Testing      isSubPatOf patA patB
+patA         .{.}
+patB         .{.}
+as expected  True
+---------------------------------------------------
+Testing      isSubPatOf patA patB
+patA         .{.}
+patB         .{..}
+intersection: node arity disparity!
+as expected  False
+---------------------------------------------------
+Testing      isSubPatOf patA patB
+patA         .{.}
+patB         .{.{.}}
+expect       True
+result       False
+---------------------------------------------------
+Testing      isSubPatOf patA patB
+patA         .{..}
+patB         .{.#}
+as expected  False
+---------------------------------------------------
+Testing      isSubPatOf patA patB
+patA         .{.#}
+patB         .{..}
+expect       True
+result       False
+---------------------------------------------------
+Testing      isSubPatOf patA patB
+patA         .{..}
+patB         .{...}
+intersection: node arity disparity!
+as expected  False
+---------------------------------------------------
+Testing      isSubPatOf patA patB
+patA         .{}
+patB         .{...}
+intersection: node arity disparity!
+as expected  False
+---------------------------------------------------
+Testing      isSubPatOf patA patB
+patA         .
+patB         .{*.#}
+as expected  True
+---------------------------------------------------
+Testing      isSubPatOf patA patB
+patA         #
+patB         .{*.#}
+as expected  True
+---------------------------------------------------
+Testing      isSubPatOf patA patB
+patA         *
+patB         .{*.#}
+as expected  False
+---------------------------------------------------
+Testing      isSubPatOf patA patB
+patA         *
+patB         .{*}
+as expected  False
+---------------------------------------------------
+Testing      isSubPatOf patA patB
+patA         *
+patB         .{**}
+as expected  False
+doit13: unexpected code 4
+---------------------------------------------------
+Testing      emptyPat
+result       #
+---------------------------------------------------
+Testing      mkPat ([1,2,3],(False,"foo"))
+result       .{.{..{..{..}}}.{..{..{..{..}}}}}
+---------------------------------------------------
+Testing      growPat patA ([1,2,3],(False,"foo"))
+patA         .{.{..{..}}.{..{..}}}
+result       .{.{..{..{..}}}.{..{..{..}}}}
+---------------------------------------------------
+Testing      growPat patA ([1,2,3],(False,"foo"))
+patA         .{.{..{..{..}}}.{..{..{..}}}}
+result       .{.{..{..{..}}}.{..{..{..{..}}}}}
+---------------------------------------------------
+Testing      growPat patA ([1,2,3],(False,"foo"))
+patA         .{.{..{..{..}}}.{..{..{..{..}}}}}
+result       .{.{..{..{..}}}.{..{..{..{..}}}}}
+---------------------------------------------------
+Testing      shrinkPat patA
+patA         .{.{..{..{..}}}.{..{..{..{..}}}}}
+result       .{.{#.{#.{##}}}.{#.{#.{#.{##}}}}}
+---------------------------------------------------
+Testing      shrinkPat patA
+patA         .{.{..{..{..}}}.{..{..{..}}}}
+result       .{.{#.{#.{##}}}.{#.{#.{##}}}}
+---------------------------------------------------
+Testing      shrinkPat patA
+patA         .{.{..{..}}.{..{..}}}
+result       .{.{#.{##}}.{#.{##}}}
+---------------------------------------------------
+Testing      shrinkPat patA
+patA         .{.{#.{..}}.{#.{*3.}}}
+result       .{.{#.{##}}.{#.{*2#}}}
+---------------------------------------------------
+Testing      shrinkPat patA
+patA         .{.{#.}.{#.}}
+result       .{.{##}.{##}}
+---------------------------------------------------
+Testing      shrinkPat patA
+patA         .{..}
+result       .{##}
+---------------------------------------------------
+Testing      shrinkPat patA
+patA         .
+result       #
+---------------------------------------------------
+Testing      liftPats patstrlst
+patstrs      [".{...}",".{.#}"]
+result       .{.{...}.{.#}}
+---------------------------------------------------
+splicePats test already done test13-10!
+---------------------------------------------------
+isPath test already done test13-11!
+---------------------------------------------------
+Testing      mkPatN 2 ([1,2,3],(False,"foo"))
+result       .{.{..{}}.{..{}}}
+---------------------------------------------------
+
+Testing fusion
+-fenable-rewrite-rules -O -ddump-rules -ddump-simpl-stats -ddump-rule-firings
+
+7
+7
+7
+7
+
+  expN_1 = [__] :: [Int]
+  expN_2 = [0,1,__,3] :: [Int]
+  expN_3 = (3.4, [5,__,7], True) :: (Float, [Int], Bool)
+  expN_4 = (3.4, [5,__,7], __) :: (Float, [Int], Bool)
+
+  getN_1 xs = show $ ()
+--getN_1 xs = show $ head xs
+--getN_2 xs = show $ (xs!!1)
+  getN_2 xs = show $ (xs!!3)
+  getN_3 (_,xs,_) = show $ (xs!!2)
+
+forcen 0 expN_1 `seq` ()  =  ()
+forcen 1 expN_1 `seq` ()  =  ()
+forcen 2 expN_1 `seq` ()  =  Prelude.undefined
+forcen 3 expN_1 `seq` ()  =  Prelude.undefined
+forcen 4 expN_1 `seq` ()  =  Prelude.undefined
+
+getN_2 $ forcen 0 expN_2  =  3
+getN_2 $ forcen 1 expN_2  =  3
+getN_2 $ forcen 2 expN_2  =  3
+getN_2 $ forcen 3 expN_2  =  3
+getN_2 $ forcen 4 expN_2  =  Prelude.undefined
+
+getN_3 $ forcen 0 expN_3  =  7
+getN_3 $ forcen 1 expN_3  =  7
+getN_3 $ forcen 2 expN_3  =  7
+getN_3 $ forcen 3 expN_3  =  7
+getN_3 $ forcen 4 expN_3  =  Prelude.undefined
+
+getN_3 $ forcen 0 expN_4  =  7
+getN_3 $ forcen 1 expN_4  =  7
+getN_3 $ forcen 2 expN_4  =  Prelude.undefined
+getN_3 $ forcen 3 expN_4  =  Prelude.undefined
+getN_3 $ forcen 4 expN_4  =  Prelude.undefined
+
+===================================================
+Testing generic GNFDataN (refer to Foo.hs for the defs).
+
+---------------------------------------------------
+( getB_1 $ forcen 0  expTB_1 )  True
+( getB_1 $ forcen 1  expTB_1 )  True
+( getB_1 $ forcen 2  expTB_1 )  True
+( getB_1 $ forcen 3  expTB_1 )  True
+( getB_1 $ forcen 4  expTB_1 )  True
+( getB_1 $ forcen 5  expTB_1 )  True
+( getB_1 $ forcen 6  expTB_1 )  True
+( getB_1 $ forcen 7  expTB_1 )  True
+( getB_1 $ forcen 8  expTB_1 )  True
+( getB_1 $ forcen 9  expTB_1 )  True
+( getB_1 $ forcen 10 expTB_1 )  True
+( getB_1 $ forcen 0  expTB_2 )  True
+( getB_1 $ forcen 1  expTB_2 )  True
+( getB_1 $ forcen 2  expTB_2 )  True
+( getB_1 $ forcen 3  expTB_2 )  Prelude.undefined
+( getB_1 $ forcen 4  expTB_2 )  Prelude.undefined
+( getB_1 $ forcen 5  expTB_2 )  Prelude.undefined
+( getB_1 $ forcen 6  expTB_2 )  Prelude.undefined
+( getB_1 $ forcen 7  expTB_2 )  Prelude.undefined
+( getB_1 $ forcen 8  expTB_2 )  Prelude.undefined
+( getB_1 $ forcen 9  expTB_2 )  Prelude.undefined
+( getB_1 $ forcen 10 expTB_2 )  Prelude.undefined
+( getB_1 $ forcen 0  expTB_3 )  Prelude.undefined
+( getB_1 $ forcen 1  expTB_3 )  Prelude.undefined
+( getB_1 $ forcen 2  expTB_3 )  Prelude.undefined
+( getB_1 $ forcen 3  expTB_3 )  Prelude.undefined
+( getB_1 $ forcen 4  expTB_3 )  Prelude.undefined
+( getB_1 $ forcen 5  expTB_3 )  Prelude.undefined
+( getB_1 $ forcen 6  expTB_3 )  Prelude.undefined
+( getB_1 $ forcen 7  expTB_3 )  Prelude.undefined
+( getB_1 $ forcen 8  expTB_3 )  Prelude.undefined
+( getB_1 $ forcen 9  expTB_3 )  Prelude.undefined
+( getB_1 $ forcen 10 expTB_3 )  Prelude.undefined
+( getB_1 $ forcen 0  expTB_4 )  Prelude.undefined
+( getB_1 $ forcen 1  expTB_4 )  Prelude.undefined
+( getB_1 $ forcen 2  expTB_4 )  Prelude.undefined
+( getB_1 $ forcen 3  expTB_4 )  Prelude.undefined
+( getB_1 $ forcen 4  expTB_4 )  Prelude.undefined
+( getB_1 $ forcen 5  expTB_4 )  Prelude.undefined
+( getB_1 $ forcen 6  expTB_4 )  Prelude.undefined
+( getB_1 $ forcen 7  expTB_4 )  Prelude.undefined
+( getB_1 $ forcen 8  expTB_4 )  Prelude.undefined
+( getB_1 $ forcen 9  expTB_4 )  Prelude.undefined
+( getB_1 $ forcen 10 expTB_4 )  Prelude.undefined
+( getB_1 $ forcen 0  expTB_5 )  True
+( getB_1 $ forcen 1  expTB_5 )  True
+( getB_1 $ forcen 2  expTB_5 )  True
+( getB_1 $ forcen 3  expTB_5 )  True
+( getB_1 $ forcen 4  expTB_5 )  True
+( getB_1 $ forcen 5  expTB_5 )  Prelude.undefined
+( getB_1 $ forcen 6  expTB_5 )  Prelude.undefined
+( getB_1 $ forcen 7  expTB_5 )  Prelude.undefined
+( getB_1 $ forcen 8  expTB_5 )  Prelude.undefined
+( getB_1 $ forcen 9  expTB_5 )  Prelude.undefined
+( getB_1 $ forcen 10 expTB_5 )  Prelude.undefined
+( getB_1 $ forcen 0  expTB_6 )  True
+( getB_1 $ forcen 1  expTB_6 )  True
+( getB_1 $ forcen 2  expTB_6 )  True
+( getB_1 $ forcen 3  expTB_6 )  True
+( getB_1 $ forcen 4  expTB_6 )  Prelude.undefined
+( getB_1 $ forcen 5  expTB_6 )  Prelude.undefined
+( getB_1 $ forcen 6  expTB_6 )  Prelude.undefined
+( getB_1 $ forcen 7  expTB_6 )  Prelude.undefined
+( getB_1 $ forcen 8  expTB_6 )  Prelude.undefined
+( getB_1 $ forcen 9  expTB_6 )  Prelude.undefined
+( getB_1 $ forcen 10 expTB_6 )  Prelude.undefined
+( getB_1 $ forcen 0  expTB_7 )  Prelude.undefined
+( getB_1 $ forcen 1  expTB_7 )  Prelude.undefined
+( getB_1 $ forcen 2  expTB_7 )  Prelude.undefined
+( getB_1 $ forcen 3  expTB_7 )  Prelude.undefined
+( getB_1 $ forcen 4  expTB_7 )  Prelude.undefined
+( getB_1 $ forcen 5  expTB_7 )  Prelude.undefined
+( getB_1 $ forcen 6  expTB_7 )  Prelude.undefined
+( getB_1 $ forcen 7  expTB_7 )  Prelude.undefined
+( getB_1 $ forcen 8  expTB_7 )  Prelude.undefined
+( getB_1 $ forcen 9  expTB_7 )  Prelude.undefined
+( getB_1 $ forcen 10 expTB_7 )  Prelude.undefined
+( getB_1 $ forcen 0  expTB_8 )  True
+( getB_1 $ forcen 1  expTB_8 )  True
+( getB_1 $ forcen 2  expTB_8 )  True
+( getB_1 $ forcen 3  expTB_8 )  True
+( getB_1 $ forcen 4  expTB_8 )  Prelude.undefined
+( getB_1 $ forcen 5  expTB_8 )  Prelude.undefined
+( getB_1 $ forcen 6  expTB_8 )  Prelude.undefined
+( getB_1 $ forcen 7  expTB_8 )  Prelude.undefined
+( getB_1 $ forcen 8  expTB_8 )  Prelude.undefined
+( getB_1 $ forcen 9  expTB_8 )  Prelude.undefined
+( getB_1 $ forcen 10 expTB_8 )  Prelude.undefined
+( getB_1 $ forcen 0  expTB_9 )  True
+( getB_1 $ forcen 1  expTB_9 )  True
+( getB_1 $ forcen 2  expTB_9 )  True
+( getB_1 $ forcen 3  expTB_9 )  True
+( getB_1 $ forcen 4  expTB_9 )  Prelude.undefined
+( getB_1 $ forcen 5  expTB_9 )  Prelude.undefined
+( getB_1 $ forcen 6  expTB_9 )  Prelude.undefined
+( getB_1 $ forcen 7  expTB_9 )  Prelude.undefined
+( getB_1 $ forcen 8  expTB_9 )  Prelude.undefined
+( getB_1 $ forcen 9  expTB_9 )  Prelude.undefined
+( getB_1 $ forcen 10 expTB_9 )  Prelude.undefined
+( getB_1 $ forcen 0  expTB_10 )  True
+( getB_1 $ forcen 1  expTB_10 )  True
+( getB_1 $ forcen 2  expTB_10 )  True
+( getB_1 $ forcen 3  expTB_10 )  True
+( getB_1 $ forcen 4  expTB_10 )  True
+( getB_1 $ forcen 5  expTB_10 )  Prelude.undefined
+( getB_1 $ forcen 6  expTB_10 )  Prelude.undefined
+( getB_1 $ forcen 7  expTB_10 )  Prelude.undefined
+( getB_1 $ forcen 8  expTB_10 )  Prelude.undefined
+( getB_1 $ forcen 9  expTB_10 )  Prelude.undefined
+( getB_1 $ forcen 10 expTB_10 )  Prelude.undefined
+( getB_1 $ forcen 0  expTB_11 )  True
+( getB_1 $ forcen 1  expTB_11 )  True
+( getB_1 $ forcen 2  expTB_11 )  True
+( getB_1 $ forcen 3  expTB_11 )  True
+( getB_1 $ forcen 4  expTB_11 )  True
+( getB_1 $ forcen 5  expTB_11 )  Prelude.undefined
+( getB_1 $ forcen 6  expTB_11 )  Prelude.undefined
+( getB_1 $ forcen 7  expTB_11 )  Prelude.undefined
+( getB_1 $ forcen 8  expTB_11 )  Prelude.undefined
+( getB_1 $ forcen 9  expTB_11 )  Prelude.undefined
+( getB_1 $ forcen 10 expTB_11 )  Prelude.undefined
+( getB_1 $ forcen 0  expTB_12 )  True
+( getB_1 $ forcen 1  expTB_12 )  True
+( getB_1 $ forcen 2  expTB_12 )  True
+( getB_1 $ forcen 3  expTB_12 )  True
+( getB_1 $ forcen 4  expTB_12 )  True
+( getB_1 $ forcen 5  expTB_12 )  True
+( getB_1 $ forcen 6  expTB_12 )  True
+( getB_1 $ forcen 7  expTB_12 )  Prelude.undefined
+( getB_1 $ forcen 8  expTB_12 )  Prelude.undefined
+( getB_1 $ forcen 9  expTB_12 )  Prelude.undefined
+( getB_1 $ forcen 10 expTB_12 )  Prelude.undefined
+( getB_1 $ forcen 0  expTB_13 )  True
+( getB_1 $ forcen 1  expTB_13 )  True
+( getB_1 $ forcen 2  expTB_13 )  True
+( getB_1 $ forcen 3  expTB_13 )  True
+( getB_1 $ forcen 4  expTB_13 )  Prelude.undefined
+( getB_1 $ forcen 5  expTB_13 )  Prelude.undefined
+( getB_1 $ forcen 6  expTB_13 )  Prelude.undefined
+( getB_1 $ forcen 7  expTB_13 )  Prelude.undefined
+( getB_1 $ forcen 8  expTB_13 )  Prelude.undefined
+( getB_1 $ forcen 9  expTB_13 )  Prelude.undefined
+( getB_1 $ forcen 10 expTB_13 )  Prelude.undefined
+( getB_1 $ forcen 0  expTB_14 )  True
+( getB_1 $ forcen 1  expTB_14 )  True
+( getB_1 $ forcen 2  expTB_14 )  True
+( getB_1 $ forcen 3  expTB_14 )  True
+( getB_1 $ forcen 4  expTB_14 )  True
+( getB_1 $ forcen 5  expTB_14 )  Prelude.undefined
+( getB_1 $ forcen 6  expTB_14 )  Prelude.undefined
+( getB_1 $ forcen 7  expTB_14 )  Prelude.undefined
+( getB_1 $ forcen 8  expTB_14 )  Prelude.undefined
+( getB_1 $ forcen 9  expTB_14 )  Prelude.undefined
+( getB_1 $ forcen 10 expTB_14 )  Prelude.undefined
+( getB_1 $ forcen 0  expTB_15 )  True
+( getB_1 $ forcen 1  expTB_15 )  True
+( getB_1 $ forcen 2  expTB_15 )  True
+( getB_1 $ forcen 3  expTB_15 )  True
+( getB_1 $ forcen 4  expTB_15 )  True
+( getB_1 $ forcen 5  expTB_15 )  Prelude.undefined
+( getB_1 $ forcen 6  expTB_15 )  Prelude.undefined
+( getB_1 $ forcen 7  expTB_15 )  Prelude.undefined
+( getB_1 $ forcen 8  expTB_15 )  Prelude.undefined
+( getB_1 $ forcen 9  expTB_15 )  Prelude.undefined
+( getB_1 $ forcen 10 expTB_15 )  Prelude.undefined
+( getB_1 $ forcen 0  expTB_16 )  5
+( getB_1 $ forcen 1  expTB_16 )  5
+( getB_1 $ forcen 2  expTB_16 )  5
+( getB_1 $ forcen 3  expTB_16 )  Prelude.undefined
+( getB_1 $ forcen 4  expTB_16 )  Prelude.undefined
+( getB_1 $ forcen 5  expTB_16 )  Prelude.undefined
+( getB_1 $ forcen 6  expTB_16 )  Prelude.undefined
+( getB_1 $ forcen 7  expTB_16 )  Prelude.undefined
+( getB_1 $ forcen 8  expTB_16 )  Prelude.undefined
+( getB_1 $ forcen 9  expTB_16 )  Prelude.undefined
+( getB_1 $ forcen 10 expTB_16 )  Prelude.undefined
+( getB_1 $ forcen 0  expTB_17 )  5
+( getB_1 $ forcen 1  expTB_17 )  5
+( getB_1 $ forcen 2  expTB_17 )  Prelude.undefined
+( getB_1 $ forcen 3  expTB_17 )  Prelude.undefined
+( getB_1 $ forcen 4  expTB_17 )  Prelude.undefined
+( getB_1 $ forcen 5  expTB_17 )  Prelude.undefined
+( getB_1 $ forcen 6  expTB_17 )  Prelude.undefined
+( getB_1 $ forcen 7  expTB_17 )  Prelude.undefined
+( getB_1 $ forcen 8  expTB_17 )  Prelude.undefined
+( getB_1 $ forcen 9  expTB_17 )  Prelude.undefined
+( getB_1 $ forcen 10 expTB_17 )  Prelude.undefined
+( getB_1 $ forcen 0  expTB_18 )  5
+( getB_1 $ forcen 1  expTB_18 )  5
+( getB_1 $ forcen 2  expTB_18 )  Prelude.undefined
+( getB_1 $ forcen 3  expTB_18 )  Prelude.undefined
+( getB_1 $ forcen 4  expTB_18 )  Prelude.undefined
+( getB_1 $ forcen 5  expTB_18 )  Prelude.undefined
+( getB_1 $ forcen 6  expTB_18 )  Prelude.undefined
+( getB_1 $ forcen 7  expTB_18 )  Prelude.undefined
+( getB_1 $ forcen 8  expTB_18 )  Prelude.undefined
+( getB_1 $ forcen 9  expTB_18 )  Prelude.undefined
+( getB_1 $ forcen 10 expTB_18 )  Prelude.undefined
+( getB_1 $ forcen 0  expTB_19 )  False
+( getB_1 $ forcen 1  expTB_19 )  False
+( getB_1 $ forcen 2  expTB_19 )  Prelude.undefined
+( getB_1 $ forcen 3  expTB_19 )  Prelude.undefined
+( getB_1 $ forcen 4  expTB_19 )  Prelude.undefined
+( getB_1 $ forcen 5  expTB_19 )  Prelude.undefined
+( getB_1 $ forcen 6  expTB_19 )  Prelude.undefined
+( getB_1 $ forcen 7  expTB_19 )  Prelude.undefined
+( getB_1 $ forcen 8  expTB_19 )  Prelude.undefined
+( getB_1 $ forcen 9  expTB_19 )  Prelude.undefined
+( getB_1 $ forcen 10 expTB_19 )  Prelude.undefined
+( getB_1 $ forcen 0  expTB_20 )  beesix
+( getB_1 $ forcen 1  expTB_20 )  beesix
+( getB_1 $ forcen 2  expTB_20 )  Prelude.undefined
+( getB_1 $ forcen 3  expTB_20 )  Prelude.undefined
+( getB_1 $ forcen 4  expTB_20 )  Prelude.undefined
+( getB_1 $ forcen 5  expTB_20 )  Prelude.undefined
+( getB_1 $ forcen 6  expTB_20 )  Prelude.undefined
+( getB_1 $ forcen 7  expTB_20 )  Prelude.undefined
+( getB_1 $ forcen 8  expTB_20 )  Prelude.undefined
+( getB_1 $ forcen 9  expTB_20 )  Prelude.undefined
+( getB_1 $ forcen 10 expTB_20 )  Prelude.undefined
+( getB_1 $ forcen 0  expTB_21 )  &lt;bah&gt;
+( getB_1 $ forcen 1  expTB_21 )  &lt;bah&gt;
+( getB_1 $ forcen 2  expTB_21 )  &lt;bah&gt;
+( getB_1 $ forcen 3  expTB_21 )  &lt;bah&gt;
+( getB_1 $ forcen 4  expTB_21 )  Prelude.undefined
+( getB_1 $ forcen 5  expTB_21 )  Prelude.undefined
+( getB_1 $ forcen 6  expTB_21 )  Prelude.undefined
+( getB_1 $ forcen 7  expTB_21 )  Prelude.undefined
+( getB_1 $ forcen 8  expTB_21 )  Prelude.undefined
+( getB_1 $ forcen 9  expTB_21 )  Prelude.undefined
+( getB_1 $ forcen 10 expTB_21 )  Prelude.undefined
+( getB_1 $ forcen 0  expTB_22 )  &lt;bah&gt;
+( getB_1 $ forcen 1  expTB_22 )  &lt;bah&gt;
+( getB_1 $ forcen 2  expTB_22 )  &lt;bah&gt;
+( getB_1 $ forcen 3  expTB_22 )  &lt;bah&gt;
+( getB_1 $ forcen 4  expTB_22 )  Prelude.undefined
+( getB_1 $ forcen 5  expTB_22 )  Prelude.undefined
+( getB_1 $ forcen 6  expTB_22 )  Prelude.undefined
+( getB_1 $ forcen 7  expTB_22 )  Prelude.undefined
+( getB_1 $ forcen 8  expTB_22 )  Prelude.undefined
+( getB_1 $ forcen 9  expTB_22 )  Prelude.undefined
+( getB_1 $ forcen 10 expTB_22 )  Prelude.undefined
+( getB_1 $ forcen 0  expTB_23 )  &lt;bah&gt;
+( getB_1 $ forcen 1  expTB_23 )  &lt;bah&gt;
+( getB_1 $ forcen 2  expTB_23 )  &lt;bah&gt;
+( getB_1 $ forcen 3  expTB_23 )  &lt;bah&gt;
+( getB_1 $ forcen 4  expTB_23 )  &lt;bah&gt;
+( getB_1 $ forcen 5  expTB_23 )  &lt;bah&gt;
+( getB_1 $ forcen 6  expTB_23 )  Prelude.undefined
+( getB_1 $ forcen 7  expTB_23 )  Prelude.undefined
+( getB_1 $ forcen 8  expTB_23 )  Prelude.undefined
+( getB_1 $ forcen 9  expTB_23 )  Prelude.undefined
+( getB_1 $ forcen 10 expTB_23 )  Prelude.undefined
+( getB_1 $ forcen 0  expTB_24 )  &lt;bah&gt;
+( getB_1 $ forcen 1  expTB_24 )  &lt;bah&gt;
+( getB_1 $ forcen 2  expTB_24 )  &lt;bah&gt;
+( getB_1 $ forcen 3  expTB_24 )  &lt;bah&gt;
+( getB_1 $ forcen 4  expTB_24 )  Prelude.undefined
+( getB_1 $ forcen 5  expTB_24 )  Prelude.undefined
+( getB_1 $ forcen 6  expTB_24 )  Prelude.undefined
+( getB_1 $ forcen 7  expTB_24 )  Prelude.undefined
+( getB_1 $ forcen 8  expTB_24 )  Prelude.undefined
+( getB_1 $ forcen 9  expTB_24 )  Prelude.undefined
+( getB_1 $ forcen 10 expTB_24 )  Prelude.undefined
+( getB_1 $ forcen 0  expTB_25 )  &lt;bah&gt;
+( getB_1 $ forcen 1  expTB_25 )  &lt;bah&gt;
+( getB_1 $ forcen 2  expTB_25 )  Prelude.undefined
+( getB_1 $ forcen 3  expTB_25 )  Prelude.undefined
+( getB_1 $ forcen 4  expTB_25 )  Prelude.undefined
+( getB_1 $ forcen 5  expTB_25 )  Prelude.undefined
+( getB_1 $ forcen 6  expTB_25 )  Prelude.undefined
+( getB_1 $ forcen 7  expTB_25 )  Prelude.undefined
+( getB_1 $ forcen 8  expTB_25 )  Prelude.undefined
+( getB_1 $ forcen 9  expTB_25 )  Prelude.undefined
+( getB_1 $ forcen 10 expTB_25 )  Prelude.undefined
+( getB_1 $ forcen 0  expTB_26 )  &lt;bah&gt;
+( getB_1 $ forcen 1  expTB_26 )  &lt;bah&gt;
+( getB_1 $ forcen 2  expTB_26 )  &lt;bah&gt;
+( getB_1 $ forcen 3  expTB_26 )  &lt;bah&gt;
+( getB_1 $ forcen 4  expTB_26 )  &lt;bah&gt;
+( getB_1 $ forcen 5  expTB_26 )  &lt;bah&gt;
+( getB_1 $ forcen 6  expTB_26 )  &lt;bah&gt;
+( getB_1 $ forcen 7  expTB_26 )  Prelude.undefined
+( getB_1 $ forcen 8  expTB_26 )  Prelude.undefined
+( getB_1 $ forcen 9  expTB_26 )  Prelude.undefined
+( getB_1 $ forcen 10 expTB_26 )  Prelude.undefined
+
+
+Testing SOP rnfpDyn with SYB generic stop condition.
+
+Float
+WR
+BBB 3.4
+[Int]
+WI
+AAA 
+Bool
+WI
+AAA 
+7
+
+Testing SOP/SYB rnfpDyn again.
+
+[[Int]]
+Noo-C
+WI
+Noo-C
+AAA 
+[[[Int]]]
+Noo-D
+WI
+Noo-D
+AAA 
+6
+
+Testing SOP rnfpDyn' with SOP generic stop condition.
+
+*** :
+WR
+
+Testing SOP rnfpDyn'' with Typeable generic stop condition
+
+[[Int]]
+WI
+AAA 
+[[[Int]]]
+WI
+AAA 
+7
+
+
+Testing Seqable class (tuple with list):
+
+===================================================
+exp = &lt;refer to test code&gt;
+get (_,xs,_) = show $ (xs!!2)
+? = get $! exp
+===================================================
+1 expected value           = 7
+1 actual value             = 7
+---------------------------------------------------
+2 expected value           = Prelude.undefined
+2 actual value             = Prelude.undefined
+---------------------------------------------------
+3 expected value           = Prelude.undefined
+3 actual value             = Prelude.undefined
+---------------------------------------------------
+4 expected value           = 7
+4 actual value             = 7
+---------------------------------------------------
+5 expected value           = 7
+5 actual value             = 7
+---------------------------------------------------
+6 expected value           = Prelude.undefined
+6 actual value             = Prelude.undefined
+---------------------------------------------------
+7 expected value           = 7
+7 actual value             = 7
+---------------------------------------------------
+8 expected value           = 7
+8 actual value             = 7
+---------------------------------------------------
+9 expected value           = 7
+9 actual value             = 7
+--------------------------------------------------
+
+Testing Seqable class (nested tuples):
+
+===================================================
+exp = &lt;refer to test code&gt;
+get (_,(_,x),_) = show x
+? = get $! exp
+===================================================
+1 expected value           = 7
+1 actual value             = 7
+---------------------------------------------------
+2 expected value           = 7
+2 actual value             = 7
+---------------------------------------------------
+3 expected value           = Prelude.undefined
+3 actual value             = Prelude.undefined
+---------------------------------------------------
+4 expected value           = Prelude.undefined
+4 actual value             = Prelude.undefined
+---------------------------------------------------
+5 expected value           = Prelude.undefined
+5 actual value             = Prelude.undefined
+---------------------------------------------------
+6 expected value           = 7
+6 actual value             = 7
+---------------------------------------------------
+7 expected value           = Prelude.undefined
+7 actual value             = Prelude.undefined
+---------------------------------------------------
+8 expected value           = 7
+8 actual value             = 7
+---------------------------------------------------
+9 expected value           = Prelude.undefined
+9 actual value             = Prelude.undefined
+--------------------------------------------------
+
+Testing generic Seqable (tuple with list):
+
+===================================================
+exp = &lt;refer to test code&gt;
+get (_,xs,_) = show $ (xs!!2)
+? = get $! exp
+===================================================
+1 expected value           = 7
+1 actual value             = 7
+---------------------------------------------------
+2 expected value           = Prelude.undefined
+2 actual value             = Prelude.undefined
+---------------------------------------------------
+3 expected value           = Prelude.undefined
+3 actual value             = Prelude.undefined
+---------------------------------------------------
+4 expected value           = 7
+4 actual value             = 7
+---------------------------------------------------
+5 expected value           = 7
+5 actual value             = 7
+---------------------------------------------------
+6 expected value           = Prelude.undefined
+6 actual value             = Prelude.undefined
+---------------------------------------------------
+7 expected value           = 7
+7 actual value             = 7
+---------------------------------------------------
+8 expected value           = 7
+8 actual value             = 7
+---------------------------------------------------
+9 expected value           = 7
+9 actual value             = 7
+--------------------------------------------------
+
+Testing generic Seqable (expTJ_*):
+
+===================================================
+exp = J2 (1, J4 (__, K3 __ (J1 4.5))) __
+get = (J2 (_, J4 (_, K3 _ (J1 f))) _) = show f
+? = get exp
+===================================================
+1 expected value           = 4.5
+1 actual value             = 4.5
+---------------------------------------------------
+2 expected value           = Prelude.undefined
+2 actual value             = Prelude.undefined
+---------------------------------------------------
+3 expected value           = 4.5
+3 actual value             = 4.5
+---------------------------------------------------
+4 expected value           = Prelude.undefined
+4 actual value             = Prelude.undefined
+---------------------------------------------------
+5 expected value           = Prelude.undefined
+5 actual value             = Prelude.undefined
+---------------------------------------------------
+6 expected value           = Prelude.undefined
+6 actual value             = Prelude.undefined
+--------------------------------------------------
+
+
+FAILING ON PURPOSE TO DISPLAY THE LOGGED OUTPUT!
+
+### Failure in: All:0
+expected: 0
+ but got: 1
+Cases: 1  Tried: 1  Errors: 0  Failures: 1
+*** Exception: ExitFailure 1
+*Main&gt; 
+Leaving GHCi.
+kadath:script&gt; 
+</pre>
+</body>
+</html>
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2014, Andrew G. Seniuk
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Andrew Seniuk nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/README b/README
new file mode 100644
--- /dev/null
+++ b/README
@@ -0,0 +1,4 @@
+
+For additional documentation, browse to ./HTML
+(or http://www.fremissant.net/deepseq-bounded).
+
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,6 @@
+module Main (main) where
+
+import Distribution.Simple
+
+main :: IO ()
+main = defaultMain
diff --git a/deepseq-bounded.cabal b/deepseq-bounded.cabal
new file mode 100644
--- /dev/null
+++ b/deepseq-bounded.cabal
@@ -0,0 +1,341 @@
+
+name:		deepseq-bounded
+version:        0.5.0
+synopsis:       Bounded deepseq, including support for generic deriving
+homepage:       http://fremissant.net/deepseq-bounded
+--homepage:       https://fremissant.com/deepseq-bounded
+--bug-reports:    https://fremissant.com/deepseq-bounded/issues
+license:	BSD3
+license-file:	LICENSE
+author:         Andrew G. Seniuk
+maintainer:     andrew.seniuk@gmail.com
+category:       Control
+build-type:     Simple
+cabal-version:  >=1.10
+tested-with:    GHC==7.6.3, GHC==7.8.1, GHC==7.8.3
+stability:      provisional
+extra-source-files:     README
+                      , test/*.hs
+                      , HTML/*.html
+                      , HTML/*.css
+description:
+    This package provides methods for partially (or fully) evaluating data
+    structures (\"bounded deep evaluation\").
+    .
+    More information is available on the project <http://www.fremissant.net/deepseq-bounded homepage>.
+    .
+    Quoting comments from the
+    <https://hackage.haskell.org/package/deepseq deepseq> package:
+    .
+    /\"Artificial forcing is often used for adding strictness to a program, e.g. in order to force pending exceptions, remove space leaks, or force lazy I\/O to happen. It is also useful in parallel programs, to ensure work does not migrate to the wrong thread.\"/
+    .
+    Sometimes we don't want to, or cannot, force all the way.
+    Any infinite recursive type is an example. Also, bounded forcing
+    bridges the theoretical axis between shallow seq and full deepseq.
+    .
+    We provide two new classes "NFDataN" and "NFDataP". Instances of these
+    provide bounded deep evaluation for arbitrary polytypic terms:
+    .
+    * 'rnfn' bounds the forced evaluation by depth of recursion.
+    .
+    * 'rnfp' forces based on patterns (static or dynamic).
+    .
+    Instances of "NFDataN" and "NFDataP" can be automatically derived via
+    "Generics.SOP", backed by the "GNFDataN" and "GNFDataP" modules.
+    .
+    Another approach is "Seqable", which is similar to "NFDataN",
+    but optimised for use as a dynamically-reconfigurable forcing harness
+    in the <https://hackage.haskell.org/package/seqaid seqaid> auto-instrumentation tool.
+    .
+    Recent developments supporting parallelisation control (in "Pattern"
+    and "Seqable" modules) may justify renaming this library to
+    something which emcompasses both strictness and parallelism aspects.
+
+--  "NFDataN" can optionally be derived by the standard "GHC.Generics"
+--  facility (but not so for "NFDataP").
+
+-- extra-source-files: changelog
+-- 
+-- source-repository head
+--   type:     git
+--   location: https://www.fremissant.com/package/deepseq-bounded.git
+-- 
+-- source-repository this
+--   type:     git
+--   location: https://www.fremissant.com/package/deepseq-bounded.git
+--   tag:      deepseq-bounded-1.3.0.2-release
+
+Flag HASKELL98_FRAGMENT
+  Description: Sacrifice generic deriving, the NFDataPDyn module, and a couple functions from the PatAlg module, in exchange for true Haskell98 conformance (portability). You need to set PARALLELISM_EXPERIMENT, USE_WW_DEEPSEQ, USE_SOP, and NFDATA_INSTANCE_PATTERN to False if you set HASKELL98_FRAGMENT to True. (This was once up-to-date, but may have become in need of some attention. One thing it insists on is -XPatternGuards, although this could be relieved in the obvious way...)
+--Default:     True
+  Default:     False
+
+Flag PARALLELISM_EXPERIMENT
+  Description: We can selectively use par instead of seq, which is interesting.
+  Default:     True
+--Default:     False
+
+-- Flag SEQUENTIALISM_EXPERIMENT
+--   Description: We can selectively use pseq instead of seq, which is interesting. (This is more difficult to implement (usefully) than PARALLELISM_EXPERIMENT, and was left on hold for now.)
+-- --Default:     True
+--   Default:     False
+
+Flag JUST_ALIAS_GSEQABLE
+  Description: The SOP generic function is probably more performant, anyway! (This will be forced False if HASKELL98_FRAGMENT is True.)
+  Default:     True
+--Default:     False
+
+Flag USE_WW_DEEPSEQ
+  Description: Depend on deepseq and deepseq-generics, to provide conditional deep forcing. This is optional.
+  Default:     True
+--Default:     False
+
+Flag WARN_PATTERN_MATCH_FAILURE
+  Description: For NFDataP, if a pattern match fails a warning is output to stderr.
+--Default:     True
+  Default:     False
+
+Flag USE_SOP
+  Description: Use the generics-sop package instead of SYB for generics. NFDataPDyn and GNFDataP modules will not be available.
+  Default:     True
+--Default:     False
+
+Flag NFDATA_INSTANCE_PATTERN
+  Description: A flag to assist debugging, affecting a few modules.
+  Default:     True
+--Default:     False
+
+library {
+
+  hs-source-dirs: src
+
+  -- This library is Haskell98 if you exclude the generics bits.
+  -- See the comment below (other-extensions) for more specifics.
+  if flag(HASKELL98_FRAGMENT)
+    default-language: Haskell98
+  else
+    default-language: Haskell2010
+
+  default-extensions:  CPP
+
+-- If you exclude PatAlg.mkPat and PatAlg.growPat (which use SYB),
+-- and NFDataPDyn, GNFDataN, and GNFDataP (which use GHC.Generics
+-- and/or Generics.SOP), none of the code depends in any essential
+-- way on language extensions. I use PatternGuards for convenience,
+-- but they could be translated away easily, and we'd have Haskell98.
+  if flag(HASKELL98_FRAGMENT)
+    other-extensions:    PatternGuards
+  else
+    -- ... and more (see what SOP and SYB actually need)
+    other-extensions:    PatternGuards, DeriveGeneric
+--if impl(ghc >= 7.2)
+--  other-extensions: Safe
+
+  exposed-modules:
+      Control.DeepSeq.Bounded
+    , Control.DeepSeq.Bounded.Seqable
+    , Control.DeepSeq.Bounded.NFDataN
+    , Control.DeepSeq.Bounded.Pattern
+    , Control.DeepSeq.Bounded.PatAlg
+    , Control.DeepSeq.Bounded.NFDataP
+  if ! flag(HASKELL98_FRAGMENT)
+     exposed-modules:
+         Control.DeepSeq.Bounded.Generics
+       , Control.DeepSeq.Bounded.Generics.GNFDataN
+     if flag(USE_SOP)
+        exposed-modules:
+            Control.DeepSeq.Bounded.Generics.GNFDataP
+          , Control.DeepSeq.Bounded.Generics.GSeqable
+          , Control.DeepSeq.Bounded.NFDataPDyn
+
+  ghc-options: -optP-Wundef -fno-warn-overlapping-patterns
+
+--ghc-options:         -Wall -fenable-rewrite-rules    -ddump-rules -ddump-simpl-stats -ddump-rule-firings
+--ghc-options:         -Wall -fenable-rewrite-rules
+  ghc-options:         -fenable-rewrite-rules   
+--ghc-options:         -fenable-rewrite-rules -O2
+
+  build-depends:
+      base < 5
+--    base       >= 4.3 && < 4.8
+--    base >= 4.5 && < 4.8
+    , array
+--  , array      >= 0.3 && < 0.6
+--  , sai-shape-syb
+--- , ghc-syb-utils
+    -- for Data.Tree
+--  , containers
+    , random
+
+  if ! flag(HASKELL98_FRAGMENT)
+     build-depends:
+         syb
+
+  -- deepseq not used for any legitimate reason, unless USE_WW_DEEPSEQ;
+  -- but it's used in some debugging and testing code (although probably
+  -- shouldn't be), so the dep stays for now:
+  build-depends:
+      deepseq
+--    deepseq >= 1.2.0.1 && < 1.4
+
+  if flag(USE_WW_DEEPSEQ)
+     build-depends:
+         deepseq
+--       deepseq >= 1.2.0.1 && < 1.4
+     if ! flag(HASKELL98_FRAGMENT)
+        build-depends:
+            deepseq-generics
+     cpp-options: -DUSE_WW_DEEPSEQ=1
+  else
+     cpp-options: -DUSE_WW_DEEPSEQ=0
+
+  if flag(WARN_PATTERN_MATCH_FAILURE)
+     cpp-options: -DWARN_PATTERN_MATCH_FAILURE=1
+  else
+     cpp-options: -DWARN_PATTERN_MATCH_FAILURE=0
+
+  if ! flag(HASKELL98_FRAGMENT)
+      if flag(USE_SOP)
+         build-depends:
+             generics-sop
+         cpp-options: -DUSE_SOP=1
+      else
+         cpp-options: -DUSE_SOP=0
+  else
+      cpp-options: -DUSE_SOP=0
+
+  if flag(HASKELL98_FRAGMENT)
+     cpp-options: -DHASKELL98_FRAGMENT=1
+  else
+     cpp-options: -DHASKELL98_FRAGMENT=0
+
+  if flag(NFDATA_INSTANCE_PATTERN)
+     cpp-options: -DNFDATA_INSTANCE_PATTERN=1
+  else
+     cpp-options: -DNFDATA_INSTANCE_PATTERN=0
+
+  if flag(PARALLELISM_EXPERIMENT)
+     build-depends:
+         parallel
+
+--if flag(SEQUENTIALISM_EXPERIMENT)
+--   build-depends:
+--       -- yes, really
+--       parallel
+
+  if flag(PARALLELISM_EXPERIMENT)
+     cpp-options: -DPARALLELISM_EXPERIMENT=1
+  else
+     cpp-options: -DPARALLELISM_EXPERIMENT=0
+
+--if flag(SEQUENTIALISM_EXPERIMENT)
+--   cpp-options: -DSEQUENTIALISM_EXPERIMENT=1
+--else
+--   cpp-options: -DSEQUENTIALISM_EXPERIMENT=0
+
+  if flag(JUST_ALIAS_GSEQABLE)
+     cpp-options: -DJUST_ALIAS_GSEQABLE=1
+  else
+     cpp-options: -DJUST_ALIAS_GSEQABLE=0
+
+}
+
+test-suite deepseq-bounded-tests {
+
+  if flag(HASKELL98_FRAGMENT)
+    default-language: Haskell98
+  else
+    default-language: Haskell2010
+
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      test
+  main-is:             Suite.hs
+  other-modules:       Tests, Foo
+  if flag(HASKELL98_FRAGMENT)
+     other-modules:       Blah98
+  else
+     other-modules:       Blah, Bottom, FooG
+  default-extensions:  CPP
+
+  ghc-options: -optP-Wundef -fno-warn-overlapping-patterns
+
+--ghc-options:         -Wall -fenable-rewrite-rules -O -ddump-rules -ddump-simpl-stats -ddump-rule-firings
+--ghc-options:         -Wall -fenable-rewrite-rules -O
+--ghc-options:         -fenable-rewrite-rules -O
+  ghc-options:         -fenable-rewrite-rules -O2
+
+  build-depends:
+      base
+    , deepseq-bounded
+    , HUnit
+    , random
+
+    , template-haskell
+
+  if ! flag(HASKELL98_FRAGMENT)
+     build-depends:
+         ghc-prim
+
+  if ! flag(HASKELL98_FRAGMENT)
+     build-depends:
+         syb
+
+  -- deepseq not used for any legitimate reason, unless USE_WW_DEEPSEQ;
+  -- but it's used in some debugging and testing code (although probably
+  -- shouldn't be), so the dep stays for now:
+  build-depends:
+      deepseq
+--    deepseq >= 1.2.0.1 && < 1.4
+
+  if flag(USE_WW_DEEPSEQ)
+     build-depends:
+         deepseq
+--       deepseq >= 1.2.0.1 && < 1.4
+     if ! flag(HASKELL98_FRAGMENT)
+         build-depends:
+             deepseq-generics
+     cpp-options: -DUSE_WW_DEEPSEQ=1
+  else
+     cpp-options: -DUSE_WW_DEEPSEQ=0
+
+  if ! flag(HASKELL98_FRAGMENT)
+      if flag(USE_SOP)
+         build-depends:
+             generics-sop
+         cpp-options: -DUSE_SOP=1
+      else
+         cpp-options: -DUSE_SOP=0
+  else
+      cpp-options: -DUSE_SOP=0
+
+  if flag(HASKELL98_FRAGMENT)
+     cpp-options: -DHASKELL98_FRAGMENT=1
+  else
+     cpp-options: -DHASKELL98_FRAGMENT=0
+
+  if flag(PARALLELISM_EXPERIMENT)
+     build-depends:
+         parallel
+
+--if flag(SEQUENTIALISM_EXPERIMENT)
+--   build-depends:
+--       -- yes, really
+--       parallel
+
+  if flag(PARALLELISM_EXPERIMENT)
+     cpp-options: -DPARALLELISM_EXPERIMENT=1
+  else
+     cpp-options: -DPARALLELISM_EXPERIMENT=0
+
+--if flag(SEQUENTIALISM_EXPERIMENT)
+--   cpp-options: -DSEQUENTIALISM_EXPERIMENT=1
+--else
+--   cpp-options: -DSEQUENTIALISM_EXPERIMENT=0
+
+  if flag(JUST_ALIAS_GSEQABLE)
+     cpp-options: -DJUST_ALIAS_GSEQABLE=1
+  else
+     cpp-options: -DJUST_ALIAS_GSEQABLE=0
+
+}
+
diff --git a/src/Control/DeepSeq/Bounded.hs b/src/Control/DeepSeq/Bounded.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/DeepSeq/Bounded.hs
@@ -0,0 +1,122 @@
+
+-------------------------------------------------------------------------------
+
+{-  LANGUAGE CPP #-}
+
+-------------------------------------------------------------------------------
+
+-- |
+-- Module      :  Control.DeepSeq.Bounded
+-- Copyright   :  (c) 2014, Andrew G. Seniuk
+-- License     :  BSD-style (see the file LICENSE)
+-- 
+-- Maintainer  :  Andrew Seniuk <rasfar@gmail.com>
+-- Stability   :  provisional
+-- Portability :  portable (but GHC for a few modules using generics)
+--
+-- We provide forcing functions which take a non-strict value
+-- of a datatype, and force its evaluation in a pricipled way.
+-- As with 'NFData', one should bear in mind the difference
+-- between forcing and demand: in order for your forcing to
+-- take effect, demand must be placed on the forcing function
+-- itself by the course of execution.
+--
+-- A typical use of bounded forcing is to prevent resource leaks in
+-- lazy streaming, by forcing chunks of data of bounded but sufficient
+-- depth for the consumer to make progress.
+--
+-- Another use is to ensure any exceptions hidden within lazy
+-- fields of a data structure do not leak outside the scope of the
+-- exception handler; another is to force evaluation of a data structure in
+-- one thread, before passing it to another thread (preventing work moving
+-- to the wrong threads). Unlike "DeepSeq", potentially infinite coinductive
+-- data types are supported by principled bounding of deep evaluation.
+--
+-- Refer to comments in the 'deepseq' package for more information on how
+-- artificial forcing can be useful.
+--
+-- Recently, control (static or dynamic) of parallelisation has been added.
+-- Control of evaluation order should also be possible (using 'pseq').
+
+-------------------------------------------------------------------------------
+
+  module Control.DeepSeq.Bounded (
+
+     -- * Forced evaluation to an arbitrary finite depth
+
+#if 1
+       module Control.DeepSeq.Bounded.NFDataN
+#else
+       NFDataN(..)
+     , deepseqn, forcen
+#endif
+
+     -- * Forced evaluation over a pattern (arbitrary finite, or dynamic)
+
+     , module Control.DeepSeq.Bounded.Pattern
+     , module Control.DeepSeq.Bounded.PatAlg      -- re-exports the former
+     , module Control.DeepSeq.Bounded.NFDataP     -- re-exports both
+#if USE_SOP
+     , module Control.DeepSeq.Bounded.NFDataPDyn  -- re-exps. all 3 above
+#endif
+
+     -- XXX On second thoughts, I don't want to depend on containers
+     -- package just to provide a rose tree data type!...
+     -- I don't export Data.Tree; ideally the API would never
+     -- require the user to work at that low level, but if
+     -- necessary they can import Data.Tree themselves.
+
+     , Rose(..)
+
+     -- * Generic deriving support via "Generics.SOP"
+
+#if USE_SOP
+     , module Control.DeepSeq.Bounded.Generics.GSeqable
+#endif
+
+     , module Control.DeepSeq.Bounded.Generics.GNFDataN
+#if USE_SOP
+     , module Control.DeepSeq.Bounded.Generics.GNFDataP
+#endif
+
+     -- * Forced evaluation "molecular style"
+
+     , module Control.DeepSeq.Bounded.Seqable
+
+
+#if USE_WW_DEEPSEQ
+     -- * Re-exported
+
+     , module Control.DeepSeq
+#endif
+
+  ) where
+
+-------------------------------------------------------------------------------
+
+  import Control.DeepSeq.Bounded.Seqable
+  import Control.DeepSeq.Bounded.NFDataN
+
+  import Control.DeepSeq.Bounded.Pattern
+  import Control.DeepSeq.Bounded.PatAlg
+  import Control.DeepSeq.Bounded.NFDataP
+#if USE_SOP
+  import Control.DeepSeq.Bounded.NFDataPDyn
+#endif
+
+  -- In its own category, relative to GNFDataN and GNFDataP.
+#if USE_SOP
+  import Control.DeepSeq.Bounded.Generics.GSeqable
+#endif
+
+  import Control.DeepSeq.Bounded.Generics.GNFDataN
+#if USE_SOP
+  import Control.DeepSeq.Bounded.Generics.GNFDataP
+#endif
+
+#if USE_WW_DEEPSEQ
+  import Control.DeepSeq
+#endif
+
+-------------------------------------------------------------------------------
+
diff --git a/src/Control/DeepSeq/Bounded/Generics.hs b/src/Control/DeepSeq/Bounded/Generics.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/DeepSeq/Bounded/Generics.hs
@@ -0,0 +1,112 @@
+
+-------------------------------------------------------------------------------
+
+-- |
+-- Module      :  Control.DeepSeq.Bounded.Generics
+-- Copyright   :  (c) 2014, Andrew G. Seniuk
+-- License     :  BSD-style (see the LICENSE file)
+--
+-- Maintainer  :  Andrew Seniuk <rasfar@gmail.com>
+-- Stability   :  provisional
+-- Portability :  GHC
+--
+-- Support for generic deriving (via "Generics.SOP") of 'NFDataN' and 'NFDataP' instances.
+--
+-- This metaboilerplate is standard for using the generic deriving
+-- facilities of GHC.Generics and Generics.SOP.  Consider
+-- <http://hackage.haskell.org/package/seqaid seqaid> for
+-- a turnkey solution.
+--
+-- > {-# LANGUAGE TemplateHaskell #-}
+-- > {-# LANGUAGE DataKinds #-}
+-- > {-# LANGUAGE TypeFamilies #-}
+-- > {-# LANGUAGE DeriveGeneric #-}
+-- > {-# LANGUAGE DeriveDataTypeable #-}
+-- > 
+-- > import Generics.SOP.TH
+-- > import Control.DeepSeq.Bounded ( NFDataN(..), grnfn, NFDataP(..), grnfp )
+-- > import Control.DeepSeq.Generics ( NFData(..), genericRnf )
+-- > import GHC.Generics ( Generic )    -- for deriving NFData
+-- > import Data.Typeable ( Typeable )  -- for name-constrained pattern nodes
+-- > import Control.DeepSeq.Bounded ( forcen, forcep )
+-- > 
+-- > data TA = A1 TB TA | A2  deriving ( Generic, Typeable )
+-- > instance NFData  TA where rnf  = genericRnf
+-- > instance NFDataN TA where rnfn = grnfn
+-- > instance NFDataP TA where rnfp = grnfp
+-- > 
+-- > data TB = B1 Int | B2 TA  deriving ( Generic, Typeable )
+-- > instance NFData  TB where rnf  = genericRnf
+-- > instance NFDataN TB where rnfn = grnfn
+-- > instance NFDataP TB where rnfp = grnfp
+-- > 
+-- > deriveGeneric ''TA
+-- > deriveGeneric ''TB
+-- > 
+-- > main = mainP
+-- > mainN = return $! forcen 3          (A1 (B2 undefined) A2) :: IO TA
+-- > mainP = return $! forcep ".{.{.}.}" (A1 (B2 undefined) A2) :: IO TA
+-- > mainS = return $! force_ Propagate  (A1 (force_ Propagate (B2 undefined)) A2) :: IO TA
+
+-------------------------------------------------------------------------------
+
+  module Control.DeepSeq.Bounded.Generics (
+
+#if USE_SOP
+      grnf_
+    , gseq_
+    , gforce_
+#endif
+
+#if USE_SOP
+    , grnfn
+#else
+    , genericRnfn
+--  , genericRnfnV1
+#endif
+
+#if USE_SOP
+#if USE_SOP
+    , grnfp
+#else
+#if 1
+    , genericRnfp
+#if 0
+    , genericRnfpV1
+#endif
+#endif
+#endif
+#endif
+
+#if 0
+      -- * "Control.DeepSeq" re-exports
+    , deepseq
+    , force
+    , NFData(rnf)
+    , ($!!)
+#endif
+
+  ) where
+
+-------------------------------------------------------------------------------
+
+  -- In its own category, relative to GNFDataN and GNFDataP.
+  -- A GHC.Generics alternative is also quite possible?
+  -- Both these still require SOP instances to be derived
+  -- for user data types, however, which ... well, so does
+  -- the current version of Seqable (require NFDataN instances)...
+#if USE_SOP
+  import Control.DeepSeq.Bounded.Generics.GSeqable
+#endif
+
+  import Control.DeepSeq.Bounded.Generics.GNFDataN
+#if USE_SOP
+  import Control.DeepSeq.Bounded.Generics.GNFDataP
+#endif
+
+--import Control.DeepSeq.Bounded
+--import Control.DeepSeq  -- needed?
+--import GHC.Generics
+
+-------------------------------------------------------------------------------
+
diff --git a/src/Control/DeepSeq/Bounded/Generics/GNFDataN.hs b/src/Control/DeepSeq/Bounded/Generics/GNFDataN.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/DeepSeq/Bounded/Generics/GNFDataN.hs
@@ -0,0 +1,288 @@
+
+-------------------------------------------------------------------------------
+
+  {-  LANGUAGE CPP #-}
+
+#define USE_TRACE 1
+
+-------------------------------------------------------------------------------
+
+#if USE_SOP
+  {-# LANGUAGE DataKinds #-}
+  {-# LANGUAGE TypeFamilies #-}
+  {-# LANGUAGE ConstraintKinds #-}
+  {-# LANGUAGE TemplateHaskell #-}
+  {-# LANGUAGE GADTs #-}  -- for GHC 7.6.3
+#else
+  {-# LANGUAGE BangPatterns #-}
+  {-# LANGUAGE TypeOperators #-}
+  {-# LANGUAGE FlexibleContexts #-}
+  {-  LANGUAGE MultiParamTypeClasses #-}
+  {-  LANGUAGE Rank2Types #-}
+#endif
+
+-------------------------------------------------------------------------------
+
+-- |
+-- Module      :  Control.DeepSeq.Bounded.Generics.GNFDataN
+-- Copyright   :  (c) 2014, Andrew G. Seniuk
+-- License     :  BSD-style (see the LICENSE file)
+--
+-- Maintainer  :  Andrew Seniuk <rasfar@gmail.com>
+-- Stability   :  provisional
+-- Portability :  GHC
+--
+-- Support for generic deriving (via "Generics.SOP") of 'NFDataN' instances.
+--
+-- 'NFDataN' does not have any superclasses.
+--
+-- It is also possible to derive instances using 'GHC.Generics', which
+-- avoids SOP and TH, but if you plan to use 'NFDataP' then SOP is required.
+-- (SOP can be used without TH if necessary; the interested reader is
+-- referred to SOP documentation.)
+--
+-- This metaboilerplate is standard for using the generic deriving
+-- facilities of GHC.Generics and Generics.SOP.  Consider
+-- <http://hackage.haskell.org/package/seqaid seqaid> for
+-- a turnkey solution.
+--
+-- > {-# LANGUAGE TemplateHaskell #-}
+-- > {-# LANGUAGE DataKinds #-}
+-- > {-# LANGUAGE TypeFamilies #-}
+-- > {-# LANGUAGE DeriveGeneric #-}
+-- > 
+-- > import Generics.SOP.TH
+-- > import Control.DeepSeq.Bounded ( NFDataN(..), grnfn )
+-- > import GHC.Generics ( Generic )
+-- >
+-- > import Control.DeepSeq.Bounded ( forcen )
+-- > 
+-- > data TA = A1 TB TA | A2  deriving ( Generic )
+-- > instance NFDataN TA where rnfn = grnfn
+-- > 
+-- > data TB = B1 Int | B2 TA  deriving ( Generic )
+-- > instance NFDataN TB where rnfn = grnfn
+-- > 
+-- > deriveGeneric ''TA
+-- > deriveGeneric ''TB
+-- >
+-- > main = return $! forcen 3 (A1 (B2 undefined) A2)
+
+-------------------------------------------------------------------------------
+
+  module Control.DeepSeq.Bounded.Generics.GNFDataN
+#if USE_SOP
+  (
+      grnfn
+#else
+  (
+      genericRnfn
+--  , genericRnfnV1
+#endif
+#if 0
+      -- * "Control.DeepSeq" re-exports
+    , deepseq
+    , force
+    , NFData(rnf)
+    , ($!!)
+#endif
+  ) where
+
+-------------------------------------------------------------------------------
+
+  import Control.DeepSeq.Bounded.NFDataN
+
+#if USE_SOP
+  import Generics.SOP
+--import Generics.SOP.TH  -- not here, but rather in the module needing to generically derive an NFDataN instance
+#else
+  import GHC.Generics
+#endif
+
+#if 0
+  -- actually can be used in the SOP implementation (and is in the
+  -- example in the paper as well as the API docs), not that we nec.
+  -- want this; but there's no n=infinity rnfn, so I don't see how
+  -- else to manage it... after the "collapse"...
+  import Control.DeepSeq ( NFData, deepseq )
+--import Control.DeepSeq ( rnf )  -- actually can be used in the SOP implementation, not that we necessarily want this; but there's no n=infinity rnfn, so I don't see how else to manage it... after the "collapse"...
+#if 0
+  import Control.DeepSeq  -- needed?
+#endif
+#endif
+
+  import Debug.Trace ( trace )
+
+-------------------------------------------------------------------------------
+
+#if USE_SOP
+
+#if 1
+
+  grnfn :: (Generic a, All2 NFDataN (Code a)) => Int -> a -> ()
+  grnfn n x = grnfnS n (from x)
+
+  grnfnS :: (All2 NFDataN xss) => Int -> SOP I xss -> ()
+  grnfnS n (SOP (Z xs))  = grnfnP (-1+n) xs
+  grnfnS n (SOP (S xss)) = grnfnS n (SOP xss)
+
+  grnfnP :: (All NFDataN xs) => Int -> NP I xs -> ()
+  grnfnP n Nil          = ()
+  grnfnP n (I x :* xs)
+   | n <= 0             = ()
+   | otherwise          = rnfn n x `seq` grnfnP n xs
+
+#else
+
+  -- XXX NOPE! This causes decrementing as traverse ctor args!
+  -- However, the above explicit recursive version works!
+  grnfn :: (Generic a, All2 NFDataN (Code a)) => Int -> a -> ()
+-- Ah-hah!
+  grnfn n = rnfn n . hcollapse . hcliftA p (K . (if n <= 0 then const () else rnfn (-1+n)) . unI) . from
+-- This doesn't help:
+--grnfn n = let n_ = (-1+n) in
+--          rnfn n . hcollapse . hcliftA p (K . rnfn n_ . unI) . from
+-- So this is the closest I have so far, but it's broken b/c it
+-- seems to add to the requisite depth, the index of the (leftmost?)
+-- sibling bearing "undefined".
+--grnfn n = rnfn n . hcollapse . hcliftA p (K . rnfn (-1+n) . unI) . from
+-- This just delays everything by one more.
+--grnfn n = rnfn (-1+n) . hcollapse . hcliftA p (K . rnfn (-1+n) . unI) . from
+-- I don't think this was my problem anyhow, as arities aren't
+-- high enough to expect it to affect depth of n [??...]
+-- (And it doesn't work anyhow -- way too much stuff gets forced!)
+--grnfn n = rnf    . hcollapse . hcliftA p (K . rnfn (-1+n) . unI) . from
+    where p = Proxy :: Proxy NFDataN
+-- From the SOP paper:
+--   grnfn :: (Generic a, All2 NFDataN (Code a)) => a -> ()
+--   grnfn = rnfn . hcollapse . hcliftA p (K . rnf . unI) . from
+--     where p = Proxy :: Proxy NFDataN
+-- "We can understand this function by tracking the types. First
+-- we use from to translate from a to the generic representation
+-- SOP I (Code a). We then map rnf (modulo newtype wrapping and
+-- unwrapping) across this sum of products to get a value of type
+-- SOP (K ()) (Code a), which we can collapse to a list of type [()].
+-- Finally, we can reduce that list to a single unit value through one
+-- more application of rnf.  We use All2 in the type of grnf to require
+-- that the types of the leaves must all satisfy NFData."
+
+#endif
+
+-------------------------------------------------------------------------------
+
+#else
+
+  genericRnfn :: (Generic a, GNFDataN (Rep a)) => Int -> a -> ()
+  genericRnfn n = grnfn_ n . from
+--genericRnfn n = grnfn_ (-1+n) . from
+  {-# INLINE genericRnfn #-}
+
+--  Hidden internal type-class
+--
+-- Note: the 'V1' instance is not provided for 'GNFDataN' in order to
+-- trigger a compile-time error; see 'GNFDataNV1' which defers this to
+-- a runtime error.
+  class GNFDataN f where
+    grnfn_ :: Int -> f a -> ()
+#if 1 || USE_TRACE
+    grnfn_ n x = trace "HH-0" $ ()  -- never seen, so far...
+#else
+    grnfn_ n x = ()
+#endif
+--  grnfn_ n x = rnfn n $ to x
+--  grnfn_ n x = rnfn n x
+
+  instance GNFDataN U1 where
+#if USE_TRACE
+    grnfn_ _ !U1 = trace "HH-U1" $ ()
+#else
+    grnfn_ _ !U1 = ()
+#endif
+    {-# INLINE grnfn_ #-}
+
+  instance NFDataN a => GNFDataN (K1 i a) where
+#if USE_TRACE
+#if 1
+    grnfn_ n k@(K1 x) | n <= 0     = trace "()-K1" $ ()
+--                    | otherwise  = trace "HH-K1" $ k `seq` rnfn (-1+n) x
+--                    | otherwise  = trace "HH-K1" $ x `seq` rnfn (-1+n) x
+                      | otherwise  = trace "HH-K1" $ rnfn (-1+n) x
+#else
+    grnfn_ n | n <= 0     = const ()
+             | otherwise  = trace "HH-2" $ rnfn (-1+n) . unK1
+#endif
+#else
+    grnfn_ n (K1 x) | n <= 0     = ()
+                    | otherwise  = rnfn (-1+n) x
+#endif
+    {-# INLINE grnfn_ #-}
+
+  instance GNFDataN a => GNFDataN (M1 i c a) where
+#if USE_TRACE
+#if 0
+#elif 1
+    grnfn_ n (M1 x) | n <= 0     = trace "()-M1" $ ()  -- prob. unnec.
+                    | otherwise  = trace "HH-M1" $ grnfn_ n x
+#elif 0
+    grnfn_ n (M1 x) | n <= 0     = trace "()-M1" $ ()
+                    | otherwise  = trace "HH-M1" $ grnfn_ (-1+n) x
+#elif 0
+    grnfn_ n | n <= 0     = const ()
+             | otherwise  = trace "HH-3" $ grnfn_ (-1+n) . unM1
+#endif
+#else
+    grnfn_ n (M1 x) | n <= 0     = ()  -- prob. unnec.
+                    | otherwise  = grnfn_ n x
+#endif
+    {-# INLINE grnfn_ #-}
+
+  instance (GNFDataN a, GNFDataN b) => GNFDataN (a :*: b) where
+#if USE_TRACE
+#if 0
+#elif 1
+    grnfn_ n (x :*: y) | n <= 0     = trace "()-:*:" $ ()  -- prob. unnec.
+                       | otherwise  = trace "HH-:*:" $ let n' = n in grnfn_ n' x `seq` grnfn_ n' y
+#elif 0
+    grnfn_ n (x :*: y) | n <= 0     = trace "()-:*:" $ ()
+                       | otherwise  = trace "HH-:*:" $ let n' = -1+n in grnfn_ n' x `seq` grnfn_ n' y
+#elif 0
+    grnfn_ n (x :*: y) | n <= 0     = ()
+                       | otherwise  = trace "HH-4" $ let n' = -1+n in grnfn_ n' x `seq` grnfn_ n' y
+#endif
+#else
+    grnfn_ n (x :*: y) | n <= 0     = ()  -- prob. unnec.
+                       | otherwise  = let n' = n in grnfn_ n' x `seq` grnfn_ n' y
+#endif
+    {-# INLINE grnfn_ #-}
+
+  instance (GNFDataN a, GNFDataN b) => GNFDataN (a :+: b) where
+#if USE_TRACE
+#if 0
+#elif 1
+    grnfn_ n (L1 x) | n <= 0     = trace "()-L1" $ ()  -- prob. unnec.
+                    | otherwise  = trace "HH-L1" $ grnfn_ n x
+    grnfn_ n (R1 x) | n <= 0     = trace "()-L2" $ ()  -- prob. unnec.
+                    | otherwise  = trace "HH-L2" $ grnfn_ n x
+#elif 0
+    grnfn_ n (L1 x) | n <= 0     = trace "()-L1" $ ()
+                    | otherwise  = trace "HH-L1" $ grnfn_ (-1+n) x
+    grnfn_ n (R1 x) | n <= 0     = trace "()-L2" $ ()
+                    | otherwise  = trace "HH-L2" $ grnfn_ (-1+n) x
+#elif 0
+    grnfn_ n (L1 x) | n <= 0     = ()
+                    | otherwise  = trace "HH-5L" $ grnfn_ (-1+n) x
+    grnfn_ n (R1 x) | n <= 0     = ()
+                    | otherwise  = trace "HH-5R" $ grnfn_ (-1+n) x
+#endif
+#else
+    grnfn_ n (L1 x) | n <= 0     = ()  -- prob. unnec.
+                    | otherwise  = grnfn_ n x
+    grnfn_ n (R1 x) | n <= 0     = ()  -- prob. unnec.
+                    | otherwise  = grnfn_ n x
+#endif
+    {-# INLINE grnfn_ #-}
+
+#endif
+
+-------------------------------------------------------------------------------
+
diff --git a/src/Control/DeepSeq/Bounded/Generics/GNFDataP.hs b/src/Control/DeepSeq/Bounded/Generics/GNFDataP.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/DeepSeq/Bounded/Generics/GNFDataP.hs
@@ -0,0 +1,386 @@
+
+-------------------------------------------------------------------------------
+
+{-  LANGUAGE CPP #-}
+
+-- (Tracing code has mostly been removed for distribution.)
+#define DO_TRACE 0
+#define INCLUDE_SHOW_INSTANCES 0
+
+-------------------------------------------------------------------------------
+
+-- SOP cheat-sheet.
+--
+-- class SingI (Code a) => Generic a where
+-- Associated Types:
+--   type Code a :: [[*]]
+-- Methods:
+--   from :: a -> Rep a
+--   to :: Rep a -> a
+--
+-- type Rep a = SOP I (Code a)
+--
+-- newtype SOP f xss = SOP (NS (NP f) xss)
+--
+-- data NS :: (k -> *) -> [k] -> * where
+-- Constructors:
+--   Z :: f x -> NS f (x : xs)	 
+--   S :: NS f xs -> NS f (x : xs)	 
+-- Examples:
+--   Z         :: f x -> NS f (x ': xs)
+--   S . Z     :: f y -> NS f (x ': y ': xs)
+--   S . S . Z :: f z -> NS f (x ': y ': z ': xs)
+--
+-- data NP :: (k -> *) -> [k] -> * where
+-- Constructors:
+--   Nil :: NP f []	 
+--   (:*) :: f x -> NP f xs -> NP f (x : xs) infixr 5	 
+-- Examples (sic! they are correct):
+--   I 'x'    :* I True  :* Nil  ::  NP I       '[ Char, Bool ]
+--   K 0      :* K 1     :* Nil  ::  NP (K Int) '[ Char, Bool ]
+--   Just 'x' :* Nothing :* Nil  ::  NP Maybe   '[ Char, Bool ]
+--
+--   > :m +Generics.SOP
+--   > :m +Foo
+--   > Generics.SOP.from $ G2 1 2 3
+--   SOP (S (Z (I 1 :* (I 2 :* (I 3 :* Nil)))))
+--   > Generics.SOP.to $ Generics.SOP.from $ G2 1 2 3 :: TG
+--   G2 1 2 3
+
+-------------------------------------------------------------------------------
+
+  {-# LANGUAGE ScopedTypeVariables #-}
+  {-# LANGUAGE DataKinds #-}
+  {-# LANGUAGE TypeFamilies #-}
+  {-# LANGUAGE ConstraintKinds #-}
+  {-# LANGUAGE GADTs #-}  -- for GHC 7.6.3
+  {-# LANGUAGE TemplateHaskell #-}
+
+  -- For tracing only:
+  {-# LANGUAGE BangPatterns #-}
+
+-------------------------------------------------------------------------------
+
+-- |
+-- Module      :  Control.DeepSeq.Bounded.Generics.GNFDataP
+-- Copyright   :  (c) 2014, Andrew G. Seniuk
+-- License     :  BSD-style (see the LICENSE file)
+--
+-- Maintainer  :  Andrew Seniuk <rasfar@gmail.com>
+-- Stability   :  provisional
+-- Portability :  GHC
+--
+-- Support for generic deriving (via "Generics.SOP") of 'NFDataP' instances.
+--
+-- Note that 'NFDataP' has superclasses 'NFDataN', 'NFData' and 'Typeable'.
+--
+-- This metaboilerplate is standard for using the generic deriving
+-- facilities of GHC.Generics and Generics.SOP.  Consider
+-- <http://hackage.haskell.org/package/seqaid seqaid> for
+-- a turnkey solution.
+--
+-- > {-# LANGUAGE TemplateHaskell #-}
+-- > {-# LANGUAGE DataKinds #-}
+-- > {-# LANGUAGE TypeFamilies #-}
+-- > {-# LANGUAGE DeriveGeneric #-}
+-- > {-# LANGUAGE DeriveDataTypeable #-}
+-- > 
+-- > import Generics.SOP.TH
+-- > import Control.DeepSeq.Bounded ( NFDataP(..), grnfp )
+-- > import Control.DeepSeq.Bounded ( NFDataN(..), grnfn )
+-- > import Control.DeepSeq.Generics ( NFData(..), genericRnf )
+-- > import GHC.Generics ( Generic )    -- for deriving NFData
+-- > import Data.Typeable ( Typeable )  -- for name-constrained pattern nodes
+-- >
+-- > import Control.DeepSeq.Bounded ( forcep )
+-- > 
+-- > data TA = A1 TB TA | A2  deriving ( Generic, Typeable )
+-- > instance NFData  TA where rnf  = genericRnf
+-- > instance NFDataN TA where rnfn = grnfn
+-- > instance NFDataP TA where rnfp = grnfp
+-- > 
+-- > data TB = B1 Int | B2 TA  deriving ( Generic, Typeable )
+-- > instance NFData  TB where rnf  = genericRnf
+-- > instance NFDataN TB where rnfn = grnfn
+-- > instance NFDataP TB where rnfp = grnfp
+-- > 
+-- > deriveGeneric ''TA
+-- > deriveGeneric ''TB
+-- >
+-- > main = return $! forcep ".{.{.}.}" (A1 (B2 undefined) A2)
+
+-------------------------------------------------------------------------------
+
+  module Control.DeepSeq.Bounded.Generics.GNFDataP (
+
+      grnfp
+
+#if 0
+      -- * "Control.DeepSeq" re-exports
+    , deepseq
+    , force
+    , NFData ( rnf )
+    , ($!!)
+#endif
+
+  ) where
+
+-------------------------------------------------------------------------------
+
+  import Control.DeepSeq.Bounded.NFDataP ( NFDataP, rnfp )
+  import Control.DeepSeq.Bounded.NFDataN (          rnfn )
+  import     Control.DeepSeq                 (          rnf  )
+
+  import Control.DeepSeq.Bounded.Pattern
+           ( Pattern(..), PatNode(..), Rose(..) )
+
+  import Generics.SOP
+
+  import Data.Maybe
+  import Debug.Trace ( trace )
+--import System.IO.Unsafe ( unsafePerformIO )  -- for console output only
+
+-------------------------------------------------------------------------------
+
+#if DO_TRACE
+  mytrace = trace
+  mytrace' = trace
+#else
+  mytrace x y = y
+  mytrace' x y = y
+#endif
+
+-------------------------------------------------------------------------------
+
+  grnfp :: forall a.
+           (
+             Generic a
+           , HasDatatypeInfo a
+--         , All Show (Map ConstructorInfo (Code a))
+           , All2 NFDataP (Code a)
+#if INCLUDE_SHOW_INSTANCES
+           , All2 Show (Code a)
+#endif
+           , NFDataP a  -- NFData, NFDataN superclasses
+           ) => Pattern -> a -> ()
+  grnfp pat x = grnfp' dti proxy_a pat x xrep
+   where
+    dti = datatypeInfo proxy_a
+    proxy_a = Proxy :: Proxy a
+    xrep = from x
+
+-------------------------------------------------------------------------------
+
+  -- Show constraint is needed, but not NFData nor NFDataN.
+  -- Not quite sure why, but whatever...
+  grnfp' :: forall a.
+            (
+              Generic a
+            , HasDatatypeInfo a
+            , All2 NFDataP (Code a)
+#if INCLUDE_SHOW_INSTANCES
+            , All2 Show (Code a)
+#endif
+            , NFDataP a  -- NFData, NFDataN superclasses
+            ) =>
+                    DatatypeInfo (Code a)
+                 -> Proxy a
+                 -> Pattern
+                 -> a
+                 -> Rep a
+                 -> ()
+  grnfp' (ADT     _ _ cs) proxy_a pat x xrep
+   = grnfpS cs         proxy_a pat x xrep
+  grnfp' (Newtype _ _ c ) proxy_a pat x xrep
+   = grnfpS (c :* Nil) proxy_a pat x xrep
+
+-------------------------------------------------------------------------------
+
+-- SOP works (here) by hitting the Z (meta)constructor for the
+-- particular datatype constructor which is [inhabited].
+-- i.e. This simply dials in the correct constructor.
+-- Later: Looks like it does a bit more than that, now.
+  grnfpS :: forall a xss.
+            (
+              All2 NFDataP xss
+#if INCLUDE_SHOW_INSTANCES
+            , All2 Show xss
+#endif
+            , NFDataP a  -- NFData, NFDataN superclasses
+            ) =>
+                    NP ConstructorInfo xss
+                 -> Proxy a
+                 -> Pattern
+                 -> a
+                 -> SOP I xss
+                 -> ()
+
+  grnfpS _ _ (Node WI _) _ _ = ()  -- needed!!
+--grnfpS _ _ (Node WI _) _ (SOP (Z xs)) = ()  -- mustn't do!!
+--grnfpS (m :* _) _ (Node WI _) _ _ = ()  -- seems not to spring the bottom
+
+  grnfpS (m :* _) proxy_a (Node p pcs) x (SOP (Z xs))
+--- | WI       <- p  = ()  -- too late! (SOP (Z xs)) has already forced
+   | not status     = patMatchFail'' msg `seq` ()
+--- | WI       <- p  = ()
+-- XXX So these TR and TI (and TW?... TN?...) also need to be up
+-- in a top-level case before this one!
+   | TR treps <- p  = if elem tx treps then dorecurs else ()
+   | TI treps <- p  = if elem tx treps then () else dorecurs
+   | WW       <- p  = rnf x
+   | WN n     <- p  = rnfn n x
+   | TW treps <- p  = if elem tx treps then rnf x else ()  -- no better!
+   | otherwise      = dorecurs
+   where
+    (status,mmsg)  = grnfpP_validate True p pcs tx xs
+    !_ = mytrace ("*** "++tx) $ ()
+    tx | (Constructor n) <- m  = n
+       | (Infix n _ _) <- m    = n
+       | (Record n _) <- m     = n
+    !_ = mytrace ("VVV "++show status) $ ()
+    msg = fromJust mmsg
+#if DO_TRACE
+    dorecurs = grnfpP_ m () True p pcs xs `seq` ()
+#else
+    dorecurs = grnfpP m () True p pcs xs `seq` ()
+#endif
+
+  grnfpS (m :* ms) proxy_a pat x (SOP (S xss))
+   = grnfpS ms proxy_a pat x (SOP xss)
+
+  grnfpS _ _ _ _ _ = error "grnfpS: unexpected case!!"
+
+-------------------------------------------------------------------------------
+
+  grnfpP :: forall cs xs.
+            (
+              All NFDataP xs
+#if INCLUDE_SHOW_INSTANCES
+            , All Show xs
+#endif
+            ) =>
+                    ConstructorInfo cs
+                 -> ()
+                 -> Bool
+                 -> PatNode
+                 -> [Pattern]
+                 -> NP I xs
+                 -> ()
+  grnfpP ci acc b pp [] Nil = acc
+  grnfpP ci acc True pp [] (I x :* xs)
+   = grnfpP ci acc True pp [] xs
+  grnfpP ci acc b pp (p@(Node pn pgcs):pcs) (I x :* xs)
+   = grnfpP ci (acc `seq` step) False pp pcs xs
+   where
+    step | WI <- pn        = ()
+         | TR treps <- pn  = if elem tx treps then thestep else ()
+         | TI treps <- pn  = if elem tx treps then () else thestep
+         | otherwise       = thestep
+     where
+      thestep = rnfp p x
+      tx | (Constructor n) <- ci  = n
+         | (Infix n _ _) <- ci    = n
+         | (Record n _) <- ci     = n
+  grnfpP ci acc b pp ps xs
+   = error $ "*6* "++show b++" "++show pp++" "++show ps++" "++show (lenxs xs)
+
+-------------------------------------------------------------------------------
+
+  -- Preliminary check for arity mismatch or constructor name mismatch.
+  -- Note: I don't presently know of a way to obtain the arity of a ctor
+  -- from it's name as a String. Arity checking is done between the
+  -- pattern and the value, but the arity of a ctor named in a pattern
+  -- constraints is not available.
+  grnfpP_validate :: forall xs.
+            (
+              All NFDataP xs
+#if INCLUDE_SHOW_INSTANCES
+            , All Show xs
+#endif
+            ) =>
+                    Bool
+                 -> PatNode
+                 -> [Pattern]
+                 -> String
+                 -> NP I xs
+                 -> (Bool, Maybe String)
+  grnfpP_validate True  pp@(TR cnames) ps tx xss
+   | b          = grnfpP_validate' True pp ps tx xss
+   | otherwise  = (False,Just $ "<generic> TR ctor name constraint mismatch (not "++tx++")")
+   where b = head cnames == tx
+  grnfpP_validate True  pp@(TW cnames) ps tx xss
+   | b          = grnfpP_validate' True pp ps tx xss
+   | otherwise  = (False,Just $ "<generic> TW ctor name constraint mismatch (not "++tx++")")
+   where b = head cnames == tx
+  grnfpP_validate True  pp@(TI cnames) ps tx xss
+   | b          = grnfpP_validate' True pp ps tx xss
+   | otherwise  = (False,Just $ "<generic> TI ctor name constraint mismatch (not "++tx++")")
+   where b = head cnames == tx
+  grnfpP_validate b     pp             ps tx xss
+   = grnfpP_validate' b pp ps tx xss
+
+  grnfpP_validate' :: forall xs.
+            (
+              All NFDataP xs
+#if INCLUDE_SHOW_INSTANCES
+            , All Show xs
+#endif
+            ) =>
+                    Bool
+                 -> PatNode
+                 -> [Pattern]
+                 -> String
+                 -> NP I xs
+                 -> (Bool, Maybe String)
+  grnfpP_validate' True   WS    []  tx xss = (True,Nothing)
+  grnfpP_validate' True   WI    []  tx xss = (True,Nothing)
+  grnfpP_validate' True  (WN n) []  tx xss = (True,Nothing)
+  grnfpP_validate' True   WW    []  tx xss = (True,Nothing)
+  grnfpP_validate' True   pp    ps  tx xss
+   | WS <- pp   = if lenps > 0 then (False,Nothing) else (True,Nothing)
+   | b          = (True,Nothing)
+   | otherwise  = (False,Just "<generic> arity mismatch #1")
+   where
+    b = lenps == lenxs xss
+    lenps = length ps
+  grnfpP_validate' False  pp    []  tx Nil = (True,Nothing)
+  grnfpP_validate' False pp (p:pcs) tx (I x :* xs)
+   = grnfpP_validate False pp pcs tx xs
+  grnfpP_validate' b pp ps tx xs
+   = error $ " &&& " ++ show b ++ " " ++ show pp ++ " " ++ show ps
+-- = error $ show b ++ " " ++ show pp ++ " " ++ show ps ++ " " ++ show (hcliftA (Proxy :: Proxy Show) (K . show . unI) xs)
+
+-------------------------------------------------------------------------------
+
+  lenxs :: NP I xs' -> Int
+  lenxs Nil = 0
+  lenxs (I x' :* xs') = 1 + lenxs xs'
+  lenxs _ = error "lenxs: unexpected"
+
+-------------------------------------------------------------------------------
+
+#if 0
+-- Works so far as it goes, but is not currently used.
+-- Also, this is exactly Data.Generics.Schemes.glength
+  arity :: Data a => a -> Int
+  arity = length . gmapQ (const ())
+#endif
+
+-------------------------------------------------------------------------------
+
+  patMatchFail'' :: String -> ()
+  patMatchFail'' msg
+#if 0
+     -- With this, the expected match failures are seen.
+     = error "BOO!!!!"
+#else
+#if WARN_PATTERN_MATCH_FAILURE
+     = trace ("GNFDataP: warning: pattern match failure (" ++ msg ++ ")") $ ()
+--   = unsafePerformIO $! putStrLn $! "GNFDataP: warning: pattern match failure (" ++ msg ++ ")"
+#else
+     = ()
+#endif
+#endif
+
+-------------------------------------------------------------------------------
+
diff --git a/src/Control/DeepSeq/Bounded/Generics/GSeqable.hs b/src/Control/DeepSeq/Bounded/Generics/GSeqable.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/DeepSeq/Bounded/Generics/GSeqable.hs
@@ -0,0 +1,137 @@
+
+-------------------------------------------------------------------------------
+
+-- XXX Not only untested, but now unneeded...
+-- There is no Seqable class, because every instance would default.
+-- (rnf_ is just a polymorphic function now.)
+-- The module is left as "Seqable" at least for now.
+
+-------------------------------------------------------------------------------
+
+-- XXX UNTESTED. And I just changed it a bunch when moved
+-- from Bool to SeqNodeKind, but it's still probably far off...
+
+-------------------------------------------------------------------------------
+
+  {-  LANGUAGE CPP #-}
+
+#define USE_TRACE 1
+
+-------------------------------------------------------------------------------
+
+#if USE_SOP
+  {-# LANGUAGE DataKinds #-}
+  {-# LANGUAGE TypeFamilies #-}
+  {-# LANGUAGE ConstraintKinds #-}
+  {-# LANGUAGE TemplateHaskell #-}
+  {-# LANGUAGE GADTs #-}  -- for GHC 7.6.3
+#else
+  {-# LANGUAGE BangPatterns #-}
+  {-# LANGUAGE TypeOperators #-}
+  {-# LANGUAGE FlexibleContexts #-}
+  {-  LANGUAGE MultiParamTypeClasses #-}
+  {-  LANGUAGE Rank2Types #-}
+#endif
+
+-------------------------------------------------------------------------------
+
+-- |
+-- Module      :  Control.DeepSeq.Bounded.Generics.GSeqable
+-- Copyright   :  (c) 2014, Andrew G. Seniuk
+-- License     :  BSD-style (see the LICENSE file)
+--
+-- Maintainer  :  Andrew Seniuk <rasfar@gmail.com>
+-- Stability   :  provisional
+-- Portability :  GHC
+--
+-- Generic function version of "Seqable" (via "Generics.SOP").
+--
+-- Probably, a "GHC.Generics" variant would also be possible.
+--
+-- This metaboilerplate is standard for using the generic deriving
+-- facilities of Generics.SOP.  Consider
+-- <http://hackage.haskell.org/package/seqaid seqaid>
+-- for a turnkey solution.
+--
+-- > {-# LANGUAGE TemplateHaskell #-}
+-- > {-# LANGUAGE DataKinds #-}
+-- > {-# LANGUAGE TypeFamilies #-}
+-- > {-# LANGUAGE DeriveDataTypeable #-}
+-- > 
+-- > import Generics.SOP.TH
+-- > import Control.DeepSeq.Bounded.Seqable
+-- > 
+-- > data TA = A1 TB TA | A2
+-- > data TB = B1 Int | B2 TA
+-- > 
+-- > deriveGeneric ''TA
+-- > deriveGeneric ''TB
+-- > 
+-- > main = return $! force_ Propagate (A1 (force_ Propagate (B2 undefined)) A2)
+
+-------------------------------------------------------------------------------
+
+  module Control.DeepSeq.Bounded.Generics.GSeqable
+#if USE_SOP
+  (
+      grnf_
+    , gseq_
+    , gforce_
+#else
+  (
+      genericSeq_
+--  , genericSeq_V1
+#endif
+  ) where
+
+-------------------------------------------------------------------------------
+
+  import Control.DeepSeq.Bounded.Pattern ( SeqNodeKind(..) )
+--import Control.DeepSeq.Bounded.Seqable ( SeqNodeKind(..) )
+
+#if USE_SOP
+  import Generics.SOP
+--import Generics.SOP.TH  -- not here, but rather in the module needing to generically derive an Seqable instance
+#else
+  import GHC.Generics
+#endif
+
+  import Control.Parallel ( par )
+
+  import Debug.Trace ( trace )
+
+-------------------------------------------------------------------------------
+
+#if USE_SOP
+
+  gseq_ :: Generic a => SeqNodeKind -> a -> b -> b
+  gseq_ Insulate     a b  =                 b
+  gseq_ k            a b  = grnf_ k a `seq` b  -- sic! both Propagate and Spark
+
+  gforce_ :: Generic a => SeqNodeKind -> a -> a
+  gforce_ Insulate     a  =                 a
+  gforce_ k            a  = grnf_ k a `seq` a  -- sic! both Propagate and Spark
+
+  grnf_ :: Generic a => SeqNodeKind -> a -> ()
+  grnf_ Insulate x = ()
+  grnf_ k x = grnf_S k (from x)
+
+  grnf_S :: SeqNodeKind -> SOP I xss -> ()
+  grnf_S Propagate  (SOP (Z xs))   = grnf_P xs `seq` ()
+  grnf_S {-Spark-}_ (SOP (Z xs))   = grnf_P xs `par` ()
+  grnf_S k          (SOP (S xss))  = grnf_S k (SOP xss)
+
+  grnf_P :: NP I xs -> ()
+  grnf_P Nil = ()
+  grnf_P (I x :* xs)  = x `seq` grnf_P xs
+
+-------------------------------------------------------------------------------
+
+#else
+
+#error "GSeqable: must use SOP for now..."
+
+#endif
+
+-------------------------------------------------------------------------------
+
diff --git a/src/Control/DeepSeq/Bounded/NFDataN.hs b/src/Control/DeepSeq/Bounded/NFDataN.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/DeepSeq/Bounded/NFDataN.hs
@@ -0,0 +1,366 @@
+
+-------------------------------------------------------------------------------
+
+  {-  LANGUAGE CPP #-}  -- specified in .cabal default-extensions
+
+#define USE_NFDATA_SUPERCLASS 0
+
+-------------------------------------------------------------------------------
+
+  -- Later: I'm not so sure about this, actually; is the arithmetic
+  -- on n actually not piling up thunks, without the bang-patterns?
+  --
+  -- It would be easy to get rid of the bang-patterns.
+  -- The Complex instance is done as an example.
+  -- If you do go with the case's, probably want -fno-warn-name-shadowing.
+  {-# LANGUAGE BangPatterns #-}
+  {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+
+-------------------------------------------------------------------------------
+
+-- |
+-- Module      :  Control.DeepSeq.Bounded.NFDataN
+-- Copyright   :  (c) 2014, Andrew G. Seniuk
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  Andrew Seniuk <rasfar@gmail.com>
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- This module provides an overloaded function, 'deepseqn', for partially
+-- (or fully) evaluating data structures to a given depth.
+--
+
+-------------------------------------------------------------------------------
+
+  module Control.DeepSeq.Bounded.NFDataN (
+
+      -- * Depth-bounded analogues of 'deepseq' and 'force'
+
+      deepseqn
+    , forcen
+
+      -- * Class of things that can be evaluated to an arbitrary finite depth
+
+    , NFDataN(..)
+
+  ) where
+
+-------------------------------------------------------------------------------
+
+--import qualified Data.Generics.Shape as S  -- not actually used
+
+#if USE_NFDATA_SUPERCLASS
+  import Control.DeepSeq
+#endif
+
+--import Data.Data
+
+  import Data.Int
+  import Data.Word
+  import Data.Ratio
+  import Data.Complex
+  import Data.Array
+  import Data.Fixed
+  import Data.Version
+
+-------------------------------------------------------------------------------
+
+-- infixr 0 $!!
+
+-------------------------------------------------------------------------------
+
+  -- | @'deepseqn' n x y@ evaluates @x@ to depth n, before returning @y@.
+  --
+  -- This is used when expression @x@ also appears in @y@, but mere
+  -- evaluation of @y@ does not force the embedded @x@ subexpression
+  -- as deeply as we wish.
+  --
+  -- The name 'deepseqn' is used to illustrate the relationship to 'seq':
+  -- where 'seq' is shallow in the sense that it only evaluates the top
+  -- level of its argument, @'deepseqn' n@ traverses (evaluates) the entire
+  -- top @n@ levels of the data structure.
+  --
+  -- A typical use is to ensure any exceptions hidden within lazy
+  -- fields of a data structure do not leak outside the scope of the
+  -- exception handler; another is to force evaluation of a data structure in
+  -- one thread, before passing it to another thread (preventing work moving
+  -- to the wrong threads). Unlike "DeepSeq", potentially infinite coinductive
+  -- data types are supported by principled bounding of deep evaluation.
+  --
+  -- It is also useful for diagnostic purposes when trying to understand
+  -- and manipulate space\/time trade-offs in lazy code,
+  -- and as a less indiscriminate substitute for 'deepseq'.
+  --
+  -- Furthermore, 'deepseqn' can sometimes a better solution than
+  -- using stict fields in your data structures, because the
+  -- latter will behave strictly everywhere that its constructors
+  -- are used, instead of just where its laziness is problematic.
+  --
+  -- There may be possible applications to the prevention of resource leaks
+  -- in lazy streaming, but I'm not certain.
+  --
+
+  deepseqn :: NFDataN a => Int -> a -> b -> b
+  deepseqn n a b = rnfn n a `seq` b
+#if 1
+  -- XXX Need to double-check that this makes sense; didn't think
+  -- it through -- when b != a, things are not so simple.
+  -- XXX Partially-applied; is that okay in GHC RULES?
+  {-# RULES
+    "deepseqn/composition"    forall n1 n2 x.  (.) (deepseqn n2) (deepseqn n1) x = deepseqn ( max n1 n2 ) x
+      #-}
+#endif
+
+-------------------------------------------------------------------------------
+
+#if 0
+-- As per DeepSeq:
+  -- | the deep analogue of '$!'.  In the expression @f $!! x@, @x@ is
+  -- fully evaluated before the function @f@ is applied to it.
+  ($!!) :: NFData a => (a -> b) -> a -> b
+  f $!! x = x `deepseq` f x
+#endif
+
+-------------------------------------------------------------------------------
+
+  -- | 'forcen' is a variant of 'deepseqn' that is useful in some circumstances.
+  --
+  -- > forcen n x = deepseqn n x x
+  --
+  -- @forcen n x@ evaluates @x@ to depth @n@, and then returns it.
+  -- Recall that, in common with all Haskell functions, @forcen@ only
+  -- performs evaluation when upstream demand actually occurs,
+  -- so essentially it turns shallow evaluation into depth-@n@ evaluation.
+
+  forcen :: NFDataN a => Int -> a -> a
+  forcen n x = deepseqn n x x
+#if 1
+  {-# RULES
+    "forcen/composition"    forall n1 n2 x.  (.) (forcen n2) (forcen n1) x = forcen ( max n1 n2 ) x
+      #-}
+#endif
+
+-------------------------------------------------------------------------------
+
+  -- | A class of types that can be evaluated to arbitrary depth.
+#if USE_NFDATA_SUPERCLASS
+  class NFData a => NFDataN a where
+#else
+  class NFDataN a where
+#endif
+#if 0
+    -- | rnf should reduce its argument to normal form (that is, fully
+    -- evaluate all sub-components), and then return '()'.
+    --
+    -- The default implementation of 'rnf' is
+    --
+    -- > rnf a = a `seq` ()
+    --
+    -- which may be convenient when defining instances for data types with
+    -- no unevaluated fields (e.g. enumerations).
+    rnf :: a -> ()
+    rnf a = a `seq` ()
+#endif
+    rnfn :: Int -> a -> ()
+#if USE_NFDATA_SUPERCLASS
+    -- ?? not sure about this (whatever, we'll override it)
+#if 1
+    rnfn n a | n <= 0     = ()  -- case needed? (seems to be!)
+             | otherwise  = rnf a
+#else
+    rnfn _ a = rnf a
+#endif
+#else
+#if 0
+#elif 1
+    rnfn n x | n <= 0     = ()
+             | otherwise  = x `seq` ()
+#elif 0
+    rnfn _ x = x `seq` ()
+#elif 0
+    rnfn _ _ = ()
+#endif
+#endif
+#if 1
+  {-# RULES
+    "rnfn/composition"    forall n1 n2 x.  (.) (rnfn n2) (rnfn n1) x = rnfn ( max n1 n2 ) x
+      #-}
+--   "rnfp/composition"    forall p1 p2 x.  compose (rnfp p2) (rnfp p1) x = rnfp ( unionPat [p1, p2] ) x
+--   "rnfp/composition"    forall p1 p2 x.  ( rnfp p2 . rnfp p1 ) x = rnfp ( unionPat [p1, p2] ) x
+#endif
+
+-------------------------------------------------------------------------------
+
+  instance NFDataN Int
+  instance NFDataN Word
+  instance NFDataN Integer
+  instance NFDataN Float
+  instance NFDataN Double
+
+  instance NFDataN Char
+  instance NFDataN Bool
+  instance NFDataN ()
+
+  instance NFDataN Int8
+  instance NFDataN Int16
+  instance NFDataN Int32
+  instance NFDataN Int64
+
+  instance NFDataN Word8
+  instance NFDataN Word16
+  instance NFDataN Word32
+  instance NFDataN Word64
+
+  instance NFDataN (Fixed a)
+
+  -- [Quoted from deepseq:]
+  -- This instance is for convenience and consistency with 'seq'.
+  -- This assumes that WHNF is equivalent to NF for functions.
+  instance NFDataN (a -> b)
+
+#if 0
+  instance NFDataN a => NFDataN (IO a) where
+    rnfn !n x = ()  -- XXX ignore if in IO (cludge easing an experiment...)
+#endif
+
+  -- not taken to be a level of depth
+  instance (Integral a, NFDataN a) => NFDataN (Ratio a) where
+    rnfn !n x = rnfn n (numerator x, denominator x)
+
+  instance (RealFloat a, NFDataN a) => NFDataN (Complex a) where
+#if 1
+    rnfn n (x:+y) = case n of
+     n | n <= 0  -> ()
+     _           -> let n' = -1+n in
+                    rnfn n' x `seq`
+                    rnfn n' y `seq`
+                    ()
+#else
+    rnfn !n (x:+y)
+     | n <= 0    = ()
+     | otherwise = let n' = -1+n in
+                   rnfn n' x `seq`
+                   rnfn n' y `seq`
+                   ()
+#endif
+
+  instance NFDataN a => NFDataN (Maybe a) where
+    rnfn _ Nothing  = ()
+    rnfn !n (Just x)
+     | n <= 0     = ()
+     | otherwise  = rnfn (-1+n) x
+
+  instance (NFDataN a, NFDataN b) => NFDataN (Either a b) where
+    rnfn !n (Left x)
+     | n <= 0     = ()
+     | otherwise  = rnfn (-1+n) x
+    rnfn !n (Right y)
+     | n <= 0     = ()
+     | otherwise  = rnfn (-1+n) y
+
+  instance NFDataN Data.Version.Version where
+    rnfn !n (Data.Version.Version branch tags)
+     | n <= 0     = ()
+     | otherwise  = let n' = -1+n in
+                    rnfn n' branch `seq` rnfn n' tags
+
+  instance NFDataN a => NFDataN [a] where
+    rnfn _ [] = ()
+    rnfn !n (x:xs)
+     | n <= 0     = ()
+     | otherwise  = let n' = -1+n in
+                    rnfn n' x `seq` rnfn n' xs
+
+  -- not taken to be a level of depth
+  instance (Ix a, NFDataN a, NFDataN b) => NFDataN (Array a b) where
+    rnfn !n x = rnfn n (bounds x, Data.Array.elems x)
+
+  instance (NFDataN a, NFDataN b) => NFDataN (a,b) where
+    rnfn !n (x,y)
+     | n <= 0     = ()
+     | otherwise  = let n' = -1+n in
+                    rnfn n' x `seq` rnfn n' y
+
+  instance (NFDataN a, NFDataN b, NFDataN c) => NFDataN (a,b,c) where
+    rnfn !n (x,y,z)
+     | n <= 0     = ()
+     | otherwise  = let n' = -1+n in
+                    rnfn n' x `seq` rnfn n' y `seq` rnfn n' z
+
+  instance (NFDataN a, NFDataN b, NFDataN c, NFDataN d) => NFDataN (a,b,c,d) where
+    rnfn !n (x1,x2,x3,x4)
+     | n <= 0     = ()
+     | otherwise  = let n' = -1+n in
+                    rnfn n' x1 `seq`
+                    rnfn n' x2 `seq`
+                    rnfn n' x3 `seq`
+                    rnfn n' x4
+
+  instance (NFDataN a1, NFDataN a2, NFDataN a3, NFDataN a4, NFDataN a5) =>
+           NFDataN (a1, a2, a3, a4, a5) where
+    rnfn !n (x1,x2,x3,x4,x5)
+     | n <= 0     = ()
+     | otherwise  = let n' = -1+n in
+                    rnfn n' x1 `seq`
+                    rnfn n' x2 `seq`
+                    rnfn n' x3 `seq`
+                    rnfn n' x4 `seq`
+                    rnfn n' x5
+
+  instance (NFDataN a1, NFDataN a2, NFDataN a3, NFDataN a4, NFDataN a5, NFDataN a6) =>
+           NFDataN (a1, a2, a3, a4, a5, a6) where
+    rnfn !n (x1,x2,x3,x4,x5,x6)
+     | n <= 0     = ()
+     | otherwise  = let n' = -1+n in
+                    rnfn n' x1 `seq`
+                    rnfn n' x2 `seq`
+                    rnfn n' x3 `seq`
+                    rnfn n' x4 `seq`
+                    rnfn n' x5 `seq`
+                    rnfn n' x6
+
+  instance (NFDataN a1, NFDataN a2, NFDataN a3, NFDataN a4, NFDataN a5, NFDataN a6, NFDataN a7) =>
+           NFDataN (a1, a2, a3, a4, a5, a6, a7) where
+    rnfn !n (x1,x2,x3,x4,x5,x6,x7)
+     | n <= 0     = ()
+     | otherwise  = let n' = -1+n in
+                    rnfn n' x1 `seq`
+                    rnfn n' x2 `seq`
+                    rnfn n' x3 `seq`
+                    rnfn n' x4 `seq`
+                    rnfn n' x5 `seq`
+                    rnfn n' x6 `seq`
+                    rnfn n' x7
+
+  instance (NFDataN a1, NFDataN a2, NFDataN a3, NFDataN a4, NFDataN a5, NFDataN a6, NFDataN a7, NFDataN a8) =>
+           NFDataN (a1, a2, a3, a4, a5, a6, a7, a8) where
+    rnfn !n (x1,x2,x3,x4,x5,x6,x7,x8)
+     | n <= 0     = ()
+     | otherwise  = let n' = -1+n in
+                    rnfn n' x1 `seq`
+                    rnfn n' x2 `seq`
+                    rnfn n' x3 `seq`
+                    rnfn n' x4 `seq`
+                    rnfn n' x5 `seq`
+                    rnfn n' x6 `seq`
+                    rnfn n' x7 `seq`
+                    rnfn n' x8
+
+  instance (NFDataN a1, NFDataN a2, NFDataN a3, NFDataN a4, NFDataN a5, NFDataN a6, NFDataN a7, NFDataN a8, NFDataN a9) =>
+           NFDataN (a1, a2, a3, a4, a5, a6, a7, a8, a9) where
+    rnfn !n (x1,x2,x3,x4,x5,x6,x7,x8,x9)
+     | n <= 0     = ()
+     | otherwise  = let n' = -1+n in
+                    rnfn n' x1 `seq`
+                    rnfn n' x2 `seq`
+                    rnfn n' x3 `seq`
+                    rnfn n' x4 `seq`
+                    rnfn n' x5 `seq`
+                    rnfn n' x6 `seq`
+                    rnfn n' x7 `seq`
+                    rnfn n' x8 `seq`
+                    rnfn n' x9
+
+-------------------------------------------------------------------------------
+
diff --git a/src/Control/DeepSeq/Bounded/NFDataP.hs b/src/Control/DeepSeq/Bounded/NFDataP.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/DeepSeq/Bounded/NFDataP.hs
@@ -0,0 +1,1030 @@
+
+-------------------------------------------------------------------------------
+
+  {-  LANGUAGE CPP #-}
+
+#define DO_TRACE 0
+
+-- XXX Note: Show constraints are for debugging purposes.
+#define INCLUDE_SHOW_INSTANCES 0
+
+-- Formerly DEBUG_WITH_DEEPSEQ_GENERICS.
+-- Now also needed to force issuance of all compilePat warnings
+-- (so not strictly a debugging flag anymore).
+-- [Except it didn't work...]
+--- #define NFDATA_INSTANCE_PATTERN 1  -- now it's a .cabal flag
+
+-- Now specified via --flag=[-]USE_WWW_DEEPSEQ
+--- #define USE_WW_DEEPSEQ 1
+
+-------------------------------------------------------------------------------
+
+  -- For tracing only:
+  {-  LANGUAGE BangPatterns #-}
+
+  {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+  {-# OPTIONS_GHC -fno-warn-overlapping-patterns #-}
+
+-------------------------------------------------------------------------------
+
+-- |
+-- Module      :  Control.DeepSeq.Bounded.NFDataP
+-- Copyright   :  (c) 2014, Andrew G. Seniuk
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  Andrew Seniuk <rasfar@gmail.com>
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- This module provides an overloaded function, 'deepseqp', for partially
+-- (or fully) evaluating data structures to bounded depth via pattern
+-- matching on term shape, and on class, type, and constructor names.
+--
+-- There are two ways to use this API.
+--
+--  (1) You can use the 'PatNode' constructors directly.
+--
+--  (2) You can compile your patterns from strings in a concise
+--      embedded language.
+--
+-- There's no difference in expressive power, but use of the DSL
+-- is recommended, because the embedded 'Pattern' compiler can catch
+-- some errors that GHC cannot (using 'PatNode' constructors explicitly).
+-- Also, the pattern strings are easier to read and write.
+--
+-- __Motivation__
+--
+-- A typical use is to ensure any exceptions hidden within lazy
+-- fields of a data structure do not leak outside the scope of the
+-- exception handler; another is to force evaluation of a data structure in
+-- one thread, before passing it to another thread (preventing work moving
+-- to the wrong threads). Unlike "DeepSeq", potentially infinite coinductive
+-- data types are supported by principled bounding of deep evaluation.
+--
+-- It is also useful for diagnostic purposes when trying to understand
+-- and manipulate space\/time trade-offs in lazy code,
+-- and as an optimal substitute for 'deepseq'
+-- (where \"optimal\" doesn't include changing the code to remove
+-- the need for artificial forcing!).
+--
+-- 'deepseqp' with optimal patterns is usually a better solution
+-- even than stict fields in your data structures, because the
+-- latter will behave strictly everywhere the constructors
+-- are used, instead of just where its laziness is problematic.
+--
+-- There may be possible applications to the prevention of resource leaks
+-- in lazy streaming, but I'm not certain.
+--
+-- __Semantics__
+--
+-- (For additional details, see "Control.DeepSeq.Bounded.Pattern".)
+--
+-- 'deepseqp' and friends artifically force evaluation of a term
+-- so long as the pattern matches.
+--
+-- A mismatch occurs at a pattern node when the corresponding constructor node either:
+--
+--  * has arity different than the number of subpatterns (only when subpatterns given)
+--
+--  * has class\/type\/name not named in the constraint (only when constraint given)
+--
+-- A mismatch will cause evaluation down that branch to stop, but any
+-- upstream matching/forcing will continue uninterrupted.
+-- Note that patterns may extend beyond the values they match against,
+-- without incurring any mismatch. This semantics is not the only
+-- possible, but bear in mind that order of evaluation is nondeterministic,
+-- barring further measures.
+--
+-- See also "NFDataPDyn" for another approach, which dynamically
+-- generates forcing patterns, and can depend on value info
+-- (in addition to type info).
+--
+
+-------------------------------------------------------------------------------
+
+  module Control.DeepSeq.Bounded.NFDataP
+
+  (
+
+     -- * Pattern-bounded analogues of 'deepseq' and 'force'
+
+       deepseqp, forcep    -- take String arg (pattern DSL)
+
+     -- * Avoid DSL compilation overhead
+     --
+     -- However, we don't anticipate that this overhead would be
+     -- significant in most applications, because using <deepseq-bounded>
+     -- in a tight loop would only be done for diagnostic purposes.
+
+     , deepseqp_, forcep_  -- take Pattern structure arg
+
+#if 0
+       -- Don't bother, really.
+     , deepseqpM, forcepM  -- return lifted argument so can cope with bottom
+     , deepseqpM_, forcepM_
+#endif
+
+     -- * Related modules re-exported
+
+     , module Control.DeepSeq.Bounded.Pattern
+     , module Control.DeepSeq.Bounded.PatAlg  -- actually exports former
+
+     -- * Class of things that can be evaluated over an arbitrary finite pattern
+
+     , NFDataP(..)
+
+  )
+
+  where
+
+-------------------------------------------------------------------------------
+
+  import Control.DeepSeq.Bounded.Pattern
+  import Control.DeepSeq.Bounded.PatAlg ( unionPats, liftPats )
+
+  import Control.DeepSeq.Bounded.NFDataN  -- finally used ("*3" etc.)
+
+#if USE_WW_DEEPSEQ
+  import Control.DeepSeq ( NFData )
+  import Control.DeepSeq ( rnf )
+#endif
+
+--import Data.Data  -- "redundant" last checked
+
+  import Data.Typeable ( Typeable )
+#if 1
+  import Data.Typeable ( typeOf )
+#else
+-- XXX These are NOT interchangeable!
+#if __GLASGOW_HASKELL__ >= 781
+  import Data.Typeable ( typeRep )
+#else
+  import Data.Typeable ( typeOf )
+#endif
+#endif
+  import Data.Typeable ( mkTyCon3, mkTyConApp )
+  import Data.Typeable ( typeRepTyCon )
+
+#if PARALLELISM_EXPERIMENT
+  import Control.Parallel ( par )
+#endif
+
+  import Data.Int
+  import Data.Word
+  import Data.Ratio
+  import Data.Complex
+  import Data.Array
+  import Data.Fixed
+  import Data.Version
+
+  import Data.Maybe ( Maybe(..), isJust, fromJust )
+
+  import System.IO.Unsafe ( unsafePerformIO )
+
+  import Debug.Trace ( trace )
+
+-------------------------------------------------------------------------------
+
+#if DO_TRACE
+  mytrace = trace
+#else
+  mytrace _ = id
+#endif
+
+-------------------------------------------------------------------------------
+
+--infixr 0 $!!
+
+-------------------------------------------------------------------------------
+
+-- XXX NOTE: These need to return Maybe __, in order to handle
+-- patterns rooted at a WI (i.e. "#" or equivalent "#{...}").
+-- Since don't want to do that by default, will simply make
+-- it a DSL compilePat error...
+
+-- XXX NOTE TO SELF: These comments are verbatim from Control.DeepSeq:
+  -- | 'deepseqp': evaluates the first argument to the depth specified
+  -- by a 'Pattern', before returning the second.
+  --
+  -- Quoting from the DeepSeq.hs (deepseq package):
+  --
+  -- / \"'deepseq' can be useful for forcing pending exceptions, eradicating space leaks, or forcing lazy I\/O to happen.  It is also useful in conjunction with parallel Strategies (see the @parallel@ package). /
+  --
+  -- / There is no guarantee about the ordering of evaluation.  The implementation may evaluate the components of the structure in any order or in parallel.  To impose an actual order on evaluation, use 'pseq' from "Control.Parallel" in the @parallel@ package.\" /
+  --
+  -- Composition fuses (see 'deepseqp_').
+{--} -- XXX LATER: This is flawed for # at root of pattern.
+#if INCLUDE_SHOW_INSTANCES
+  deepseqp :: (Show a, NFDataP a) => String -> a -> b -> b
+#else
+  deepseqp :: NFDataP a => String -> a -> b -> b
+#endif
+#if 0
+#elif 0
+  deepseqp patstr a b = fromJust $ deepseqp_ (compilePat patstr) a b
+--deepseqp patstr = fromJust $ deepseqp_ (compilePat patstr)
+#elif 1
+  deepseqp patstr = deepseqp_ (compilePat patstr)
+#elif 0
+  deepseqp patstr a b = rnfp (compilePat patstr) a `seq` b
+  -- XXX Partially-applied; is that okay in GHC RULES?
+  {-# RULES
+    "deepseqp/composition"    forall p1 p2 x.  (.) (deepseqp p2) (deepseqp p1) x = deepseqp_ ( unionPats [compilePat p1, compilePat p2] ) x
+      #-}
+#endif
+
+  -- | Self-composition fuses via
+  --
+  -- @
+  --     "deepseqp_/composition"
+  --        forall p1 p2 x1 x2.
+  --            (.) ('deepseqp_' p2 x2) ('deepseqp_' p1 x1)
+  --          = 'deepseqp_' ( 'liftPats' [p1, p2] ) (x1,x2)
+  -- @
+  --
+  -- (Other fusion rules, not yet documented, may also be in effect.)
+{--}
+  -- XXX Oh! We have a fundamental problem here!
+  -- I realised that
+  --   forcep "#" (undefined::Int)
+  -- was bottoming out. Then sought to repair that by "doing nothing"
+  -- if WI etc. here, as in rnfp.
+  -- However, how can we return type b, and "do nothing"?
+  --  - if go "`seq` b" does this not force b?
+  --    (don't see why it should actually)
+  --  - if go "`seq` ()", this is a type error for deepseqp
+  --  - if go "`seq` (undefined::b)", this defeats the purpose, as we
+  --    precisely do not want to hit bottom... still, this might be
+  --    a possible way, if can do it right....
+  --  - if go "`seq` defaultValue_in_type_b" -- this is never acceptable
+  --    in library code...
+  --  - we CAN return Maybe b! This is, after all, deepseqp_
+  --    Can decide how to cope with that in the caller.
+  --    But at least the need to return type b here is lifted...
+  -- As for the RULES, I think they're not ready to use now...
+-- XXX LATER: This is flawed for # at root of pattern.
+-- Maybe not quite flawed, just "untestable" if there's bottom at
+-- the root of the value (that is to say, the value is (undefined::b).
+#if INCLUDE_SHOW_INSTANCES
+  deepseqp_ :: (Show a, NFDataP a) => Pattern -> a -> b -> b
+#else
+  deepseqp_ :: NFDataP a => Pattern -> a -> b -> b
+#endif
+#if 0
+#elif 0
+  deepseqp_ pat@(Node WI _) _ b = b
+  deepseqp_ pat@(Node (TR treps) chs) a b = if elem ta treps then doit `seq` b else b
+   where ta = show $ typeRepTyCon $ typeOf a
+         doit = rnfp pat a `seq` b
+  deepseqp_ pat@(Node (TI treps) chs) a b = if elem ta treps then b else doit `seq` b
+   where ta = show $ typeRepTyCon $ typeOf a
+         doit = rnfp pat a `seq` b
+  deepseqp_ pat a b = rnfp pat a `seq` b
+#elif 1
+  deepseqp_ pat a b = rnfp pat a `seq` b
+  -- XXX Need to double-check that this makes sense; didn't think
+  -- it through -- when b != a, things are not so simple.
+  -- XXX Partially-applied; is that okay in GHC RULES?
+  {-# RULES
+    "deepseqp_/composition"    forall p1 p2 x1 x2.  (.) (deepseqp_ p2 x2) (deepseqp_ p1 x1) = deepseqp_ ( liftPats [p1, p2] ) (x1,x2)
+      #-}
+--  "deepseqp_/composition"    forall p1 p2 x.  (.) (deepseqp_ p2) (deepseqp_ p1) x = deepseqp_ ( unionPats [p1, p2] ) x
+#endif
+
+  -- | Lifted result, so can cope with undefined values and
+  -- still take the head in the caller (if call is after 'seq' or '$!'
+  -- for instance).
+#if INCLUDE_SHOW_INSTANCES
+  deepseqpM :: (Show a, NFDataP a) => String -> a -> b -> Maybe b
+#else
+  deepseqpM :: NFDataP a => String -> a -> b -> Maybe b
+#endif
+  deepseqpM patstr a b = deepseqpM_ (compilePat patstr) a b
+#if INCLUDE_SHOW_INSTANCES
+  deepseqpM_ :: (Show a, NFDataP a) => Pattern -> a -> b -> Maybe b
+#else
+  deepseqpM_ :: NFDataP a => Pattern -> a -> b -> Maybe b
+#endif
+  deepseqpM_ pat@(Node WI _) _ _ = Nothing
+  deepseqpM_ pat@(Node (TR treps) chs) a b = if elem ta treps then doit `seq` Just b else Nothing
+   where ta = show $ typeRepTyCon $ typeOf a
+         doit = rnfp pat a `seq` b
+  deepseqpM_ pat@(Node (TI treps) chs) a b = if elem ta treps then Nothing else doit `seq` Just b
+   where ta = show $ typeRepTyCon $ typeOf a
+         doit = rnfp pat a `seq` b
+  deepseqpM_ pat a b = rnfp pat a `seq` Just b
+
+-------------------------------------------------------------------------------
+
+#if 0
+  -- | the deep analogue of '$!'.  In the expression @f $!! x@, @x@ is
+  -- fully evaluated before the function @f@ is applied to it.
+  ($!!) :: (NFData a) => (a -> b) -> a -> b
+  f $!! x = x `deepseq` f x
+#endif
+
+  -- | a variant of 'deepseqp' that is sometimes convenient:
+  --
+  -- > forcep pat x = x `deepseqp pat` x
+  --
+  -- @forcep pat x@ evaluates @x@ to the depth determined by @pat@, and
+  -- then returns @x@.  Note that @forcep pat x@ only takes effect
+  -- when the value of @forcep pat x@ itself is demanded, so essentially
+  -- it turns shallow evaluation into evaluation to arbitrary bounded depth.
+  --
+  -- Composition fuses (see 'forcep_').
+{--}
+-- XXX What about mixed cases??...
+-- XXX LATER: This is flawed for # at root of pattern.
+#if INCLUDE_SHOW_INSTANCES
+  forcep :: (Show a, NFDataP a) => String -> a -> a
+#else
+  forcep :: NFDataP a => String -> a -> a
+#endif
+#if 0
+#elif 0
+  forcep patstr x
+   | p          = fromJust ma
+-- | otherwise  = error "here"
+   | otherwise  = undefined::a
+   where ma = deepseqp_ (compilePat patstr) x x
+         p = isJust ma
+#elif 0
+  forcep patstr x = fromJust $ deepseqp_ (compilePat patstr) x x
+#elif 0
+  forcep patstr x
+   | b          = x
+   | otherwise  = fromJust y
+   where y = deepseqp_ (compilePat patstr) x (Just x)
+         pat@(Node p chs) = compilePat patstr
+         b | WI <- p      = True
+           | TR _ <- p    = True
+           | TN _ _ <- p  = True
+           | TW _ <- p    = True
+           | TI _ <- p    = True
+           | otherwise    = False
+#elif 1
+  forcep patstr x = deepseqp_ (compilePat patstr) x x
+--forcep patstr x = deepseqp patstr x x
+  {-# RULES
+    "forcep/composition"    forall p1 p2 x.  (.) (forcep p2) (forcep p1) x = forcep_ ( unionPats [compilePat p1, compilePat p2] ) x
+      #-}
+#endif
+
+  -- | Self-composition fuses via
+  --
+  -- @
+  --     "forcep_/composition"
+  --        forall p1 p2 x.
+  --            (.) ('forcep_' p2) ('forcep_' p1) x
+  --          = 'forcep_' ( 'unionPats' [p1, p2] ) x
+  -- @
+  --
+  -- (Other fusion rules, not yet documented, may also be in effect.)
+{--}
+-- XXX LATER: This is flawed for # at root of pattern.
+#if INCLUDE_SHOW_INSTANCES
+  forcep_ :: (Show a, NFDataP a) => Pattern -> a -> a
+#else
+  forcep_ :: NFDataP a => Pattern -> a -> a
+#endif
+#if 0
+  forcep_ pat x = fromJust $ deepseqp_ pat x x
+#else
+  forcep_ pat x = deepseqp_ pat x x
+  {-# RULES
+    "forcep_/composition"    forall p1 p2 x.  (.) (forcep_ p2) (forcep_ p1) x = forcep_ ( unionPats [p1, p2] ) x
+      #-}
+#endif
+
+  -- | Lifted result, so can cope with undefined values and
+  -- still take the head in the caller (if call is after 'seq' or '$!'
+  -- for instance).
+#if INCLUDE_SHOW_INSTANCES
+  forcepM :: (Show a, NFDataP a) => String -> a ->  Maybe a
+#else
+  forcepM :: NFDataP a => String -> a ->  Maybe a
+#endif
+  forcepM patstr a = forcepM_ (compilePat patstr) a
+#if INCLUDE_SHOW_INSTANCES
+  forcepM_ :: (Show a, NFDataP a) => Pattern -> a -> Maybe a
+#else
+  forcepM_ :: NFDataP a => Pattern -> a -> Maybe a
+#endif
+  forcepM_ pat x = deepseqpM_ pat x x
+
+-------------------------------------------------------------------------------
+
+  -- | A class of types that can be evaluated over an arbitrary finite pattern.
+#if USE_WW_DEEPSEQ
+  class (Typeable a, NFDataN a, NFData a) => NFDataP a where
+#else
+  class (Typeable a, NFDataN a) => NFDataP a where
+#endif
+    -- | Self-composition fuses via
+    --
+    -- @
+    --     "rnfp/composition"
+    --        forall p1 p2 x.
+    --            (.) ('rnfp' p2) ('rnfp' p1) x
+    --          = 'rnfp' ( 'unionPats' [p1, p2] ) x
+    -- @
+    --
+    -- (Other fusion rules, not yet documented, may also be in effect.)
+    {-  NOINLINE rnfp #-}
+#if INCLUDE_SHOW_INSTANCES
+    rnfp :: Show a => Pattern -> a -> ()
+#else
+    rnfp :: Pattern -> a -> ()
+#endif
+    rnfp (Node WI _) _ = ()
+    rnfp (Node (TR treps) chs) d = if elem td treps then d `seq` () else ()
+     where td = show $ typeRepTyCon $ typeOf d
+    rnfp (Node (TI treps) chs) d = if elem td treps then () else d `seq` ()
+     where td = show $ typeRepTyCon $ typeOf d
+#if 1
+    rnfp _ d = d `seq` ()
+--  rnfp _ _ = ()
+#else
+    -- XXX temporarily (at least) commenting out; not making any
+    -- use of patternShapeOK -- but there is room for more
+    -- error-trapping code in here, definitely...
+    rnfp pat a | not $ patternShapeOK pat a  = ()
+               | otherwise  = rnf a
+#endif
+
+  {-# RULES
+    "rnfp/composition"    forall p1 p2 x.  (.) (rnfp p2) (rnfp p1) x = rnfp ( unionPats [p1, p2] ) x
+      #-}
+--  "rnfp/composition"    forall p1 p2 x.  compose (rnfp p2) (rnfp p1) x = rnfp ( unionPats [p1, p2] ) x
+--  "rnfp/composition"    forall p1 p2 x.  ( rnfp p2 . rnfp p1 ) x = rnfp ( unionPats [p1, p2] ) x
+
+-------------------------------------------------------------------------------
+
+  -- It seems that people will tell you this should not
+  -- be a class method; helper functions of class methods
+  -- should not be inside the class?...
+  -- I've just read in
+  -- https://www.fpcomplete.com/user/thoughtpolice/using-reflection
+  -- that there's an optimisation (which may also affect type issues)
+  -- when a class has a single method only; so I moved rnfp' out of
+  -- the NFDataP class finally (it was recommended to do so before,
+  -- but I never understood why; now I at least had some reason).
+  -- (It has not affected my type errors in this case though; no
+  -- surprise as DeepSeqBounded/T02/t.hs shows it happening with
+  -- a single-method class.)
+#if USE_WW_DEEPSEQ
+  rnfp' :: (Typeable a, NFDataN a, NFData a) => PatNode -> () -> a -> ()
+#else
+  rnfp' :: (Typeable a, NFDataN a) => PatNode -> () -> a -> ()
+#endif
+-- Sig. as it was as a class method of NFDataP:
+--rnfp' :: PatNode -> () -> a -> ()
+  rnfp' pat recurs d
+   -- I can only conclude that we've already evaluated the argument
+   -- by the time this code runs (or that we evaluate it after...).
+   -- But this code doesn't do the dirty deed!
+   = {-trace ( "rnfp' " ++ show pat) $-}
+     let td = show $ typeRepTyCon $ typeOf d in  -- no problem on bottom
+     case pat of
+      WI -> error "rnfp: unexpected WI (please report this bug!)"
+      TR treps -> error "rnfp: unexpected TR (please report this bug!)"
+      TI treps -> error "rnfp: unexpected TI (please report this bug!)"
+#if PARALLELISM_EXPERIMENT
+      -- XXX will this work? ... YES IT SEEMS TO!!! (Esp. evident in ghci.)
+      PR -> recurs `par` ()
+      PN n -> rnfn n d `par` ()
+#if USE_WW_DEEPSEQ
+      PW -> rnf d `par` ()  -- the only place deepseq package is used
+#endif
+#endif
+#ifdef SEQUENTIALISM_EXPERIMENT
+#error Sorry, SEQUENTIALISM_EXPERIMENT is not done yet.
+-- XXX Alas! This won't work, at least not according to the same method
+-- as PR etc.  There's no possible use in the `pseq` () section!
+-- (Unlike `par` (), which is already working for parallel speedup.)
+-- So, SEQUENTIALISM_EXPERIMENT may be the one where we would need
+-- to edit all the instances individually...  This again raises the
+-- question of how we handle higher-arity nodes? It makes no sense
+-- (unlike parallel) to pseq just one sibling. If you pseq a subset
+-- of siblings, their subharnesses will be sequenced, yes (and the
+-- remainder will be order-free).
+--   Unfortunately, to express this is not easy (unlike for parallel).
+-- So, this is on hold for the time being.
+--    SR -> recurs `pseq` ()
+#endif
+      WR -> recurs
+      WS -> ()
+--      WS -> d `seq` ()
+      WN n -> rnfn n d
+#if USE_WW_DEEPSEQ
+      WW -> rnf d  -- the only place deepseq package is used
+#endif
+      -- This code stays the same whether we (are able to) compare
+      -- actual TypeRep's for equality, or we just hack it
+      -- and match:  show . typeRepTyCon . typeOf
+      TR treps ->  if       elem td treps then recurs else ()
+#if 0
+      -- This is not right. To pull this off (b/c it depends on
+      -- types in the value your matching with), need to construct
+      -- the pattern dynamically.  In particular, to produce Nil
+      -- where a TR (or TS) constraint causes (or would cause)
+      -- match failure.
+      TS treps ->  if       elem td treps then () else ()
+#endif
+      TN n treps ->  if       elem td treps then rnfn n d else ()
+#if USE_WW_DEEPSEQ
+      TW treps ->  if       elem td treps then rnf d else ()
+#endif
+#if 0
+      NTR treps -> if not $ elem td treps then recurs else ()
+      NTN n treps -> if not $ elem td treps then rnfn n d else ()
+#if USE_WW_DEEPSEQ
+      NTW treps -> if not $ elem td treps then rnf d else ()
+#endif
+#endif
+      _ -> error "rnfp: Unexpected constructor!"
+
+-------------------------------------------------------------------------------
+
+#if 0
+  compose = (.)
+  {-# NOINLINE compose #-}
+  -- Can't do this, unfortunately.  GHC warns it may get inlined before
+  -- rules have a chance to fire.  I would rather avoid forcing the API
+  -- user to use some custom "compose" function, since base (.) works
+  -- perfectly, except it's hard to control its inlining...
+  {-  NOINLINE (.) #-}
+#endif
+
+-------------------------------------------------------------------------------
+
+  instance NFDataP Int
+  instance NFDataP Word
+  instance NFDataP Integer
+  instance NFDataP Float
+  instance NFDataP Double
+
+  instance NFDataP Char
+#if 0
+-- (testing something or other)
+  instance NFDataP Bool
+   where
+    rnfp (Node WI _) _ = ()
+    rnfp _ d = d `seq` ()
+#else
+  instance NFDataP Bool
+#endif
+  instance NFDataP ()
+
+  instance NFDataP Int8
+  instance NFDataP Int16
+  instance NFDataP Int32
+  instance NFDataP Int64
+
+  instance NFDataP Word8
+  instance NFDataP Word16
+  instance NFDataP Word32
+  instance NFDataP Word64
+
+-------------------------------------------------------------------------------
+
+  instance Typeable a => NFDataP (Fixed a)
+--instance NFDataP (Fixed a)
+
+-------------------------------------------------------------------------------
+
+  -- [Quoted from deepseq:]
+  -- This instance is for convenience and consistency with 'seq'.
+  -- This assumes that WHNF is equivalent to NF for functions.
+  instance (Typeable a, Typeable b) => NFDataP (a -> b)
+--instance NFDataP (a -> b)
+
+-------------------------------------------------------------------------------
+
+#if 0
+
+-- XXX ignore if in IO (cludge easing an experiment...)
+
+#if USE_WW_DEEPSEQ
+  instance NFData a => NFData (IO a) where
+    rnf x = ()  -- XXX ignore if in IO (cludge easing an experiment...)
+#endif
+
+  instance NFDataP a => NFDataP (IO a) where
+    rnfp pat x = ()  -- XXX ignore if in IO (cludge easing an experiment...)
+
+#endif
+
+-------------------------------------------------------------------------------
+
+--Rational and complex numbers.
+
+-- not taken to be a level of depth
+#if INCLUDE_SHOW_INSTANCES
+  instance (Show a, Integral a, NFDataP a) => NFDataP (Ratio a) where
+#else
+  instance (Integral a, NFDataP a) => NFDataP (Ratio a) where
+#endif
+    -- XXX This is very dubious!...
+    {-  NOINLINE rnfp #-}
+    rnfp (Node WI _) _ = ()
+    rnfp pat x = rnfp pat (numerator x, denominator x)
+
+  -- Note that (Complex a) constructor (:+) has strict fields,
+  -- so unwrapping the ctor also forces both components.
+#if INCLUDE_SHOW_INSTANCES
+  instance (Show a, RealFloat a, NFDataP a) => NFDataP (Complex a) where
+#else
+  instance (RealFloat a, NFDataP a) => NFDataP (Complex a) where
+#endif
+    {-  NOINLINE rnfp #-}
+    rnfp (Node WI _) _ = ()
+    rnfp (Node pat chs) d
+     | TR treps <- pat  = if elem td treps then recurs else ()
+     | TI treps <- pat  = if elem td treps then () else recurs
+     | otherwise        = rnfp' pat recurs d
+     where
+      td = show $ typeRepTyCon $ typeOf d
+      recurs = case length chs of
+        0 -> case pat of
+              WS -> ()
+              _ -> pat_match_fail
+        2 -> let [px,py] = chs ; (x:+y) = d
+             in       rnfp px x
+                `seq` rnfp py y
+                `seq` ()  -- needed?
+        _ -> pat_match_fail
+      pat_match_fail = patMatchFail' "(Complex a)" pat chs d
+    rnfp (Node pat chs) d = patMatchFail pat chs d  -- unreachable
+
+-- XXX Never until now (so much later) did I properly consider how to
+-- handle a no-arg (nullary) constructor! It's not hard, but it's
+-- significantly different than the other cases, as there's no
+-- subvalue we can grab hold of -- there's no "d"; so this invalidates
+-- all the code, in the posary (complement of nullary, coinage :) case
+-- case, which references d.
+#if INCLUDE_SHOW_INSTANCES
+  instance (Show a, NFDataP a) => NFDataP (Maybe a) where
+#else
+  instance NFDataP a => NFDataP (Maybe a) where
+#endif
+    {-  NOINLINE rnfp #-}
+    rnfp (Node WI _) _ = ()
+    rnfp (Node pat chs) Nothing
+     | not $ null chs   = pat_match_fail
+     | otherwise        = ()
+     where
+      pat_match_fail = patMatchFail' "Nothing" pat chs ()
+    rnfp (Node pat chs) (Just d)
+     | TR treps <- pat  = if elem td treps then recurs else ()
+     | TI treps <- pat  = if elem td treps then () else recurs
+     | otherwise        = rnfp' pat recurs d
+     where
+      td = show $ typeRepTyCon $ typeOf d
+      recurs = case length chs of
+        0 -> case pat of
+              WS -> ()
+              _ -> pat_match_fail
+        1 -> let [p_J] = chs
+             in       rnfp p_J d
+                `seq` ()  -- needed?
+        _ -> pat_match_fail
+      pat_match_fail = patMatchFail' "Just" pat chs d
+    rnfp (Node pat chs) d = patMatchFail pat chs d  -- unreachable
+
+#if INCLUDE_SHOW_INSTANCES
+  instance (Show a, Show b, NFDataP a, NFDataP b) => NFDataP (Either a b) where
+#else
+  instance (NFDataP a, NFDataP b) => NFDataP (Either a b) where
+#endif
+    {-  NOINLINE rnfp #-}
+    rnfp (Node WI _) _ = ()
+    rnfp (Node pat chs) (Left d)
+     | TR treps <- pat  = if elem td treps then recurs else ()
+     | TI treps <- pat  = if elem td treps then () else recurs
+     | otherwise        = rnfp' pat recurs d
+     where
+      td = show $ typeRepTyCon $ typeOf d
+      recurs = case length chs of
+        0 -> case pat of
+              WS -> ()
+              _ -> pat_match_fail
+        1 -> let [p_L] = chs ;
+             in       rnfp p_L d
+                `seq` ()  -- needed?
+        _ -> pat_match_fail
+      pat_match_fail = patMatchFail' "Left" pat chs d
+--    pat_match_fail = patMatchFail' "(Either a b)" pat chs d
+    rnfp (Node pat chs) (Right d)
+     | TR treps <- pat  = if elem td treps then recurs else ()
+     | TI treps <- pat  = if elem td treps then () else recurs
+     | otherwise        = rnfp' pat recurs d
+     where
+      td = show $ typeRepTyCon $ typeOf d
+      recurs = case length chs of
+        0 -> case pat of
+              WS -> ()
+              _ -> pat_match_fail
+        1 -> let [p_R] = chs
+             in       rnfp p_R d
+                `seq` ()  -- needed?
+        _ -> pat_match_fail
+      pat_match_fail = patMatchFail' "Right" pat chs d
+--    pat_match_fail = patMatchFail' "(Either a b)" pat chs d
+    rnfp (Node pat chs) d = patMatchFail pat chs d  -- unreachable
+
+--- #if __GLASGOW_HASKELL__ < 781
+--- -- requires -XStandaloneDeriving
+--- -- orphan instance, but better than dropping support
+--- -- (It seems it already has its Show instance!)
+--- deriving instance Data Data.Version.Version
+--- #endif
+
+--deriving instance Data TypeRep  -- can't b/c not all data ctors are in scope!
+
+  -- Data.Version ctor does /not/ have strict fields.
+  instance NFDataP Data.Version.Version where
+    {-  NOINLINE rnfp #-}
+    rnfp (Node WI _) _ = ()
+    rnfp (Node pat chs) d
+     | TR treps <- pat  = if elem td treps then recurs else ()
+     | TI treps <- pat  = if elem td treps then () else recurs
+     | otherwise        = rnfp' pat recurs d
+     where
+      td = show $ typeRepTyCon $ typeOf d
+      recurs = case length chs of
+        0 -> case pat of
+              WS -> ()
+              _ -> pat_match_fail
+        2 -> let [pbr,ptags] = chs ; Data.Version.Version branch tags = d
+             in       rnfp pbr branch
+                `seq` rnfp ptags tags
+                `seq` ()  -- needed?
+        _ -> pat_match_fail
+      pat_match_fail = patMatchFail' "Data.Version.Version" pat chs d
+    rnfp (Node pat chs) d = patMatchFail pat chs d  -- unreachable
+
+  -- Data.List ctors do /not/ have strict fields (i.e. (:) is not strict).
+#if INCLUDE_SHOW_INSTANCES
+  instance (Show a, NFDataP a) => NFDataP [a] where
+#else
+  instance NFDataP a => NFDataP [a] where
+#endif
+    {-  NOINLINE rnfp #-}
+    rnfp (Node WI _) _ = ()
+    rnfp _ [] = ()  -- perhaps dubious?...
+    rnfp (Node pat chs) d
+     | TR treps <- pat  = if elem td treps then recurs else ()
+     | TI treps <- pat  = if elem td treps then () else recurs
+     | otherwise        = rnfp' pat recurs d
+     where
+      td = show $ typeRepTyCon $ typeOf d
+      recurs = case length chs of
+        0 -> case pat of
+              WS -> ()
+              _ -> pat_match_fail
+        2 -> let [px,pxs] = chs ; (x:xs) = d
+             in       rnfp px x
+                `seq` rnfp pxs xs
+                `seq` ()  -- needed?
+        _ -> pat_match_fail
+      pat_match_fail = patMatchFail' "[a]" pat chs d
+    rnfp (Node pat chs) d = patMatchFail pat chs d  -- unreachable
+
+  -- Data.Array ctor does /not/ have strict fields.
+  -- not taken to be a level of depth
+#if INCLUDE_SHOW_INSTANCES
+  instance (Show a, Show b, Ix a, NFDataP a, NFDataP b) => NFDataP (Array a b) where
+#else
+  instance (Ix a, NFDataP a, NFDataP b) => NFDataP (Array a b) where
+#endif
+    -- XXX This is very dubious!...
+    {-  NOINLINE rnfp #-}
+    rnfp (Node WI _) _ = ()
+    rnfp pat x =        rnfp pat (bounds x, Data.Array.elems x)
+                  `seq` ()  -- needed?
+
+#if INCLUDE_SHOW_INSTANCES
+  instance (Show a,Typeable a,NFDataP a, Show b,Typeable b,NFDataP b) => NFDataP (a,b) where
+#else
+  instance (Typeable a,NFDataP a, Typeable b,NFDataP b) => NFDataP (a,b) where
+#endif
+    {-  NOINLINE rnfp #-}
+    rnfp (Node WI _) _ = ()
+    rnfp (Node pat chs) d
+     | TR treps <- pat  = if elem td treps then recurs else ()
+     | TI treps <- pat  = if elem td treps then () else recurs
+     | otherwise        = rnfp' pat recurs d
+     where
+      td = show $ typeRepTyCon $ typeOf d
+      recurs = case length chs of
+        0 -> case pat of
+              WS -> ()
+              _ -> pat_match_fail
+        2 -> let [px,py] = chs ; (x,y) = d
+             in       rnfp px x
+                `seq` rnfp py y
+                `seq` ()  -- needed?
+        _ -> pat_match_fail
+      pat_match_fail = patMatchFail' "(,)" pat chs d
+    rnfp (Node pat chs) d = patMatchFail pat chs d  -- unreachable
+
+#if INCLUDE_SHOW_INSTANCES
+  instance (Show a, Typeable a, NFDataP a, Show b, Typeable b, NFDataP b, Show c, Typeable c, NFDataP c) => NFDataP (a,b,c) where
+#else
+  instance (Typeable a, NFDataP a, Typeable b, NFDataP b, Typeable c, NFDataP c) => NFDataP (a,b,c) where
+#endif
+    {-  NOINLINE rnfp #-}
+    rnfp (Node WI _) _ = ()
+    rnfp (Node pat chs) d
+     | TR treps <- pat  = if elem td treps then recurs else ()
+     | TI treps <- pat  = if elem td treps then () else recurs
+     | otherwise        = rnfp' pat recurs d
+     where
+      td = show $ typeRepTyCon $ typeOf d
+      recurs = case length chs of
+        0 -> case pat of
+              WS -> ()
+              _ -> pat_match_fail
+        3 -> {-trace "WWW" $-} let [px,py,pz] = chs ; (x,y,z) = d
+             in       ({-trace "XXX" $-} rnfp px x)
+                `seq` ({-trace "YYY" $-} rnfp py y)
+-- This WILL change the semantics unfortunately...
+--              `seq` (trace ("YYY "++show py++" "++show y) $ rnfp py y)
+                `seq` ({-trace "ZZZ" $-} rnfp pz z)
+                `seq` ()  -- needed?
+        _ -> pat_match_fail
+      pat_match_fail = patMatchFail' "(,,)" pat chs d
+    rnfp (Node pat chs) d = patMatchFail pat chs d  -- unreachable
+
+#if INCLUDE_SHOW_INSTANCES
+  instance (Show a, Typeable a, NFDataP a, Show b, Typeable b, NFDataP b, Show c, Typeable c, NFDataP c, Show d, Typeable d, NFDataP d) => NFDataP (a,b,c,d) where
+#else
+  instance (Typeable a, NFDataP a, Typeable b, NFDataP b, Typeable c, NFDataP c, Typeable d, NFDataP d) => NFDataP (a,b,c,d) where
+#endif
+    {-  NOINLINE rnfp #-}
+    rnfp (Node WI _) _ = ()
+    rnfp (Node pat chs) d
+     | TR treps <- pat  = if elem td treps then recurs else ()
+     | TI treps <- pat  = if elem td treps then () else recurs
+     | otherwise        = rnfp' pat recurs d
+     where
+      td = show $ typeRepTyCon $ typeOf d
+      recurs = case length chs of
+        0 -> case pat of
+              WS -> ()
+              _ -> pat_match_fail
+        4 -> let [px1,px2,px3,px4] = chs ; (x1,x2,x3,x4) = d
+             in       rnfp px1 x1
+                `seq` rnfp px2 x2
+                `seq` rnfp px3 x3
+                `seq` rnfp px4 x4
+                `seq` ()  -- needed?
+        _ -> pat_match_fail
+      pat_match_fail = patMatchFail' "(,,,)" pat chs d
+    rnfp (Node pat chs) d = patMatchFail pat chs d
+
+#if INCLUDE_SHOW_INSTANCES
+  instance (Show a1, Typeable a1, NFDataP a1, Show a2, Typeable a2, NFDataP a2, Show a3, Typeable a3, NFDataP a3, Show a4, Typeable a4, NFDataP a4, Show a5, Typeable a5, NFDataP a5) =>
+#else
+  instance (Typeable a1, NFDataP a1, Typeable a2, NFDataP a2, Typeable a3, NFDataP a3, Typeable a4, NFDataP a4, Typeable a5, NFDataP a5) =>
+#endif
+         NFDataP (a1, a2, a3, a4, a5) where
+    {-  NOINLINE rnfp #-}
+    rnfp (Node WI _) _ = ()
+    rnfp (Node pat chs) d
+     | TR treps <- pat  = if elem td treps then recurs else ()
+     | TI treps <- pat  = if elem td treps then () else recurs
+     | otherwise        = rnfp' pat recurs d
+     where
+      td = show $ typeRepTyCon $ typeOf d
+      recurs = case length chs of
+        0 -> case pat of
+              WS -> ()
+              _ -> pat_match_fail
+        5 -> let [px1,px2,px3,px4,px5] = chs ; (x1,x2,x3,x4,x5) = d
+             in       rnfp px1 x1
+                `seq` rnfp px2 x2
+                `seq` rnfp px3 x3
+                `seq` rnfp px4 x4
+                `seq` rnfp px5 x5
+                `seq` ()  -- needed?
+        _ -> pat_match_fail
+      pat_match_fail = patMatchFail' "(,,,,)" pat chs d
+    rnfp (Node pat chs) d = patMatchFail pat chs d
+
+#if INCLUDE_SHOW_INSTANCES
+  instance (Show a1, Typeable a1, NFDataP a1, Show a2, Typeable a2, NFDataP a2, Show a3, Typeable a3, NFDataP a3, Show a4, Typeable a4, NFDataP a4, Show a5, Typeable a5, NFDataP a5, Show a6, Typeable a6, NFDataP a6) =>
+#else
+  instance (Typeable a1, NFDataP a1, Typeable a2, NFDataP a2, Typeable a3, NFDataP a3, Typeable a4, NFDataP a4, Typeable a5, NFDataP a5, Typeable a6, NFDataP a6) =>
+#endif
+         NFDataP (a1, a2, a3, a4, a5, a6) where
+    {-  NOINLINE rnfp #-}
+    rnfp (Node WI _) _ = ()
+    rnfp (Node pat chs) d
+     | TR treps <- pat  = if elem td treps then recurs else ()
+     | TI treps <- pat  = if elem td treps then () else recurs
+     | otherwise        = rnfp' pat recurs d
+     where
+      td = show $ typeRepTyCon $ typeOf d
+      recurs = case length chs of
+        0 -> case pat of
+              WS -> ()
+              _ -> pat_match_fail
+        6 -> let [px1,px2,px3,px4,px5,px6] = chs ; (x1,x2,x3,x4,x5,x6) = d
+             in       rnfp px1 x1
+                `seq` rnfp px2 x2
+                `seq` rnfp px3 x3
+                `seq` rnfp px4 x4
+                `seq` rnfp px5 x5
+                `seq` rnfp px6 x6
+                `seq` ()  -- needed?
+        _ -> pat_match_fail
+      pat_match_fail = patMatchFail' "(,,,,,)" pat chs d
+    rnfp (Node pat chs) d = patMatchFail pat chs d
+
+#if INCLUDE_SHOW_INSTANCES
+  instance (Show a1, Typeable a1, NFDataP a1, Show a2, Typeable a2, NFDataP a2, Show a3, Typeable a3, NFDataP a3, Show a4, Typeable a4, NFDataP a4, Show a5, Typeable a5, NFDataP a5, Show a6, Typeable a6, NFDataP a6, Show a7, Typeable a7, NFDataP a7) =>
+#else
+  instance (Typeable a1, NFDataP a1, Typeable a2, NFDataP a2, Typeable a3, NFDataP a3, Typeable a4, NFDataP a4, Typeable a5, NFDataP a5, Typeable a6, NFDataP a6, Typeable a7, NFDataP a7) =>
+#endif
+         NFDataP (a1, a2, a3, a4, a5, a6, a7) where
+    {-  NOINLINE rnfp #-}
+    rnfp (Node WI _) _ = ()
+    rnfp (Node pat chs) d
+     | TR treps <- pat  = if elem td treps then recurs else ()
+     | TI treps <- pat  = if elem td treps then () else recurs
+     | otherwise        = rnfp' pat recurs d
+     where
+      td = show $ typeRepTyCon $ typeOf d
+      recurs = case length chs of
+        0 -> case pat of
+              WS -> ()
+              _ -> pat_match_fail
+        7 -> let [px1,px2,px3,px4,px5,px6,px7] = chs ; (x1,x2,x3,x4,x5,x6,x7) = d
+             in       rnfp px1 x1
+                `seq` rnfp px2 x2
+                `seq` rnfp px3 x3
+                `seq` rnfp px4 x4
+                `seq` rnfp px5 x5
+                `seq` rnfp px6 x6
+                `seq` rnfp px7 x7
+                `seq` ()  -- needed?
+        _ -> pat_match_fail
+      pat_match_fail = patMatchFail' "(,,,,,,)" pat chs d
+    rnfp (Node pat chs) d = patMatchFail pat chs d
+
+-- No Typeable instances for tuples larger than 7 in 7.8.1, seemingly.
+#if 0
+  instance (Show a1, Typeable a1, NFDataP a1, Show a2, Typeable a2, NFDataP a2, Show a3, Typeable a3, NFDataP a3, Show a4, Typeable a4, NFDataP a4, Show a5, Typeable a5, NFDataP a5, Show a6, Typeable a6, NFDataP a6, Show a7, Typeable a7, NFDataP a7, Show a8, Typeable a8, NFDataP a8) =>
+         NFDataP (a1, a2, a3, a4, a5, a6, a7, a8) where
+    rnfp Nil _ = ()
+    rnfp (Node pat [px1,px2,px3,px4,px5,px6,px7,px8]) d@(x1,x2,x3,x4,x5,x6,x7,x8) = rnfp' pat recurs d
+     where recurs =       rnfp px1 x1
+                    `seq` rnfp px2 x2
+                    `seq` rnfp px3 x3
+                    `seq` rnfp px4 x4
+                    `seq` rnfp px5 x5
+                    `seq` rnfp px6 x6
+                    `seq` rnfp px7 x7
+                    `seq` rnfp px8 x8
+    rnfp (Node pat chs) d = patMatchFail pat chs d
+
+  instance (Show a1, Typeable a1, NFDataP a1, Show a2, Typeable a2, NFDataP a2, Show a3, Typeable a3, NFDataP a3, Show a4, Typeable a4, NFDataP a4, Show a5, Typeable a5, NFDataP a5, Show a6, Typeable a6, NFDataP a6, Show a7, Typeable a7, NFDataP a7, Show a8, Typeable a8, NFDataP a8, Show a9, Typeable a9, NFDataP a9) =>
+         NFDataP (a1, a2, a3, a4, a5, a6, a7, a8, a9) where
+    rnfp Nil _ = ()
+    rnfp (Node pat [px1,px2,px3,px4,px5,px6,px7,px8,px9]) d@(x1,x2,x3,x4,x5,x6,x7,x8,x9) = rnfp' pat recurs d
+     where recurs =       rnfp px1 x1
+                    `seq` rnfp px2 x2
+                    `seq` rnfp px3 x3
+                    `seq` rnfp px4 x4
+                    `seq` rnfp px5 x5
+                    `seq` rnfp px6 x6
+                    `seq` rnfp px7 x7
+                    `seq` rnfp px8 x8
+                    `seq` rnfp px9 x9
+    rnfp (Node pat chs) d = patMatchFail pat chs d
+#endif
+
+-------------------------------------------------------------------------------
+
+  patMatchFail :: (Show a, Show b) => a -> b -> c -> ()
+  patMatchFail pat chs d
+#if WARN_PATTERN_MATCH_FAILURE
+   = ( unsafePerformIO $! putStrLn $! "NFDataP: warning: couldn't match " ++ show pat ++ " (having children " ++ show chs ++ ")" ) `seq` ()
+#else
+   = ()
+#endif
+-- = error $ "NFDataP: Couldn't match " ++ show pat ++ " (having children " ++ show chs ++ ")\nwith data " ++ show d
+
+  patMatchFail' :: (Show a, Show b) => String -> a -> b -> c -> ()
+  patMatchFail' inst pat chs d
+#if WARN_PATTERN_MATCH_FAILURE
+   = ( unsafePerformIO $! putStrLn $! "NFDataP: warning: instance " ++ inst ++ ": bad PatNode child list" ) `seq` patMatchFail pat chs d
+#else
+   = ()
+#endif
+
+-------------------------------------------------------------------------------
+
diff --git a/src/Control/DeepSeq/Bounded/NFDataPDyn.hs b/src/Control/DeepSeq/Bounded/NFDataPDyn.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/DeepSeq/Bounded/NFDataPDyn.hs
@@ -0,0 +1,605 @@
+
+-------------------------------------------------------------------------------
+
+  {-  LANGUAGE CPP #-}
+
+#define DO_TRACE 0
+#define WARN_IGNORED_SUBPATTERNS 1
+#define NEVER_IGNORE_SUBPATTERNS 0
+
+-- Now specified via --flag=[-]USE_WWW_DEEPSEQ
+--- #define USE_WW_DEEPSEQ 1
+
+-------------------------------------------------------------------------------
+
+#if USE_SOP
+  {-# LANGUAGE TypeFamilies #-}
+  {-# LANGUAGE ConstraintKinds #-}
+  {-# LANGUAGE GADTs #-}  -- for GHC 7.6.3
+#endif
+
+  {-# LANGUAGE Rank2Types #-}
+  {-  LANGUAGE ScopedTypeVariables #-}
+
+  -- For tracing only:
+  {-  LANGUAGE BangPatterns #-}
+
+-------------------------------------------------------------------------------
+
+-- |
+-- Module      :  Control.DeepSeq.Bounded.NFDataPDyn
+-- Copyright   :  (c) 2014, Andrew G. Seniuk
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  Andrew Seniuk <rasfar@gmail.com>
+-- Stability   :  experimental
+-- Portability :  GHC
+--
+
+-------------------------------------------------------------------------------
+
+  module Control.DeepSeq.Bounded.NFDataPDyn
+
+  (
+
+     -- * Dynamic pattern-directed forcing
+
+     -- | These functions are concerned with extending the forcing pattern
+     -- dynamically, depending on the types of the nodes encountered while
+     -- generically traversing a term.
+     --
+     -- (Work in progress...).
+
+       rnfpDyn
+     , deepseqpDyn
+     , forcepDyn
+
+     , rnfpDyn'
+     , deepseqpDyn'
+     , forcepDyn'
+
+     , rnfpDyn''
+     , deepseqpDyn''
+     , forcepDyn''
+
+     -- * Re-exported for convenience
+
+     , module Control.DeepSeq.Bounded.NFDataP
+
+  )
+
+  where
+
+-------------------------------------------------------------------------------
+
+  import Control.DeepSeq.Bounded.NFDataP
+
+  import Control.DeepSeq.Bounded.NFDataN  -- finally used ("*3" etc.)
+
+#if USE_WW_DEEPSEQ
+  import Control.DeepSeq ( NFData )
+--import Control.DeepSeq ( rnf )
+#endif
+
+  import Data.Data ( Data )
+
+#if 1
+  import Data.Typeable ( Typeable )
+  import Data.Typeable ( typeOf )
+#else
+-- XXX These are NOT interchangeable!
+#if __GLASGOW_HASKELL__ >= 781
+  import Data.Typeable ( typeRep )
+#else
+  import Data.Typeable ( typeOf )
+#endif
+#endif
+
+  import Debug.Trace ( trace )
+
+#if USE_SOP
+  import Generics.SOP hiding ( Shape )
+#endif
+
+-------------------------------------------------------------------------------
+
+#if DO_TRACE
+  mytrace = trace
+#else
+  mytrace _ = id
+#endif
+
+-------------------------------------------------------------------------------
+
+  -- | SOP/SYB hybrid dynamic 'deepseqp'.
+  deepseqpDyn :: (Show a, NFDataP a, Generic a, Data a
+    , All2 Show (Code a)
+    , All2 NFData (Code a)
+    , All2 NFDataN (Code a)
+    , All2 NFDataP (Code a)
+    , All2 Data (Code a)
+    ) => (forall c. Data c => c -> PatNode) -> a -> b -> b
+  deepseqpDyn fg a b = rnfpDyn fg a `seq` b
+  -- XXX Partially-applied; is that okay in GHC RULES?
+  {-  RULES
+    "deepseqpDyn/composition"    forall fg1 fg2 x.  (.) (deepseqpDyn fg2) (deepseqpDyn fg1) x = deepseqpDyn (gcombQ fg1 fg2) x
+      #-}
+
+  -- | SOP/Typeable hybrid dynamic 'deepseqp'.
+  deepseqpDyn'' :: (Show a, NFDataP a, Generic a, Data a
+    , All2 Show (Code a)
+    , All2 NFData (Code a)
+    , All2 NFDataN (Code a)
+    , All2 NFDataP (Code a)
+--  , All2 Data (Code a)
+    ) => (forall c. Typeable c => c -> PatNode) -> a -> b -> b
+  deepseqpDyn'' fg a b = rnfpDyn'' fg a `seq` b
+  -- XXX Partially-applied; is that okay in GHC RULES?
+  {-  RULES
+    "deepseqpDyn''/composition"    forall fg1 fg2 x.  (.) (deepseqpDyn'' fg2) (deepseqpDyn'' fg1) x = deepseqpDyn'' (gcombQ fg1 fg2) x
+      #-}
+
+  -- | SOP-only dynamic 'deepseqp'.
+  deepseqpDyn' :: (Show a, NFDataP a, Generic a, Data a
+    , All2 Generic (Code a)
+    , All2 Show (Code a)
+    , All2 NFData (Code a)
+    , All2 NFDataN (Code a)
+    , All2 NFDataP (Code a)
+    ) => (forall c. Generic c => c -> PatNode) -> a -> b -> b
+  deepseqpDyn' fg a b = rnfpDyn' fg a `seq` b
+
+-------------------------------------------------------------------------------
+
+  -- | SOP/SYB hybrid dynamic 'forcep'.
+  forcepDyn :: (Show a, NFDataP a, Generic a, Data a
+    , All2 Show (Code a)
+    , All2 NFData (Code a)
+    , All2 NFDataN (Code a)
+    , All2 NFDataP (Code a)
+    , All2 Data (Code a)
+    ) => (forall c. Data c => c -> PatNode) -> a -> a
+  forcepDyn fg x = deepseqpDyn fg x x
+  {-  RULES
+    "forcepDyn/composition"    forall fg1 fg2 x.  (.) (forcepDyn fg2) (forcepDyn fg1) x = forcepDyn (gcombQ fg1 fg2) x
+      #-}
+
+  -- | SOP/Typeable hybrid dynamic 'forcep'.
+  forcepDyn'' :: (Show a, NFDataP a, Generic a, Data a
+    , All2 Show (Code a)
+    , All2 NFData (Code a)
+    , All2 NFDataN (Code a)
+    , All2 NFDataP (Code a)
+--  , All2 Data (Code a)
+    ) => (forall c. Typeable c => c -> PatNode) -> a -> a
+  forcepDyn'' fg x = deepseqpDyn'' fg x x
+  {-  RULES
+    "forcepDyn''/composition"    forall fg1 fg2 x.  (.) (forcepDyn'' fg2) (forcepDyn'' fg1) x = forcepDyn'' (gcombQ fg1 fg2) x
+      #-}
+
+  -- | SOP-only dynamic 'forcep'.
+  forcepDyn' :: (Show a, NFDataP a, Generic a, Data a
+    , All2 Generic (Code a)
+    , All2 Show (Code a)
+    , All2 NFData (Code a)
+    , All2 NFDataN (Code a)
+    , All2 NFDataP (Code a)
+    ) => (forall c. Generic c => c -> PatNode) -> a -> a
+  forcepDyn' fg x = deepseqpDyn' fg x x
+
+-------------------------------------------------------------------------------
+
+#if USE_SOP
+
+-------------------------------------------------------------------------------
+
+#if 1
+
+-------------------------------------------------------------------------------
+
+-- This one, trying for a SOP (not SYB) based generic stop function arg.
+-- This should be straightforward. We have adequate precedent in GNFDataP.
+
+  -- | SOP-only dynamic 'rnfp'.
+  -- Takes an SOP generic function yielding 'PatNode', which extends
+  -- the pattern dynamically, depending on the type of the value node.
+  rnfpDyn' :: forall a. (
+               Generic a
+             , All2 Generic (Code a)
+             , All2 Show    (Code a)
+             , All2 NFData  (Code a)
+             , All2 NFDataN (Code a)
+             , All2 NFDataP (Code a)
+--           , NFData  a
+--           , NFDataN a
+--           , NFDataP a
+             ) =>
+                     ( forall c. (
+                         Generic c
+--                     , All2 Show (Code c)
+                       ) => c -> PatNode
+                     )
+                  -> a
+                  -> ()
+  rnfpDyn' fg d = rnfpDynS' fg (from d)
+
+  rnfpDynS' :: forall xss. (
+                All2 Generic xss
+              , All2 Show    xss
+              , All2 NFData  xss
+              , All2 NFDataN xss
+              , All2 NFDataP xss
+--            , NFData  xss
+--            , NFDataN xss
+--            , NFDataP xss
+              ) =>
+                      ( forall c. (
+                          Generic c
+--                      , All2 Show (Code c)
+                        ) => c -> PatNode
+                      )
+                   -> SOP I xss
+                   -> ()
+  rnfpDynS' fg (SOP (Z xs))  = rnfpDynP' fg xs
+  rnfpDynS' fg (SOP (S xss)) = rnfpDynS' fg (SOP xss)
+
+  rnfpDynP' :: forall xs. (
+                All Generic xs
+              , All Show    xs
+              , All NFData  xs
+              , All NFDataN xs
+              , All NFDataP xs
+--            , NFData  xs
+--            , NFDataN xs
+--            , NFDataP xs
+              ) =>
+                      ( forall c. (
+                          Generic c
+--                      , All2 Show (Code c)
+                        ) => c -> PatNode
+                      )
+                   -> NP I xs
+                   -> ()
+  rnfpDynP' fg Nil         = ()
+  rnfpDynP' fg (I x :* xs)
+   | trace (show $ typeOf x) False = undefined
+   | WI <- pn   = trace ("Boo A "        ) $ rnfpDynP' fg xs         `seq` ()
+   | otherwise  = trace ("Boo B "++show x) $ rnfpDynP' fg xs `seq` x `seq` ()
+   where
+--  pn = WR
+    pn = fg x {-:: PatNode-}
+    pat = Node pn [] {-:: Pattern-}
+
+-------------------------------------------------------------------------------
+
+-- Trying explicit SOP recursion, since it seems then Proxy isn't needed?
+
+  -- | SOP/SYB hybrid dynamic 'rnfp'.
+  -- Takes a SYB 'GenericQ' 'PatNode' argument, which extends the pattern
+  -- dynamically, depending on the type of the value node.
+---rnfpDyn :: (Generic a, All2 NFData (Code a)) => a -> ()
+  rnfpDyn :: forall a. (
+               Generic a
+             , All2 Show    (Code a)
+             , All2 NFData  (Code a)
+             , All2 NFDataN (Code a)
+             , All2 NFDataP (Code a)
+             , All2 Data    (Code a)
+--           , NFData  a
+--           , NFDataN a
+--           , NFDataP a
+             ) =>
+#if 0
+                     a
+#else
+                     ( forall c. (
+#if 1
+                         Data c
+#else
+                         Generic c
+--                     , All2 Show (Code c)
+#endif
+                       ) => c -> PatNode
+                     )
+                  -> a
+#endif
+                  -> ()
+#if 0
+  rnfpDyn d = ()
+#else
+  rnfpDyn fg d = rnfpDynS fg (from d)
+--rnfpDyn fg d = ()
+#endif
+
+--rnfpDynS :: (All2 NFData xss) => SOP I xss -> ()
+  rnfpDynS :: forall xss. (
+                All2 Show    xss
+              , All2 NFData  xss
+              , All2 NFDataN xss
+              , All2 NFDataP xss
+              , All2 Data    xss
+--            , NFData  xss
+--            , NFDataN xss
+--            , NFDataP xss
+              ) =>
+#if 0
+                      SOP I xss
+#else
+                      ( forall c. (
+                          Data c
+                        ) => c -> PatNode
+                      )
+                   -> SOP I xss
+#endif
+                   -> ()
+  rnfpDynS fg (SOP (Z xs))  = rnfpDynP fg xs
+  rnfpDynS fg (SOP (S xss)) = rnfpDynS fg (SOP xss)
+
+--rnfpDynP :: (All NFData xs) => NP I xs -> ()
+  rnfpDynP :: forall xs. (
+                All Show    xs
+              , All NFData  xs
+              , All NFDataN xs
+              , All NFDataP xs
+              , All Data    xs
+--            , NFData  xs
+--            , NFDataN xs
+--            , NFDataP xs
+              ) =>
+#if 0
+                      NP I xs
+#else
+                      ( forall c. (
+                          Data c
+                        ) => c -> PatNode
+                      )
+                   -> NP I xs
+#endif
+                   -> ()
+  rnfpDynP fg Nil         = ()
+--rnfpDynP fg (I x :* xs) = rnfpDynP fg xs `seq` x `seq` ()
+  rnfpDynP fg (I x :* xs)
+   | trace (show $ typeOf x) False = undefined
+--- | trace (show $ typeOf x) $! False = undefined
+#if 0
+   | WI <- pn   = trace ("AAA "++show x) $ ()
+   | otherwise  = trace ("BBB "++show x) $ ()
+#else
+   | WI <- pn   = trace ("AAA "        ) $ rnfpDynP fg xs         `seq` ()
+--- | WI <- pn   = trace ("AAA "++show x) $ rnfpDynP fg xs         `seq` ()
+--- | WI <- pn   = trace ("AAA "++show x) $ ()
+--- | otherwise  = trace ("BBB "++show x) $ rnfpDynP fg xs `seq` rnfp pat x `seq` ()
+---- | otherwise  = trace ("BBB "++show x) $ rnfpDynP fg xs `seq` rnfpDyn fg x `seq` ()
+   | otherwise  = trace ("BBB "++show x) $ rnfpDynP fg xs `seq` x `seq` ()
+#endif
+   where
+#if 0
+    pn = WR
+#else
+    pn = trace (show $ fg x) $ fg x {-:: PatNode-}
+--  pn = fg x {-:: PatNode-}
+#endif
+    pat = Node pn [] {-:: Pattern-}
+#if 0
+    proxy_a = Proxy :: Proxy a
+--  proxy_a = Proxy (Proxy :: Proxy a, Proxy :: Proxy b)
+#endif
+--rnfpDynP (I x :* xs) = x `deepseq` (rnfpDynP xs)
+
+-------------------------------------------------------------------------------
+
+  -- | SOP/Typeable hybrid dynamic 'rnfp'.
+  -- Takes a SYB 'GenericQ' 'PatNode' argument, which extends the pattern
+  -- dynamically, depending on the type of the value node.
+  rnfpDyn'' :: forall a. (
+               Generic a
+             , All2 Show    (Code a)
+             , All2 NFData  (Code a)
+             , All2 NFDataN (Code a)
+             , All2 NFDataP (Code a)
+--           , All2 Data    (Code a)
+             ) =>
+                     ( forall c. (
+                         Typeable c
+                       ) => c -> PatNode
+                     )
+                  -> a
+                  -> ()
+  rnfpDyn'' fg d = rnfpDyn''S fg (from d)
+
+  rnfpDyn''S :: forall xss. (
+                All2 Show    xss
+              , All2 NFData  xss
+              , All2 NFDataN xss
+              , All2 NFDataP xss
+--            , All2 Data    xss
+              ) =>
+                      ( forall c. (
+                          Typeable c
+                        ) => c -> PatNode
+                      )
+                   -> SOP I xss
+                   -> ()
+  rnfpDyn''S fg (SOP (Z xs))  = rnfpDyn''P fg xs
+  rnfpDyn''S fg (SOP (S xss)) = rnfpDyn''S fg (SOP xss)
+
+  rnfpDyn''P :: forall xs. (
+                All Show    xs
+              , All NFData  xs
+              , All NFDataN xs
+              , All NFDataP xs
+--            , All Data    xs
+              ) =>
+                      ( forall c. (
+                          Typeable c
+                        ) => c -> PatNode
+                      )
+                   -> NP I xs
+                   -> ()
+  rnfpDyn''P fg Nil         = ()
+  rnfpDyn''P fg (I x :* xs)
+   | trace (show $ typeOf x) False = undefined
+   | WI <- pn   = trace ("AAA "        ) $ rnfpDyn''P fg xs         `seq` ()
+   | otherwise  = trace ("BBB "++show x) $ rnfpDyn''P fg xs `seq` x `seq` ()
+   where
+    pn = trace (show $ fg x) $ fg x {-:: PatNode-}
+--  pn = fg x {-:: PatNode-}
+    pat = Node pn [] {-:: Pattern-}
+
+-------------------------------------------------------------------------------
+
+#else
+
+#if 0
+               Generic a
+             , HasDatatypeInfo a
+--           , All Show (Map ConstructorInfo (Code a))
+             , All2 NFDataP (Code a)
+             , All2 Show (Code a)
+             , Typeable a
+             , NFDataN a
+             , NFDataP a
+#endif
+  rnfpDyn :: forall a. (
+               Generic a
+             , All2 Show    (Code a)
+             , All2 NFDataP (Code a)
+             , All2 NFData  (Code a)
+             , NFDataP a
+             , NFData  a
+             ) =>
+#if 1
+                     a
+#else
+                     ( forall b. (
+                         Generic b
+                       , All2 Show    (Code b)
+                       ) => b -> PatNode
+                     )
+                  -> a
+#endif
+                  -> ()
+--rnfpDyn fg d = ()
+#if 1
+  rnfpDyn d
+#else
+  rnfpDyn fg d
+#endif
+   -- This appears to work from the bottom-up which is not
+   -- what's wanted ... but I must be mistaken? Well, not "must"...
+   -- The question is whether hcollapse makes a head available
+   -- without having to finish recursions completely.
+#if 1
+   = (rnfp pat . hcollapse . hcliftA (Proxy :: Proxy a) (\ (I x) -> K (rnfpDyn x)) . from) d
+-- = (rnfp pat . hcollapse . hcliftA (Proxy :: Proxy NFDataP) (\ (I x) -> K (rnfpDyn x)) . from) d
+#else
+   = (rnfp pat . hcollapse . hcliftA (Proxy :: Proxy NFDataP) (\ (I x) -> K (rnfpDyn fg x)) . from) d
+#endif
+-- = (rnfp pat . hcollapse . hcliftA (Proxy :: Proxy a) (\ (I x) -> K (rnfpDyn fg x)) . from) d
+-- = (rnfp pat . hcollapse . hcliftA proxy_a (\ (I x) -> K (rnfpDyn fg x)) . from) d
+-- = rnfp pat x `seq` map (rnfpDyn fg) x `seq` ()
+   where
+#if 1
+    pn = WR
+#else
+    pn = fg d {-:: PatNode-}
+#endif
+    pat = Node pn [] {-:: Pattern-}
+    proxy_a = Proxy :: Proxy a
+--  proxy_a = Proxy (Proxy :: Proxy a, Proxy :: Proxy b)
+
+#endif
+
+-------------------------------------------------------------------------------
+
+#else
+
+-------------------------------------------------------------------------------
+
+#if 0
+  -- XXX This was written to try to get rid of type errors, b/c
+  -- I have definitely seen SYB refuse to compile until things
+  -- are USED. (No joy yet.)
+  blah :: (Show a, NFData a, NFDataP a, Data a) => a -> ()
+  blah x = rnfpDynG (mkQ WI f :: GenericQ PatNode) x
+   where
+    f :: (Int,Bool) -> PatNode
+    f (n,b) | n < 3 || not b  = WI
+            | otherwise       = WS
+#endif
+
+-------------------------------------------------------------------------------
+
+#if 0
+
+-- Well Fuck.
+
+#if 0
+  rnfpDynG :: (Show d,NFDataP d,NFData d,Data d) => d -> ()
+--rnfpDynG :: (Typeable d,Show d,NFDataP d,NFData d,Data d) => d -> ()
+--rnfpDynG :: (Typeable d,Show d,NFDataP d,NFData d) => d -> ()
+--rnfpDynG :: Data d => d -> ()
+  rnfpDynG x = rnfpDynG' f x
+   where
+    f :: (Int,Bool) -> PatNode
+    f (n,b) | n < 3 || not b  = WI
+            | otherwise       = WS
+    rnfpDynG' :: forall e. Data e => ((Int,Bool) -> PatNode) -> e -> ()
+--  rnfpDynG' :: ((Int,Bool) -> PatNode) -> d -> ()
+--  rnfpDynG' :: (Show d,NFDataP d,NFData d,Data d) => ((Int,Bool) -> PatNode) -> d -> ()
+    rnfpDynG' f x
+     = (gmapQ (rnfpDynG' f) x) `seq` ()
+     where
+      pn = fg x :: PatNode
+      pat = Node pn [] {-:: Pattern-}
+      fg = mkQ WI f
+--    fg = ( mkQ WI f :: d -> PatNode )
+--    fg = mkQ WI ( f :: (Int,Bool) -> PatNode )
+#else
+  -- Note that (rnfpDynG fg) is itself a GenericQ ().
+  rnfpDynG :: forall d. (Show d,NFDataP d,NFData d,Data d) => (forall e. (Show e,NFDataP e,NFData e,Data e) => e -> PatNode) -> d -> ()
+--rnfpDynG :: forall d. (Show d,NFDataP d,NFData d,Data d) => (d -> PatNode) -> d -> ()
+--rnfpDynG :: forall d. (Typeable d,Show d,NFDataP d,NFData d,Data d) => (d -> PatNode) -> d -> ()
+--rnfpDynG :: forall d. (Typeable d,Show d,NFDataP d,NFData d,Data d) => (forall e. (NFDataP e,NFData e,Data e) => e -> PatNode) -> d -> ()
+--rnfpDynG :: (Typeable d,Show d,NFDataP d,NFData d,Data d) => (forall e. (NFDataP e,NFData e,Data e) => e -> PatNode) -> d -> ()
+--rnfpDynG :: (Typeable d,Show d,NFDataP d,NFData d,Data d) => GenericQ PatNode -> d -> ()
+--rnfpDynG :: forall d. (Show d, NFDataP d, Data d) => (forall d. Data d => d -> PatNode) -> d -> ()
+--rnfpDynG :: GenericQ PatNode -> GenericQ ()
+--rnfpDynG :: forall d a. (Show d, NFDataP d, Data d, Show a, NFDataP a, Data a) => GenericQ PatNode -> a -> ()
+--rnfpDynG :: forall d. (Show d, NFDataP d, NFData d, Data d) => (d -> PatNode) -> d -> ()
+--rnfpDynG :: forall d. (Show d, NFDataP d, NFData d, Data d) => GenericQ PatNode -> d -> ()
+--rnfpDynG :: forall d. (Show d, NFDataP d, Data d) => GenericQ PatNode -> d -> ()
+--rnfpDynG :: forall d. (Show d, NFDataP d, Data d) => GenericQ PatNode -> d -> ()
+  rnfpDynG fg x
+#if 0
+-- = (rnfp pat x) `seq` ()
+-- =                    (gmapQ ((rnfpDynG fg)::GenericQ ()) x) `seq` ()
+-- =                    (gmapQ ((rnfpDynG fg)::d->()) x) `seq` ()
+-- =                    (gmapQ ((rnfpDynG fg)::NFDataP d => d->()) x) `seq` ()
+-- =                    ((gmapQ (rnfpDynG fg) x)::[()]) `seq` ()
+   =                    (gmapQ (rnfpDynG fg) x) `seq` ()
+-- = (rnfp pat x) `seq` (gmapQ (rnfpDynG fg) x) `seq` ()
+#else
+   | WI <- pn   = ()
+   | otherwise  = (rnfp pat x) `seq` (gmapQ ((rnfpDynG (fg::forall b. (Show b,NFDataP b,NFData b,Data b) => b -> PatNode)) :: forall c. (Show c,NFDataP c,NFData c,Data c) => c -> ()) x) `seq` ()
+--- | otherwise  = (rnfp pat x) `seq` (gmapQ ((rnfpDynG fg) :: forall e. (Show e,NFDataP e,NFData e,Data e) => e -> ()) x) `seq` ()
+--- | otherwise  = (rnfp pat x) `seq` (gmapQ ((rnfpDynG fg) :: forall e. Data e => e -> ()) x) `seq` ()
+--- | otherwise  = (rnfp pat x) `seq` (gmapQ (rnfpDynG fg) x) `seq` ()
+--- | otherwise  = (rnfp pat x) `seq` ()  -- this is fine
+--- | otherwise  = rnfp pat x `seq` gmapQ (rnfpDynG fg) x `seq` ()
+--- | otherwise  = rnfp pat x `seq` gmapQ ((rnfpDynG fg) :: GenericQ ()) x `seq` ()
+--- | otherwise  = ( ( rnfp pat ) :: d -> () ) d `seq` gmapQ (rnfpDynG fg) d `seq` ()
+#endif
+   where
+    pn = fg x {-:: PatNode-}
+    pat = Node pn [] {-:: Pattern-}
+#endif
+
+#endif
+
+-------------------------------------------------------------------------------
+
+#endif
+
+-------------------------------------------------------------------------------
+
diff --git a/src/Control/DeepSeq/Bounded/PatAlg.hs b/src/Control/DeepSeq/Bounded/PatAlg.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/DeepSeq/Bounded/PatAlg.hs
@@ -0,0 +1,740 @@
+
+-------------------------------------------------------------------------------
+
+  {-  LANGUAGE CPP #-}
+
+-- Temporarily for compatibility of seqaid demo output
+-- with documents already written.
+#define PROVIDE_OLD_SHRINK_PAT 1
+
+-- As for intersection, if the arities differ, the node
+-- effectively becomes non-recursive.  (Whether this is
+-- theoretically the best choice is still uncertain.)
+-- What is certain is, unless support richer Pattern's,
+-- a union of two recursive Pattern nodes with differing
+-- arities is not well-definable.
+--   The reason this switch exists at all is, it can
+-- be expensive to compute this predicate, especially
+-- considering that recursive nodes are very common,
+-- with WR being ("in the average case") the single most
+-- abundant node type in a pattern, probably followed
+-- in order by WS, WI, WW, WN (or parallel counterparts).
+#define ENFORCE_SAME_ARITY_UNION 1
+
+#define DO_TRACE 0
+
+-- Now specified via --flag=[-]USE_WWW_DEEPSEQ
+--- #define USE_WW_DEEPSEQ 1
+
+-------------------------------------------------------------------------------
+
+  -- XXX For debugging only!
+  {-# LANGUAGE BangPatterns #-}
+
+  {-# LANGUAGE Rank2Types #-}
+  {-  LANGUAGE ScopedTypeVariables #-}
+
+-------------------------------------------------------------------------------
+
+-- |
+-- Module      :  Control.DeepSeq.Bounded.PatAlg
+-- Copyright   :  (c) 2014, Andrew G. Seniuk
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  Andrew Seniuk <rasfar@gmail.com>
+-- Stability   :  provisional
+-- Portability :  portable, except mkPat, mkPatN and growPat (which use SYB)
+--
+
+-------------------------------------------------------------------------------
+
+  module Control.DeepSeq.Bounded.PatAlg
+
+  (
+
+     -- * Basic operations on Patterns
+
+       unionPats
+     , intersectPats
+     , isSubPatOf
+--   , unionPatsStr
+
+#if ! HASKELL98_FRAGMENT
+     -- * Operations for obtaining and modifying Patterns based on a term
+
+     , mkPat
+     , mkPatN
+     , growPat
+#endif
+
+     -- * Operations for obtaining subpatterns (in the 'isSubPatOf' sense)
+
+     , truncatePat
+     , shrinkPat
+#if PROVIDE_OLD_SHRINK_PAT
+     , shrinkPat_old
+#endif
+
+     -- * Operations for the direct construction and perturbation of Patterns
+
+     , emptyPat
+     , liftPats
+
+     , splicePats
+     , elidePats
+
+     , erodePat
+
+     -- * Re-exported for convenience
+
+     , module Control.DeepSeq.Bounded.Pattern
+
+  )
+
+  where
+
+-------------------------------------------------------------------------------
+
+  import Control.DeepSeq.Bounded.Pattern
+
+  import Data.Maybe ( isNothing, fromJust )
+
+#if ! HASKELL98_FRAGMENT
+  import Data.Data ( Data )
+  import Data.Generics ( GenericQ )
+  import Data.Generics ( gmapQ )
+#endif
+
+  import Data.List ( findIndex )
+--import Data.List ( elemIndex )
+  import Data.List ( sortBy )
+--import Data.List ( nub )
+  import Data.List ( foldl' )
+  import Data.List ( group )
+  import Data.List ( sort )
+  import Data.List ( intersect )
+
+  import System.Random
+
+  import Debug.Trace ( trace )
+  import Control.DeepSeq ( force )
+
+-------------------------------------------------------------------------------
+
+#if DO_TRACE
+  mytrace = trace
+#else
+  mytrace _ = id
+#endif
+
+-------------------------------------------------------------------------------
+
+  -- | Compute the union of a list of 'Pattern's.
+  unionPats :: [ Pattern ] -> Pattern
+  unionPats [] = Node WI []  -- or what?
+--unionPats [] = Nil  -- or what?
+  unionPats ps = foldr1 (union' False) ps
+--unionPats ps = foldr1 union' $ trace (">> " ++ show ps) $ ps
+--unionPats = foldr union' Nil
+  union' :: Bool -> Pattern -> Pattern -> Pattern
+#if 1
+  union' _ (Node WI _) (Node WI _) = Node WI []
+  union' _ p          (Node WI _) = p
+  union' _ (Node WI _) p          = p
+#else
+  union' _ Nil Nil = {-trace "NilNil" $-} Nil  -- case not needed (caught by either of the next two!)
+#if 0
+  -- XXX Later: It is going to work out better if take the
+  -- very opposite convention. That is consistent with
+  -- how composition behaves when # is involved.
+  -- This says # trumps any other pattern node. This is the only
+  -- sensible resolution it seems to me, but sadly it breaks every
+  -- law I've penned for NFDataP...
+  union' _ p   Nil = {-trace ("pNil "++show p) $-} Nil
+  union' _ Nil p   = {-trace ("Nilp "++show p) $-} Nil
+#else
+  -- This makes for less interesting composites perhaps, where # is
+  -- involved, but at least it is consistent with non-fused composition.
+  union' _ p   Nil = p
+  union' _ Nil p   = p
+#endif
+#endif
+  -- Symmetric cases:
+  union' b node1@(Node p1 cs1) node2@(Node p2 cs2)
+   -- XXX Those cases using zipWith are not correct,
+   -- unless length cs1 == length cs2.  But one hates to
+   -- have to compute that. Caveat Emptor! This will behave
+   -- as a true union operator only if the child pattern lists
+   -- are compatibly-sized!
+   --   In seqaid (and in /correct/ manual use), this problem
+   -- will never arise.
+#if 0
+   -- XXX Don't do it -- (==) on PatNode might be more expensive
+   -- than I think, some nodes have list parameters...
+   | p1 == p2           = Node p1 $ zipWith (union' b) cs1 cs2
+#endif
+#if ENFORCE_SAME_ARITY_UNION
+   | WR <- p1, WR <- p2 = {-trace "WRWR" $-}
+      if csokay then Node WR $ zipWith (union' False) cs1 cs2
+      else error "unionPat: WRWR: encountered arity disparity!"
+#else
+   | WR <- p1, WR <- p2 = {-trace "WRWR" $-} Node WR $ zipWith (union' False) cs1 cs2
+#endif
+   | WS <- p1, WS <- p2 = {-trace "WSWS" $-} Node WS []
+#if USE_WW_DEEPSEQ
+   | WW <- p1, WW <- p2 = {-trace "WWWW" $-} Node WW []
+#endif
+#if ENFORCE_SAME_ARITY_UNION
+   | TR tys1 <- p1, TR tys2 <- p2 = {-trace "TRTR" $-}
+      if csokay then Node (TR (unionTys tys1 tys2)) $ zipWith (union' False) cs1 cs2
+      else error "unionPat: TRTR: encountered arity disparity!"
+   | TI tys1 <- p1, TI tys2 <- p2 = {-trace "TITI" $-}
+      if csokay then Node (TI (intersectTys tys1 tys2)) $ zipWith (union' False) cs1 cs2
+      else error "unionPat: TITI: encountered arity disparity!"
+#else
+   | TR tys1 <- p1, TR tys2 <- p2
+      = {-trace "TRTR" $-} Node (TR (unionTys tys1 tys2)) $ zipWith (union' False) cs1 cs2
+   | TI tys1 <- p1, TI tys2 <- p2
+      = {-trace "TITI" $-} Node (TI (intersectTys tys1 tys2)) $ zipWith (union' False) cs1 cs2
+--- | TR cls1 tys1 cns1 <- p1, TR cls2 tys2 cns2 <- p2
+--    = {-trace "TRWR" $-} Node (TR (cls1++cls2) (tys1++tys2) (cns1++cns2)) $ zipWith union' cs1 cs2
+#endif
+--- | ...
+   where  -- (yes where's can be empty)
+#if ENFORCE_SAME_ARITY_UNION
+    csokay = length cs1 == length cs2  -- ouch
+#endif
+  -- Now the asymmetric cases:
+  union' b node1@(Node p1 cs1) node2@(Node p2 cs2)
+   -- XXX Those cases using zipWith are not correct,
+   -- unless length cs1 == length cs2.  But one hates to
+   -- have to compute that. Caveat Emptor! This will behave
+   -- as a true union operator only if the child pattern lists
+   -- are compatibly-sized!
+   --   Actually, if zipWith (which is acting on two [Pattern];
+   -- you could supply union-unit pattern for missing children
+   -- in shorter list, but then which children exactly were missing?
+   -- So rather than play such a game without a racket, we just
+   -- require the lists to be the same length or all bets are off.
+   --   In seqaid, this problem will never arise.
+   -- And in /correct/ manual use...
+   | WR <- p1, WS <- p2 = {-trace "WRWS" $-} Node WR cs1
+#if USE_WW_DEEPSEQ
+   | WR <- p1, WW <- p2 = {-trace "WRWW" $-} Node WW []
+#endif
+#if USE_WW_DEEPSEQ
+   | WS <- p1, WW <- p2 = {-trace "WSWW" $-} Node WW []
+#endif
+#if ENFORCE_SAME_ARITY_UNION
+   | TR _ <- p1, WR <- p2 = {-trace "TRWR" $-}
+      if csokay then node1
+      else error $ "unionPat: " ++ if b then "WRTR" else "TRWR" ++ ": encountered arity disparity!"
+#else
+   | TR _ <- p1, WR <- p2 = {-trace "TRWR" $-} node1
+#endif
+   | TR _ <- p1, WS <- p2 = {-trace "TRWS" $-} node1
+#if USE_WW_DEEPSEQ
+   | TR _ <- p1, WW <- p2 = {-trace "TRWW" $-} node2
+#endif
+#if ENFORCE_SAME_ARITY_UNION
+   | TI _ <- p1, WR <- p2 = {-trace "TIWR" $-}
+      if csokay then node2
+      else error $ "unionPat: " ++ if b then "WRTI" else "TIWR" ++ ": encountered arity disparity!"
+#else
+   | TI _ <- p1, WR <- p2 = {-trace "TIWR" $-} node2
+#endif
+   | TI _ <- p1, WS <- p2 = {-trace "TIWS" $-} node2
+#if USE_WW_DEEPSEQ
+   | TI _ <- p1, WW <- p2 = {-trace "TIWW" $-} node2
+#endif
+#if 0
+   | TS _ <- p1, WR <- p2 = {-trace "TSWR" $-} node2
+   | TS _ <- p1, WS <- p2 = {-trace "TSWS" $-} node2
+   | TS _ <- p1, WW <- p2 = {-trace "TSWW" $-} node2
+#endif
+#if USE_WW_DEEPSEQ
+   | TW _ <- p1, WR <- p2 = {-trace "TWWR" $-} node1
+   | TW _ <- p1, WS <- p2 = {-trace "TWWS" $-} node1
+   | TW _ <- p1, WW <- p2 = {-trace "TWWW" $-} node2
+#endif
+#if ENFORCE_SAME_ARITY_UNION
+   | TI tys1 <- p1, TR tys2 <- p2 = {-trace "TITR" $-}
+      if csokay then Node (TR (tys1++tys2)) $ zipWith (union' False) cs1 cs2
+      else error $ "unionPat: " ++ if b then "TRTI" else "TITR" ++ ": encountered arity disparity!"
+#else
+   | TI tys1 <- p1, TR tys2 <- p2
+      = {-trace "TITR" $-} Node (TR (tys1++tys2)) $ zipWith (union' False) cs1 cs2
+#endif
+--- | ...
+   | not b = union' True node2 node1
+   | otherwise = error "unionPats: unexpected failure to (Haskell) pattern-match arguments!"
+   where  -- (yes where's can be empty)
+#if ENFORCE_SAME_ARITY_UNION
+    csokay = length cs1 == length cs2  -- ouch
+#endif
+
+#if 0
+  -- | This (unionPatsStr) seems pretty silly?... (It is used in the tests though.)
+  unionPatsStr :: [ String ] -> String
+  unionPatsStr = showPat . unionPats . map compilePat
+#endif
+
+-------------------------------------------------------------------------------
+
+  -- Probably overkill for typical lengths.
+  -- Would pay to special case for some short lists.
+  -- Optimisations come later.
+
+  unionTys :: [String] -> [String] -> [String]
+  unionTys ss1 ss2 = nubsort $ ss1 ++ ss2
+
+  nubsort :: Ord a => [a] -> [a]
+  nubsort = map head . group . sort
+
+  intersectTys :: [String] -> [String] -> [String]
+  intersectTys ss1 ss2 = intersect (nubsort ss1) (nubsort ss2)
+
+-------------------------------------------------------------------------------
+
+  -- | Return 'True' if the first pattern matches the second (and 'False' otherwise).
+  --
+  -- Note that matching does not imply spanning. Equality ('==') or @'flip' 'isSubPatOf'@ will work there, depending on your intentions.
+  --
+  -- XXX This doesn't yet handle type-constrained 'PatNode's
+  -- ('TI', 'TR', 'TN' or 'TW'), because 'intersectPats' doesn't.
+  isSubPatOf :: Pattern -> Pattern -> Bool
+  isSubPatOf p pp = p == intersectPats [p, pp]  -- probably faster on avg.
+--isSubPatOf p pp = pp == unionPats [p, pp]
+
+-------------------------------------------------------------------------------
+
+  -- | Compute the intersection of a list of 'Pattern's.
+  --
+  -- XXX This doesn't yet handle type-constrained 'PatNode's
+  -- ('TI', 'TR', 'TN' or 'TW').
+  intersectPats :: [ Pattern ] -> Pattern
+  intersectPats [] = Node WI []  -- or what?
+  intersectPats ps = foldr1 (intersection' False) ps
+  intersection' :: Bool -> Pattern -> Pattern -> Pattern
+  intersection' _ _           (Node WI _) = Node WI []
+  intersection' _ (Node WI _) _           = Node WI []
+-- Note that chs1 == [] == chs2 (or at least is supposed to be),
+-- except for WR, PR and TR PatNode's.
+  -- First check once for symmetric cases:
+  intersection' b node1@(Node p1 cs1) node2@(Node p2 cs2)
+#if 0
+   -- XXX Don't do it -- (==) on PatNode might be more expensive
+   -- than I think, some nodes have list parameters...
+   -- (Could put this at top, allowing WN etc. to be accepted in many cases.)
+   | p1 == p2      = Node p1 $ zipWith_ "intersection" (intersection' b) cs1 cs2
+#endif
+   | WS <- p1, WS <- p2  = node1
+   | WR <- p1, WR <- p2  = let (b,zs) = zipWith_ "intersection" (intersection' b) cs1 cs2 in if b then Node WR zs else Node WS zs
+   | WN n1 <- p1, WN n2 <- p2  = Node (WN (min n1 n2)) []
+#if USE_WW_DEEPSEQ
+#if PARALLELISM_EXPERIMENT
+   | PW <- p1, PW <- p2  = node1
+#endif
+   | WW <- p1, WW <- p2  = node1
+#endif
+#if PARALLELISM_EXPERIMENT
+   | PR <- p1, PR <- p2   = let (b,zs) = zipWith_ "intersection" (intersection' b) cs1 cs2 in if b then Node PR zs else Node WS zs
+   | PN n1 <- p1, PN n2 <- p2  = Node (PN (min n1 n2)) []
+#endif
+  -- Now the asymmetric cases:
+  intersection' b node1@(Node p1 cs1) node2@(Node p2 cs2)
+   | WR <- p1, WS <- p2  = node2
+#if USE_WW_DEEPSEQ
+#if PARALLELISM_EXPERIMENT
+   | PW <- p1  = node2
+#endif
+   | WW <- p1  = node2
+#endif
+   | WR <- p1, WN n2 <- p2  = truncatePat n2 node1
+#if PARALLELISM_EXPERIMENT
+   | PR <- p1, PN n2 <- p2  = truncatePat n2 node1
+#endif
+   | TI   _ <- p1  = error "intersectPats: can't handle TI PatNode's yet"
+   | TR   _ <- p1  = error "intersectPats: can't handle TR PatNode's yet"
+   | TN _ _ <- p1  = error "intersectPats: can't handle TN PatNode's yet"
+#if USE_WW_DEEPSEQ
+   | TW   _ <- p1  = error "intersectPats: can't handle TW PatNode's yet"
+#endif
+   | not b               = intersection' True node2 node1
+   | otherwise = Node WI []
+--- | otherwise = error "intersectPats: unexpected failure to (Haskell) pattern-match arguments!"
+
+-------------------------------------------------------------------------------
+
+  zipWith_ :: String -> (a -> b -> c) -> [a] -> [b] -> (Bool,[c])
+  zipWith_ caller f xs ys
+   | b          = (b,zs)
+   | otherwise  = trace (caller ++ ": node arity disparity!") (b,zs)
+   where
+    (b,zs) = zipWith_' f xs ys []
+  zipWith_' :: (a -> b -> c) -> [a] -> [b] -> [c] -> (Bool,[c])
+  zipWith_' _ [] [] acc = (True,acc)
+  zipWith_' f (x:xs) (y:ys) acc = zipWith_' f xs ys (f x y : acc)
+  zipWith_' _ _ _ acc = (False,acc)
+
+-------------------------------------------------------------------------------
+
+  -- | Given an integer depth and a pattern, truncate the pattern to
+  -- extend to at most this requested depth.
+  truncatePat :: Int -> Pattern -> Pattern
+  truncatePat n node
+   | n <= 0              = Node WS []
+   | Node p chs <- node  = Node p $ map (truncatePat (-1+n)) chs
+
+-------------------------------------------------------------------------------
+
+  -- | There is no Nil in the Pattern type, but a single 'WI' node as
+  -- empty pattern is a dependable way to assure the empty pattern
+  -- never forces anything.
+  emptyPat :: Pattern
+  emptyPat = Node WI []  -- should do it!
+
+-------------------------------------------------------------------------------
+
+#if ! HASKELL98_FRAGMENT
+  -- | Obtain a lazy pattern, matching the shape of
+  -- an arbitrary term (value expression).
+  -- Interior nodes will be 'WR', and leaves will be 'WS'.
+  --
+  -- Note this gives counter-intuitive results when used on @'Rose' a@.
+  -- For example, a rose tree with a single node will have a 3-node /\\ shape.)
+  -- Formally, 'mkPat' is not idempotent on 'Pattern's, but
+  -- rather grows without bound when iterated. This shouldn't be
+  -- an issue in practise.
+  mkPat :: forall d. Data d => d -> Pattern
+  mkPat = f . shapeOf
+   where f (Node p cs) = Node (if null cs then WS else WR) $ map f cs
+--mkPat x = fmap (\ (Node p cs) -> if null cs then WS else WR) $ shapeOf x
+--mkPat x = (\ (Node p cs) -> if null cs then WS else WR) <$> shapeOf x
+--mkPat x = WR <$ shapeOf x
+
+  -- | Obtain a lazy pattern, matching the shape of
+  -- an arbitrary term, but only down to at most depth @n@.
+  -- Interior nodes will be 'WR'.
+  -- Leaf nodes will be 'WS' if they were leaves in the host value;
+  -- otherwise (i.e. if they are at depth @n@) they will be 'WR'.
+  --
+  -- Satisfies @'forcep' . 'mkPatN' n = 'forcen' n@.
+  --
+  -- See caveat in the comment to 'mkPat'.
+  mkPatN :: forall d. Data d => Int -> d -> Pattern
+  mkPatN n = f n . shapeOf
+   where
+    f 0 (Node p cs) = Node (if null cs then WS else WR) []
+    f n (Node p cs) = Node (if null cs then WS else WR) $ map (f (-1+n)) cs
+#endif
+
+-------------------------------------------------------------------------------
+
+  -- | Elide all leaves which have no non-leaf sibling.
+  -- We want the pattern to still match the same value, only less of it.
+  -- Merely eliding all leaves would, in most cases, cause match failure,
+  -- so we have to be a bit more subtle.  There are some arbitrary
+  -- decisions about the relaxation route through the lattice.
+  -- (Refer to the source for details.)
+  shrinkPat :: Pattern -> Pattern
+  shrinkPat (Node p cs)
+   | WI <- p  = Node WI []  -- can't shrink (eventually elided from parent)
+   | WS <- p  = Node WI []  -- may as well
+   | WN n <- p  = if n <= 1 then Node WI []
+                  else if n == 2 then Node WS []
+                  else Node (WN (-1+n)) []
+#if USE_WW_DEEPSEQ
+   | WW <- p  = Node (WN 5) []  -- XXX arbitrary hardcode
+#endif
+#if PARALLELISM_EXPERIMENT
+   -- take de-parallelisation as shrinkage
+   | PR <- p  = Node WR cs
+   | PN n <- p  = Node (WN n) []
+#if USE_WW_DEEPSEQ
+   | PW <- p  = Node WW []
+#endif
+#endif
+   -- take un-type-constrained as shrinkage
+   | TI _ <- p  = Node WI []
+   | TR _ <- p  = Node WR cs
+   | TN n _ <- p  = Node (WN n) []
+#if USE_WW_DEEPSEQ
+   | TW _ <- p  = Node WW []
+#endif
+   -- If this node has any grandchildren, recurse on the children.
+   | not $ null $ filter (\ (Node q gcs) -> not $ null gcs) cs
+      = Node p $ map shrinkPat cs
+   -- At this point we know this node has no grandchildren.
+   -- Check if all children are insulator nodes.
+   | null $ filter (\ (Node p _) -> case p of
+                                     WI -> False
+                                     _ -> True) cs
+      = case p of
+         -- Must go to WI, since .{##} -> . is /not/ a lazification.
+         WR -> Node WI []
+#if PARALLELISM_EXPERIMENT
+         PR -> Node WI []  -- sic
+#endif
+         TR _ -> Node WI []  -- sic
+         _ -> error "shrinkPat: unexpected!"
+   | otherwise
+      = Node p $ map shrinkPat cs  -- still contains shrinkable children
+
+-------------------------------------------------------------------------------
+
+#if PROVIDE_OLD_SHRINK_PAT
+  -- | Old version, for temporary compatibility of seqaid demo mode.
+  {-  DEPRECATED shrinkPat_old "For temporary compatibility of seqaid demo mode." #-}
+  -- (Deprecation warning too noisy for me. Nobody will use this by accident.)
+  shrinkPat_old :: Pattern -> Pattern
+  shrinkPat_old (Node p cs)
+   | not $ null $ filter (\ (Node q gcs) -> not $ null gcs) cs  = Node p $ map shrinkPat_old cs
+   | WR <- p  = Node WS []
+   | otherwise  = Node p []
+#endif
+
+-------------------------------------------------------------------------------
+
+#if ! HASKELL98_FRAGMENT
+  -- | Grow all leaves by one level within the shape of the provided value.
+  growPat :: forall d. Data d => Pattern -> d -> Pattern
+  growPat pat x = growPat' pat $ shapeOf x
+  growPat' :: Pattern -> Shape -> Pattern
+  growPat' (Node p []) (Node q ds) = Node p $ map (const (Node WS [])) ds
+  growPat' (Node p cs) (Node q ds) = Node p $ zipWith growPat' cs ds
+#endif
+
+-------------------------------------------------------------------------------
+
+  -- | This creates a new 'WR' node, the common root. The argument patterns
+  -- become the children of the root (order is preserved).
+  liftPats :: [ Pattern ] -> Pattern
+  liftPats ps = Node WR ps
+
+-------------------------------------------------------------------------------
+
+  -- | Introduce siblings at a node (interior or leaf) of the target.
+  -- The first argument is target, the second is a path, and the
+  -- third is a list of subpatterns for insertion, along with the
+  -- indices of the child before which to insert. If this index
+  -- is negative, it counts from the right. Indices are always
+  -- relative to the original target as it was received.
+{--}
+-- XXX Later: I don't understand. When would you use this?
+-- You change the number of children at a node, which seems
+-- unuseful. More reasonable than insertion would be to replace
+-- select children with a new subpatterns.
+  splicePats :: Pattern -> [Int] -> [ (Int, Pattern) ] -> Pattern
+  splicePats target path isibs'
+--- | isibs /= isibs'    = error "splicePats: siblings to be inserted must be indexed in increasing order"
+--- | not uniqueIdxs     = error "splicePats: siblings to be inserted must be uniquely indexed"
+--- | not $ isPath path  = error "splicePats: path malformed"
+   | otherwise          = splice' target path isibs
+   where
+--  uniqueIdxs = length isibs == ( length $ nub $ map fst isibs )
+    isibs = sortBy comp isibs'  -- questionable solution
+     where
+      comp (x1,_) (x2,_) = compare x1 x2
+    -- Now, what's the clever way to do this? it's ugly manual
+    -- recursion if don't think of something nicer. (This is
+    -- the ugly manual recursion!)
+    splice' (Node p cs) [] isibs  -- end of path chain
+     | maximum (map fst isibs) > ncs  = error "splicePats: sibling indices must not exceed the number of existing children"
+     | otherwise  = {-trace "**1**" $-} Node p $ f 0 cs isibs_
+     where
+      ncs = length cs
+      isibs_ = let lst = takeWhile ((== -1) . fst) isibs in
+               drop (length lst) isibs ++ map (\ (x,y) -> (ncs,y)) lst
+      f n cs [] = cs
+      f n [] isibs_remaining = map snd isibs_remaining
+--    f n [] isibs_remaining = error $ "splicePats: (2) path escapes target: " ++ show isibs_remaining  -- shouldn't happen
+      f n lst1@(c:cs) lst2@((i,s):iss)
+---    | trace ("**3**"++show lst1++" "++show lst2) False  = undefined
+       | ii == n    = map snd ss ++ (c : f (1+n) cs ss')
+       | otherwise  =                c : f (1+n) cs lst2
+       where (ss,ss') = span (\ (i,s) -> i == n) lst2
+             ii = if i < 0 then ncs-(-i) else i
+    splice' (Node p cs) (i:is) isibs
+---  | trace ("**4** "++show i++" / "++show cs++" / "++show pathcs) False  = undefined
+     | null cs  = error "splicePats: path escapes target (depth)"
+     | length cs < 1+i  = error "splicePats: path escapes target (breadth)"
+     | null ccsR  = error "splicePats: (2) path escapes target (depth)"
+     | otherwise  = {-trace "**2**" $-} Node p (csL ++ [splice' c is isibs] ++ csR)
+     where
+      (c:csR) = ccsR
+      (csL,ccsR) = splitAt i cs
+
+-------------------------------------------------------------------------------
+
+  -- | Elide siblings at a node (interior or leaf) of the target.
+  -- The first argument is target, the second is a path, and the
+  -- third is a list of child indices for elision.
+  -- If this index is negative, it counts from the right.
+  -- Indices are always relative to the original target as it was received.
+{--}
+-- XXX Later: I don't understand. When would you want to
+-- change the number of children at a node (except possibly
+-- to zero)?...
+-- XXX This is templated from splicePats, and it seems more useful
+-- for it to just take a single path, or a list of paths; it doesn't
+-- really make sense to support multiple sibling elision in single pass.
+-- XXX Yes, change that! Let it take a list of paths instead.
+  elidePats :: Pattern -> [Int] -> [Int] -> Pattern
+  elidePats target path isibs'
+   | otherwise          = elide' target path isibs
+   where
+    isibs = sortBy comp isibs'  -- questionable solution
+     where
+      comp x1 x2 = compare x1 x2
+    -- (See comment in elidePats.)
+    elide' (Node p cs) [] isibs  -- end of path chain
+     | maximum isibs > ncs  = error "elidePats: sibling indices must not exceed the number of existing children"
+     | otherwise  = {-trace "**1**" $-} Node p $ f 0 cs isibs_
+     where
+      ncs = length cs
+      isibs_ = let lst = takeWhile (== -1) isibs in
+               drop (length lst) isibs ++ map (\ x -> ncs) lst
+      f n cs [] = cs
+      f n [] isibs_remaining = error $ "elidePats: (2) path escapes target: " ++ show isibs_remaining  -- shouldn't happen
+      f n lst1@(c:cs) lst2@(i:iss)
+---    | trace ("**3**"++show lst1++" "++show lst2) False  = undefined
+       | ii == n    =     f (1+n) cs ss'
+       | otherwise  = c : f (1+n) cs lst2
+       where (ss,ss') = span (\ i -> i == n) lst2
+             ii = if i < 0 then ncs-(-i) else i
+    elide' (Node p cs) (i:is) isibs
+---  | trace ("**4** "++show i++" / "++show cs++" / "++show pathcs) False  = undefined
+     | null cs  = error "elidePats: path escapes target (depth)"
+     | length cs < 1+i  = error "elidePats: path escapes target (breadth)"
+     | null ccsR  = error "elidePats: (2) path escapes target (depth)"
+     | otherwise  = {-trace "**2**" $-} Node p (csL ++ [elide' c is isibs] ++ csR)
+     where
+      (c:csR) = ccsR
+      (csL,ccsR) = splitAt i cs
+
+-------------------------------------------------------------------------------
+
+  -- | Select a leaf at random, and elide it.
+  -- In order to achieve fairness, the node probabilities are
+  -- weighted by nodes in branch.
+  -- The path arg can "focus" the stochastic erosion to only
+  -- consider leaves beneath a given node.
+{--}
+-- XXX Later: I don't understand. When would you want to
+-- allow the number of children at a node to change (except
+-- possibly to zero)?...
+-- XXX It would be better if the weighting could be done once,
+-- then maintained, but will have to see how it performs...
+-- XXX It is lamentable that the change history of this function
+-- along with the GHC error messages (notably the topmost of them)
+-- is lost, since stuff like this would make exellent input
+-- to compiler AI (for improving prioritisation of error
+-- messages for example; the "lexical tradition" is also
+-- at work here!...).
+-- XXX Hey! This doesn't even need to call elidePats.
+  erodePat :: StdGen -> [Int] -> Pattern -> (Pattern, StdGen)
+  -- Just descend the path, reconstructing recursively (usual thing),
+  -- and when get to the node addressed by path, then choose (fair) your
+  -- leaf under that.
+  erodePat g (h:t) (Node pn chs)
+   = ( Node pn $ left ++ [ ch'' ] ++ right , g' )
+   where
+    ch'' = ch'
+--  ch'' = (\ (Node (r,p) chs) -> Node r chs) ch'
+    (ch',g') = erodePat g t lucky
+    (left,lucky:right) = splitAt h chs
+  erodePat g [] pat = (pat', g')
+--erodePat g [] pat = trace (showRose wpat ++ "\n" ++ showRose (weightedRose pat)) $ (pat', g')
+   where
+    pat' = fst $ unzipRose wpat'
+    !_ = probDensRose pat
+--  !_ = force $ probDensRose pat
+    (wpat', g') = f g wpat
+--  !wpat@(Node pn chs) = probDensRose pat
+    wpat@(Node pn chs) = probDensRose pat
+    f :: StdGen -> Rose (PatNode,Double) -> (Rose (PatNode,Double), StdGen)
+    f g (Node pn chs)
+     | isNothing mh  = ( Node pn chs, g )  -- ??
+     | null chs   = ( Node pn [], g )
+---  | null chs   = ( Node pn [], g'' )
+     | null gchs  = ( Node pn $ left ++ [ Node (WI,1.0) [] ] ++ right , g'' )
+---  | null gchs  = ( Node pn $ left ++ right , g'' )
+     | otherwise  = ( Node pn $ left ++ [ ch' ] ++ right , g'' )
+     where
+-- XXX I see; I have a logic error.
+-- Cyclical definition.
+-- null gchs
+-- but gchs depends on lucky
+-- and lucky depends on ... [?]
+      (Node _ gchs) = lucky
+      (ch',g'') = f g' lucky
+      chprobs = map (\ (Node (_,p) _) -> p) chs
+      mh = lucky_child 0 0.0 chprobs
+#if 1
+      h = fromJust mh
+#else
+      h | isNothing mh  = error "UNEXPECTED!"  -- definitely get here
+        | otherwise     = fromJust mh
+#endif
+      (left,lucky:right) = splitAt h chs
+--    !_ = trace ("r=" ++ show r) $ ()
+--    (r,g') = trace "HERE!" $ randomR (0,1) g
+      (r,g') = randomR (0,1) g
+      lucky_child :: Int -> Double -> [Double] -> Maybe Int
+      lucky_child idx acc [] = Nothing
+      lucky_child idx acc (cp:cps)
+---    | trace (" >>> " ++ show acc ++ "  " ++ show acc') $ False = undefined
+       | acc' >= r   = Just idx
+       | otherwise  = lucky_child (1+idx) acc' cps
+       where
+        acc' = acc + cp
+
+-------------------------------------------------------------------------------
+
+  -- See the sai-shape-syb package for an API full of this sort of thing.
+
+#if ! HASKELL98_FRAGMENT
+  type Shape = Rose ()
+  shapeOf :: forall d. Data d => d -> Shape
+  shapeOf = ghom $ const ()
+  ghom :: forall r d. Data d => GenericQ r -> d -> Rose r
+  ghom f x = foldl k b (gmapQ (ghom f) x)
+   where
+     b = Node (f x) []
+     k (Node r chs) nod = Node r (chs++[nod])
+#endif
+
+  probDensRose :: Rose r -> Rose (r, Double)
+  probDensRose = probDensRose' 1.0 . weightedRose
+  probDensRose' :: Double -> Rose (r, Int) -> Rose (r, Double)
+--probDensRose' p (Node (r,w) []) = Node (r,p) []  -- (helps avoid div-by-zero)
+  probDensRose' p (Node (r,w) chs)
+   = Node (r,p) $ zipWith probDensRose' chprobs chs
+   where
+    chwts   = map (\ (Node (_,w) _) -> w) chs
+    chwtsum = foldl' (+) 0 chwts
+    normfac = 1 / fromIntegral chwtsum
+--- !_ = trace (" *** " ++ show chprobs)
+    chprobs = map (\ (Node (_,w) _) -> normfac * (fromIntegral w)) chs
+
+  weightedRose :: Rose r -> Rose (r, Int)
+  weightedRose (Node r chs) = foldl k' b (map weightedRose chs)
+   where
+     k = (\ (r,w) (r',w') -> (r,w+w'))
+     b = Node (r,1) []
+     k' (Node rw chs) nod@(Node rw' _) = Node (rw `k` rw') (chs++[nod])
+
+  unzipRose :: Rose (r, s) -> (Rose r, Rose s)
+  unzipRose (Node (x,y) ns) = (Node x xns, Node y yns)
+   where
+    (xns,yns) = unzip $ map unzipRose ns
+
+  showRose :: Show r => Rose r -> String
+  showRose = show' 0
+   where show' n (Node r chs)
+           = indent n ++ show r ++ "\n" ++ concatMap (show' (1+n)) chs
+              where indent n = concat $ replicate n "| "
+
+-------------------------------------------------------------------------------
+
diff --git a/src/Control/DeepSeq/Bounded/Pattern.hs b/src/Control/DeepSeq/Bounded/Pattern.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/DeepSeq/Bounded/Pattern.hs
@@ -0,0 +1,684 @@
+
+-------------------------------------------------------------------------------
+
+  {-  LANGUAGE CPP #-}
+
+#define DO_TRACE 0
+
+#define WARN_IGNORED_SUBPATTERNS 1
+#define NEVER_IGNORE_SUBPATTERNS 0
+
+-- Formerly DEBUG_WITH_DEEPSEQ_GENERICS.
+-- Now also needed to force issuance of all compilePat warnings
+-- (so not strictly a debugging flag anymore).
+-- [Except it didn't work...]
+--- #define NFDATA_INSTANCE_PATTERN 0  -- now a .cabal flag
+
+#define DO_DERIVE_DATA_AND_TYPEABLE 0
+#define DO_DERIVE_ONLY_TYPEABLE 1
+
+-- Now specified via --flag=[-]USE_WWW_DEEPSEQ
+--- #define USE_WW_DEEPSEQ 1
+
+-------------------------------------------------------------------------------
+
+-- Good idea: Let * be followed by an integer N.
+-- This shall have the semantics that, when that node
+-- is matched in the pattern, instead of rnf it is forcen N'd.
+
+-- There may be fusion possible (which is worth trying here
+-- for practise, even if this lib is not used much):
+--
+--   forcep p1 . forcep p2 = forcep (unionPat [p1,p2])
+--
+-- This holds if pattern doesn't contain #, or any (type-)constrained
+-- subpatterns -- the latter might work out, if exclude # from them too,
+-- but I'm not sure.  With #, we lose even monotonicity, let alone
+-- the above law.
+--
+-- For the above to hold, remember, the union must have exactly
+-- the "forcing potential" of the LHS -- no more, no less.
+
+-------------------------------------------------------------------------------
+
+#if DO_DERIVE_DATA_AND_TYPEABLE
+  {-# LANGUAGE DeriveDataTypeable #-}
+#endif
+-- XXX Only needed for something in Blah.hs.
+-- Check into it, and see if can't get rid of the need
+-- for Typeable instances in here!
+#if DO_DERIVE_ONLY_TYPEABLE
+  {-# LANGUAGE DeriveDataTypeable #-}
+#endif
+#if NFDATA_INSTANCE_PATTERN
+  -- For testing only (controlling trace interleaving):
+  {-# LANGUAGE DeriveGeneric #-}
+#endif
+  {-  LANGUAGE DeriveFunctor #-}
+
+-------------------------------------------------------------------------------
+
+-- |
+-- Module      :  Control.DeepSeq.Bounded.Pattern
+-- Copyright   :  (c) 2014, Andrew G. Seniuk
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  Andrew Seniuk <rasfar@gmail.com>
+-- Stability   :  experimental
+-- Portability :  portable
+--
+
+-------------------------------------------------------------------------------
+
+  module Control.DeepSeq.Bounded.Pattern
+
+  (
+
+     -- * Pattern datatype
+
+       Pattern, PatNode(..)
+
+--   , patternShapeOK  -- useful for defining instances of NFDataP
+
+     -- * Pattern DSL
+
+  -- | __Grammar__
+  --
+  -- @
+  -- /pat/ /->/ /[/ __=__ /]/ __.__ /[/ __{__ /{/ /pat/ /}/ __}__ /]/
+  --     /|/  /(/ /[/ __=__ /]/ __*__ /[/ /decimalint/ /]/ /|/ __#__ /)/
+  --     /|/  __.:__ /ctorname/ /{/ /space/ /ctorname/ /}/ __{__ /[/ /{/ /pat/ /}/ /]/ __}__
+  --     /|/  /(/ __*__ /[/ /decimalint/ /]/ /|/ __#__ /)/ __:__ /typename/ /{/ /space/ /typename/ /}/ __{}__
+  -- /typename/ -> /string/
+  -- /ctorname/ -> /string/
+  -- /decimalint/ -> /digit string not beginning with zero/
+  -- /space/ -> /space character ASCII 0x32/
+  -- @
+  --
+  -- [I regret that Haddock cannot offer better markup for distinguishing
+  -- the metasyntax.  The bold is not bold enough.  The alternation symbol,
+  -- although \/|\/ in the document comment, does not show as slanted for me.
+  -- Had no luck using color, also Unicode support seems pretty sketchy.
+  -- Embedding an image is possible via data URL, but this has been known
+  -- to crash Haddock except for very small images.]
+  --
+  -- __Examples__
+  --
+  -- @".{...}"@ will match any ternary constructor.
+  --
+  -- @'rnfp' ".{...}" expr@ will force evaluation of @expr@ to a depth of two,
+  -- provided the head of @expr@ is a ternary constructor; otherwise it behaves
+  -- as @'rnfp' "#" expr@ (i.e. do nothing).
+  --
+  -- @'rnfp' ".{###}" expr@ will force it to only a depth of one. That is,
+  -- @'rnfp' ".{###}" expr = 'rnfp' "." expr@ when the head of @expr@
+  -- is a ternary constructor; otherwise it won't perform any evaluation.
+  --
+  -- @'rnfp' "*" expr = 'rnf' expr@.
+  --
+  -- @'rnfp' ".{***}" expr@ will 'rnf' (deep) any ternary constructor, but
+  -- will not touch any constructor of other arity.
+  --
+  -- @'rnfp' ".{..{*.}.}" expr@ will match any ternary constructor, then
+  -- match the second subexpression constructor if it is binary, and
+  -- if matching got this far, then the left sub-subexpression
+  -- will be forced ('rnf'), but not the right.
+  --
+  -- @'rnfp' ".{.*:T{}#}" expr@ will unwrap (shallow 'seq') the first
+  -- subexpression of @expr@, and the third subexpression won't be touched.
+  -- As for the second subexpression, if its type is @T@ it will be
+  -- completely evaluated ('rnf'), but otherwise it won't be touched.
+  --
+  -- @'rnfp' ".{=**}" expr@ will spark the /parallel/ complete evaluation of
+  -- the two components of any pair. (Whether the computations actually
+  -- run in parallel depends on resource availability, and the discretion
+  -- of the RTS, as usual).
+  --
+  -- __Details__
+  --
+  -- The present pattern parser ignores any subpatterns of all
+  -- pattern nodes except 'WR', 'TR' and 'PR', optionally emitting a warning.
+  -- Hence, only 'WR', 'TR' and 'PR' patterns are potentially recursive.
+  --
+  -- When specifying a list of subpatterns with 'WR' or 'PR',
+  -- in order for the match to succeed, the number of subpatterns must
+  -- be equal to the arity of the named constructor.
+  --
+  -- Type constraints must always be followed by __{__ (opening brace) as delimiter.
+  -- In the case of 'TR', if no recursion is desired, provide __{}__.
+  -- In order for the match to succeed, the number of subpatterns must either
+  -- be zero (__{}__), or be equal to the arity of the named constructor.
+  --
+
+     , compilePat
+     , showPat
+
+     -- * Why depend on whole containers package, when we only want a rose tree
+
+     , Rose(..)
+
+     -- * Preferred to have this in Seqable, but had cyclical dependency issues
+
+     , SeqNodeKind(..)
+
+  )
+
+  where
+
+-------------------------------------------------------------------------------
+
+#if DO_DERIVE_DATA_AND_TYPEABLE
+  import Data.Data ( Data )
+  import Data.Typeable ( Typeable )
+#elif DO_DERIVE_ONLY_TYPEABLE
+  import Data.Typeable ( Typeable )
+#endif
+
+#if USE_WW_DEEPSEQ
+  import Control.DeepSeq ( NFData )
+#endif
+
+  import Data.List ( intersperse )
+  import Data.Char ( isDigit )
+  import Data.Maybe ( isNothing, fromJust )
+
+  import Debug.Trace ( trace )
+#if USE_WW_DEEPSEQ
+  -- The only uses of force in this module are for debugging purposes
+  -- (including trying to get messages to be displayed in a timely
+  -- manner, although that problem has not been completely solved).
+  import Control.DeepSeq ( force )
+#if NFDATA_INSTANCE_PATTERN
+  -- for helping trace debugging
+  import qualified Control.DeepSeq.Generics as DSG
+  import qualified GHC.Generics as GHC ( Generic )
+#endif
+#endif
+
+-------------------------------------------------------------------------------
+
+#if DO_TRACE
+  mytrace = trace
+#else
+  mytrace _ = id
+#endif
+
+-------------------------------------------------------------------------------
+
+  data Rose a = Node a [ Rose a ]
+#if NFDATA_INSTANCE_PATTERN
+#if DO_DERIVE_DATA_AND_TYPEABLE
+   deriving (Show, Eq, GHC.Generic, Data, Typeable)
+-- deriving (Show, Eq, Functor, GHC.Generic, Data, Typeable)
+#elif DO_DERIVE_ONLY_TYPEABLE
+   deriving (Show, Eq, GHC.Generic, Typeable)
+#else
+   deriving (Show, Eq, GHC.Generic)
+#endif
+#else
+#if DO_DERIVE_DATA_AND_TYPEABLE
+   deriving (Show, Eq, Data, Typeable)
+#elif DO_DERIVE_ONLY_TYPEABLE
+   deriving (Show, Eq, Typeable)
+#else
+   deriving (Show, Eq)
+#endif
+#endif
+  type Pattern = Rose PatNode
+
+  instance Functor Rose where
+    fmap f (Node x chs) = Node (f x) (map (fmap f) chs)
+
+#if NFDATA_INSTANCE_PATTERN
+  instance NFData a => NFData (Rose a) where rnf = DSG.genericRnf
+#endif
+
+-------------------------------------------------------------------------------
+
+  -- | Note that only 'WR', 'TR' and 'PR' allow for explicit recursion.
+  -- The other 'PatNode's are in leaf position when they occur in a 'Pattern'.
+
+  data PatNode
+       =
+         WR  -- ^ Continue pattern matching descendants.
+       | WS  -- ^ Stop recursing (nothing more forced down this branch).
+       | WN Int  -- ^ @'rnfn' n@ the branch under this node.
+#if USE_WW_DEEPSEQ
+       | WW  -- ^ Fully force ('rnf') the whole branch under this node.
+#endif
+       | WI  -- ^ Don't even unwrap the constructor of this node.
+{--} -- XXX It's still unclear whether TI should allow subpatterns;
+-- the alternative is for TI, when type doesn't match, to behave
+-- as "." (no subpatterns); but since I say "otherwise behave as TR",
+-- and TR says "continue pattern matching descendants", this seems to
+-- say that subpatterns should be permitted.  Certainly it's no problem
+-- to permit subpatterns in this case, but WI should still ignore
+-- subpatterns since it will always be # regardless of node type.
+-- (Subpatterns ought to be "safely redundant" in this case, but whether
+-- they are depends on implementation and needs to be tested if allow
+-- WI subpatterns to survive past the parser/compiler!)
+--   And this all applies to TW and TN too, right? Yes.
+-- It seems clear that TI, TW and TN should all allow subpatterns.
+-- And that WI, WW and WN should elide them and issue a warning.
+--   But, none of my present woes seem to be connected with this...
+-- Nonetheless, it's important to pin down the semantics.
+#if 1
+       | TR [String]  -- ^ Match any of the types in the list (and continue pattern matching descendants); behave as 'WI' for nodes of type not in the list. (Note this behaviour is the complement of 'TI' behaviour.)
+---    | TS [String]  -- ^ Same as 'TR' except no subpatterns present.
+       | TN Int [String]  -- ^ @'rnfn' n@ the branch under this node, if the node type matches any of the types in the list.
+#if USE_WW_DEEPSEQ
+       | TW [String]  -- ^ Fully force ('rnf') the whole branch under this node, if the node type matches any of the types in the list; otherwise behave as 'WI'.
+#endif
+       | TI [String]  -- ^ Don't even unwrap the constructor of this node, if it's type is in the list; otherwise behave as 'WR'. (Note this behaviour is the complement of 'TR' behaviour.)
+#else
+       | TR [TypeRep]  -- ...
+#endif
+#if PARALLELISM_EXPERIMENT
+       | PR  -- ^ Spark the pattern matching of this subtree.
+       | PN Int  -- ^ Spark @'rnfn' n@ of this subtree.
+#if USE_WW_DEEPSEQ
+       | PW  -- ^ Spark the full forcing ('rnf') of this subtree.
+#endif
+#endif
+#if NFDATA_INSTANCE_PATTERN
+#if DO_DERIVE_DATA_AND_TYPEABLE
+       deriving ( Show, Eq, Typeable, Data, GHC.Generic )
+#elif DO_DERIVE_ONLY_TYPEABLE
+       deriving ( Show, Eq, Typeable, GHC.Generic )
+#else
+       deriving ( Show, Eq, GHC.Generic )
+#endif
+#else
+#if DO_DERIVE_DATA_AND_TYPEABLE
+       deriving ( Show, Eq, Typeable )  -- Data apparently not needed
+#elif DO_DERIVE_ONLY_TYPEABLE
+       deriving ( Show, Eq, Typeable )
+#else
+       deriving ( Show, Eq )
+#endif
+#endif
+
+#if NFDATA_INSTANCE_PATTERN
+  instance NFData PatNode where rnf = DSG.genericRnf
+#endif
+
+-------------------------------------------------------------------------------
+
+#if 0
+  patternShapeOK :: Data a => Pattern -> a -> Bool
+  patternShapeOK pat x = S.shapeOf pat == S.shapeOf x
+#endif
+
+-------------------------------------------------------------------------------
+
+  -- XXX Doing this to ensure issuance of all warning messages
+  -- pertaining to the pattern to be compiled!
+  -- Which isn't quite working?!?.... [Never did resolve this.]
+  compilePat :: String -> Pattern
+#if NFDATA_INSTANCE_PATTERN
+  compilePat s = force $ compilePat_ s
+--compilePat s = let pat = force $! compilePat_ s in trace (show pat) $! pat
+--compilePat s = let pat = force $ compilePat_ s in trace (show pat) $! pat
+--compilePat s = let !pat = force $ compilePat_ s in trace (show pat) $ pat
+--compilePat s = let pat = force $ compilePat_ s in trace (show pat) $ pat
+#else
+  compilePat = compilePat_
+#endif
+
+  compilePat_ :: String -> Pattern
+--compilePat_ :: String -> (Pattern, String)
+--compilePat_ s = Node WW []
+  compilePat_ s
+   | null plst         = error "compilePat: empty pattern (syntax error)"
+   | length plst > 1   = error "compilePat: disconnected pattern (not rooted)\nPerhaps you used parentheses instead of braces?"
+   | not $ null s'     = error $ "compilePat: parse error: not all input consumed\nRemaining: " ++ s'
+#if 1
+   | otherwise   = head plst
+   where
+#else
+-- When find the time, should add a CPP switch to enable emitting
+-- a warning message in these cases; but it's too common/useful to
+-- brutally disallow like this!...
+   | WI <- p      = error "compilePat: top pattern node cannot be #"
+   | TR _ <- p    = error "compilePat: top pattern node cannot be .:<qual>"
+   | TN _ _ <- p  = error "compilePat: top pattern node cannot be *:<qual>"
+   | TW _ <- p    = error "compilePat: top pattern node cannot be *:<qual>"
+   | TI _ <- p    = error "compilePat: top pattern node cannot be #:<qual>"
+   | otherwise    = hplst
+   where
+    hplst@(Node p _) = head plst
+#endif
+    (plst, s') = compilePat' False Nothing Nothing [] s_ []  -- XXX ??
+    s_ = translateStarN s
+
+  translateStarN [] = []
+  translateStarN ('@':cs) = error $ "compilePat: parse error: unexpected '@'"
+  translateStarN ('*':cs)
+   | isNothing mn  = '*' : translateStarN cs'  -- or cs
+   | otherwise     = '@' : ( fromJust mn ++ translateStarN cs' )
+   where
+--  !_ = trace ("Boo: " ++ show (mn, cs')) ()
+    (mn, cs') = parseInt cs ""
+  translateStarN (c:cs) = c : translateStarN cs
+
+  parseInt :: String -> String -> ( Maybe String, String )
+  parseInt [] acc = ( if null acc then Nothing else Just acc , "" )
+  parseInt s@(c:cs) acc
+   | length acc > 8  = error $ "compilePat: * followed by too many (>8) digits"
+   | isDigit c       = parseInt cs (acc++[c])
+   | otherwise       = ( if null acc then Nothing else Just acc , s )
+
+  -- compilePat' parameters:
+  --  spark    - the next node parsed will, when matched, spark parallel
+  --             evaluation of its subpatterns
+  --  mpn      - says what the last PatNode parsed was (list args are empty)
+  --           - what do I mean "list args are empty"?
+  --              - oh: T* nodes have a list arg
+  --           - I see that mpn is never used (except in some dead code)...
+  --  mn       - says what n is for rnfn (eg. 3 for "*3")
+  --           - note that, when Just, this signals to parser that * is for
+  --             a WN/TN node rather than a WW/TW node
+  --  (t:ts)   - the list of type constraints (currently, constructor names)
+  --           - empty list doesn't signal anything about whether W* or T* node
+  --  (c:cs)   - is what's left of the input string we're parsing
+  --  acc      - is an accumulator parameter, collecting patterns parsed
+  compilePat' :: Bool -> Maybe PatNode -> Maybe Int -> [String] -> String -> [Pattern] -> ([Pattern], String)
+  compilePat' spark mpn mn (t:ts) (c:cs) _
+   | not $ c `elem` "{.*#"  = error $ "compilePat: parse error: post-treps pattern char " ++ show c ++ " not one of {.*#"
+  compilePat' spark mpn mn [] [] acc = mytrace "EMPTY" $ (acc, [])
+  compilePat' spark mpn mn [] (' ':cs) acc = mytrace "space" $ compilePat' spark mpn mn [] cs acc
+  compilePat' spark mpn mn [] ('}':'{':cs) acc = error $ "compilePat: opening brace cannot follow closing brace"
+  compilePat' spark mpn mn [] ('}':cs) acc
+#if 0
+        -- Lenient parser tolerates subpatterns of these.
+        -- (The semantics is that any such subpatterns are ignored --
+        -- discarded with a warning.)
+#if USE_WW_DEEPSEQ
+   | isJust mpn, Just WW <- mpn  = trace "compilePat-\"}\": warning: * with subpattern" $ mytrace "}" $ (acc, cs)
+#endif
+   | isJust mpn, Just WI <- mpn  = trace "compilePat-\"}\": warning: # with subpattern" $ mytrace "}" $ (acc, cs)
+#endif
+   | otherwise  = mytrace "}" $ (acc, cs)
+  compilePat' spark mpn mn [] (c:':':cs) acc
+   | null treps  = error $ "compilePat: colon must be followed by at least one type name"
+   | otherwise   = compilePat' spark mpn mn treps (c:cs') acc
+   where
+--  !_ = trace ("Boo: " ++ show (treps, cs')) ()
+    (treps, cs') = compileTypeReps cs
+  compilePat' spark mpn Nothing [] ('@':cs) acc
+   | isNothing mn  = error $ "compilePat: internal error @2 (please report this bug!)"
+   | otherwise     = compilePat' spark mpn mn [] ('@':cs') acc  -- mn is Just n
+   where
+--  !_ = trace ("Boo: " ++ show (mn, cs')) ()
+    (mn_, cs') = parseInt cs ""
+    mn | isNothing mn_  = Nothing
+       | otherwise      = Just ( read (fromJust mn_) :: Int )
+  compilePat' spark mpn (Just n) [] ('@':cs) acc
+   = compilePat' False mpn Nothing [] cs (acc++[node])
+#if PARALLELISM_EXPERIMENT
+    where node | spark      = Node (PN n) []
+               | otherwise  = Node (WN n) []
+#else
+    where node = Node (WN n) []
+#endif
+  compilePat' spark mpn (Just n) [] (c:cs) acc
+   = error $ "compilePat: internal error @1(" ++ [c] ++") (please report this bug!)"
+  compilePat' spark mpn mn treps (c:'{':cs) acc = compilePat' spark mpn mn [] cs' (acc++[node])
+   where
+    (chs, cs') = mytrace (".{-cs="++cs) $ compilePat' spark mpn mn [] cs []
+    node
+     | null treps = case c of
+        '.' -> mytrace (".{-recurs: "++show chs) $ Node WR chs
+        -- Lenient parser tolerates subpatterns of these.
+        -- (The semantics is that any such subpatterns are ignored --
+        -- discarded with a warning.)
+-- It's more convenient to keep the subpatterns, if want to issue
+-- a warning when they don't match for type-constrained patterns.
+-- True the semantics is the same except for the warning message,
+-- but, well, I want to see it at the moment!
+#if NEVER_IGNORE_SUBPATTERNS
+#if ! WARN_IGNORED_SUBPATTERNS
+#if USE_WW_DEEPSEQ
+        '*' -> Node WW chs
+#endif
+        '#' -> Node WI chs
+#else
+#if USE_WW_DEEPSEQ
+        '*' -> trace "compilePat-\"{\": warning: * with subpattern" $ Node WW chs
+#endif
+        '#' -> trace "compilePat-\"{\": warning: # with subpattern" $ Node WI chs
+#endif
+#else
+#if ! WARN_IGNORED_SUBPATTERNS
+#if USE_WW_DEEPSEQ
+        '*' -> Node WW []
+#endif
+        '#' -> Node WI []
+#else
+#if USE_WW_DEEPSEQ
+        '*' -> trace "compilePat-\"{\": warning: * with subpattern" $ Node WW []
+#endif
+        -- Yes, we do see the error for each test we expect a warning from!
+--      '#' -> error "compilePat-\"{\": warning: # with subpattern"
+--      '#' -> force $! trace "compilePat-\"{\": warning: # with subpattern" $! Node WI []
+        '#' -> trace "compilePat-\"{\": warning: # with subpattern" $ Node WI []
+#endif
+#endif
+        _ -> error $ "compilePat-\"{\": unexpected " ++ show c ++ " (cs'=" ++ cs'
+     | otherwise = case c of
+        '.' -> mytrace ("T-.{-recurs: "++show chs) $ Node (TR treps) chs
+#if NEVER_IGNORE_SUBPATTERNS
+#if ! WARN_IGNORED_SUBPATTERNS
+#if USE_WW_DEEPSEQ
+        '*' -> Node (TW treps) chs
+#endif
+        '#' -> Node (TI treps) chs
+#else
+#if USE_WW_DEEPSEQ
+        '*' -> trace "compilePat-\"{\": warning: * with subpattern" $ Node (TW treps) chs
+#endif
+        '#' -> trace "compilePat-\"{\": warning: # with subpattern" $ Node (TI treps) chs
+#endif
+#else
+#if ! WARN_IGNORED_SUBPATTERNS
+#if USE_WW_DEEPSEQ
+        '*' -> Node (TW treps) []
+#endif
+        '#' -> Node (TI treps) []
+#else
+#if USE_WW_DEEPSEQ
+        '*' -> trace "compilePat-\"{\": warning: * with subpattern" $ Node (TW treps) []
+#endif
+        '#' -> trace "compilePat-\"{\": warning: # with subpattern" $ Node (TI treps) []
+#endif
+#endif
+        _ -> error $ "compilePat-T-\"{\": unexpected " ++ show c ++ " (cs'=" ++ cs'
+#if PARALLELISM_EXPERIMENT
+  compilePat' spark mpn mn treps ('=':cs) acc = compilePat' True mpn mn treps cs acc
+#endif
+  compilePat' spark mpn mn treps (c:cs) acc = compilePat' False mpn mn [] cs (acc++[node])
+--compilePat' spark mpn mn treps (c:cs) acc = compilePat' False mpn mn [] cs $ force (acc++[node])
+   where
+    node
+#if PARALLELISM_EXPERIMENT
+     | spark = case c of
+        '.' -> mytrace ".:cs" $ Node PR []
+#if USE_WW_DEEPSEQ
+        '*' -> mytrace "*:cs" $ Node PW []
+#endif
+        _ -> error $ "compilePat-\"c:cs\"-spark: unexpected " ++ show c ++ " (cs=" ++ cs
+#endif
+     | null treps = case c of
+        '.' -> mytrace ".:cs" $ Node WS []  -- sic!
+#if USE_WW_DEEPSEQ
+        '*' -> mytrace "*:cs" $ Node WW []
+#endif
+        '#' -> mytrace "#:cs" $ Node WI []
+        _ -> error $ "compilePat-\"c:cs\": unexpected " ++ show c ++ " (cs=" ++ cs
+     | otherwise = case c of
+        '.' -> mytrace ".:cs" $ Node (TR treps) []
+--      '.' -> mytrace ".:cs" $ Node (TS treps) []
+#if USE_WW_DEEPSEQ
+        '*' -> mytrace "*:cs" $ Node (TW treps) []
+#endif
+        '#' -> mytrace "#:cs" $ Node (TI treps) []
+        _ -> error $ "compilePat-T-\"c:cs\": unexpected " ++ show c ++ " (cs=" ++ cs
+
+-------------------------------------------------------------------------------
+
+  -- | Using String instead of TypeRep since I wasn't sure
+  -- how to avoid mandatory recursion to complete the latter.
+  -- (Probably it can be done -- ':~:' perhaps -- but I was
+  -- unsure and this is working for the moment.)
+  compileTypeReps :: String -> ([String], String)
+--compileTypeReps :: String -> ([TypeRep], String)
+  compileTypeReps cs = (treps,cs')
+   where
+    (tnames, cs') = parseTyNames cs
+    parseTyNames :: String -> ([String], String)
+    parseTyNames s = (sps', s')
+     where
+      sps' = map (dropWhile pstop) sps
+--    !_ = trace ("(sps,s') = " ++ show (sps,s')) ()
+      (sps,s') = splitPred psplit pstop s
+--    (sps,s') = splitPred p s
+      pstop x = x == '{' || x == '}'
+--    pstop x = x == '{'
+      psplit x = x == ' ' || pstop x
+--    p x = x == ' ' || x == '{'
+--    p x = not $ isAlphaNum x || x == '_' || x == '\''
+#if 1
+-- XXX In consideration of the recursion problem with mkTyConApp below,
+-- try to use typeOf instead -- but, this won't work! Because we are
+-- starting with a String encoding the ...
+-- ... or will it? We have to compare two strings; one comes from
+-- the user-supplied pattern string we're parsing; the other? We
+-- are not "comparing equality" here, it will be done later; we're
+-- only compiling a pattern...  So if the treps remain strings
+-- in a Pattern, until we're ready to make comparisons; it's
+-- inefficient unfortunately, but I feel this will work.
+--   More detail: B/c when it comes time to match the pattern,
+-- you DO have a concrete value (of some type); it is THEN that
+-- you apply (show . typeRepTyCon . typeOf) to it, and then
+-- make your Eq String comparison. [This can be optimised later;
+-- I'm concerned now with a proof-of-concept, without TH.]
+    treps = tnames
+#else
+    treps = map mktrep tnames
+-- XXX You need the recursion for (==) to work; that may not mean
+-- we can't use it, but will need some form of pattern-matching,
+-- as full equality is going to be disfunctional. (B/c user would
+-- have to specify the fully-recursive pattern [when they want to
+-- use wildcards or stop nodes down there] -- totally ridiculous.)
+--   This could be what :~: is for? (It's recursive, but you perhaps
+-- can use in patterns without going full depth?)
+-- mkTyConApp (mkTyCon3 "base" "Data.Either" "Either") [typeRep (Proxy::Proxy Bool), typeRep (Proxy::Proxy Int)] == typeRep (Proxy :: Proxy (Either Bool Int))
+    mktrep :: String -> TypeRep
+    mktrep tname = trep
+     where
+      tcon = mkTyCon3 "" "" tname
+      trep = mkTyConApp tcon []
+--mkTyCon3 :: 3xString -> TypeCon
+--mkTyConApp :: TyCon -> [TypeRep] -> TypeRep
+#endif
+
+-------------------------------------------------------------------------------
+
+  -- Split on the psplit predicate, stop consuming the list
+  -- on the pstop predicate.
+  splitPred :: (a -> Bool) -> (a -> Bool) -> [a] -> ([[a]], [a])
+  splitPred psplit pstop list = splitPred' psplit pstop list []
+  splitPred' :: (a -> Bool) -> (a -> Bool) -> [a] -> [[a]] -> ([[a]], [a])
+  splitPred' psplit pstop list acc
+   | null first  = {-trace "-1-" $-} (acc, rest)
+   | null rest   = {-trace "-2-" $-} (acc', [])  -- or (acc, rest), obv.
+   | pstop h     = {-trace "-3-" $-} (acc', rest)
+   | otherwise   = {-trace "-4-" $-} splitPred' psplit pstop t acc'
+   where
+    (first,rest) = break psplit list
+    (h:t) = rest
+    acc' = acc ++ [first]
+
+-------------------------------------------------------------------------------
+
+  -- | Inverse of 'compilePat'.
+  --
+  -- @'showPat' . 'compilePat' patstring  =  patstring@
+  --
+  -- provided that @'compilePat' patstring@ succeeds. (And, only up to
+  -- subpatterns elided from # ('WI' or 'TI') or from * ('WW', 'WN',
+  -- 'TW', 'TN', 'PW' or 'PN') nodes.)
+  showPat :: Pattern -> String
+  showPat (Node p chs)
+
+    | WR         <- p  = "."  ++ descend chs ++ perhapsEmptyBraces
+    | WS         <- p  = "."  ++ descend chs
+    | WN n       <- p  = "*"  ++ show n
+    | WI         <- p  = "#"  ++ descend chs
+#if USE_WW_DEEPSEQ
+    | WW         <- p  = "*"  ++ descend chs
+#endif
+
+#if PARALLELISM_EXPERIMENT
+    | PR         <- p  = "."  ++ descend chs ++ perhapsEmptyBraces
+    | PN n       <- p  = error "PN PatNode not yet supported (sorry!)"
+#if USE_WW_DEEPSEQ
+    | PW         <- p  = "#"  ++ descend chs
+#endif
+#endif
+
+    | TR treps   <- p  = ".:" ++ descendT treps chs ++ perhapsEmptyBraces
+    | TI treps   <- p  = "#:" ++ descendT treps chs
+--- | TS treps   <- p  = ".:" ++ descendT treps chs
+    | TN n treps <- p  = "*"  ++ show n ++ ":" ++ descendT treps chs
+#if USE_WW_DEEPSEQ
+    | TW treps   <- p  = "*:" ++ descendT treps chs
+#endif
+   where
+    perhapsEmptyBraces = if null chs then "{}" else ""
+  descend :: [Pattern] -> String
+  descend chs
+   | null chs = ""
+   | otherwise = "{" ++ concatMap showPat chs ++ "}"
+  descendT :: [String] -> [Pattern] -> String
+  descendT treps chs = treps_ ++ descend chs
+   where treps_ = concat (intersperse " " treps)
+
+-------------------------------------------------------------------------------
+
+  -- Note that Ord is derived, so the order that the constructors
+  -- are listed matters!  (This only affects GHC rules, SFAIK.)
+  -- (This data type is here, to avoid cyclical imports which
+  -- GHC pretty much is useless with.)
+  --------
+  -- On the one hand, we want to keep this lightweight -- it can in
+  -- principle be a single bit (Insulate/Propagate), as originally planned!
+  -- But the Spark thing was too useful; and Print and Error would
+  -- also be useful.  But they're more orthogonal.
+#if 0
+  type Spark = Bool
+  type PrintPeriod = Int
+  type ErrorMsg = String
+  data SeqNodeKind =
+           Insulate Spark PrintPeriod
+         | Conduct Spark PrintPeriod
+         | Force Spark PrintPeriod
+         | Error ErrorMsg
+    deriving ( Eq, Ord )
+#else
+  data SeqNodeKind =
+           Insulate
+---      | Conduct
+         | Propagate  -- XXX if include Conduct, then rename Propagate to Force
+#if PARALLELISM_EXPERIMENT
+         | Spark
+#endif
+-- These would break the Ord; and besides, they're sort of orthogonal
+-- (as is Spark)
+---      | Print Int
+---      | Error String
+    deriving ( Eq, Ord )
+#endif
+
+-------------------------------------------------------------------------------
+
diff --git a/src/Control/DeepSeq/Bounded/Seqable.hs b/src/Control/DeepSeq/Bounded/Seqable.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/DeepSeq/Bounded/Seqable.hs
@@ -0,0 +1,214 @@
+
+-------------------------------------------------------------------------------
+
+-- XXX Although there's nothing wrong with this, nevertheless
+-- GSeqable works so well, and is probably more performant,
+-- so going to just alias that here.
+
+-------------------------------------------------------------------------------
+
+-- XXX This no longer uses classes, so make sure that's
+-- reflected in all comments and documentation (here, and
+-- in other places!)...
+
+-------------------------------------------------------------------------------
+
+-- XXX This is finally working -- once I moved to DEPTH_TWO branches,
+-- ALL the tests passed, first go! (So nice to see!)
+--
+-- BUT (XXX), it would be really great if we can be CERTAIN that
+-- all "rnfn 2" calls are INLINED (RECURSIVELY, as it's not deep,
+-- in case there was any recursion).
+--
+-- Unfortunately, GHC can't inline recursive functions [?],
+-- but something should be done, and I hope it's not going
+-- back to class/instances here in Seqable...
+
+-------------------------------------------------------------------------------
+
+-- XXX Comments were preliminary, and are a bit rotten...
+
+-- The plan for this is an optimised, specialised version of NFDataN.
+-- It will handle only two possible depths (so it takes one Bit of
+-- information for it's depth argument, only).
+--
+-- I'm not yet certain this will be generally useful, but it
+-- is closer to the model of what I would like to see offered
+-- by the Haskell RTS itself...
+--
+-- Semantically:
+--
+--   seq_ :: Bit -> a -> b -> b
+--   seq_ 0 x y = deepseqn 1 x y
+--   seq_ 1 x y = deepseqn 2 x y
+--   seq_ n _ _ = error.
+--
+-- The difference is that seq_ has been specialised and optimised
+-- for the fact that it's only defined for two, shallow depths.
+-- Just enough to prime recursion.
+--
+-- This is "only useful" when multiple seq_'s are working
+-- in tandem within an extended expression/value.
+--
+-- This can be controlled dynamically (see <seqaid> project);
+-- and ideally it would be part of the RTS...
+--
+-- Another bonus is, all of Seqable.hs and GSeqable.hs [?]
+-- are in the HASKELL98_FRAGMENT.
+
+-------------------------------------------------------------------------------
+
+  {-  LANGUAGE CPP #-}  -- specified in .cabal default-extensions
+
+#define DEPTH_TWO 1
+
+#define USE_NFDATA_SUPERCLASS 0
+
+-------------------------------------------------------------------------------
+
+  -- Later: I'm not so sure about this, actually; is the arithmetic
+  -- on n actually not piling up thunks, without the bang-patterns?
+  --
+  -- It would be easy to get rid of the bang-patterns.
+  -- The Complex instance is done as an example.
+  -- If you do go with the case's, probably want -fno-warn-name-shadowing.
+  {-# LANGUAGE BangPatterns #-}
+  {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+
+  {-# LANGUAGE Rank2Types #-}
+
+  {-# LANGUAGE ScopedTypeVariables #-}
+
+-------------------------------------------------------------------------------
+
+-- |
+-- Module      :  Control.DeepSeq.Bounded.Seqable
+-- Copyright   :  (c) 2014, Andrew G. Seniuk
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  Andrew Seniuk <rasfar@gmail.com>
+-- Stability   :  provisional
+-- Portability :  GHC (uses SOP)
+--
+-- This module provides an overloaded function, 'seq_', for efficiently
+-- switching between @'forcen' 0@ and @'forcen' 2@.  This is useful for
+-- connecting units of forcing (propagating demand).  It was motivated
+-- for use with auto-instrumentation, where 'seq_' can be injected
+-- at every node of the AST (refer to the <seqaid> project).
+-- Each node carries a couple bits of information, determining which
+-- depth (0 or 2) is in force, and whether to spark parallel evaluation
+-- when the depth is 2.  This state can be configured statically
+-- or dynamically.
+
+-------------------------------------------------------------------------------
+
+  module Control.DeepSeq.Bounded.Seqable (
+
+      rnf_
+    , force_
+    , seq_
+
+    , SeqNodeKind(..)  -- re-export
+
+-- Must await seqaid implementation:
+#if 0
+    , mkSeqableHarness
+--  , initSeqableHarness
+#endif
+
+  ) where
+
+-------------------------------------------------------------------------------
+
+#if PARALLELISM_EXPERIMENT
+  import Control.Parallel ( par )
+#endif
+
+--import Data.Generics ( GenericT, mkT, everywhere )
+
+  import Control.DeepSeq.Bounded.NFDataN
+  import Control.DeepSeq.Bounded.Pattern
+
+--import Data.Typeable ( Typeable )
+--import Data.Data ( Data )
+
+#if JUST_ALIAS_GSEQABLE && ! HASKELL98_FRAGMENT
+  import Control.DeepSeq.Bounded.Generics.GSeqable
+  import Generics.SOP ( Generic )
+#else
+  import Control.DeepSeq.Bounded.Pattern ( SeqNodeKind(..) )
+#endif
+
+-------------------------------------------------------------------------------
+
+-- Had to move (to Pattern.hs), due to GHC ongoing restrictions
+-- making cyclical imports nearly impossible, even if the
+-- dependency graph, of exports actually used, is acyclic.
+#if 0
+  -- Note that Ord is derived, so the order that the constructors
+  -- are listed matters!  (This only affects GHC rules, SFAIK.)
+  data SeqNodeKind =
+           Insulate
+         | Propagate
+         | Spark
+    deriving ( Eq, Ord )
+#endif
+
+-------------------------------------------------------------------------------
+
+-- infixr 0 $!!
+
+-------------------------------------------------------------------------------
+
+#if JUST_ALIAS_GSEQABLE && ! HASKELL98_FRAGMENT
+#if 1
+  rnf_ :: forall a. Generic a => SeqNodeKind -> a -> ()
+  rnf_ = grnf_
+  force_ :: forall a. Generic a => SeqNodeKind -> a -> a
+  force_ = gforce_
+  seq_ :: forall a b. Generic a => SeqNodeKind -> a -> b -> b
+  seq_ = gseq_
+#else
+  rnf_ = grnf_ :: forall a. Generic a => SeqNodeKind -> a -> ()
+  force_ = gforce_ :: forall a. Generic a => SeqNodeKind -> a -> a
+  seq_ = gseq_ :: forall a b. Generic a => SeqNodeKind -> a -> b -> b
+#endif
+#else
+
+-------------------------------------------------------------------------------
+
+  rnf_ :: NFDataN a => SeqNodeKind -> a -> ()
+  rnf_ Insulate     a  =                ()
+#if PARALLELISM_EXPERIMENT
+  rnf_ Propagate    a  = rnfn 2 a `seq` ()
+  rnf_ {-Spark-}_   a  = rnfn 2 a `par` ()
+#else
+  rnf_ {-Propagate-}_ a  = rnfn 2 a `seq` ()
+#endif
+
+-------------------------------------------------------------------------------
+
+  force_ :: NFDataN a => SeqNodeKind -> a -> a
+  force_ Insulate     a  =                a
+#if PARALLELISM_EXPERIMENT
+  force_ Propagate    a  = rnfn 2 a `seq` a
+  force_ {-Spark-}_   a  = rnfn 2 a `par` a
+#else
+  force_ {-Propagate-}_ a  = rnfn 2 a `seq` a
+#endif
+
+-------------------------------------------------------------------------------
+
+  seq_ :: NFDataN a => SeqNodeKind -> a -> b -> b
+  seq_ Insulate     a b  =                b
+#if PARALLELISM_EXPERIMENT
+  seq_ Propagate    a b  = rnfn 2 a `seq` b
+  seq_ {-Spark-}_   a b  = rnfn 2 a `par` b
+#else
+  seq_ {-Propagate-}_ a b  = rnfn 2 a `seq` b
+#endif
+
+-------------------------------------------------------------------------------
+
+#endif
+
diff --git a/test/Blah.hs b/test/Blah.hs
new file mode 100644
--- /dev/null
+++ b/test/Blah.hs
@@ -0,0 +1,2982 @@
+
+-------------------------------------------------------------------------------
+
+-- Disclaimer: I've not used HUnit yet. I'm using it only
+-- as a "hook" so can compile/test in less clock time...
+-- (I forget the details of how why.)
+--
+-- Obviously, this should use proper HUnit eventually.
+-- And QuickCheck and SmallCheck, DEFINITELY!!!...
+-- This is a great case for those; and shape-syb no less.
+--
+-- This file could be cleaned up a lot, but that's
+-- not quite a priority at the moment...
+--
+-- The reason I shied away from making it real HUnit tests
+-- is probably related to the fancy exception throwing/catching
+-- and catching of all exceptions (including error), etc.
+-- Which was aggravated by the nature of this project and
+-- of its tests, which hit bottom as a matter of course...
+--
+-- Yeah; and looking at examples of QuickCheck and SmallCheck,
+-- it's still not clear to me how to work bottoming-out
+-- into my tests.
+--   I guess I could catch the bottoms in my code, and return
+-- some reserved value to indicate that it occurred?...
+
+-------------------------------------------------------------------------------
+
+{-# LANGUAGE CPP #-}
+
+-------------------------------------------------------------------------------
+
+#define FOCUS_TEST 0
+#define USE_TRACE 0
+
+-------------------------------------------------------------------------------
+
+-- Later: This may work with some versions of GHC, but I'm quite
+-- sure I've seen it not work with some recent version...
+-- Unfortunately, this doesn't work -- all pragmas are processed,
+-- regardless of CPP (so CPP must run after).
+-- The fact the CPP itself can be set via a pragma complicates this.
+-- It could be made an exception, and the LANGUAGE CPP pragma could
+-- be parsed regardless of CPP context (as all pragmas currently are).
+-- As it is, we need separate source modules, and to switch at
+-- import statements (and in the .cabal file).
+-- THIS IS A BUG.
+-- So anyhow, this is only here as a reminder:
+---  #if ! HASKELL98_FRAGMENT
+---  {-# LANGUAGE ... #-}
+---  #endif
+  {-# LANGUAGE DeriveGeneric #-}
+  {-# LANGUAGE DeriveDataTypeable #-}  -- to make BottomedOut
+  {-# LANGUAGE BangPatterns #-}
+
+  {-# LANGUAGE Rank2Types #-}  -- for SYB (testing rnfpDyn and friends)
+
+-------------------------------------------------------------------------------
+
+  -- SOP pragmas:
+
+  -- Not necessarily needed to work with SOP, but I think it'll
+  -- be helpful here [?] ...
+  {-# LANGUAGE ScopedTypeVariables #-}
+  {-  LANGUAGE AllowAmbiguousTypes #-}
+
+-- Actually, CPP doesn't work with Haskell (GHC) pragmas last I checked...
+#if USE_SOP
+  {-# LANGUAGE DataKinds #-}
+  {-# LANGUAGE TypeFamilies #-}
+  {-# LANGUAGE ConstraintKinds #-}
+  {-# LANGUAGE TemplateHaskell #-}
+#endif
+
+-------------------------------------------------------------------------------
+
+  module Blah ( run_tests ) where
+
+-------------------------------------------------------------------------------
+
+  import Bottom
+  import Foo
+  import FooG
+
+--import     Control.DeepSeq.Generics
+  import Control.DeepSeq.Bounded
+--import Control.DeepSeq.Bounded hiding ( F )
+  import Control.DeepSeq.Bounded.Generics
+
+#if 0
+  import GHC.Generics
+--import GHC.Generics ( Generic )
+#endif
+
+  import Data.Maybe
+
+  import Control.Exception
+--import Control.Monad ( guard )
+  import Control.Monad ( replicateM )
+  import Control.Monad ( when )
+  import Data.Typeable ( Typeable )
+  import Data.Typeable ( typeOf )
+
+  import Data.Data ( Data )
+
+  import Data.Generics.Aliases ( mkQ, extQ, GenericQ )
+
+--import Util ( spoor )
+  import Debug.Trace ( trace )
+  import Control.DeepSeq
+
+  import Data.Typeable ( Proxy(..) )
+
+#if USE_SOP
+  import Generics.SOP hiding ( Shape )
+#endif
+
+  import System.Random
+
+  import System.IO.Unsafe ( unsafePerformIO )
+
+-------------------------------------------------------------------------------
+
+  -- For convenience in GHCi interactive sessions:
+  cp = compilePat
+  ip = intersectPats
+  isp = isSubPatOf
+
+  -- For more compact test expressions:
+-- XXX Refer to Seqable.hs for comments about JUST_ALIAS_GSEQABLE.
+#if 1
+#if JUST_ALIAS_GSEQABLE
+  fI :: forall a. Generic a => a -> a
+  fI = force_ Insulate
+  fP :: forall a. Generic a => a -> a
+  fP = force_ Propagate
+#else
+  fI :: forall a. NFDataN a => a -> a
+  fI = force_ Insulate
+  fP :: forall a. NFDataN a => a -> a
+  fP = force_ Propagate
+#endif
+#else
+  fI = force_ Insulate
+  fP = force_ Propagate
+#endif
+
+  gI :: forall a. Generic a => a -> a
+  gI = gforce_ Insulate
+  gP :: forall a. Generic a => a -> a
+  gP = gforce_ Propagate
+
+-------------------------------------------------------------------------------
+
+  run_tests = do
+
+    putStr "\n"
+    -- So can notice the start when scrollback, esp. in ghci reload/reruns.
+--  replicateM 50 $ putStrLn "################################################################################"
+    putStrLn "\nTesting.\n"
+
+#if ! FOCUS_TEST
+
+#if 1
+--  let shp s = s ++ replicate (30 - length s) ' ' ++ show (compilePat s)
+    let shp s = 
+         unsafePerformIO $ 
+         catch
+          ( return $! force $ s ++ replicate (30 - length s) ' ' ++ show (compilePat s) )
+          ( \e -> do let err = show (e :: ErrorCall)
+                     return err )
+
+    putStrLn "Pattern                       Compiles to"
+--  putStrLn $ shp ""  -- empty pattern syntax error
+    putStrLn $ shp "*"  -- Node WW []
+--  putStrLn $ shp "@"  -- Node WS []  -- obsoleted (use "." w/o children)
+    putStrLn $ shp "#"  -- Node I []  -- no parent to absorb (should be error)
+    putStrLn $ shp "."  -- Node WS []
+--  putStrLn $ shp "**"  -- Node WS []  -- "disconnected pattern (not rooted)"
+--  putStrLn $ shp ".*"  -- Node WS []  -- "disconnected pattern (not rooted)"
+--  putStrLn $ shp "*."  -- Node WS []  -- "disconnected pattern (not rooted)"
+    putStrLn $ shp ".{}"  -- Node WR []
+    putStrLn $ shp ".{*}"  -- Node WR [Node WW []]
+    putStrLn $ shp ".{**}"  -- Node WR [Node WW [],Node WW []]
+    putStrLn $ shp ".{.*}"  -- Node WR [Node WS [],Node WW []]
+    putStrLn $ shp ".{#.}"  -- Node WR [Node I [],Node WS []]
+    putStrLn $ shp ".{#{#}}"  -- Node WR [Node I []] with warning
+    putStrLn $ shp ".{.{#}}"  -- Node WR [Node WR [Node I []]]
+    putStrLn $ shp ".{*#*#*#**#*#*}"  -- looks fine
+    putStrLn $ shp ".{*#.{*#.{*#}*}*{#*}#*}"  -- warning about *{...}
+    putStrLn $ shp ".{*#.{*#.{*#}*}*#*}"
+--  putStrLn $ shp ".{*#.{*#.{*#}*}{*}{#*}#*}"  -- }{ syntax error
+-- [old comment for that last:] NodeM WR [NodeM WW [],Nil,NodeM WR [NodeM WW [],Nil,NodeM WR [NodeM WW [],Nil],NodeM WW [],NodeM WW [],Nil,NodeM WW []],Nil,NodeM WW []] -- was wrong but is fixed I think
+    putStrLn $ shp ".{.*.{*23*}}"
+#if PARALLELISM_EXPERIMENT
+    putStrLn $ shp ".{.=*.{=*23*}}"
+#endif
+#endif
+
+#endif
+
+#if ! FOCUS_TEST
+
+#if 1
+    let test_patterns10 = [
+           (4,  "")  -- syntax error
+         , (4,  ".##")  -- syntax error (disconnected pattern)
+         , (1,  ".{.##}")  -- fail
+         , (5,  ".{.{}#{}#{}}")
+         , (2,  "*")
+         , (2,  ".{***}")
+         , (1,  ".{###}")
+         , (1,  ".{*##}")
+         , (2,  ".{**#}")
+         , (2,  ".{##*}")
+
+           -- Remember, [a] is a recursive binary ctor app!...
+           -- The next four tests give instance errors for [a], but if
+           -- testing expTG_* (GNFDataP/grnfp) then it's no longer a list...
+         , (13, ".{..{*#*}#}")
+         , (13, ".{..{*###}#}")
+         , (13, ".{..{*####}#}")
+         , (23, ".{..{*####}.}")
+
+         , (2,  ".{..{*#}*}")
+         , (1,  ".{..{*#}#}")
+         , (1,  ".{..{*.{#*}}#}")
+         , (2,  ".{..{*.{*#}}#}")
+         , (13, ".{..{.{..{#*}}}#}")  -- See above comment about [a] instance
+         , (2,  ".{#.{..{..{#*}}}#}")
+
+           -- (See Book, p.84.)
+         , (1,  ".{..{..{#.{..}}}#}")
+         , (1,  ".{..{..{#*}}#}")
+         , (1,  ".{*.{*.{#*}}#}")
+         , (2,  ".{##*}")
+         , (2,  ".{*#*}")
+         , (1,  ".:Tuple3{*.{*.{#*}}#}")  -- oops...
+         , (1,  ".:(,,){*.{*.{#*}}#}")
+         , (2,  ".:(,,){*.{*.{.*}}#}")
+         , (1,  ".:Bool{***}")  -- XXX makes no sense (but works) -- oh well;
+                                  -- this is an important point to note in
+                                  -- docs/blog also...
+         , (1,  "*:Bool")
+         , (2,  "*:(,,)")
+         , (2,  ".{*#.}")
+         , (2,  ".{*#.:Bool}")  -- XXX this gives parse error on 2nd .
+         , (2,  ".{*#.:Bool{}}")  -- XXX this gives no parse error; if it does what
+                                  -- it says, it will only match a childless Bool node
+         , (1,  ".{*#.:Int{}}")  -- still need to implement # when not in type
+         , (1,  ".{*#.:(,){}}")  -- still need to implement # when not in type
+         , (1,  ".{*#.:Int }")  -- still need to implement # when not in type
+         , (1,  ".{*#.:Int'}")  -- still need to implement # when not in type
+         , (1,  ".{*##:Bool}")
+         , (2,  ".{*##:Int}")
+         , (2,  ".{*##:(,)}")
+         , (1,  ".{*##:Bool{}}")
+         , (2,  ".{*##:Int{}}")
+         , (2,  ".{*##:(,){}}")
+         , (1,  ".{**2#}")
+         , (2,  ".{**3#}")
+         , (1,  ".{*#:G2{}#}")
+         , (1,  ".{*#:Int{}#}")
+         ]
+    doit14 True test_patterns10
+--  doit10 True test_patterns10
+#endif
+
+#if USE_SOP
+
+-- Seems fine; it's not a good test as the # in the middle
+-- only forces one ctor when type doesn't match, and need
+-- to force one more level to hit an undefined.
+#if 1
+    let test_patterns11 = [
+           (4,  "")  -- syntax error
+#if 0
+         , (4,  ".##")  -- syntax error (disconnected pattern)
+         , (1,  ".{.##}")  -- fail
+         , (5,  ".{.{}#{}#{}}")
+         , (2,  "*")
+         , (2,  ".{***}")
+         , (1,  ".{###}")
+         , (1,  ".{*##}")
+         , (2,  ".{**#}")
+         , (2,  ".{##*}")
+
+           -- Remember, [a] is a recursive binary ctor app!...
+           -- The next four tests give instance errors for [a], but if
+           -- testing expTG_* (GNFDataP/grnfp) then it's no longer a list...
+         , (13, ".{..{*#}#}")
+         , (13, ".{..{*###}#}")
+         , (13, ".{..{*####}#}")
+         , (23, ".{..{*####}.}")
+
+         , (2,  ".{..{*##}*}")
+         , (1,  ".{..{*##}#}")
+         , (1,  ".{..{*#*}#}")
+         , (2,  ".{..{**#}#}")
+
+           -- (See Book, p.84.)
+         , (1,  ".{..{.#.}#}")
+         , (1,  ".{..{.#*}#}")
+         , (1,  ".{*.{*#*}#}")
+         , (2,  ".{##*}")
+         , (2,  ".{*#*}")
+         , (1,  ".:Tuple3{*.{*#*}#}")  -- oops...
+         , (1,  ".:(,,){*.{*#*}#}")
+         , (2,  ".:(,,){*.{*.*}#}")
+         , (1,  ".:Bool{***}")  -- XXX makes no sense (but works) -- oh well;
+                                -- this is an important point to note in
+                                -- docs/blog also...
+         , (1,  "*:Bool")
+         , (2,  "*:(,,)")
+         , (2,  ".{*#.}")
+         , (2,  ".{*#.:Bool}")  -- XXX this gives parse error on 2nd .
+         , (2,  ".{*#.:Bool{}}")  -- XXX this gives no parse error; if it does what
+                                  -- it says, it will only match a childless Bool node
+         , (1,  ".{*#.:Int{}}")  -- still need to implement # when not in type
+         , (1,  ".{*#.:(,){}}")  -- still need to implement # when not in type
+         , (1,  ".{*#.:Int }")  -- still need to implement # when not in type
+         , (1,  ".{*#.:Int'}")  -- still need to implement # when not in type
+         , (1,  ".{*##:Bool}")
+         , (2,  ".{*##:Int}")
+         , (2,  ".{*##:(,)}")
+         , (1,  ".{*##:Bool{}}")
+         , (2,  ".{*##:Int{}}")
+         , (2,  ".{*##:(,){}}")
+         , (1,  ".{**0#}")
+         , (1,  ".{**1#}")
+         , (2,  ".{**2#}")
+         , (2,  ".{**3#}")
+#endif
+         , (1,  ".{*#:G2{}#}")
+         , (1,  ".{*#:Int{}#}")
+         ]
+    doit15 True test_patterns11
+#endif
+
+#endif
+
+#if USE_SOP
+
+-- All fine last checked.
+#if 1
+    let test_patterns12 = [
+#if 0
+           (1, ".{.##}")
+#else
+#if 1
+           (4, "..")
+
+         , (2, "*")
+         , (1, "*0")
+         , (1, "*1")
+         , (2, "*2")
+         , (2, "*3")
+
+#if 1
+
+         , (1, ".{.#.}")
+         , (2, ".{...}")
+
+         , (1, "*:TG")  -- (misuse; TG is a type name, not the name of a ctor)
+         , (1, "*:G1")
+         , (2, "*:G2")
+         , (1, "*:G1{..}")
+         , (1, "*:G1{...}")
+         , (2, "*:G2{..}")
+         , (2, "*:G2{...}")
+
+         -- the getter used makes the rest uninteresting (none touch bottom)
+         , (1, "#:G1")
+         , (1, "#:G2")
+         , (1, "#:G1{..}")
+         , (1, "#:G1{...}")
+--       , (6, "#:G1{...}")
+         , (1, "#:G2{..}")
+         , (1, "#:G2{...}")
+
+         , (1, ".:G1{..}")
+         , (1, ".:G1{...}")
+         , (1, ".:G2{..}")
+         , (2, ".:G2{...}")
+#endif
+#else
+           (2, "#:G1{}")
+         , (1, "#:G2{}")
+         , (2, "#:Int{}")
+         , (1, "*:G1")
+         , (2, "*:G2")
+         , (1, "*:G1{}")
+         , (2, "*:G2{}")
+         , (1, "*:Int{}")
+         , (2, "*:G2{..}")
+         , (2, "*:G2{...}")
+         , (2, "*{..}")
+         , (2, "*{....}")
+         , (1, ".{..}")
+         , (2, ".{...}")
+         , (1, ".{....}")
+#endif
+#endif
+         ]
+    doit16 True test_patterns12
+#endif
+
+#endif
+
+#if USE_SOP
+
+-- This should work, once the patterns are right for lists,
+-- but until I get non-list generic tests working I'm not
+-- going to struggle with this.
+#if 0
+    let test_patterns13 = [
+-- expTH_1 = H2 1 [H1 2.3, H3, H4 (H3, I3 I2 (H1 4.5))] False    (for ref.)
+-- expTH_4 = H2 1 [H1 2.3, H3, H4 (__, I3 __ (H1 4.5))] __       (in use)
+           (4,  "")  -- syntax error
+         , (1,  ".{..{..{..{.{#.{#.}}.}}}#}")
+         , (2,  ".{..{..{..{.{..{#.}}.}}}#}")
+         , (2,  ".{..{..{..{.{#.{..}}.}}}#}")
+         , (2,  ".{..{..{..{.{#.{#.}}.}}}.}")
+         , (1,  ".{..{.{.}.{..{.{#.{#.{.}}}.}}}#}")
+         , (2,  ".{..{.{.}.{..{.{..{#.{.}}}.}}}#}")
+         , (2,  ".{..{.{.}.{..{.{#.{..{.}}}.}}}#}")
+         , (2,  ".{..{.{.}.{..{.{#.{#.{.}}}.}}}.}")
+         , (2,  ".{..{.{.}.{..{.{#.{#..{.}}}.}}}.}")
+         ]
+    doit17 True test_patterns13
+#endif
+
+#if 1
+    let test_patterns14 = [
+-- expTJ_1 = J2 ( 1, J4 ( J3, K3 K2 ( J1 4.5))) False     -- for ref.
+-- expTJ_2 = J2 ( 1, J4 ( J3, K3 __ ( J1 4.5))) False
+-- expTJ_3 = J2 ( 1, J4 ( __, K3 K2 ( J1 4.5))) False
+-- expTJ_4 = J2 ( 1, J4 ( __, K3 __ ( J1 4.5))) __        -- in use
+--           {  { {} {  { {}  {  {} { {  {} }}}}}}}
+-- XXX The tuples are ctors, I forgot...
+           (4 ,  "")  -- syntax error
+#if 0
+         , (1 ,  ".")
+         , (13,  ".{}")
+         , (13,  ".{.}")
+         , (2 ,  ".{..}")
+         , (13,  ".{...}")
+         , (13,  ".{....}")
+         , (13,  ".{.....}")
+#endif
+-- expTJ_1 = J2 ( 1, J4 ( J3, K3 K2 ( J1 4.5))) False     -- for ref.
+--                J2 { (,) { I J4 { (,) { J3 K3 { K2 { J1 { 4.5 } } } } } } False }
+--                .  {  .  { .  . {  .  { .  .  {  . { .  { .   } } } } } } . }
+           -- this pattern also double-checked on paper
+         , (2 ,  ".{.{..{.{..{..{.}}}}}.}")
+--       , (1 ,  ".{.{..{.{..{#.{.}}}}}#}")  -- blows (in partic. expTJ_2)
+         , (1 ,  ".{.{..{.{#.{..{.}}}}}#}")  -- blows (in partic. expTJ_3)
+--       , (1 ,  ".{.{..{.{#.{#.{.}}}}}#}")  -- blows (in partic. expTJ_4)
+#if 0
+         , (1 ,  ".{.{..{#{##{##{#}}}}}#}")  -- = ".{.{..{#}}#}" (no blow)
+         , (1 ,  ".{.{..{#{#.{#.{.}}}}}#}")  -- = ".{.{..{#}}#}" (no blow)
+         , (1 ,  ".{.{..{#{..{#.{.}}}}}#}")  -- = ".{.{..{#}}#}" (no blow)
+         , (1 ,  ".{.{..{.{..{#.{.}}}}}#}")  -- blows
+         , (1 ,  ".{.{..{.{##{##{#}}}}}#}")  -- blows
+         , (1 ,  ".{.{..{#}}#}")             -- confirming (no blow)
+#endif
+#if 0
+         , (2 ,  ".{.{..{.{..{.{.{.}}}}}}.}")
+         , (1 ,  ".{.{..{.{#.{#{.{.}}}}}}#}")
+         , (1 ,  "#{#{##{#{##{#{#{#}}}}}}#}")
+         , (1 ,  ".{#{##{#{##{#{#{#}}}}}}#}")
+         , (1 ,  ".{.{##{#{##{#{#{#}}}}}}#}")
+         , (1 ,  ".{.{..{#{##{#{#{#}}}}}}#}")
+#endif
+#if 0
+         , (1,  ".{..{#.{#.{.}}}#}")
+         , (2,  ".{..{..{..{.}}}.}")
+         , (2,  "*")
+         , (2,  ".{.*.}")
+         , (2,  ".{***}")
+#endif
+         ]
+    doit18 True test_patterns14
+#endif
+
+#if 1
+    let test_patterns14b = [
+-- expTJ_5 = J2 ( 1, J4 ( __, K2 )) False
+           (4 ,  "")  -- syntax error
+         , (2 ,  ".{.{..{.{..}}}.}")
+         , (1 ,  ".{.{..{.{#.}}}.}")
+         , (1 ,  ".{.{..{#{..}}}.}")
+         , (1 ,  ".{.{.#{.{..}}}.}")
+         ]
+    doit18b True test_patterns14b
+#endif
+
+#if 1
+    let test_patterns14c = [
+-- expTJ_6 = J4 ( __, K2 ) False
+           (4 ,  "")  -- syntax error
+         , (2 ,  ".{.{..}}")
+         , (1 ,  ".{.{#.}}")
+         , (1 ,  ".{#{..}}")
+         , (1 ,  "#{.{..}}")
+         ]
+    doit18c True test_patterns14c
+#endif
+
+#if 1
+    let test_patterns14d = [
+-- expTJ_7 = ( __, K2 )
+           (4 ,  "")  -- syntax error
+         , (2 ,  ".{..}")
+         , (1 ,  ".{#.}")
+         , (1 ,  "#{..}")
+         ]
+    doit18d True test_patterns14d
+#endif
+
+#if 1
+    let test_patterns14e = [
+-- expTJ_8 = __ :: TJ
+           (4 ,  "")  -- syntax error
+         , (2 ,  ".")
+         , (1 ,  "#")
+         ]
+    doit18e True test_patterns14e
+#endif
+
+#if 1
+    let test_patterns14f = [
+-- expTJ_8 = (K5 (__::TJ))
+           (4 ,  "")  -- syntax error
+         , (1 ,  ".")
+         , (1 ,  ".{#}")
+         , (2 ,  ".{.}")
+         , (1 ,  "#")
+         ]
+    doit18f True test_patterns14f
+#endif
+
+-- These work!
+#define TRY_THIS 1
+#if 1
+    let test_patterns14g = [
+#if TRY_THIS
+-- exp = K3 (__::TK) J3
+#else
+-- exp = K3 K2 (__::TJ)
+#endif
+           (4 ,  "")  -- syntax error
+         , (1 ,  ".")
+#if TRY_THIS
+         , (1 ,  ".{#.}")
+         , (2 ,  ".{.#}")
+#else
+         , (2 ,  ".{#.}")
+         , (1 ,  ".{.#}")
+#endif
+         , (2 ,  ".{..}")
+         , (1 ,  "#")
+         ]
+    doit18g True test_patterns14g
+#endif
+
+-- Okay last I checked.
+#if 1
+    let test_patterns15 = [
+-- expTL_1 = L1 5.6 (M1 True)
+-- expTL_2 = L1 5.6 (M1 __)
+-- expTL_3 = L1 5.6 __
+-- expTL_4 = L1 __ (M1 True)
+           (4 ,  "")  -- syntax error
+#if 0
+#elif 1
+         , (1 ,  "#")
+         , (5 ,  "#{..}")
+         , (1 ,  ".{..}")
+         , (2 ,  ".{.{.}.}")
+         , (1 ,  ".{.{#}.}")
+#elif 0
+         , (1 ,  "#")
+         , (5 ,  "#{..}")
+         , (2 ,  ".{..}")
+         , (1 ,  ".{#.{.}}")
+#elif 0
+         , (1 ,  "#")
+         , (5 ,  "#{..}")
+         , (2 ,  ".{..}")
+         , (2 ,  ".{..{.}}")
+         , (2 ,  ".{..{#}}")
+#elif 0
+         , (1 ,  "#")
+         , (5 ,  "#{..}")
+         , (1 ,  ".{..}")
+         , (2 ,  ".{..{.}}")
+         , (1 ,  ".{..{#}}")
+#endif
+         ]
+    doit19 True test_patterns15
+#endif
+
+-- Good test case for the problem. No tuples; every step is generic.
+#if 1
+    let test_patterns16 = [
+-- expTK_1 = K3 K2 ( J1 4.5)     -- for ref.
+-- expTK_2 = K3 __ ( J1 4.5)
+--           {  {} { {  {} }}}
+-- XXX Don't forget tuples are ctors...
+           (4 ,  "")  -- syntax error
+#if 0
+         , (2 ,  ".{..}")
+         , (1 ,  ".{#.}")
+         , (2 ,  ".{.#}")
+         , (1 ,  ".{##}")
+#else
+         , (2 ,  ".{..{.}}")  -- ok
+         , (1 ,  ".{##}")     -- X
+         , (1 ,  ".{#.}")     -- X
+         , (1 ,  ".{#.{#}}")  -- X
+         , (1 ,  ".{#.{.}}")  -- X
+         , (2 ,  ".{.#{.}}")  -- X  & this does give the # with subpat. warning.
+         , (2 ,  ".{.#{#}}")  -- X  & why no warning about # with subpattern?
+         , (1 ,  ".{##{#}}")  -- X  & why no warning about # with subpattern?
+         , (1 ,  "#{##{#}}")  -- ok & why no warning about # with subpattern?
+#endif
+         ]
+    doit20 True test_patterns16
+#endif
+
+#endif
+
+---------------------------------------------
+
+#endif
+
+-- Later: Oh! Don't be silly -- it's all compile-time, and the
+-- size or shape of the list is irrelevant -- which rules
+-- will fire depends on THIS FILE'S SOURCE CODE (not it's
+-- data, including static values)!
+-- XXX Even with empty list, the same rule firings occur!...
+-- If comment out this block however, the rules do not fire!
+#if 1
+    -- Testing composition and union:
+    let test_patterns11 = [
+           (1, ".", ".")
+         , (2, ".", "*")
+         , (2, "*", ".")
+         , (2, "*", "*")
+         , (2, ".{...}", ".{*..}")
+         , (2, ".{*..}", ".{..*}")
+         , (2, ".{.*#}", ".{.#.}")
+         ]
+    doit11 True test_patterns11
+#endif
+
+#if ! FOCUS_TEST
+
+#if 1
+    -- Testing splicePats
+    let test_patterns12 = [
+           (1, ".", [], [(0,"*")])
+         , (1, ".{}", [], [(0,"*")])
+         , (1, ".", [0], [(0,"*")])
+         , (1, ".{..}", [], [(0,"*")])
+         , (1, ".{..}", [0], [(0,"*")])
+         , (1, ".{..}", [2], [(0,"*")])
+         , (1, ".{..}", [], [(0,"*"),(0,"#")])
+         , (1, ".{..}", [], [(0,"*"),(1,"#")])
+         , (1, ".{..}", [], [(1,"#"),(0,"*")])
+         , (1, ".{..}", [], [(0,"*"),(2,"#")])
+         , (1, ".{..}", [], [(2,"*"),(2,"#"),(2,"#")])
+         , (1, ".{..}", [], [(-1,"*")])
+         , (1, ".{..}", [], [(0,"*")])
+         , (1, ".{..}", [], [(1,"*")])
+         , (1, ".{..}", [], [(2,"*")])
+         , (1, ".{..}", [], [(3,"*")])
+         , (1, ".{..{..}.}", [1], [(0,"*")])
+         , (1, ".{..{..}.}", [1], [(0,"*3"),(1,"#"),(2,"*")])
+         , (1, ".{..{..}.}", [1,0], [(0,"*"),(0,"#")])
+         , (1, ".{.{...}.{.{}.}.}", [1], [(0,"*"),(0,"#")])
+         , (1, ".{.{...}.{.{}.}.}", [1,0], [(0,"*"),(0,"#")])
+         , (1, ".{.{###}.{.{}#}#}", [1,0], [(0,"*"),(0,"#")])
+         , (1, ".{.:(,,){###}.{.{}#}#}", [1,0], [(0,"*"),(0,"#")])
+         ]
+    doit12 True test_patterns12
+#endif
+
+#if 1
+    -- Testing elidePats
+    -- XXX There's a nice way to do this, by rewriting each test
+    -- automatically (or via manual regex substitutions) so that
+    -- the target is the result of the corresponding splicePats test.
+    -- Unfortunately, the expected results are not encoded for
+    -- the splicePats test, so oh well, for now at least, just
+    -- build some fresh tests!
+    let test_patterns12b = [
+           (1, ".{.{..}..{.}}", [], [0])
+         , (1, ".{.{..}..{.}}", [0], [0])
+         , (1, ".{.{..}..{.}}", [1], [0])
+         , (1, ".{.{..}..{.}}", [1], [1])
+         ]
+    doit12b True test_patterns12b
+#endif
+
+#endif
+
+#if ! FOCUS_TEST
+
+#if 1
+    -- Testing erodePat
+    -- XXX Note we toss the stdgen when done here...
+    stdgen12c <- newStdGen
+--  let stdgen12c = mkStdGen seed
+    let test_patterns12c = [
+           (1, ".{.{..}..{.}}", [])  -- recursive test...
+         ]
+--  stdgen12c <- doit12c True test_patterns12c
+#if 0
+    stdgen12c' <- doit12c True test_patterns12c stdgen12c
+    stdgen12c'' <- doit12c True test_patterns12c stdgen12c'
+    stdgen12c''' <- doit12c True test_patterns12c stdgen12c''
+    return ()
+#else
+#if 1
+    stdgen12c' <- doit12c True test_patterns12c stdgen12c 5
+    return ()
+#else
+    doit12c True test_patterns12c stdgen12c
+      >>= doit12c True test_patterns12c
+      >>= doit12c True test_patterns12c
+      >>= doit12c True test_patterns12c
+      >>= doit12c True test_patterns12c
+      >>= doit12c True test_patterns12c
+      >>= doit12c True test_patterns12c
+      >>= doit12c True test_patterns12c
+      >>= doit12c True test_patterns12c
+#endif
+#endif
+#endif
+
+#endif
+
+#if 1
+    -- Testing anything else we can with a single function!
+    -- (Getting sick of this cloning.)
+    -- Functions are listed in (current) export order.
+    -- Things still needing testing are >'d.
+    -- Things tested but failing some tests have a *.
+    -- 
+    -- XXX Wow does this ever look cleaner with "Pat" instead of "Pattern"!...
+    -- Fortunately splicePats is already tested separately; the rest
+    -- we need to test deal only in Pat args (or list of same), so
+    -- we can pass a couple [Pat] to test13 along with an Int code
+    -- to control delegation.
+    --  1    unionPats        :: [ Pat ] -> Pat
+    --  2    intersectPats    :: [ Pat ] -> Pat
+    --  3    isSubPatOf      :: Pat -> Pat -> Bool
+--  --  4    unionPatssStr    :: [ String ] -> String
+    --  5    emptyPat        :: Pat
+    --  6    mkPat           :: forall d. Data d => d -> Pat
+    --  7    growPat         :: forall d. Data d => Pat -> d -> Pat
+    --  8    shrinkPat       :: Pat -> Pat
+    --  9    liftPats         :: [ Pat ] -> Pat
+    -- 10    splicePats       :: Pat -> [Int] -> [(Int, Pat)] -> Pat
+    -- 11    isPath          :: Pat -> Bool
+    -- 12    mkPatN          :: Int -> Pat -> Bool
+    -- 13    elidePats        :: Pat -> Pat -> [Int] -> Pat
+    -- 14    erodePat        :: StdGen -> [Int] -> Pat -> (Pat, StdGen)
+    let test_patterns13 = [
+           ( 1, [".{...}", ".{.#}"], "")
+         , ( 2, [".{...}", ".{.#}"], "")
+         , ( 3, [".", "."], "True")
+         , ( 3, ["#", "#"], "True")
+         , ( 3, ["*", "*"], "True")
+         , ( 3, [".", ".{}"], "True")
+         , ( 3, [".{}", "."], "False")
+         , ( 3, [".{}", ".{.}"], "False")
+         , ( 3, [".{.}", ".{.}"], "True")
+         , ( 3, [".{.}", ".{..}"], "False")
+         , ( 3, [".{.}", ".{.{.}}"], "True")
+         , ( 3, [".{..}", ".{.#}"], "False")
+         , ( 3, [".{.#}", ".{..}"], "True")
+         , ( 3, [".{..}", ".{...}"], "False")
+         , ( 3, [".{}", ".{...}"], "False")
+         , ( 3, [".", ".{*.#}"], "True")
+         , ( 3, ["#", ".{*.#}"], "True")
+         , ( 3, ["*", ".{*.#}"], "False")
+         , ( 3, ["*", ".{*}"], "False")
+         , ( 3, ["*", ".{**}"], "False")
+         , ( 4, [".{...}", ".{.#}"], "")
+         , ( 5, [".{...}", ".{.#}"], "")
+         , ( 6, [".{...}", ".{.#}"], "")
+         -- matching against val = ([1,2,3::Int],(False,"foo"))
+         -- mkPat val = ".{.{..{..{..}}}.{..{..{..{..}}}}}"
+         , ( 7, [".{.{..{..}}.{..{..}}}"], "")
+         , ( 7, [".{.{..{..{..}}}.{..{..{..}}}}"], "")
+         , ( 7, [".{.{..{..{..}}}.{..{..{..{..}}}}}"], "")
+         , ( 8, [".{.{..{..{..}}}.{..{..{..{..}}}}}"], "")
+         , ( 8, [".{.{..{..{..}}}.{..{..{..}}}}"], "")
+         , ( 8, [".{.{..{..}}.{..{..}}}"], "")
+         , ( 8, [".{.{#.{..}}.{#.{*3.}}}"], "")
+         , ( 8, [".{.{#.}.{#.}}"], "")
+         , ( 8, [".{..}"], "")
+         , ( 8, ["."], "")
+         , ( 9, [".{...}", ".{.#}"], "")
+         , (10, [".{...}", ".{.#}"], "")
+         , (11, [".{...}", ".{.#}"], "")
+         , (12, [".{...}", ".{.#}"], "")
+    -- 12    mkPatN          :: Int -> Pat -> Bool
+    -- 13    elidePats        :: Pat -> Pat -> [Int] -> Pat
+    -- 14    erodePat        :: StdGen -> [Int] -> Pat -> (Pat, StdGen)
+         ]
+    putStrLn "==================================================="
+    putStrLn "Testing miscellaneous PatAlg functions..."
+    doit13 True test_patterns13
+#endif
+
+#if ! FOCUS_TEST
+
+#if 1
+    -- Testing fusion
+    putStrLn "\nTesting fusion\n-fenable-rewrite-rules -O -ddump-rules -ddump-simpl-stats -ddump-rule-firings\n"
+    let exp12 = (3.4, [5,__,7], __) :: (Float, [Int], Bool)
+    let get12 (_,xs,_) = (xs!!2)
+    putStrLn $ show $ get12 $ ( forcep ".:Bool" . forcep ".:Int" ) exp12
+    putStrLn $ show $ get12 $ ( forcep ".:Bool" . forcep_ (compilePat ".:Int") ) exp12
+    putStrLn $ show $ get12 $ ( forcep_ (compilePat ".:Bool") . forcep ".:Int" ) exp12
+    putStrLn $ show $ get12 $ ( forcep_ (compilePat ".:Bool") . forcep_ (compilePat ".:Int") ) exp12
+#endif
+
+#if 1
+    putStrLn "\n\
+  expN_1 = [__] :: [Int]\n\
+  expN_2 = [0,1,__,3] :: [Int]\n\
+  expN_3 = (3.4, [5,__,7], True) :: (Float, [Int], Bool)\n\
+  expN_4 = (3.4, [5,__,7], __) :: (Float, [Int], Bool)\n\
+\n\
+  getN_1 xs = show $ ()\n\
+--getN_1 xs = show $ head xs\n\
+--getN_2 xs = show $ (xs!!1)\n\
+  getN_2 xs = show $ (xs!!3)\n\
+  getN_3 (_,xs,_) = show $ (xs!!2)\n"
+    doit5 1 0 1 "" >>= putStrLn
+    doit6 1 0 1 "" >>= putStrLn
+    doit7 1 0 1 "" >>= putStrLn
+    doit8 1 0 1 "" >>= putStrLn
+#if 0
+    doit9 >>= putStrLn  -- XXX broken (whatever it is)
+#endif
+#endif
+
+#if 1
+    putStr hdline
+    putStrLn "Testing generic GNFDataN (refer to Foo.hs for the defs).\n"
+    putStr hline
+#if 0
+#if ! USE_SOP
+    putStrLn $ show $ from expTE_1
+    putStrLn $ show $ from $ F 23
+    putStrLn $ show $ from $ Just 11  -- bad comparison: two constructors!
+#endif
+--  putStrLn $ show $ from $ Just (undefined::Int)
+--  putStrLn $ show $ from expTE_2
+--  putStrLn $ show $ from expTE_3
+    putStr "\n"
+    putStrLn $ ""
+           ++ "expBase7 = B2 (A1 True 4) (B1 True (A2 undefined))\n"
+           ++ "expBase8 = B2 (A1 undefined 4) (B1 True (A2 undefined))\n"
+           ++ "expBase9 = B2 (A1 undefined 4) (B1 undefined (A2 undefined))\n"
+           ++ "...\n"
+           ++ "getB_1 (B2 _ (B1 b _)) = b\n"
+           ++ "getB_2 (B2 (A1 _ n) _) = n\n"
+#endif
+    s2 <- doit2 1 0 1 ""
+    putStrLn s2
+#if 0
+    putStrLn $ ""
+           ++ "expTB_15 = (A3 (B3 False undefined 5) False)\n"
+           ++ "getA (A3 _ b) = show b\n"
+    s3 <- doit3 1 1 1 ""
+    putStrLn s3
+#endif
+#endif
+
+#if 0
+    s4 <- doit4 1 0 1 ""
+    putStrLn s4
+#endif
+
+#if 0
+    putStrLn $ ""
+           ++ "expBase1 = ([True,False],3,Just \"fox\")         :: ([Bool],Int,Maybe String)\n"
+           ++ "expBase2 = ([True,False],__,Just \"fox\")        :: ([Bool],Int,Maybe String)\n"
+           ++ "expBase3 = ([True,__],3,Just \"fox\")            :: ([Bool],Int,Maybe String)\n"
+           ++ "expBase4 = ([True,__],3,Just __)               :: ([Bool],Int,Maybe String)\n"
+           ++ "expBase5 = ([True,False],3,Just ['f',__,'x'])  :: ([Bool],Int,Maybe String)\n"
+           ++ "expBase6 = ([True,False],3,Just __)            :: ([Bool],Int,Maybe String)\n"
+           ++ "get1 ((x:_),_,_) = x           -- True\n"
+           ++ "get2 (_,x,_) = x               -- 3\n"
+           ++ "get3 (_,_,x) = fromJust x      -- \"fox\"\n"
+           ++ "get4 (_,_,Just (x:_)) = x      -- 'f'\n"
+    s1 <- doit1 1 1 1 ""
+    putStrLn s1
+#endif
+
+#if USE_SOP
+
+#if 1
+    -- Testing rnfpDyn -- working
+    putStrLn "\nTesting SOP rnfpDyn with SYB generic stop condition.\n"
+#if 1
+    let exp21 = (3.4, [5,__,7], __) :: (Float, [Int], Bool)
+    let get21 (_,xs,_) = (xs!!2)
+    let f21_a :: [Int] -> PatNode
+        f21_a _ = WI
+    let f21_b :: Bool -> PatNode
+        f21_b _ = WI
+    let fg21 :: GenericQ PatNode
+        fg21 = mkQ WR f21_a `extQ` f21_b
+--  let fg21 = mkQ WR f21_a `extQ` f21_b :: forall a. Data a => a -> PatNode
+--  let fg21 = mkQ WR f21_a `extQ` f21_b :: GenericQ PatNode
+    putStrLn $ show $ get21 $ forcepDyn fg21 exp21
+#else
+    let exp21 = (3.4, [5,__,7], False) :: (Float, [Int], Bool)
+    let get21 (_,xs,_) = (xs!!2)
+#if 0
+#elif 1
+    let f21 :: [Int] -> PatNode
+        f21 _ = WI
+    let fg21 :: GenericQ PatNode
+        fg21 = mkQ WR f21
+#elif 0
+    let f21 :: (Float,[Int],Bool) -> PatNode
+    -- Cannot do in SYB? We can't just "stop on any 3-tuple"; we need
+    -- to give the types of the components of the tuple as well?
+--  let f21 :: (,,) a b c -> PatNode
+--  let f21 :: (,,) * * * -> PatNode
+--  let f21 :: (,,) -> PatNode
+--  let f21 :: (a,b,c) -> PatNode
+--  let f21 :: (Typeable a,Typeable b,Typeable c) => (a,b,c) -> PatNode
+--  let f21 :: (Data a,Typeable a,Data b,Typeable b,Data c,Typeable c) => (a,b,c) -> PatNode
+        f21 _ = WI
+--      f21 (x,y,z) = WI
+    let fg21 :: GenericQ PatNode
+        fg21 = mkQ WR f21
+#elif 0
+    let f21 :: Int -> PatNode
+        f21 x = WI
+--      f21 x = case x of { 5 -> WR ; _ -> WI }  -- "case x" forces x!
+--  let (f21::Int->PatNode) x = case x of { 5 -> WR ; _ -> WI }
+    let fg21 :: GenericQ PatNode
+        fg21 = mkQ WR f21
+#endif
+    putStrLn $ show $ get21 $ forcepDyn fg21 exp21
+#endif
+#endif
+
+#if 1
+    -- Testing rnfpDyn again -- not working...
+    putStrLn "\nTesting SOP/SYB rnfpDyn again.\n"
+#if 0
+#elif 1
+    let exp22 = [[[__]],[[__,6],[7]]] :: [[[Int]]]
+-- These three should be exactly equivalent (same core produced)?
+--  let get22 xs = (((xs!!1)!!1)!!0)
+--  let get22 [_,[[_,n],_]] = n
+    let get22 (_:((_:n:_):_):_) = n
+    let f22a :: Int -> PatNode
+        f22a _ = trace "Noo-A" $ WI
+    let f22b :: [Int] -> PatNode
+        f22b _ = trace "Noo-B" $ WI
+    let f22c :: [[Int]] -> PatNode
+        f22c _ = trace "Noo-C" $ WI
+    let f22d :: [[[Int]]] -> PatNode  -- goes boom
+        f22d _ = trace "Noo-D" $ WI
+    let fg22 :: GenericQ PatNode
+        fg22 = mkQ WR id
+--                                                              -- blows
+--                                                 `extQ` f22d  -- blows
+                                       `extQ` f22c `extQ` f22d  -- FINE
+--                         `extQ` f22b `extQ` f22c `extQ` f22d  -- FINE
+--             `extQ` f22a `extQ` f22b `extQ` f22c              -- blows
+--             `extQ` f22a `extQ` f22b `extQ` f22c `extQ` f22d  -- FINE
+#elif 0
+    let exp22 = [[[__]],[[__,6],__,[7]]] :: [[[Int]]]
+    let get22 xs = (((xs!!1)!!2)!!0)
+    let f22 :: Int -> PatNode        -- goes boom
+--  let f22 :: [Int] -> PatNode      -- goes boom
+--  let f22 :: [[Int]] -> PatNode    -- goes boom
+--  let f22 :: [[[Int]]] -> PatNode  -- goes boom
+        f22 _ = trace "Noo-A" $ WI
+    let fg22 :: GenericQ PatNode
+        fg22 = mkQ WR f22
+#else
+    let exp22 = (3.4, [[[__]],[[__,6],__,[7]]], __) :: (Float, [[[Int]]], Bool)
+--  let exp22 = (3.4, [[__],[[__,6],__,[7]]], __) :: (Float, [[[Int]]], Bool)
+    let get22 (_,xs,_) = (((xs!!1)!!2)!!0)
+    let f22_a :: [[Int]] -> PatNode
+        f22_a _ = WI
+    let f22_b :: Bool -> PatNode
+        f22_b _ = WI
+    let fg22 :: GenericQ PatNode
+        fg22 = mkQ WR f22_a `extQ` f22_b
+--  let fg22 = mkQ WR f22_a `extQ` f22_b :: forall a. Data a => a -> PatNode
+--  let fg22 = mkQ WR f22_a `extQ` f22_b :: GenericQ PatNode
+#endif
+    putStrLn $ show $ get22 $ forcepDyn fg22 exp22
+#endif
+
+#if 1
+-- XXX This isn't working yet.
+-- And it won't work naively either, b/c SOP is *shallow*...
+-- Note:
+-- *Foo> :m +Generics.SOP
+-- *Foo Generics.SOP> datatypeInfo (Proxy :: Proxy [[Int]])
+-- ADT "GHC.Types" "[]" (Constructor "[]" :* (Infix ":" RightAssociative 5 :* Nil))
+-- So, as done in GNFDataP, we need to pattern-match in tandem on this,
+-- through the *S and *P SOP recursion auxilliaries...
+-- XXX I came back to this -- getting type errors, could probably
+-- get rid of by adding extra functions (as per GNFDataP.hs code),
+-- but remember, this is supposed to be API-user code ... if it's
+-- going to be that painful to write, we have a problem...
+-- (Still, can probably write friendlier wrapper functions.)
+    -- Testing rnfpDyn' with SOP generic stop condition
+    putStrLn "\nTesting SOP rnfpDyn' with SOP generic stop condition.\n"
+#if 0
+#elif 1
+    putStrLn $ doit23
+#elif 0
+    let exp23 = [[[__]],[[__,6],__,[7]]] :: [[[Int]]]
+    let get23 xs = (((xs!!1)!!2)!!0)
+    let fg23 :: forall a. (Generic a, HasDatatypeInfo a) => a -> PatNode
+        fg23 d | cname == "[[Int]]"  = WI
+               | otherwise           = WR
+          where
+#if 1
+           ADT mname tname (Constructor cname :* _) = dti
+--         ADT mname tname (Constructor cname :* _) = dti :: DatatypeInfo (Code a)
+--         (mname,tname,cname) = case dti of ...
+--         ADT mname tname (Constructor cname :* (Infix ":" RightAssociative 5 :* Nil)) = dti
+#endif
+           dti = datatypeInfo proxy_a
+           proxy_a = Proxy :: Proxy a
+           xrep = from d
+    putStrLn $ show $ get23 $ forcepDyn' fg23 exp23
+#endif
+#endif
+
+#if 1
+-- Gave up on the fully-SOP one, at least for now, b/c
+-- it seems like it's hard to write (much uglier than SYB one),
+-- and then writing a friendly wrapper looks tough as well.
+-- But here is a 3rd alternative, hybrid SOP/Typeable which
+-- is even simpler from the user perspective, only less efficient.
+    putStrLn "Testing SOP rnfpDyn'' with Typeable generic stop condition\n"
+    let exp24 = [[[__]],[[__,6],__,[7]]] :: [[[Int]]]
+    let get24 xs = (((xs!!1)!!2)!!0)
+    let fg24 :: forall a. Typeable a => a -> PatNode
+        fg24 d | t == "[[[Int]]]"  = WI
+               | t == "[[Int]]"    = WI
+               | otherwise         = WR
+         where t = show $ typeOf d
+    -- This is a simple alternative to the SOP/SYB hybrid.
+    -- If efficiency isn't prime concern, this would appear to be
+    -- even simpler ... the above looks much more lucid to me than
+    -- the usual SYB way of mkQ/extQ; here, just define one normal
+    -- function, and away you go...
+    putStrLn $ show $ get24 $ forcepDyn'' fg24 exp24
+#endif
+
+#endif
+
+#endif
+
+#if ! FOCUS_TEST
+
+#if 1
+    putStrLn "\nTesting Seqable class (tuple with list):\n"
+    let test_patterns24 = [
+           (1,  1, (3.4, [5, __, 7], False))                        -- okay
+         , (2,  2, fP (3.4, fP (5 : fP (__ : fP (7 : []))), __))    -- okay
+         , (2,  3, fP (3.4, fP (5 : fI (__ : fP (7 : []))), __))    -- okay
+         , (1,  4, fI (3.4, fP (5 : fI (__ : fP (7 : []))), __))    -- XXX
+         , (1,  5, fI (3.4, fI (5 : fI (__ : fP (7 : []))), __))    -- okay
+         , (2,  6, fI (3.4, fI (5 : fP (__ : fP (7 : []))), __))    -- okay
+         , (1,  7, fI (3.4, fP (5 : fI (__ : fP (7 : []))), True))  -- XXX
+         , (1,  8, fP (3.4, fI (5 : fI (__ : fP (7 : []))), True))  -- XXX
+         , (1,  9, fP (3.4, fI (5 : fI (__ : fI (7 : []))), True))  -- XXX
+         ] :: [(Int,Int,(Float,[Int],Bool))]
+    doit24 True test_patterns24
+#endif
+
+#if 1
+    putStrLn "\nTesting Seqable class (nested tuples):\n"
+    let test_patterns25 = [
+           (1,  1, (3.4, (__, 7), False))       -- okay
+         , (1,  2, fI (3.4 ,fI (__, 7) ,__))    -- okay
+         , (2,  3, fP (3.4 ,fP (__, 7) ,__))    -- XXX
+         , (2,  4, fP (3.4 ,fI (__, 7) ,__))    -- XXX
+         , (2,  5, fI (3.4 ,fP (__, 7) ,__))    -- XXX
+         , (1,  6, fI (3.4 ,fI (__, 7) ,True))  -- okay
+         , (2,  7, fP (3.4 ,fP (__, 7) ,True))  -- XXX
+         , (1,  8, fP (3.4 ,fI (__, 7) ,True))  -- okay
+         , (2,  9, fI (3.4 ,fP (__, 7) ,True))  -- XXX
+         ] :: [(Int,Int,(Float,(Bool,Int),Bool))]
+    doit25 True test_patterns25
+#endif
+
+#if USE_SOP
+
+#if 1
+    putStrLn "\nTesting generic Seqable (tuple with list):\n"
+    let test_patterns26 = [
+           (1,  1, (3.4, [5, __, 7], False))                        -- okay
+         , (2,  2, gP (3.4, gP (5 : gP (__ : gP (7 : []))), __))    -- okay
+         , (2,  3, gP (3.4, gP (5 : gI (__ : gP (7 : []))), __))    -- okay
+         , (1,  4, gI (3.4, gP (5 : gI (__ : gP (7 : []))), __))    -- XXX
+         , (1,  5, gI (3.4, gI (5 : gI (__ : gP (7 : []))), __))    -- okay
+         , (2,  6, gI (3.4, gI (5 : gP (__ : gP (7 : []))), __))    -- okay
+         , (1,  7, gI (3.4, gP (5 : gI (__ : gP (7 : []))), True))  -- XXX
+         , (1,  8, gP (3.4, gI (5 : gI (__ : gP (7 : []))), True))  -- XXX
+         , (1,  9, gP (3.4, gI (5 : gI (__ : gI (7 : []))), True))  -- XXX
+         ] :: [(Int,Int,(Float,[Int],Bool))]
+    doit26 True test_patterns26
+#endif
+
+#if 1
+    putStrLn "\nTesting generic Seqable (expTJ_*):\n"
+-- expTJ_1 = J2 ( 1, J4 ( J3, K3 K2 ( J1 4.5))) False     -- for ref.
+-- expTJ_2 = J2 ( 1, J4 ( J3, K3 __ ( J1 4.5))) False
+-- expTJ_3 = J2 ( 1, J4 ( __, K3 K2 ( J1 4.5))) False
+-- expTJ_4 = J2 ( 1, J4 ( __, K3 __ ( J1 4.5))) __        -- in use
+    let test_patterns27 = [
+           (1,  1, gI (J2 (gI ( 1, gI (J4 (gI ( __, gI (K3 __ ( gI (J1 4.5)))))))) __))
+         , (2,  2, gP (J2 (gP ( 1, gP (J4 (gP ( __, gP (K3 __ ( gP (J1 4.5)))))))) __))
+         , (1,  3, gI (J2 (gP ( 1, gP (J4 (gI ( __, gI (K3 __ ( gP (J1 4.5)))))))) __))
+         , (2,  4, gP (J2 (gP ( 1, gP (J4 (gI ( __, gI (K3 __ ( gP (J1 4.5)))))))) __))
+         , (2,  5, gI (J2 (gP ( 1, gP (J4 (gP ( __, gI (K3 __ ( gP (J1 4.5)))))))) __))
+         , (2,  6, gI (J2 (gP ( 1, gP (J4 (gI ( __, gP (K3 __ ( gP (J1 4.5)))))))) __))
+         ] :: [(Int,Int,TJ)]
+    doit27 True test_patterns27
+    putStrLn "\n"
+#endif
+
+#endif
+
+#endif
+
+-------------------------------------------------------------------------------
+
+  hline :: String
+  hline = "---------------------------------------------------\n"
+  hdline :: String
+  hdline = "===================================================\n"
+
+-------------------------------------------------------------------------------
+
+  doit1 :: Int -> Int -> Int -> String -> IO String
+  doit1 i j k acc
+   -- this glitch (the exception that seemingly escapes my catch)
+   -- happens just for these combos (and for all j):
+-- | i == 3 && k == 4  = doit1 (1+i) j k acc  -- trying to avoid a glitch...
+-- | i == 3 && k == 5  = doit1 (1+i) j k acc  -- trying to avoid a glitch...
+-- | i == 3 && j < 4 && k == 5  = doit1 (1+i) j k acc  -- trying to avoid a glitch...
+   | k == 7  = return acc
+   | j == 6  = doit1 1 1 (1+k) acc
+   | i == 5  = doit1 1 (1+j) k acc
+   | otherwise  = do
+      fexp <- catch
+               -- The semantics of the !'s here are not what they were,
+               -- since forcing in some places. [?] But at least the
+               -- first one seems definitely still needed...
+               -- LATER: The second one is also needed, finally seen!
+               -- (It is needed for a version of getE _ = "getee", only.)
+               -- XXX I'm just not sure whether the second ! is better
+               -- to leave in or leave out...
+               ( return $! get $! forcen dep exp )
+               (\e -> do let err = show (e :: ErrorCall)
+--             (\e -> do let err = show (e :: BottomedOut)
+                         return err)
+--    doit1 (1+i) j k $! force $ acc
+      doit1 (1+i) j k $! acc
+--    doit1 (1+i) j k $ acc
+        ++ "( get" ++ show i ++ " $ forcen " ++ show dep ++ " expBase" ++ show k ++ " )  "
+        ++ fexp ++ "\n"
+   where
+    exp = case k of
+            1 -> expBase1
+            2 -> expBase2
+            3 -> expBase3
+            4 -> expBase4
+            5 -> expBase5
+            6 -> expBase6
+    get = case i of
+           1 -> get1
+           2 -> get2
+--         3 -> unsafePerformIO . get3  -- yeesh!...
+--         3 -> get3
+           3 -> get3 (i,j,k)
+           4 -> get4
+    dep = j
+
+  -- XXX All this fuss to deal with the case that the
+  -- entire argument m is undefined (or whatever is going
+  -- for "undefined" at the moment...) -- but, none of
+  -- the expBase[1-5] have this! ch.
+  myFromJust :: Maybe a -> IO (Either () a)
+  myFromJust m = do
+                    putStrLn "Boo!"
+                    catch
+                      (myFromJust' m)
+                      (\e -> do putStrLn $! show (e::BottomedOut)
+                                putStrLn "HERE!"
+                                return $! Left ())
+  myFromJust' :: Maybe a -> IO (Either () a)
+  myFromJust' Nothing = do
+--                         throw BottomedOut
+                           return $! Left ()
+  myFromJust' (Just x) = return $! Right x
+--myFromJust _ = throw BottomedOut
+
+--------------------------------
+
+  doit2 :: Int -> Int -> Int -> String -> IO String
+  doit2 i j k acc
+-- | k == 2  = {- trace (show (i,j,k)) $ -} return acc
+-- | k == 7  = return acc
+   | k == 27  = return acc
+-- | k == 21  = return acc
+-- | k == 5  = return acc
+-- | j == 15  = doit2 1 0 (1+k) acc
+   | j == 11  = {- trace (show (i,j,k)) $ -} doit2 1 0 (1+k) acc
+-- | j == 8  = {- trace (show (i,j,k)) $ -} doit2 1 0 (1+k) acc
+-- | j == 3  = {- trace (show (i,j,k)) $ -} doit2 1 0 (1+k) acc
+#if USE_TRACE
+   | i == 2  = trace ("End of " ++ show (i,j',k')) $ doit2 1 (1+j) k acc
+-- | i == 3  = trace ("End of " ++ show (i,j',k')) $ doit2 1 (1+j) k acc
+#else
+   | i == 2  = doit2 1 (1+j) k acc
+-- | i == 3  = doit2 1 (1+j) k acc
+#endif
+   | otherwise  = do
+      fexp <- catch
+               ( return $! get $! forcen dep exp )
+--             ( return $! get $! forcen dep exp )
+               -- ErrorCall if use __ = undefined
+               -- BottomedOut if use __ = throw BottomedOut
+               (\e -> do let err = show (e :: ErrorCall)
+--             (\e -> do let err = show (e :: BottomedOut)
+                         return err)
+      doit2 (1+i) j k $! acc
+        ++ "( getB_" ++ show i ++ " $ forcen " ++ show dep ++ (if dep < 10 then " " else "") ++ " expTB_" ++ show (k'-6) ++ " )  "
+--      ++ "( getB_" ++ show i ++ " $ forcen " ++ show dep ++ (if dep < 10 then " " else "") ++ " expBase" ++ show k' ++ " )  "
+        ++ fexp ++ "\n"
+   where
+    exp = case k' of
+            7 -> expBase7
+            8 -> expBase8
+            9 -> expBase9
+            10 -> expBase10
+            11 -> expBase11
+            12 -> expBase12
+            13 -> expBase13
+            14 -> expBase14
+            15 -> expBase15
+            16 -> expBase16
+            17 -> expBase17
+            18 -> expBase18
+            19 -> expBase19
+            20 -> expBase20
+            21 -> expBase20  -- fudge it!!
+            22 -> expBase22
+            23 -> expBase23
+            24 -> expBase24
+            25 -> expBase25
+            26 -> expBase26
+            27 -> expBase27
+            28 -> expBase28
+            29 -> expBase29
+            30 -> expBase30
+            31 -> expBase31
+            32 -> expBase32
+    get = case i of
+           1 -> if k' >= 27 then getB_3 else getB_1
+           2 -> getB_2
+    dep = j'
+    j' = j
+--  j' = j+11
+--  k' = k+26
+    k' = k+6
+
+  doit3 :: Int -> Int -> Int -> String -> IO String
+  doit3 i j k acc
+   | k == 2  = return acc
+   | j == 8  = {- trace (show (i,j,k)) $ -} doit3 1 1 (1+k) acc
+#if USE_TRACE
+   | i == 2  = trace ("End of " ++ show (i,j',k')) $ doit3 1 (1+j) k acc
+#else
+   | i == 2  = doit3 1 (1+j) k acc
+#endif
+   | otherwise  = do
+      fexp <- catch
+               ( return $! get $! forcen dep exp )
+               -- ErrorCall if use __ = undefined
+               -- BottomedOut if use __ = throw BottomedOut
+               (\e -> do let err = show (e :: ErrorCall)
+--             (\e -> do let err = show (e :: BottomedOut)
+                         return err)
+      doit3 (1+i) j k $! acc
+        ++ "( getB_" ++ show i ++ " $ forcen " ++ show dep ++ " expBase" ++ show k' ++ " )  "
+        ++ fexp ++ "\n"
+   where
+    exp = case k' of
+            21 -> expBase21
+    get = case i of
+           1 -> getA
+    dep = j'
+    i' = i
+    j' = j
+    k' = k+20
+
+  doit4 :: Int -> Int -> Int -> String -> IO String
+  doit4 i j k acc
+-- | k == 2  = return acc
+   | k == 4  = return acc
+   | j == 8  = {- trace (show (i,j,k)) $ -} doit4 1 0 (1+k) acc
+#if USE_TRACE
+   | i == 2  = trace ("End of " ++ show (i,j',k')) $ doit4 1 (1+j) k acc
+#else
+   | i == 2  = doit4 1 (1+j) k acc
+#endif
+   | otherwise  = do
+      fexp <- catch
+               ( return $! get $! forcen dep exp )
+               -- ErrorCall if use __ = undefined
+               -- BottomedOut if use __ = throw BottomedOut
+               (\e -> do let err = show (e :: ErrorCall)
+--             (\e -> do let err = show (e :: BottomedOut)
+                         return err)
+      doit4 (1+i) j k $! acc
+        ++ "( getE $ forcen " ++ show dep ++ " expTE_" ++ show k' ++ " )  "
+        ++ fexp ++ "\n"
+   where
+    exp = case k' of
+            1 -> expTE_1
+            2 -> expTE_2
+            3 -> expTE_3
+    get = case i of
+           1 -> getE
+    dep = j'
+    i' = i
+    j' = j
+    k' = k
+
+-------------------------------------------------------------------------------
+
+  doit5 :: Int -> Int -> Int -> String -> IO String
+  doit5 i j k acc
+   | k == 2  = return acc
+   | j == 5  = {- trace (show (i,j,k)) $ -} doit5 1 0 (1+k) acc
+#if USE_TRACE
+   | i == 2  = trace ("End of " ++ show (i,j',k')) $ doit5 1 (1+j) k acc
+#else
+   | i == 2  = doit5 1 (1+j) k acc
+#endif
+   | otherwise  = do
+      fexp <- catch
+               ( return $! get $! forcen dep exp )
+               -- ErrorCall if use __ = undefined
+               -- BottomedOut if use __ = throw BottomedOut
+               (\e -> do let err = show (e :: ErrorCall)
+--             (\e -> do let err = show (e :: BottomedOut)
+                         return err)
+      doit5 (1+i) j k $! acc
+        ++ "forcen " ++ show dep ++ " expN_" ++ show k' ++ " `seq` ()  =  "
+        ++ fexp ++ "\n"
+   where
+    exp = case k' of
+            1 -> expN_1
+    get = case i of
+           1 -> getN_1
+    dep = j'
+    i' = i
+    j' = j
+    k' = k
+
+-------------------------------------------------------------------------------
+
+  doit6 :: Int -> Int -> Int -> String -> IO String
+  doit6 i j k acc
+   | k == 2  = return acc
+   | j == 5  = {- trace (show (i,j,k)) $ -} doit6 1 0 (1+k) acc
+#if USE_TRACE
+   | i == 2  = trace ("End of " ++ show (i',j',k')) $ doit6 1 (1+j) k acc
+#else
+   | i == 2  = doit6 1 (1+j) k acc
+#endif
+   | otherwise  = do
+      fexp <- catch
+               ( return $! get $! forcen dep exp )
+               -- ErrorCall if use __ = undefined
+               -- BottomedOut if use __ = throw BottomedOut
+               (\e -> do let err = show (e :: ErrorCall)
+--             (\e -> do let err = show (e :: BottomedOut)
+                         return err)
+      doit6 (1+i) j k $! acc
+        ++ "getN_" ++ show i' ++" $ forcen " ++ show dep ++ " expN_" ++ show k' ++ "  =  "
+        ++ fexp ++ "\n"
+   where
+    exp = case k' of
+            _ -> expN_2
+    get = case i of
+           _ -> getN_2
+    dep = j'
+    i' = i+1
+    j' = j
+    k' = k+1
+
+-------------------------------------------------------------------------------
+
+  doit7 :: Int -> Int -> Int -> String -> IO String
+  doit7 i j k acc
+   | k == 2  = return acc
+   | j == 5  = {- trace (show (i,j,k)) $ -} doit7 1 0 (1+k) acc
+#if USE_TRACE
+   | i == 2  = trace ("End of " ++ show (i',j',k')) $ doit7 1 (1+j) k acc
+#else
+   | i == 2  = doit7 1 (1+j) k acc
+#endif
+   | otherwise  = do
+      fexp <- catch
+               ( return $! get $! forcen dep exp )
+               -- ErrorCall if use __ = undefined
+               -- BottomedOut if use __ = throw BottomedOut
+               (\e -> do let err = show (e :: ErrorCall)
+--             (\e -> do let err = show (e :: BottomedOut)
+                         return err)
+      doit7 (1+i) j k $! acc
+        ++ "getN_" ++ show i' ++" $ forcen " ++ show dep ++ " expN_" ++ show k' ++ "  =  "
+        ++ fexp ++ "\n"
+   where
+    exp = case k' of
+            _ -> expN_3
+    get = case i of
+           _ -> getN_3
+    dep = j'
+    i' = i+2
+    j' = j
+    k' = k+2
+
+-------------------------------------------------------------------------------
+
+  doit8 :: Int -> Int -> Int -> String -> IO String
+  doit8 i j k acc
+   | k == 2  = return acc
+   | j == 5  = {- trace (show (i,j,k)) $ -} doit8 1 0 (1+k) acc
+#if USE_TRACE
+   | i == 2  = trace ("End of " ++ show (i',j',k')) $ doit8 1 (1+j) k acc
+#else
+   | i == 2  = doit8 1 (1+j) k acc
+#endif
+   | otherwise  = do
+      fexp <- catch
+               ( return $! get $! forcen dep exp )
+               -- ErrorCall if use __ = undefined
+               -- BottomedOut if use __ = throw BottomedOut
+               (\e -> do let err = show (e :: ErrorCall)
+--             (\e -> do let err = show (e :: BottomedOut)
+                         return err)
+      doit8 (1+i) j k $! acc
+        ++ "getN_" ++ show i' ++" $ forcen " ++ show dep ++ " expN_" ++ show k' ++ "  =  "
+        ++ fexp ++ "\n"
+   where
+    exp = case k' of
+            _ -> expN_4
+    get = case i of
+           _ -> getN_3
+    dep = j'
+    i' = i+2
+    j' = j
+    k' = k+3
+
+-------------------------------------------------------------------------------
+
+#if 0
+
+#if 0
+  expP_1 = (3.4, [5,__,7], __) :: (Float, [Int], Bool)
+  patP_1 = Node (TR [typeOf ((__,__,__)::(Float, [Int], Bool))])
+             [ Node (TR [typeOf (__::Bool)]) []
+--           [ Node (TR [typeOf (__::Float)]) []
+--           [ Node (NTR [typeOf (__::Bool)]) []
+--           [ Node (NTR [typeOf (__::Float)]) []
+--           , Node WS []
+             , Node (TW [typeOf ([__]::[Int])]) []
+--           , Node (TR [typeOf ([__]::[Int])]) []
+--           , Node (TR [typeOf ([__]::[Int])]) [ Node WS [], Node WS [] ]  -- why not?
+             , Node WW []
+--           , Node I []
+             ]
+  getP_1 (_,xs,_) = show $ (xs!!2)
+#endif
+
+  doit9 :: IO String
+  doit9 = do
+#if 0
+    putStrLn "\
+  expP_1 = (3.4, [5,__,7], __) :: (Float, [Int], Bool)\n\
+  patP_1 = Node (T [typeOf ((__,__,__)::(Float, [Int], Bool))])\n\
+             [ Node W []\n\
+             , Node (T [typeOf ([__]::[Int])]) []\n\
+             , Node I []\n\
+             ]\n\
+  getP_1 (_,xs,_) = show $ (xs!!2)\n"
+    putStrLn "getP_1 $ forcep patP_1 expP_1"
+#endif
+    s <- catch
+             ( return $! getP_1 $! forcep patP_1 expP_1 )
+--           ( return $! getP_2 $! forcep patP_2 expP_2 )
+--           ( return $! getP_3 $! forcep patP_3 expP_3 )
+             -- ErrorCall if use __ = undefined
+             -- BottomedOut if use __ = throw BottomedOut
+             (\e -> do let err = show (e :: ErrorCall)
+--           (\e -> do let err = show (e :: BottomedOut)
+                       return err)
+    return s
+
+#endif
+
+-------------------------------------------------------------------------------
+
+  doit10 :: Bool -> [(Int,String)] -> IO ()
+  doit10 _ [] = do
+                   putStrLn "--------------------------------------------------"
+                   return ()
+  doit10 b ((code,patstr):t) = do
+    let expect = case code of
+                  1 -> "7"
+                  2 -> "Prelude.undefined"
+                  3 -> "pattern-match failure"
+                  4 -> "syntax error"
+                  5 -> "7 (but \"# with subpattern\" warning)"
+                  6 -> "7 (but \"constraint/subpattern arity mismatch\" warning)"
+                  13 -> "7 (but with pattern-match failure warning)"
+                  23 -> "Prelude.undefined (but with pattern-match failure warning)"
+                  _ -> error $ "doit10: unexpected code " ++ show code
+    s <- catch
+           ( do
+                let exp = (3.4, [5,__,7], __) :: (Float, [Int], Bool)
+                let pat = compilePat patstr
+                let get (_,xs,_) = show $ (xs!!2)
+                if b
+                then do
+                  putStrLn "==================================================="
+                  putStrLn "exp = (3.4, [5,__,7], __) :: (Float, [Int], Bool)"
+                  putStrLn "get (_,xs,_) = show $ (xs!!2)"
+                  putStrLn "? = get $ forcep patstr exp"
+                  putStrLn "==================================================="
+                else do
+                  putStrLn "---------------------------------------------------"
+                putStrLn $ "patstr                   = " ++ patstr
+                if code > 4
+                then putStrLn $  "expected value           = " ++ expect
+                else return ()
+--              putStrLn $ "pat = " ++ show pat
+                putStrLn $ "showPat.compilePat       = " ++ showPat pat
+                if code <= 4
+                then putStrLn $  "expected value           = " ++ expect
+                else return ()
+                s1 <- catch
+                        ( return $! force $! get $! forcep patstr exp )
+                        (\e -> do let err = show (e :: ErrorCall)
+--                      (\e -> do let err = show (e :: BottomedOut)
+                                  return err)
+                putStr "actual value             = "
+                return $! s1
+           )
+           -- ErrorCall if use __ = undefined
+           -- BottomedOut if use __ = throw BottomedOut
+           (\e -> do let err = show (e :: ErrorCall)
+--         (\e -> do let err = show (e :: BottomedOut)
+                     return err)
+    putStrLn s
+    doit10 False t
+
+-------------------------------------------------------------------------------
+
+  doit11 :: Bool -> [(Int,String,String)] -> IO ()
+  doit11 _ [] = do
+                   putStrLn "--------------------------------------------------"
+                   return ()
+  doit11 b ((code,patstr1,patstr2):t) = do
+    let expect = case code of
+                  1 -> "7"
+                  2 -> "Prelude.undefined"
+                  3 -> "pattern-match failure"
+                  4 -> "syntax error"
+                  5 -> "7 (but \"# with subpattern\" warning)"
+                  6 -> "7 (but \"constraint/subpattern arity mismatch\" warning)"
+                  _ -> error $ "doit11: unexpected code " ++ show code
+    s <- catch
+           ( do
+                let exp = (3.4, [5,__,7], __) :: (Float, [Int], Bool)
+                let patstrU = showPat $ unionPats [compilePat patstr1, compilePat patstr2]
+                let pat1 = compilePat patstr1
+                let pat2 = compilePat patstr2
+                let patU = unionPats [pat1,pat2]
+                let get (_,xs,_) = show $ (xs!!2)
+                if b
+                then do
+                  putStrLn "==================================================="
+                  putStrLn "exp = (3.4, [5,__,7], __) :: (Float, [Int], Bool)"
+                  putStrLn "get (_,xs,_) = show $ (xs!!2)"
+                  putStrLn "? = get $ ( forcep patstr2 . forcep patstr1 ) exp"
+--                putStrLn "? = get $ ( forcep ( unionPatsStr [ patstr1, patstr2 ] ) ) exp"
+                  putStrLn "? = get $! ( forcep_ ( unionPats [ pat1, pat2 ] ) ) exp"
+                  putStrLn "(Results were more interesting with a previous semantics...)."
+                  putStrLn "==================================================="
+                else do
+                  putStrLn "---------------------------------------------------"
+                putStrLn $ "patstr1                     = " ++ patstr1
+                putStrLn $ "patstr2                     = " ++ patstr2
+                putStrLn $ "patstrU                     = " ++ patstrU
+                if code > 4
+                then putStrLn $  "expected value              = " ++ expect
+                else return ()
+--              putStrLn $ "pat = " ++ show pat
+                putStrLn $ "showPat.compilePat patstr1  = " ++ showPat pat1
+                putStrLn $ "showPat.compilePat patstr2  = " ++ showPat pat2
+                putStrLn $ "showPat.compilePat patstrU  = " ++ showPat patU
+                if code <= 4
+                then putStrLn $  "expected value              = " ++ expect
+                else return ()
+                putStr "actual value                = "
+                let s1 = get $! ( forcep patstr2 . forcep patstr1 ) exp
+                putStrLn s1
+                putStr "actual value                = "
+                let s2 = get $! forcep patstrU exp
+#if 1
+                let s3 = s2
+#else
+                putStrLn s2
+                let s3 = get $! forcep_ ( unionPats [ pat1, pat2 ] ) exp
+#endif
+                return $! s3
+           )
+           -- ErrorCall if use __ = undefined
+           -- BottomedOut if use __ = throw BottomedOut
+           (\e -> do let err = show (e :: ErrorCall)
+--         (\e -> do let err = show (e :: BottomedOut)
+                     return err)
+    putStrLn s
+    doit11 False t
+
+-------------------------------------------------------------------------------
+
+  doit12 :: Bool -> [(Int,String,[Int],[(Int,String)])] -> IO ()
+--doit12 :: Bool -> [(Int,String,String,[(Int,String)])] -> IO ()
+  doit12 _ [] = do
+                   return ()
+  doit12 b ((code,patstr1,path,isibs'):t) = do
+    let expect = case code of
+                  1 -> "7"
+                  2 -> "Prelude.undefined"
+                  3 -> "pattern-match failure"
+                  4 -> "syntax error"
+                  5 -> "7 (but \"# with subpattern\" warning)"
+                  6 -> "7 (but \"constraint/subpattern arity mismatch\" warning)"
+                  _ -> error $ "doit12: unexpected code " ++ show code
+    s <- catch
+           ( do
+                let target = compilePat patstr1
+--              let path = compilePat patstr2
+                let isibs = map (\ (x,y) -> (x,compilePat y)) isibs'
+                if b
+                then do
+                  putStr hdline
+                  putStrLn "Testing splicePats."
+                  putStr hline
+                else return ()
+                putStrLn $ "target       " ++ patstr1
+                putStrLn $ "path         " ++ show path
+--              putStrLn $ "path         " ++ patstr2
+                putStrLn $ "isibs        " ++ show isibs'
+                let s1 = force $ showPat $ splicePats target path isibs
+--              let s1 = showPat $! splicePats target path isibs
+--              let s1 = showPat $ splicePats target path isibs
+                putStr "result       "
+                return $! s1
+           )
+           -- ErrorCall if use __ = undefined
+           -- BottomedOut if use __ = throw BottomedOut
+           (\e -> do let err = show (e :: ErrorCall)
+--         (\e -> do let err = show (e :: BottomedOut)
+                     return err)
+    putStrLn s
+    if null t then return () else putStr hline
+    doit12 False t
+
+-------------------------------------------------------------------------------
+
+  doit12b :: Bool -> [(Int,String,[Int],[Int])] -> IO ()
+  doit12b _ [] = do
+                   return ()
+  doit12b b ((code,patstr1,path,isibs'):t) = do
+    let expect = case code of
+                  1 -> "7"
+                  2 -> "Prelude.undefined"
+                  3 -> "pattern-match failure"
+                  4 -> "syntax error"
+                  5 -> "7 (but \"# with subpattern\" warning)"
+                  6 -> "7 (but \"constraint/subpattern arity mismatch\" warning)"
+                  _ -> error $ "doit12b: unexpected code " ++ show code
+    s <- catch
+           ( do
+                let target = compilePat patstr1
+                let isibs = isibs'
+                if b
+                then do
+                  putStr hdline
+                  putStrLn "Testing elidePats."
+                  putStr hline
+                else return ()
+                putStrLn $ "target       " ++ patstr1
+                putStrLn $ "path         " ++ show path
+                putStrLn $ "isibs        " ++ show isibs'
+                let s1 = force $ showPat $ elidePats target path isibs
+                putStr "result       "
+                return $! s1
+           )
+           -- ErrorCall if use __ = undefined
+           -- BottomedOut if use __ = throw BottomedOut
+           (\e -> do let err = show (e :: ErrorCall)
+--         (\e -> do let err = show (e :: BottomedOut)
+                     return err)
+    putStrLn s
+    if null t then return () else putStr hline
+    doit12b False t
+
+-------------------------------------------------------------------------------
+
+  -- This is the first recursive test [much later than "12" would suggest].
+  doit12c :: Bool -> [(Int,String,[Int])] -> StdGen -> Int -> IO StdGen
+--doit12c :: Bool -> [(Int,String,[Int],Int)] -> StdGen -> IO StdGen
+--doit12c :: Bool -> [(Int,String,StdGen,[Int],Int)] -> IO StdGen
+--doit12c :: Bool -> [(Int,String,StdGen,[Int],Int)] -> IO ()
+  doit12c _ [] g _ = do
+                   return g
+--                 return ()
+  doit12c b lst@((code,patstr1,path):t) g 0 = return g
+  doit12c b lst@((code,patstr1,path):t) g nreps = do  -- but singleton expected?
+    let expect = case code of
+                  1 -> "7"
+                  2 -> "Prelude.undefined"
+                  3 -> "pattern-match failure"
+                  4 -> "syntax error"
+                  5 -> "7 (but \"# with subpattern\" warning)"
+                  6 -> "7 (but \"constraint/subpattern arity mismatch\" warning)"
+                  _ -> error $ "doit12c: unexpected code " ++ show code
+    (s, g') <- catch
+--  s <- catch
+           ( do
+                let target = compilePat patstr1
+                if b
+                then do
+                  putStr hdline
+                  putStrLn "Testing erodePat."
+                  putStr hline
+                else return ()
+                putStrLn $ "target       " ++ patstr1
+                putStrLn $ "stdgen       " ++ show g
+                putStrLn $ "path         " ++ show path
+                let (rslt, g') = erodePat g path target
+                let s1 = force $ showPat $ rslt
+--              let s1 = force $ showPat $ erodePat g path target
+                putStr "result       "
+                return $! (s1, g')
+--              return $! s1
+           )
+           -- ErrorCall if use __ = undefined
+           -- BottomedOut if use __ = throw BottomedOut
+           (\e -> do let err = show (e :: ErrorCall)
+--         (\e -> do let err = show (e :: BottomedOut)
+                     return (err, g))
+--                   return err)
+    putStrLn s
+    putStr hline
+    doit12c False lst g' (-1+nreps)
+--  doit12c False t g' (-1+nreps)
+
+-------------------------------------------------------------------------------
+
+  doit13 :: Bool -> [(Int,[String],String)] -> IO ()
+  doit13 _ [] = do
+                   putStr hline
+                   return ()
+  doit13 b ((code,patstrlst,expectstr):t) = do
+    s <- catch
+           ( do
+                s1 <- case code of
+-- Where were they done already?
+-- Oh, in doit11 and doit12 above...
+                       1 -> error $ hline ++ "unionPats test already done test13-1!"
+--                     4 -> error $ hline ++ "unionPatsStr test already done test13-4!"
+                       10 -> error $ hline ++ "splicePats test already done test13-10!"
+                       11 -> error $ hline ++ "isPath test already done test13-11!"
+    --  1    unionPats        :: [ Pat ] -> Pat
+    --  2  * intersectPats :: [ Pat ] -> Pat
+    --  3  * isSubPatOf      :: Pat -> Pat -> Bool
+--  --  4    unionPatsStr     :: [ String ] -> String
+    --  5  * emptyPat        :: Pat
+    --  6  * mkPat           :: forall d. Data d => d -> Pat
+    --  7  * growPat         :: forall d. Data d => Pat -> d -> Pat
+    --  8  * shrinkPat       :: Pat -> Pat
+    --  9  * liftPats         :: [ Pat ] -> Pat
+    -- 10    splicePats       :: Pat -> Pat -> [(Int, Pat)] -> Pat
+    -- 11    isPath          :: Pat -> Bool
+                       2 -> do
+                               let patA = patstrlst!!0
+                               let patB = patstrlst!!1
+                               putStr hline
+                               putStrLn "Testing      intersectPats [patA, patB]"
+                               putStrLn $ "patA         " ++ patA
+                               putStrLn $ "patB         " ++ patB
+                               putStr $ "result       "
+                               let s1 = force $ showPat $ intersectPats [compilePat patA, compilePat patB]
+                               return s1
+                       3 -> do
+                               let patA = patstrlst!!0
+                               let patB = patstrlst!!1
+                               putStr hline
+                               putStrLn "Testing      isSubPatOf patA patB"
+                               putStrLn $ "patA         " ++ patA
+                               putStrLn $ "patB         " ++ patB
+                               let s1 = force $ show $ isSubPatOf (compilePat patA) (compilePat patB)
+                               if s1 /= expectstr
+                               then do putStrLn $ "expect       " ++ expectstr
+                                       putStr $ "result       "
+                               else putStr $ "as expected  "
+                               return s1
+                       5 -> do
+                               putStr hline
+                               putStrLn "Testing      emptyPat"
+                               putStr $ "result       "
+                               let s1 = force $ showPat $ emptyPat
+                               return s1
+                       6 -> do
+                               putStr hline
+                               putStrLn "Testing      mkPat ([1,2,3],(False,\"foo\"))"
+                               putStr $ "result       "
+                               let s1 = force $ showPat $ mkPat ([1,2,3::Int],(False,"foo"))
+                               return s1
+                       7 -> do
+                               let patA = patstrlst!!0
+                               putStr hline
+                               putStrLn "Testing      growPat patA ([1,2,3],(False,\"foo\"))"
+                               putStrLn $ "patA         " ++ patA
+                               putStr $ "result       "
+                               let s1 = force $ showPat $ growPat (compilePat patA) ([1,2,3::Int],(False,"foo"))
+                               return s1
+                       8 -> do
+                               let patA = patstrlst!!0
+                               putStr hline
+                               putStrLn "Testing      shrinkPat patA"
+                               putStrLn $ "patA         " ++ patA
+                               putStr $ "result       "
+                               let s1 = force $ showPat $ shrinkPat (compilePat patA)
+                               return s1
+                       9 -> do
+                               putStr hline
+                               putStrLn "Testing      liftPats patstrlst"
+                               putStrLn $ "patstrs      " ++ show patstrlst
+                               putStr $ "result       "
+                               let s1 = force $ showPat $ liftPats $ map compilePat patstrlst
+                               return s1
+    -- 12    mkPatN          :: Int -> Pat -> Bool
+    -- 13    elidePats        :: Pat -> Pat -> [Int] -> Pat
+    -- 14    erodePat        :: StdGen -> [Int] -> Pat -> (Pat, StdGen)
+                       12 -> do
+                               putStr hline
+                               putStrLn "Testing      mkPatN 2 ([1,2,3],(False,\"foo\"))"
+                               putStr $ "result       "
+                               let s1 = force $ showPat $ mkPatN 2 ([1,2,3::Int],(False,"foo"))
+                               return s1
+                       _ -> error $ "doit13: unexpected code " ++ show code
+                return $! s1
+           )
+           -- ErrorCall if use __ = undefined
+           -- BottomedOut if use __ = throw BottomedOut
+           (\e -> do let err = show (e :: ErrorCall)
+--         (\e -> do let err = show (e :: BottomedOut)
+                     return err)
+    putStrLn s
+    doit13 False t
+
+-------------------------------------------------------------------------------
+
+  doit14 :: Bool -> [(Int,String)] -> IO ()
+  doit14 _ [] = do
+                   putStrLn "--------------------------------------------------"
+                   return ()
+  doit14 b ((code,patstr):t) = do
+    let expect = case code of
+                  1 -> "7"
+                  2 -> "Prelude.undefined"
+                  3 -> "pattern-match failure"
+                  4 -> "syntax error"
+                  5 -> "7 (but \"# with subpattern\" warning)"
+                  6 -> "7 (but \"constraint/subpattern arity mismatch\" warning)"
+                  13 -> "7 (but with pattern-match failure warning)"
+                  23 -> "Prelude.undefined (but with pattern-match failure warning)"
+                  _ -> error $ "doit14: unexpected code " ++ show code
+    s <- catch
+           ( do
+                let exp = (3.4, [5,__,7], __) :: (Float, [Int], Bool)
+                let pat = compilePat patstr
+                let get (_,xs,_) = show $ (xs!!2)
+                if b
+                then do
+                  putStrLn "==================================================="
+                  putStrLn "exp = (3.4, [5,__,7], __) :: (Float, [Int], Bool)"
+                  putStrLn "get (_,xs,_) = show $ (xs!!2)"
+                  putStrLn "? = get $ forcep patstr exp"
+                  putStrLn "==================================================="
+                else do
+                  putStrLn "---------------------------------------------------"
+                putStrLn $ "patstr                   = " ++ patstr
+                if code > 4
+                then putStrLn $  "expected value           = " ++ expect
+                else return ()
+--              putStrLn $ "pat = " ++ show pat
+                putStrLn $ "showPat.compilePat       = " ++ showPat pat
+                if code <= 4
+                then putStrLn $  "expected value           = " ++ expect
+                else return ()
+                s1 <- catch
+                        ( return $! force $! get $! forcep patstr exp )
+                        (\e -> do let err = show (e :: ErrorCall)
+--                      (\e -> do let err = show (e :: BottomedOut)
+                                  return err)
+                putStr "actual value             = "
+                return $! s1
+           )
+           -- ErrorCall if use __ = undefined
+           -- BottomedOut if use __ = throw BottomedOut
+           (\e -> do let err = show (e :: ErrorCall)
+--         (\e -> do let err = show (e :: BottomedOut)
+                     return err)
+    putStrLn s
+    doit14 False t
+
+-------------------------------------------------------------------------------
+
+#if USE_SOP
+
+  -- This is an adaptation of doit10 to user-defined datatypes,
+  -- for testing GNFDataP, which is finally within reach thanks
+  -- to SOP!
+  doit15 :: Bool -> [(Int,String)] -> IO ()
+  doit15 _ [] = do
+                   putStrLn "--------------------------------------------------"
+                   return ()
+  doit15 b ((code,patstr):t) = do
+    let expect = case code of
+                  1 -> "7"
+                  2 -> "Prelude.undefined"
+                  3 -> "pattern-match failure"
+                  4 -> "syntax error"
+                  5 -> "7 (but \"# with subpattern\" warning)"
+                  6 -> "7 (but \"constraint/subpattern arity mismatch\" warning)"
+                  13 -> "7 (but with pattern-match failure warning)"
+                  23 -> "Prelude.undefined (but with pattern-match failure warning)"
+                  _ -> error $ "doit15: unexpected code " ++ show code
+    s <- catch
+           ( do
+                let exp = expTG_5  -- ( G1, G2 5 __ 7, __ )
+--              let exp = expTG_4  -- ( G1, G2 5 6 7, __ )
+--              let exp = expTG_3  -- ( G1, G2 __ __ 7, __ )
+--              let exp = expTG_2  -- ( __, G2 __ __ 7, __ )
+--              let exp = expTG_1  -- ( G1, G2 5 6 7, True )
+--              let exp = (3.4, [5,__,7], __) :: (Float, [Int], Bool)
+                let pat = compilePat patstr
+                let get = getG
+--              let get (_,xs,_) = show $ (xs!!2)
+                if b
+                then do
+                  putStrLn "==================================================="
+                  putStrLn "exp = (G1, G2 5 __ 7, __) :: (TG, TG, Bool)"
+                  putStrLn "get (_,(G2 _ _ n),_) = n"
+                  putStrLn "? = get $ forcep patstr exp"
+                  putStrLn "==================================================="
+                else do
+                  putStrLn "---------------------------------------------------"
+                putStrLn $ "patstr                   = " ++ patstr
+                if code > 4
+                then putStrLn $  "expected value           = " ++ expect
+                else return ()
+--              putStrLn $ "pat = " ++ show pat
+                putStrLn $ "showPat.compilePat       = " ++ showPat pat
+                if code <= 4
+                then putStrLn $  "expected value           = " ++ expect
+                else return ()
+                s1 <- catch
+                        ( return $! force $! get $! forcep patstr exp )
+                        (\e -> do let err = show (e :: ErrorCall)
+--                      (\e -> do let err = show (e :: BottomedOut)
+                                  return err)
+                putStr "actual value             = "
+                return $! s1
+           )
+           -- ErrorCall if use __ = undefined
+           -- BottomedOut if use __ = throw BottomedOut
+           (\e -> do let err = show (e :: ErrorCall)
+--         (\e -> do let err = show (e :: BottomedOut)
+                     return err)
+    putStrLn s
+    doit15 False t
+
+-------------------------------------------------------------------------------
+
+  doit16 :: Bool -> [(Int,String)] -> IO ()
+  doit16 _ [] = do
+                   putStrLn "--------------------------------------------------"
+                   return ()
+  doit16 b ((code,patstr):t) = do
+    let expect = case code of
+                  1 -> "7"
+                  2 -> "Prelude.undefined"
+                  3 -> "pattern-match failure"
+                  4 -> "syntax error"
+                  5 -> "7 (but \"# with subpattern\" warning)"
+                  6 -> "7 (but \"constraint/subpattern arity mismatch\" warning)"
+                  13 -> "7 (but with pattern-match failure warning)"
+                  23 -> "Prelude.undefined (but with pattern-match failure warning)"
+                  _ -> error $ "doit16: unexpected code " ++ show code
+    s <- catch
+           ( do
+                let exp = expTG_6  -- G2 5 __ 7
+                let pat = compilePat patstr
+                let get = getG'
+                if b
+                then do
+                  putStrLn "==================================================="
+                  putStrLn "exp = G2 5 __ 7 :: TG"
+                  putStrLn "get (G2 _ _ n) = n"
+                  putStrLn "? = get $ forcep patstr exp"
+                  putStrLn "==================================================="
+                else do
+                  putStrLn "---------------------------------------------------"
+                putStrLn $ "patstr                   = " ++ patstr
+                if code > 4
+                then putStrLn $  "expected value           = " ++ expect
+                else return ()
+--              putStrLn $ "pat = " ++ show pat
+                putStrLn $ "showPat.compilePat       = " ++ showPat pat
+                if code <= 4
+                then putStrLn $  "expected value           = " ++ expect
+                else return ()
+                s1 <- catch
+                        ( return $! force $! get $! forcep patstr exp )
+                        (\e -> do let err = show (e :: ErrorCall)
+--                      (\e -> do let err = show (e :: BottomedOut)
+                                  return err)
+                putStr "actual value             = "
+                return $! s1
+           )
+           -- ErrorCall if use __ = undefined
+           -- BottomedOut if use __ = throw BottomedOut
+           (\e -> do let err = show (e :: ErrorCall)
+--         (\e -> do let err = show (e :: BottomedOut)
+                     return err)
+    putStrLn s
+    doit16 False t
+
+-------------------------------------------------------------------------------
+
+  doit17 :: Bool -> [(Int,String)] -> IO ()
+  doit17 _ [] = do
+                   putStrLn "--------------------------------------------------"
+                   return ()
+  doit17 b ((code,patstr):t) = do
+    let expect = case code of
+                  1 -> "4.5"
+                  2 -> "Prelude.undefined"
+                  3 -> "pattern-match failure"
+                  4 -> "syntax error"
+                  5 -> "4.5 (but \"# with subpattern\" warning)"
+                  6 -> "4.5 (but \"constraint/subpattern arity mismatch\" warning)"
+                  13 -> "4.5 (but with pattern-match failure warning)"
+                  23 -> "Prelude.undefined (but with pattern-match failure warning)"
+                  _ -> error $ "doit17: unexpected code " ++ show code
+    s <- catch
+           ( do
+--              let exp = expTH_1  -- H2 1 [H1 2.3, H3, H4 (H3, I3 I2 (H1 4.5))] False
+--              let exp = expTH_2  -- H2 1 [H1 2.3, H3, H4 (__, I3 I2 (H1 4.5))] False
+--              let exp = expTH_3  -- H2 1 [H1 2.3, H3, H4 (__, I3 I2 (H1 4.5))] __
+                let exp = expTH_4  -- H2 1 [H1 2.3, H3, H4 (__, I3 __ (H1 4.5))] __
+                let pat = compilePat patstr
+                let get = getH
+                if b
+                then do
+                  putStrLn "==================================================="
+                  putStrLn "exp = H2 1 [H1 2.3, H3, H4 (__, I3 I2 (H1 4.5))] __ :: TH"
+--                putStrLn "exp = H2 1 [H1 2.3, H3, H4 (H3, I3 I2 (H1 4.5))] False :: TH"
+                  putStrLn "get = (H2 _ [_, _, H4 (_, I3 _ (H1 f))] _) = show f"
+                  putStrLn "? = get $ forcep patstr exp"
+                  putStrLn "==================================================="
+                else do
+                  putStrLn "---------------------------------------------------"
+                putStrLn $ "patstr                   = " ++ patstr
+                if code > 4
+                then putStrLn $  "expected value           = " ++ expect
+                else return ()
+--              putStrLn $ "pat = " ++ show pat
+                putStrLn $ "showPat.compilePat       = " ++ showPat pat
+                if code <= 4
+                then putStrLn $  "expected value           = " ++ expect
+                else return ()
+                s1 <- catch
+                        ( return $! force $! get $! forcep patstr exp )
+                        (\e -> do let err = show (e :: ErrorCall)
+--                      (\e -> do let err = show (e :: BottomedOut)
+                                  return err)
+                putStr "actual value             = "
+                return $! s1
+           )
+           -- ErrorCall if use __ = undefined
+           -- BottomedOut if use __ = throw BottomedOut
+           (\e -> do let err = show (e :: ErrorCall)
+--         (\e -> do let err = show (e :: BottomedOut)
+                     return err)
+    putStrLn s
+    doit17 False t
+
+-------------------------------------------------------------------------------
+
+  doit18 :: Bool -> [(Int,String)] -> IO ()
+  doit18 _ [] = do
+                   putStrLn "--------------------------------------------------"
+                   return ()
+  doit18 b ((code,patstr):t) = do
+    let expect = case code of
+                  1 -> "4.5"
+                  2 -> "Prelude.undefined"
+                  3 -> "pattern-match failure"
+                  4 -> "syntax error"
+                  5 -> "4.5 (but \"# with subpattern\" warning)"
+                  6 -> "4.5 (but \"constraint/subpattern arity mismatch\" warning)"
+                  13 -> "4.5 (but with pattern-match failure warning)"
+                  23 -> "Prelude.undefined (but with pattern-match failure warning)"
+                  _ -> error $ "doit18: unexpected code " ++ show code
+    s <- catch
+           ( do
+--              let exp = expTJ_1  -- J2 (1, J4 (J3, K3 K2 (J1 4.5))) False
+--              let exp = expTJ_2  -- J2 (1, J4 (J3, K3 __ (J1 4.5))) False
+                let exp = expTJ_3  -- J2 (1, J4 (__, K3 K2 (J1 4.5))) False
+--              let exp = expTJ_4  -- J2 (1, J4 (__, K3 __ (J1 4.5))) __
+                let pat = compilePat patstr
+                let get = getJ
+                if b
+                then do
+                  putStrLn "==================================================="
+--                putStrLn "exp = J2 (1, J4 (J3, K3 K2 (J1 4.5))) False"
+                  putStrLn "exp = J2 (1, J4 (J3, K3 __ (J1 4.5))) False"
+--                putStrLn "exp = J2 (1, J4 (__, K3 K2 (J1 4.5))) False"
+--                putStrLn "exp = J2 (1, J4 (__, K3 __ (J1 4.5))) __"
+                  putStrLn "get = (J2 (_, J4 (_, K3 _ (J1 f))) _) = show f"
+                  putStrLn "? = get $ forcep patstr exp"
+                  putStrLn "==================================================="
+                else do
+                  putStrLn "---------------------------------------------------"
+                putStrLn $ "patstr                   = " ++ patstr
+                if code > 4
+                then putStrLn $  "expected value           = " ++ expect
+                else return ()
+--              putStrLn $ "pat = " ++ show pat
+                putStrLn $ "showPat.compilePat       = " ++ showPat pat
+                if code <= 4
+                then putStrLn $  "expected value           = " ++ expect
+                else return ()
+                s1 <- catch
+                        ( return $! force $! get $! forcep patstr exp )
+                        (\e -> do let err = show (e :: ErrorCall)
+--                      (\e -> do let err = show (e :: BottomedOut)
+                                  return err)
+                putStr "actual value             = "
+                return $! s1
+           )
+           -- ErrorCall if use __ = undefined
+           -- BottomedOut if use __ = throw BottomedOut
+           (\e -> do let err = show (e :: ErrorCall)
+--         (\e -> do let err = show (e :: BottomedOut)
+                     return err)
+    putStrLn s
+    doit18 False t
+
+-------------------------------------------------------------------------------
+
+  doit18b :: Bool -> [(Int,String)] -> IO ()
+  doit18b _ [] = do
+                   putStrLn "--------------------------------------------------"
+                   return ()
+  doit18b b ((code,patstr):t) = do
+    let expect = case code of
+                  1 -> "1"
+                  2 -> "Prelude.undefined"
+                  3 -> "pattern-match failure"
+                  4 -> "syntax error"
+                  5 -> "1 (but \"# with subpattern\" warning)"
+                  6 -> "1 (but \"constraint/subpattern arity mismatch\" warning)"
+                  13 -> "1 (but with pattern-match failure warning)"
+                  23 -> "Prelude.undefined (but with pattern-match failure warning)"
+                  _ -> error $ "doit18b: unexpected code " ++ show code
+    s <- catch
+           ( do
+                let exp = expTJ_5  -- J2 (1, J4 (__, K2)) False
+                let pat = compilePat patstr
+                let get = getJ'
+                if b
+                then do
+                  putStrLn "==================================================="
+                  putStrLn "exp = J2 (1, J4 (__, K2)) False"
+                  putStrLn "get ~_ = show 1  -- seems to suffice?!?..."
+--                putStrLn "get (J2 (n, J4 (_, K2)) False) = show n"
+                  putStrLn "? = get $ forcep patstr exp"
+                  putStrLn "==================================================="
+                else do
+                  putStrLn "---------------------------------------------------"
+                putStrLn $ "patstr                   = " ++ patstr
+                if code > 4
+                then putStrLn $  "expected value           = " ++ expect
+                else return ()
+--              putStrLn $ "pat = " ++ show pat
+                putStrLn $ "showPat.compilePat       = " ++ showPat pat
+                if code <= 4
+                then putStrLn $  "expected value           = " ++ expect
+                else return ()
+                s1 <- catch
+                        ( return $! force $! get $! forcep patstr exp )
+                        (\e -> do let err = show (e :: ErrorCall)
+--                      (\e -> do let err = show (e :: BottomedOut)
+                                  return err)
+                putStr "actual value             = "
+                return $! s1
+           )
+           -- ErrorCall if use __ = undefined
+           -- BottomedOut if use __ = throw BottomedOut
+           (\e -> do let err = show (e :: ErrorCall)
+--         (\e -> do let err = show (e :: BottomedOut)
+                     return err)
+    putStrLn s
+    doit18b False t
+
+-------------------------------------------------------------------------------
+
+  doit18c :: Bool -> [(Int,String)] -> IO ()
+  doit18c _ [] = do
+                   putStrLn "--------------------------------------------------"
+                   return ()
+  doit18c b ((code,patstr):t) = do
+    let expect = case code of
+                  1 -> "1"
+                  2 -> "Prelude.undefined"
+                  3 -> "pattern-match failure"
+                  4 -> "syntax error"
+                  5 -> "1 (but \"# with subpattern\" warning)"
+                  6 -> "1 (but \"constraint/subpattern arity mismatch\" warning)"
+                  13 -> "1 (but with pattern-match failure warning)"
+                  23 -> "Prelude.undefined (but with pattern-match failure warning)"
+                  _ -> error $ "doit18c: unexpected code " ++ show code
+    s <- catch
+           ( do
+                let exp = expTJ_6  -- J4 (__, K2)
+                let pat = compilePat patstr
+                let get = getJ6
+                if b
+                then do
+                  putStrLn "==================================================="
+                  putStrLn "exp = J4 (__, K2)"
+                  putStrLn "get ~_ = show 1  -- seems to suffice?!?..."
+--                putStrLn "get (J4 (_, K2)) = show n"
+                  putStrLn "? = get $ forcep patstr exp"
+                  putStrLn "==================================================="
+                else do
+                  putStrLn "---------------------------------------------------"
+                putStrLn $ "patstr                   = " ++ patstr
+                if code > 4
+                then putStrLn $  "expected value           = " ++ expect
+                else return ()
+--              putStrLn $ "pat = " ++ show pat
+                putStrLn $ "showPat.compilePat       = " ++ showPat pat
+                if code <= 4
+                then putStrLn $  "expected value           = " ++ expect
+                else return ()
+                s1 <- catch
+                        ( return $! force $! get $! forcep patstr exp )
+                        (\e -> do let err = show (e :: ErrorCall)
+--                      (\e -> do let err = show (e :: BottomedOut)
+                                  return err)
+                putStr "actual value             = "
+                return $! s1
+           )
+           -- ErrorCall if use __ = undefined
+           -- BottomedOut if use __ = throw BottomedOut
+           (\e -> do let err = show (e :: ErrorCall)
+--         (\e -> do let err = show (e :: BottomedOut)
+                     return err)
+    putStrLn s
+    doit18c False t
+
+-------------------------------------------------------------------------------
+
+  doit18d :: Bool -> [(Int,String)] -> IO ()
+  doit18d _ [] = do
+                   putStrLn "--------------------------------------------------"
+                   return ()
+  doit18d b ((code,patstr):t) = do
+    let expect = case code of
+                  1 -> "1"
+                  2 -> "Prelude.undefined"
+                  3 -> "pattern-match failure"
+                  4 -> "syntax error"
+                  5 -> "1 (but \"# with subpattern\" warning)"
+                  6 -> "1 (but \"constraint/subpattern arity mismatch\" warning)"
+                  13 -> "1 (but with pattern-match failure warning)"
+                  23 -> "Prelude.undefined (but with pattern-match failure warning)"
+                  _ -> error $ "doit18d: unexpected code " ++ show code
+    s <- catch
+           ( do
+                let exp = expTJ_7  -- (__, K2)
+                let pat = compilePat patstr
+                let get = getJ7
+                if b
+                then do
+                  putStrLn "==================================================="
+                  putStrLn "exp = (__, K2)"
+                  putStrLn "get ~_ = show 1  -- seems to suffice?!?..."
+                  putStrLn "? = get $ forcep patstr exp"
+                  putStrLn "==================================================="
+                else do
+                  putStrLn "---------------------------------------------------"
+                putStrLn $ "patstr                   = " ++ patstr
+                if code > 4
+                then putStrLn $  "expected value           = " ++ expect
+                else return ()
+--              putStrLn $ "pat = " ++ show pat
+                putStrLn $ "showPat.compilePat       = " ++ showPat pat
+                if code <= 4
+                then putStrLn $  "expected value           = " ++ expect
+                else return ()
+                s1 <- catch
+                        ( return $! force $! get $! forcep patstr exp )
+                        (\e -> do let err = show (e :: ErrorCall)
+--                      (\e -> do let err = show (e :: BottomedOut)
+                                  return err)
+                putStr "actual value             = "
+                return $! s1
+           )
+           -- ErrorCall if use __ = undefined
+           -- BottomedOut if use __ = throw BottomedOut
+           (\e -> do let err = show (e :: ErrorCall)
+--         (\e -> do let err = show (e :: BottomedOut)
+                     return err)
+    putStrLn s
+    doit18d False t
+
+-------------------------------------------------------------------------------
+
+  doit18e :: Bool -> [(Int,String)] -> IO ()
+  doit18e _ [] = do
+                   putStrLn "--------------------------------------------------"
+                   return ()
+  doit18e b ((code,patstr):t) = do
+    let expect = case code of
+                  1 -> "1"
+                  2 -> "Prelude.undefined"
+                  3 -> "pattern-match failure"
+                  4 -> "syntax error"
+                  5 -> "1 (but \"# with subpattern\" warning)"
+                  6 -> "1 (but \"constraint/subpattern arity mismatch\" warning)"
+                  13 -> "1 (but with pattern-match failure warning)"
+                  23 -> "Prelude.undefined (but with pattern-match failure warning)"
+                  _ -> error $ "doit18e: unexpected code " ++ show code
+    s <- catch
+           ( do
+                let exp = expTJ_8  -- __ :: TJ
+                let pat = compilePat patstr
+                let get = getJ8
+                if b
+                then do
+                  putStrLn "==================================================="
+                  putStrLn "exp = __ :: TJ"
+                  putStrLn "get ~_ = show 1  -- seems to suffice?!?..."
+                  putStrLn "? = get $ forcep patstr exp"
+                  putStrLn "==================================================="
+                else do
+                  putStrLn "---------------------------------------------------"
+                putStrLn $ "patstr                   = " ++ patstr
+                if code > 4
+                then putStrLn $  "expected value           = " ++ expect
+                else return ()
+--              putStrLn $ "pat = " ++ show pat
+                putStrLn $ "showPat.compilePat       = " ++ showPat pat
+                if code <= 4
+                then putStrLn $  "expected value           = " ++ expect
+                else return ()
+                s1 <- catch
+                        ( return $! force $! get $! forcep patstr exp )
+                        (\e -> do let err = show (e :: ErrorCall)
+--                      (\e -> do let err = show (e :: BottomedOut)
+                                  return err)
+                putStr "actual value             = "
+                return $! s1
+           )
+           -- ErrorCall if use __ = undefined
+           -- BottomedOut if use __ = throw BottomedOut
+           (\e -> do let err = show (e :: ErrorCall)
+--         (\e -> do let err = show (e :: BottomedOut)
+                     return err)
+    putStrLn s
+    doit18e False t
+
+-------------------------------------------------------------------------------
+
+  doit18f :: Bool -> [(Int,String)] -> IO ()
+  doit18f _ [] = do
+                   putStrLn "--------------------------------------------------"
+                   return ()
+  doit18f b ((code,patstr):t) = do
+    let expect = case code of
+                  1 -> "okay"
+                  2 -> "Prelude.undefined"
+                  3 -> "pattern-match failure"
+                  4 -> "syntax error"
+                  5 -> "okay (but \"# with subpattern\" warning)"
+                  6 -> "okay (but \"constraint/subpattern arity mismatch\" warning)"
+                  13 -> "okay (but with pattern-match failure warning)"
+                  23 -> "Prelude.undefined (but with pattern-match failure warning)"
+                  _ -> error $ "doit18f: unexpected code " ++ show code
+    s <- catch
+           ( do
+                let exp = (K5 (__::TJ))
+                let pat = compilePat patstr
+                let get _ = "okay"
+                if b
+                then do
+                  putStrLn "==================================================="
+                  putStrLn "exp = (K5 (__::TJ))"
+                  putStrLn "get ~_ = show 1  -- seems to suffice?!?..."
+                  putStrLn "? = get $ forcep patstr exp"
+                  putStrLn "==================================================="
+                else do
+                  putStrLn "---------------------------------------------------"
+                putStrLn $ "patstr                   = " ++ patstr
+                if code > 4
+                then putStrLn $  "expected value           = " ++ expect
+                else return ()
+--              putStrLn $ "pat = " ++ show pat
+                putStrLn $ "showPat.compilePat       = " ++ showPat pat
+                if code <= 4
+                then putStrLn $  "expected value           = " ++ expect
+                else return ()
+                s1 <- catch
+                        ( return $! force $! get $! forcep patstr exp )
+                        (\e -> do let err = show (e :: ErrorCall)
+--                      (\e -> do let err = show (e :: BottomedOut)
+                                  return err)
+                putStr "actual value             = "
+                return $! s1
+           )
+           -- ErrorCall if use __ = undefined
+           -- BottomedOut if use __ = throw BottomedOut
+           (\e -> do let err = show (e :: ErrorCall)
+--         (\e -> do let err = show (e :: BottomedOut)
+                     return err)
+    putStrLn s
+    doit18f False t
+
+
+-------------------------------------------------------------------------------
+
+  doit18g :: Bool -> [(Int,String)] -> IO ()
+  doit18g _ [] = do
+                   putStrLn "--------------------------------------------------"
+                   return ()
+  doit18g b ((code,patstr):t) = do
+    let expect = case code of
+                  1 -> "okay"
+                  2 -> "Prelude.undefined"
+                  3 -> "pattern-match failure"
+                  4 -> "syntax error"
+                  5 -> "okay (but \"# with subpattern\" warning)"
+                  6 -> "okay (but \"constraint/subpattern arity mismatch\" warning)"
+                  13 -> "okay (but with pattern-match failure warning)"
+                  23 -> "Prelude.undefined (but with pattern-match failure warning)"
+                  _ -> error $ "doit18g: unexpected code " ++ show code
+    s <- catch
+           ( do
+#if TRY_THIS
+                let exp = K3 (__::TK) J3
+#else
+                let exp = K3 K2 (__::TJ)
+#endif
+                let pat = compilePat patstr
+                let get _ = "okay"
+                if b
+                then do
+                  putStrLn "==================================================="
+#if TRY_THIS
+                  putStrLn "exp = K3 (__::TK) J3"
+#else
+                  putStrLn "exp = K3 K2 (__::TJ)"
+#endif
+                  putStrLn "get ~_ = show 1  -- seems to suffice?!?..."
+                  putStrLn "? = get $ forcep patstr exp"
+                  putStrLn "==================================================="
+                else do
+                  putStrLn "---------------------------------------------------"
+                putStrLn $ "patstr                   = " ++ patstr
+                if code > 4
+                then putStrLn $  "expected value           = " ++ expect
+                else return ()
+--              putStrLn $ "pat = " ++ show pat
+                putStrLn $ "showPat.compilePat       = " ++ showPat pat
+                if code <= 4
+                then putStrLn $  "expected value           = " ++ expect
+                else return ()
+                s1 <- catch
+                        ( return $! force $! get $! forcep patstr exp )
+                        (\e -> do let err = show (e :: ErrorCall)
+--                      (\e -> do let err = show (e :: BottomedOut)
+                                  return err)
+                putStr "actual value             = "
+                return $! s1
+           )
+           -- ErrorCall if use __ = undefined
+           -- BottomedOut if use __ = throw BottomedOut
+           (\e -> do let err = show (e :: ErrorCall)
+--         (\e -> do let err = show (e :: BottomedOut)
+                     return err)
+    putStrLn s
+    doit18g False t
+
+-------------------------------------------------------------------------------
+
+  doit19 :: Bool -> [(Int,String)] -> IO ()
+  doit19 _ [] = do
+                   putStrLn "--------------------------------------------------"
+                   return ()
+  doit19 b ((code,patstr):t) = do
+--  let expstr = "True"
+    let expstr = "5.6"
+    let expect = case code of
+                  1 -> expstr
+                  2 -> "Prelude.undefined"
+                  3 -> "pattern-match failure"
+                  4 -> "syntax error"
+                  5 -> expstr ++ " (but \"# with subpattern\" warning)"
+                  6 -> expstr ++ " (but \"constraint/subpattern arity mismatch\" warning)"
+                  13 -> expstr ++ " (but with pattern-match failure warning)"
+                  23 -> "Prelude.undefined (but with pattern-match failure warning)"
+                  _ -> error $ "doit19: unexpected code " ++ show code
+    s <- catch
+           ( do
+--              let exp = expTL_1  -- L1 5.6 (M1 True)
+                let exp = expTL_2  -- L1 5.6 (M1 __)
+--              let exp = expTL_3  -- L1 5.6 __
+--              let exp = expTL_4  -- L1 __ (M1 True)
+                let pat = compilePat patstr
+                let get = getL
+--              let get = getL'
+                if b
+                then do
+                  putStrLn "==================================================="
+                  putStrLn "exp = L1 5.6 (M1 __)"
+--                putStrLn "exp = L1 5.6 __"
+--                putStrLn "exp = L1 __ (M1 True)"
+                  putStrLn "get (L1 f (M1 _)) = show f"
+--                putStrLn "get (L1 f _) = show f"
+--                putStrLn "get (L1 _ (M1 b)) = show b"
+                  putStrLn "? = get $ forcep patstr exp"
+                  putStrLn "==================================================="
+                else do
+                  putStrLn "---------------------------------------------------"
+                putStrLn $ "patstr                   = " ++ patstr
+                if code > 4
+                then putStrLn $  "expected value           = " ++ expect
+                else return ()
+--              putStrLn $ "pat = " ++ show pat
+                putStrLn $ "showPat.compilePat       = " ++ showPat pat
+                if code <= 4
+                then putStrLn $  "expected value           = " ++ expect
+                else return ()
+                s1 <- catch
+                        ( return $! force $! get $! forcep patstr exp )
+                        (\e -> do let err = show (e :: ErrorCall)
+--                      (\e -> do let err = show (e :: BottomedOut)
+                                  return err)
+                putStr "actual value             = "
+                return $! s1
+           )
+           -- ErrorCall if use __ = undefined
+           -- BottomedOut if use __ = throw BottomedOut
+           (\e -> do let err = show (e :: ErrorCall)
+--         (\e -> do let err = show (e :: BottomedOut)
+                     return err)
+    putStrLn s
+    doit19 False t
+
+-------------------------------------------------------------------------------
+
+  doit20 :: Bool -> [(Int,String)] -> IO ()
+  doit20 _ [] = do
+                   putStrLn "--------------------------------------------------"
+                   return ()
+  doit20 b ((code,patstr):t) = do
+    let expect = case code of
+                  1 -> "4.5"
+                  2 -> "Prelude.undefined"
+                  3 -> "pattern-match failure"
+                  4 -> "syntax error"
+                  5 -> "4.5 (but \"# with subpattern\" warning)"
+                  6 -> "4.5 (but \"constraint/subpattern arity mismatch\" warning)"
+                  13 -> "4.5 (but with pattern-match failure warning)"
+                  23 -> "Prelude.undefined (but with pattern-match failure warning)"
+                  _ -> error $ "doit20: unexpected code " ++ show code
+    s <- catch
+           ( do
+--              let exp = expTK_1  -- K3 K2 (J1 4.5)
+                let exp = expTK_2  -- K3 __ (J1 4.5)
+                let pat = compilePat patstr
+                let get = getK
+                if b
+                then do
+                  putStrLn "==================================================="
+--                putStrLn "exp = K3 K2 (J1 4.5)"
+                  putStrLn "exp = K3 __ (J1 4.5)"
+                  putStrLn "get = (K3 _ (J1 f)) = show f"
+                  putStrLn "? = get $ forcep patstr exp"
+                  putStrLn "==================================================="
+                else do
+                  putStrLn "---------------------------------------------------"
+                putStrLn $ "patstr                   = " ++ patstr
+                if code > 4
+                then putStrLn $  "expected value           = " ++ expect
+                else return ()
+--              putStrLn $ "pat = " ++ show pat
+                putStrLn $ "showPat.compilePat       = " ++ showPat pat
+                if code <= 4
+                then putStrLn $  "expected value           = " ++ expect
+                else return ()
+                s1 <- catch
+                        ( return $! force $! get $! forcep patstr exp )
+                        (\e -> do let err = show (e :: ErrorCall)
+--                      (\e -> do let err = show (e :: BottomedOut)
+                                  return err)
+                putStr "actual value             = "
+                return $! s1
+           )
+           -- ErrorCall if use __ = undefined
+           -- BottomedOut if use __ = throw BottomedOut
+           (\e -> do let err = show (e :: ErrorCall)
+--         (\e -> do let err = show (e :: BottomedOut)
+                     return err)
+    putStrLn s
+    doit20 False t
+
+-------------------------------------------------------------------------------
+
+  doit23 :: String
+  doit23 = show $ fg23 exp23
+--doit23 = show $ get23 $ forcepDyn' fg23 exp23
+   where
+    exp23 = [[[__]],[[__,6],__,[7]]] :: [[[Int]]]
+    get23 xs = (((xs!!1)!!2)!!0)
+#if 0
+    fg23 :: forall a. (Generic a, HasDatatypeInfo a) => a -> DatatypeInfo (Code a)
+    fg23 d = dti
+#else
+    fg23 :: forall a. (Generic a, HasDatatypeInfo a, All2 Show (Code a), Typeable a) => a -> PatNode
+#if 1
+    fg23 d = doit23' dti proxy_a d (from d)
+#else
+    fg23 d | cname == "[[Int]]"  = WI
+           | otherwise           = WR
+#endif
+#endif
+     where
+--    ADT mname tname (Constructor cname :* _) = dti
+--    ADT mname tname (Constructor cname :* _) = dti :: DatatypeInfo (Code a)
+--    (mname,tname,cname) = case dti of ...
+--    ADT mname tname (Constructor cname :* (Infix ":" RightAssociative 5 :* Nil)) = dti
+      dti = datatypeInfo proxy_a
+      proxy_a = Proxy :: Proxy a
+      xrep = from d
+
+  doit23' :: forall a.
+             (
+               Generic a
+             , HasDatatypeInfo a
+--           , All2 NFDataP (Code a)
+             , All2 Show (Code a)
+             , Typeable a
+--           , NFDataN a
+--           , NFDataP a
+             ) =>
+                     DatatypeInfo (Code a)
+                  -> Proxy a
+                  -> a
+                  -> Rep a
+                  -> PatNode
+  doit23' (ADT     _ _ cs) proxy_a x xrep
+   = doit23'' cs         proxy_a x xrep
+  doit23' (Newtype _ _ c ) proxy_a x xrep
+   = doit23'' (c :* Nil) proxy_a x xrep
+
+  doit23'' :: forall a xss.
+            (
+              Generic a
+            , HasDatatypeInfo a
+            , All2 Show xss
+            ) =>
+                    NP ConstructorInfo xss
+                 -> Proxy a
+                 -> a
+                 -> SOP I xss
+                 -> PatNode
+  doit23'' (m :* _) proxy_a x (SOP (Z xs))
+   | tx == "[[Int]]"  = WI
+   | otherwise        = WR
+   where
+    !_ = trace ("*** "++tx) $ ()
+    tx | (Constructor n) <- m  = n
+       | (Infix n _ _) <- m    = n
+       | (Record n _) <- m     = n
+  doit23'' (m :* ms) proxy_a x (SOP (S xss))
+   = doit23'' ms proxy_a x (SOP xss)
+  doit23'' _ _ _ _ = error "doit23'': unexpected case!!"
+
+-------------------------------------------------------------------------------
+
+#endif
+
+  doit24 :: Bool -> [(Int,Int,(Float,[Int],Bool))] -> IO ()
+  doit24 _ [] = do
+                   putStrLn "--------------------------------------------------"
+                   return ()
+  doit24 b ((code,ident,exp):t) = do
+    let expect = case code of
+                  1 -> "7"
+                  2 -> "Prelude.undefined"
+                  3 -> "pattern-match failure"
+                  4 -> "syntax error"
+                  5 -> "7 (but \"# with subpattern\" warning)"
+                  6 -> "7 (but \"constraint/subpattern arity mismatch\" warning)"
+                  13 -> "7 (but with pattern-match failure warning)"
+                  23 -> "Prelude.undefined (but with pattern-match failure warning)"
+                  _ -> error $ "doit24: unexpected code " ++ show code
+    s <- catch
+           ( do
+--              let exp = force_ Propagate (force_ Propagate 3.4, force_ Propagate (force_ Propagate 5 : (force_ Propagate __ : (force_ Propagate 7 : force_ Propagate []))), force_ Propagate __) :: (Float, [Int], Bool)
+--              let seq_exp = mkSeqableHarness exp
+--              let pat = compilePat patstr
+                let get (_,xs,_) = show $ (xs!!2)
+                if b
+                then do
+                  putStrLn "==================================================="
+                  putStrLn "exp = <refer to test code>"
+                  putStrLn "get (_,xs,_) = show $ (xs!!2)"
+                  putStrLn "? = get $! exp"
+                  putStrLn "==================================================="
+                else do
+                  putStrLn "---------------------------------------------------"
+--              putStrLn $ "patstr                   = " ++ patstr
+                if code > 4
+                then putStrLn $  show ident ++ " expected value           = " ++ expect
+                else return ()
+--              putStrLn $ "pat = " ++ show pat
+--              putStrLn $ "showPat.compilePat       = " ++ showPat pat
+                if code <= 4
+                then putStrLn $  show ident ++ " expected value           = " ++ expect
+                else return ()
+                s1 <- catch
+                        ( return $! force $! get $! exp )
+                        (\e -> do let err = show (e :: ErrorCall)
+--                      (\e -> do let err = show (e :: BottomedOut)
+                                  return err)
+                putStr $ show ident ++ " actual value             = "
+                return $! s1
+           )
+           -- ErrorCall if use __ = undefined
+           -- BottomedOut if use __ = throw BottomedOut
+           (\e -> do let err = show (e :: ErrorCall)
+--         (\e -> do let err = show (e :: BottomedOut)
+                     return err)
+    putStrLn s
+    doit24 False t
+
+-------------------------------------------------------------------------------
+
+  doit25 :: Bool -> [(Int,Int,(Float,(Bool,Int),Bool))] -> IO ()
+  doit25 _ [] = do
+                   putStrLn "--------------------------------------------------"
+                   return ()
+  doit25 b ((code,ident,exp):t) = do
+    let expect = case code of
+                  1 -> "7"
+                  2 -> "Prelude.undefined"
+                  3 -> "pattern-match failure"
+                  4 -> "syntax error"
+                  5 -> "7 (but \"# with subpattern\" warning)"
+                  6 -> "7 (but \"constraint/subpattern arity mismatch\" warning)"
+                  13 -> "7 (but with pattern-match failure warning)"
+                  23 -> "Prelude.undefined (but with pattern-match failure warning)"
+                  _ -> error $ "doit25: unexpected code " ++ show code
+    s <- catch
+           ( do
+--              let exp = force_ Propagate (force_ Propagate 3.4, force_ Propagate (force_ Propagate 5 : (force_ Propagate __ : (force_ Propagate 7 : force_ Propagate []))), force_ Propagate __) :: (Float, [Int], Bool)
+--              let seq_exp = mkSeqableHarness exp
+--              let pat = compilePat patstr
+                let get (_,(_,x),_) = show x
+                if b
+                then do
+                  putStrLn "==================================================="
+                  putStrLn "exp = <refer to test code>"
+                  putStrLn "get (_,(_,x),_) = show x"
+                  putStrLn "? = get $! exp"
+                  putStrLn "==================================================="
+                else do
+                  putStrLn "---------------------------------------------------"
+--              putStrLn $ "patstr                   = " ++ patstr
+                if code > 4
+                then putStrLn $  show ident ++ " expected value           = " ++ expect
+                else return ()
+--              putStrLn $ "pat = " ++ show pat
+--              putStrLn $ "showPat.compilePat       = " ++ showPat pat
+                if code <= 4
+                then putStrLn $  show ident ++ " expected value           = " ++ expect
+                else return ()
+                s1 <- catch
+                        ( return $! force $! get $! exp )
+                        (\e -> do let err = show (e :: ErrorCall)
+--                      (\e -> do let err = show (e :: BottomedOut)
+                                  return err)
+                putStr $ show ident ++ " actual value             = "
+                return $! s1
+           )
+           -- ErrorCall if use __ = undefined
+           -- BottomedOut if use __ = throw BottomedOut
+           (\e -> do let err = show (e :: ErrorCall)
+--         (\e -> do let err = show (e :: BottomedOut)
+                     return err)
+    putStrLn s
+    doit25 False t
+
+-------------------------------------------------------------------------------
+
+#if USE_SOP
+
+  doit26 :: Bool -> [(Int,Int,(Float,[Int],Bool))] -> IO ()
+  doit26 _ [] = do
+                   putStrLn "--------------------------------------------------"
+                   return ()
+  doit26 b ((code,ident,exp):t) = do
+    let expect = case code of
+                  1 -> "7"
+                  2 -> "Prelude.undefined"
+                  3 -> "pattern-match failure"
+                  4 -> "syntax error"
+                  5 -> "7 (but \"# with subpattern\" warning)"
+                  6 -> "7 (but \"constraint/subpattern arity mismatch\" warning)"
+                  13 -> "7 (but with pattern-match failure warning)"
+                  23 -> "Prelude.undefined (but with pattern-match failure warning)"
+                  _ -> error $ "doit26: unexpected code " ++ show code
+    s <- catch
+           ( do
+--              let exp = force_ Propagate (force_ Propagate 3.4, force_ Propagate (force_ Propagate 5 : (force_ Propagate __ : (force_ Propagate 7 : force_ Propagate []))), force_ Propagate __) :: (Float, [Int], Bool)
+--              let seq_exp = mkSeqableHarness exp
+--              let pat = compilePat patstr
+                let get (_,xs,_) = show $ (xs!!2)
+                if b
+                then do
+                  putStrLn "==================================================="
+                  putStrLn "exp = <refer to test code>"
+                  putStrLn "get (_,xs,_) = show $ (xs!!2)"
+                  putStrLn "? = get $! exp"
+                  putStrLn "==================================================="
+                else do
+                  putStrLn "---------------------------------------------------"
+--              putStrLn $ "patstr                   = " ++ patstr
+                if code > 4
+                then putStrLn $  show ident ++ " expected value           = " ++ expect
+                else return ()
+--              putStrLn $ "pat = " ++ show pat
+--              putStrLn $ "showPat.compilePat       = " ++ showPat pat
+                if code <= 4
+                then putStrLn $  show ident ++ " expected value           = " ++ expect
+                else return ()
+                s1 <- catch
+                        ( return $! force $! get $! exp )
+                        (\e -> do let err = show (e :: ErrorCall)
+--                      (\e -> do let err = show (e :: BottomedOut)
+                                  return err)
+                putStr $ show ident ++ " actual value             = "
+                return $! s1
+           )
+           -- ErrorCall if use __ = undefined
+           -- BottomedOut if use __ = throw BottomedOut
+           (\e -> do let err = show (e :: ErrorCall)
+--         (\e -> do let err = show (e :: BottomedOut)
+                     return err)
+    putStrLn s
+    doit26 False t
+
+-------------------------------------------------------------------------------
+
+  doit27 :: Bool -> [(Int,Int,TJ)] -> IO ()
+  doit27 _ [] = do
+                   putStrLn "--------------------------------------------------"
+                   return ()
+  doit27 b ((code,ident,exp):t) = do
+    let expect = case code of
+                  1 -> "4.5"
+                  2 -> "Prelude.undefined"
+                  3 -> "pattern-match failure"
+                  4 -> "syntax error"
+                  5 -> "4.5 (but \"# with subpattern\" warning)"
+                  6 -> "4.5 (but \"constraint/subpattern arity mismatch\" warning)"
+                  13 -> "4.5 (but with pattern-match failure warning)"
+                  23 -> "Prelude.undefined (but with pattern-match failure warning)"
+                  _ -> error $ "doit27: unexpected code " ++ show code
+    s <- catch
+           ( do
+--              let exp = expTJ_1  -- J2 (1, J4 (J3, K3 K2 (J1 4.5))) False
+--              let exp = expTJ_2  -- J2 (1, J4 (J3, K3 __ (J1 4.5))) False
+--              let exp = expTJ_3  -- J2 (1, J4 (__, K3 K2 (J1 4.5))) False
+--              let exp = expTJ_4  -- J2 (1, J4 (__, K3 __ (J1 4.5))) __
+--              let pat = compilePat patstr
+                let get = getJ
+                if b
+                then do
+                  putStrLn "==================================================="
+--                putStrLn "exp = J2 (1, J4 (J3, K3 K2 (J1 4.5))) False"
+--                putStrLn "exp = J2 (1, J4 (J3, K3 __ (J1 4.5))) False"
+--                putStrLn "exp = J2 (1, J4 (__, K3 K2 (J1 4.5))) False"
+                  putStrLn "exp = J2 (1, J4 (__, K3 __ (J1 4.5))) __"
+                  putStrLn "get = (J2 (_, J4 (_, K3 _ (J1 f))) _) = show f"
+                  putStrLn "? = get exp"
+                  putStrLn "==================================================="
+                else do
+                  putStrLn "---------------------------------------------------"
+--              putStrLn $ "patstr                   = " ++ patstr
+                if code > 4
+                then putStrLn $  show ident ++ " expected value           = " ++ expect
+                else return ()
+--              putStrLn $ "pat = " ++ show pat
+--              putStrLn $ "showPat.compilePat       = " ++ showPat pat
+                if code <= 4
+                then putStrLn $  show ident ++ " expected value           = " ++ expect
+                else return ()
+                s1 <- catch
+                        ( return $! force $! get $! exp )
+                        (\e -> do let err = show (e :: ErrorCall)
+--                      (\e -> do let err = show (e :: BottomedOut)
+                                  return err)
+                putStr $ show ident ++ " actual value             = "
+                return $! s1
+           )
+           -- ErrorCall if use __ = undefined
+           -- BottomedOut if use __ = throw BottomedOut
+           (\e -> do let err = show (e :: ErrorCall)
+--         (\e -> do let err = show (e :: BottomedOut)
+                     return err)
+    putStrLn s
+    doit27 False t
+
+-------------------------------------------------------------------------------
+
+#endif
+
diff --git a/test/Blah98.hs b/test/Blah98.hs
new file mode 100644
--- /dev/null
+++ b/test/Blah98.hs
@@ -0,0 +1,1093 @@
+
+-------------------------------------------------------------------------------
+
+-- This is a pared-down version of Blah.hs, for testing
+-- deepseq-bounded when built with the HASKELL98_FRAGMENT
+-- flag set.  See Blah.hs for comments and other "flesh".
+
+-------------------------------------------------------------------------------
+
+{-# LANGUAGE CPP #-}
+
+-------------------------------------------------------------------------------
+
+#define FOCUS_TEST 0
+#define USE_TRACE 0
+
+-------------------------------------------------------------------------------
+
+  module Blah98 ( run_tests ) where
+
+-------------------------------------------------------------------------------
+
+  import Foo
+
+  import Control.DeepSeq.Bounded hiding ( F )
+
+  import Data.Maybe
+
+  import Control.Exception
+--import Control.Monad ( guard )
+  import Control.Monad ( replicateM )
+  import Control.Monad ( when )
+
+  import Data.Typeable ( Typeable )
+  import Data.Typeable ( typeOf )
+
+--import Util ( spoor )
+  import Debug.Trace ( trace )
+  import Control.DeepSeq
+
+  import Data.Typeable ( Proxy(..) )
+
+  import System.IO.Unsafe ( unsafePerformIO )
+
+-------------------------------------------------------------------------------
+
+  -- For convenience in GHCi interactive sessions:
+  cp = compilePat
+  ip = intersectPats
+  isp = isSubPatOf
+
+-------------------------------------------------------------------------------
+
+  run_tests = do
+    putStr "\n"
+    -- So can notice the start when scrollback, esp. in ghci reload/reruns.
+--  replicateM 50 $ putStrLn "################################################################################"
+    putStrLn "\nTesting.\n"
+
+#if ! FOCUS_TEST
+
+#if 1
+--  let shp s = s ++ replicate (30 - length s) ' ' ++ show (compilePat s)
+    let shp s = 
+         unsafePerformIO $
+         catch
+          ( return $! force $ s ++ replicate (30 - length s) ' ' ++ show (compilePat s) )
+          ( \e -> do let err = show (e :: ErrorCall)
+                     return err )
+
+    putStrLn "Pattern                       Compiles to"
+--  putStrLn $ shp ""  -- empty pattern syntax error
+    putStrLn $ shp "*"  -- Node WW []
+--  putStrLn $ shp "@"  -- Node WS []  -- obsoleted (use "." w/o children)
+    putStrLn $ shp "#"  -- Node I []  -- no parent to absorb (should be error)
+    putStrLn $ shp "."  -- Node WS []
+--  putStrLn $ shp "**"  -- Node WS []  -- "disconnected pattern (not rooted)"
+--  putStrLn $ shp ".*"  -- Node WS []  -- "disconnected pattern (not rooted)"
+--  putStrLn $ shp "*."  -- Node WS []  -- "disconnected pattern (not rooted)"
+    putStrLn $ shp ".{}"  -- Node WR []
+    putStrLn $ shp ".{*}"  -- Node WR [Node WW []]
+    putStrLn $ shp ".{**}"  -- Node WR [Node WW [],Node WW []]
+    putStrLn $ shp ".{.*}"  -- Node WR [Node WS [],Node WW []]
+    putStrLn $ shp ".{#.}"  -- Node WR [Node I [],Node WS []]
+    putStrLn $ shp ".{#{#}}"  -- Node WR [Node I []] with warning
+    putStrLn $ shp ".{.{#}}"  -- Node WR [Node WR [Node I []]]
+    putStrLn $ shp ".{*#*#*#**#*#*}"  -- looks fine
+    putStrLn $ shp ".{*#.{*#.{*#}*}*{#*}#*}"  -- warning about *{...}
+    putStrLn $ shp ".{*#.{*#.{*#}*}*#*}"
+--  putStrLn $ shp ".{*#.{*#.{*#}*}{*}{#*}#*}"  -- }{ syntax error
+-- [old comment for that last:] NodeM WR [NodeM WW [],Nil,NodeM WR [NodeM WW [],Nil,NodeM WR [NodeM WW [],Nil],NodeM WW [],NodeM WW [],Nil,NodeM WW []],Nil,NodeM WW []] -- was wrong but is fixed I think
+    putStrLn $ shp ".{.*.{*23*}}"
+#endif
+
+#if 1
+    let test_patterns10 = [
+           (4,  "")  -- syntax error
+         , (4,  ".##")  -- syntax error (disconnected pattern)
+         , (1,  ".{.##}")  -- fail
+         , (5,  ".{.{}#{}#{}}")
+         , (2,  "*")
+         , (2,  ".{***}")
+         , (1,  ".{###}")
+         , (1,  ".{*##}")
+         , (2,  ".{**#}")
+         , (2,  ".{##*}")
+
+           -- Remember, [a] is a recursive binary ctor app!...
+           -- The next four tests give instance errors for [a], but if
+           -- testing expTG_* (GNFDataP/grnfp) then it's no longer a list...
+         , (13, ".{..{*#*}#}")
+         , (13, ".{..{*###}#}")
+         , (13, ".{..{*####}#}")
+         , (23, ".{..{*####}.}")
+
+         , (2,  ".{..{*#}*}")
+         , (1,  ".{..{*#}#}")
+         , (1,  ".{..{*.{#*}}#}")
+         , (2,  ".{..{*.{*#}}#}")
+         , (13, ".{..{.{..{#*}}}#}")  -- See above comment about [a] instance
+         , (2,  ".{#.{..{..{#*}}}#}")
+
+           -- (See Book, p.84.)
+         , (1,  ".{..{..{#.{..}}}#}")
+         , (1,  ".{..{..{#*}}#}")
+         , (1,  ".{*.{*.{#*}}#}")
+         , (2,  ".{##*}")
+         , (2,  ".{*#*}")
+         , (1,  ".:Tuple3{*.{*.{#*}}#}")  -- oops...
+         , (1,  ".:(,,){*.{*.{#*}}#}")
+         , (2,  ".:(,,){*.{*.{.*}}#}")
+         , (1,  ".:Bool{***}")  -- XXX makes no sense (but works) -- oh well;
+                                  -- this is an important point to note in
+                                  -- docs/blog also...
+         , (1,  "*:Bool")
+         , (2,  "*:(,,)")
+         , (2,  ".{*#.}")
+         , (2,  ".{*#.:Bool}")  -- XXX this gives parse error on 2nd .
+         , (2,  ".{*#.:Bool{}}")  -- XXX this gives no parse error; if it does what
+                                  -- it says, it will only match a childless Bool node
+         , (1,  ".{*#.:Int{}}")  -- still need to implement # when not in type
+         , (1,  ".{*#.:(,){}}")  -- still need to implement # when not in type
+         , (1,  ".{*#.:Int }")  -- still need to implement # when not in type
+         , (1,  ".{*#.:Int'}")  -- still need to implement # when not in type
+         , (1,  ".{*##:Bool}")
+         , (2,  ".{*##:Int}")
+         , (2,  ".{*##:(,)}")
+         , (1,  ".{*##:Bool{}}")
+         , (2,  ".{*##:Int{}}")
+         , (2,  ".{*##:(,){}}")
+         , (1,  ".{**2#}")
+         , (2,  ".{**3#}")
+         , (1,  ".{*#:G2{}#}")
+         , (1,  ".{*#:Int{}#}")
+         ]
+    doit14 True test_patterns10
+--  doit10 True test_patterns10
+#endif
+
+#endif
+
+---------------------------------------------
+
+-- Later: Oh! Don't be silly -- it's all compile-time, and the
+-- size or shape of the list is irrelevant -- which rules
+-- will fire depends on THIS FILE'S SOURCE CODE (not it's
+-- data, including static values)!
+-- XXX Even with empty list, the same rule firings occur!...
+-- If comment out this block however, the rules do not fire!
+#if 1
+    -- Testing composition and union:
+    let test_patterns11 = [
+           (1, ".", ".")
+         , (2, ".", "*")
+         , (2, "*", ".")
+         , (2, "*", "*")
+         , (2, ".{...}", ".{*..}")
+         , (2, ".{*..}", ".{..*}")
+         , (2, ".{.*#}", ".{.#.}")
+         ]
+    doit11 True test_patterns11
+#endif
+
+#if 1
+    -- Testing splicePats
+    let test_patterns12 = [
+#if 1
+           (1, ".", [], [(0,"*")])
+         , (1, ".{}", [], [(0,"*")])
+         , (1, ".", [0], [(0,"*")])
+         , (1, ".{..}", [], [(0,"*")])
+         , (1, ".{..}", [0], [(0,"*")])
+         , (1, ".{..}", [2], [(0,"*")])
+         , (1, ".{..}", [], [(0,"*"),(0,"#")])
+         , (1, ".{..}", [], [(0,"*"),(1,"#")])
+         , (1, ".{..}", [], [(1,"#"),(0,"*")])
+         , (1, ".{..}", [], [(0,"*"),(2,"#")])
+         , (1, ".{..}", [], [(2,"*"),(2,"#"),(2,"#")])
+         , (1, ".{..}", [], [(-1,"*")])
+         , (1, ".{..}", [], [(0,"*")])
+         , (1, ".{..}", [], [(1,"*")])
+         , (1, ".{..}", [], [(2,"*")])
+         , (1, ".{..}", [], [(3,"*")])
+         , (1, ".{..{..}.}", [1], [(0,"*")])
+         , (1, ".{..{..}.}", [1], [(0,"*3"),(1,"#"),(2,"*")])
+         , (1, ".{..{..}.}", [1,0], [(0,"*"),(0,"#")])
+         , (1, ".{.{...}.{.{}.}.}", [1], [(0,"*"),(0,"#")])
+         , (1, ".{.{...}.{.{}.}.}", [1,0], [(0,"*"),(0,"#")])
+         , (1, ".{.{###}.{.{}#}#}", [1,0], [(0,"*"),(0,"#")])
+         , (1, ".{.:(,,){###}.{.{}#}#}", [1,0], [(0,"*"),(0,"#")])
+#else
+           (1, ".", ".{}", [(0,"*")])
+         , (1, ".{}", ".{}", [(0,"*")])
+         , (1, ".", ".{.{}}", [(0,"*")])  -- added later, did uncover a bug! (irrefutable pattern failure)
+         , (1, ".{..}", ".{}", [(0,"*")])
+         , (1, ".{..}", ".{.{}}", [(0,"*")])
+         , (1, ".{..}", ".{...{}}", [(0,"*")])
+         , (1, ".{..}", ".{}", [(0,"*"),(0,"#")])
+         , (1, ".{..}", ".{}", [(0,"*"),(1,"#")])
+         , (1, ".{..}", ".{}", [(1,"#"),(0,"*")])
+         , (1, ".{..}", ".{}", [(0,"*"),(2,"#")])
+         , (1, ".{..}", ".{}", [(2,"*"),(2,"#"),(2,"#")])
+         , (1, ".{..}", ".{}", [(-1,"*")])
+         , (1, ".{..}", ".{}", [(0,"*")])
+         , (1, ".{..}", ".{}", [(1,"*")])
+         , (1, ".{..}", ".{}", [(2,"*")])
+         , (1, ".{..}", ".{}", [(3,"*")])
+         , (1, ".{..{..}.}", ".{..{}.}", [(0,"*")])
+         , (1, ".{..{..}.}", ".{..{}.}", [(0,"*3"),(1,"#"),(2,"*")])
+         , (1, ".{..{..}.}", ".{..{.{}.}.}", [(0,"*"),(0,"#")])
+         , (1, ".{..{..}.}", ".{..{.{}}}", [(0,"*"),(0,"#")])
+         , (1, ".{.{...}.{.{}.}.}", ".{..{}}", [(0,"*"),(0,"#")])
+         , (1, ".{.{...}.{.{}.}.}", ".{..{.{}}}", [(0,"*"),(0,"#")])
+         , (1, ".{.{###}.{.{}#}#}", ".{..{.{}}}", [(0,"*"),(0,"#")])
+         , (1, ".{.:(,,){###}.{.{}#}#}", ".{..{.{}}}", [(0,"*"),(0,"#")])
+#endif
+         ]
+    doit12 True test_patterns12
+#endif
+
+#if ! FOCUS_TEST
+
+#if 1
+    -- Testing anything else we can with a single function!
+    -- (Getting sick of this cloning.)
+    -- Functions are listed in (current) export order.
+    -- Things still needing testing are >'d.
+    -- Things tested but failing some tests have a *.
+    -- 
+    -- XXX Wow does this ever look cleaner with "Pat" instead of "Pattern"!...
+    -- Fortunately splicePats is already tested separately; the rest
+    -- we need to test deal only in Pat args (or list of same), so
+    -- we can pass a couple [Pat] to test13 along with an Int code
+    -- to control delegation.
+    --  1    unionPats       :: [ Pat ] -> Pat
+    --  2    intersectPats   :: [ Pat ] -> Pat
+    --  3    isSubPatOf      :: Pat -> Pat -> Bool
+--  --  4    unionPatsStr    :: [ String ] -> String
+    --  5    emptyPat        :: Pat
+--  --  6    mkPat           :: forall d. Data d => d -> Pat
+--  --  7    growPat         :: forall d. Data d => Pat -> d -> Pat
+    --  8    shrinkPat       :: Pat -> Pat
+    --  9    liftPats        :: [ Pat ] -> Pat
+    -- 10    splicePats      :: Pat -> Pat -> [(Int, Pat)] -> Pat
+    -- 11    isPath          :: Pat -> Bool
+    let test_patterns13 = [
+           ( 1, [".{...}", ".{.#}"], "")
+         , ( 2, [".{...}", ".{.#}"], "")
+         , ( 3, [".", "."], "True")
+         , ( 3, ["#", "#"], "True")
+         , ( 3, ["*", "*"], "True")
+         , ( 3, [".", ".{}"], "True")
+         , ( 3, [".{}", "."], "False")
+         , ( 3, [".{}", ".{.}"], "False")
+         , ( 3, [".{.}", ".{.}"], "True")
+         , ( 3, [".{.}", ".{..}"], "False")
+         , ( 3, [".{.}", ".{.{.}}"], "True")
+         , ( 3, [".{..}", ".{.#}"], "False")
+         , ( 3, [".{.#}", ".{..}"], "True")
+         , ( 3, [".{..}", ".{...}"], "False")
+         , ( 3, [".{}", ".{...}"], "False")
+         , ( 3, [".", ".{*.#}"], "True")
+         , ( 3, ["#", ".{*.#}"], "True")
+         , ( 3, ["*", ".{*.#}"], "False")
+         , ( 3, ["*", ".{*}"], "False")
+         , ( 3, ["*", ".{**}"], "False")
+         , ( 4, [".{...}", ".{.#}"], "")
+         , ( 5, [".{...}", ".{.#}"], "")
+#if 0
+         , ( 6, [".{...}", ".{.#}"], "")
+         -- matching against val = ([1,2,3::Int],(False,"foo"))
+         -- mkPat val = ".{.{..{..{..}}}.{..{..{..{..}}}}}"
+#endif
+#if 0
+         , ( 7, [".{.{..{..}}.{..{..}}}"], "")
+         , ( 7, [".{.{..{..{..}}}.{..{..{..}}}}"], "")
+         , ( 7, [".{.{..{..{..}}}.{..{..{..{..}}}}}"], "")
+#endif
+         , ( 8, [".{.{..{..{..}}}.{..{..{..{..}}}}}"], "")
+         , ( 8, [".{.{..{..{..}}}.{..{..{..}}}}"], "")
+         , ( 8, [".{.{..{..}}.{..{..}}}"], "")
+         , ( 8, [".{.{#.{..}}.{#.{*3.}}}"], "")
+         , ( 8, [".{.{#.}.{#.}}"], "")
+         , ( 8, [".{..}"], "")
+         , ( 8, ["."], "")
+         , ( 9, [".{...}", ".{.#}"], "")
+         , (10, [".{...}", ".{.#}"], "")
+         , (11, [".{...}", ".{.#}"], "")
+         ]
+    putStrLn "===================================================="
+    putStrLn "Testing miscellaneous NFDataP functions..."
+    doit13 True test_patterns13
+#endif
+
+#if 1
+    -- Testing fusion
+    putStrLn "\nTesting fusion\n-fenable-rewrite-rules -O -ddump-rules -ddump-simpl-stats -ddump-rule-firings\n"
+    let exp12 = (3.4, [5,__,7], __) :: (Float, [Int], Bool)
+    let get12 (_,xs,_) = (xs!!2)
+    putStrLn $ show $ get12 $ ( forcep ".:Bool" . forcep ".:Int" ) exp12
+    putStrLn $ show $ get12 $ ( forcep ".:Bool" . forcep_ (compilePat ".:Int") ) exp12
+    putStrLn $ show $ get12 $ ( forcep_ (compilePat ".:Bool") . forcep ".:Int" ) exp12
+    putStrLn $ show $ get12 $ ( forcep_ (compilePat ".:Bool") . forcep_ (compilePat ".:Int") ) exp12
+#endif
+
+#if 1
+    putStrLn "\n\
+  expN_1 = [__] :: [Int]\n\
+  expN_2 = [0,1,__,3] :: [Int]\n\
+  expN_3 = (3.4, [5,__,7], True) :: (Float, [Int], Bool)\n\
+  expN_4 = (3.4, [5,__,7], __) :: (Float, [Int], Bool)\n\
+\n\
+  getN_1 xs = show $ ()\n\
+--getN_1 xs = show $ head xs\n\
+--getN_2 xs = show $ (xs!!1)\n\
+  getN_2 xs = show $ (xs!!3)\n\
+  getN_3 (_,xs,_) = show $ (xs!!2)\n"
+    doit5 1 0 1 "" >>= putStrLn
+    doit6 1 0 1 "" >>= putStrLn
+    doit7 1 0 1 "" >>= putStrLn
+    doit8 1 0 1 "" >>= putStrLn
+#if 0
+    doit9 >>= putStrLn  -- XXX broken (whatever it is)
+#endif
+#endif
+
+#if 0
+    s4 <- doit4 1 0 1 ""
+    putStrLn s4
+#endif
+
+#if 0
+    putStrLn $ ""
+           ++ "expBase1 = ([True,False],3,Just \"fox\")         :: ([Bool],Int,Maybe String)\n"
+           ++ "expBase2 = ([True,False],__,Just \"fox\")        :: ([Bool],Int,Maybe String)\n"
+           ++ "expBase3 = ([True,__],3,Just \"fox\")            :: ([Bool],Int,Maybe String)\n"
+           ++ "expBase4 = ([True,__],3,Just __)               :: ([Bool],Int,Maybe String)\n"
+           ++ "expBase5 = ([True,False],3,Just ['f',__,'x'])  :: ([Bool],Int,Maybe String)\n"
+           ++ "expBase6 = ([True,False],3,Just __)            :: ([Bool],Int,Maybe String)\n"
+           ++ "get1 ((x:_),_,_) = x           -- True\n"
+           ++ "get2 (_,x,_) = x               -- 3\n"
+           ++ "get3 (_,_,x) = fromJust x      -- \"fox\"\n"
+           ++ "get4 (_,_,Just (x:_)) = x      -- 'f'\n"
+    s1 <- doit1 1 1 1 ""
+    putStrLn s1
+#endif
+
+#endif
+
+-------------------------------------------------------------------------------
+
+  hline :: String
+  hline = "----------------------------------------------------\n"
+  hdline :: String
+  hdline = "====================================================\n"
+
+-------------------------------------------------------------------------------
+
+  doit1 :: Int -> Int -> Int -> String -> IO String
+  doit1 i j k acc
+   -- this glitch (the exception that seemingly escapes my catch)
+   -- happens just for these combos (and for all j):
+-- | i == 3 && k == 4  = doit1 (1+i) j k acc  -- trying to avoid a glitch...
+-- | i == 3 && k == 5  = doit1 (1+i) j k acc  -- trying to avoid a glitch...
+-- | i == 3 && j < 4 && k == 5  = doit1 (1+i) j k acc  -- trying to avoid a glitch...
+   | k == 7  = return acc
+   | j == 6  = doit1 1 1 (1+k) acc
+   | i == 5  = doit1 1 (1+j) k acc
+   | otherwise  = do
+      fexp <- catch
+               -- The semantics of the !'s here are not what they were,
+               -- since forcing in some places. [?] But at least the
+               -- first one seems definitely still needed...
+               -- LATER: The second one is also needed, finally seen!
+               -- (It is needed for a version of getE _ = "getee", only.)
+               -- XXX I'm just not sure whether the second ! is better
+               -- to leave in or leave out...
+               ( return $! get $! forcen dep exp )
+               (\e -> do let err = show (e :: ErrorCall)
+--             (\e -> do let err = show (e :: BottomedOut)
+                         return err)
+--    doit1 (1+i) j k $! force $ acc
+      doit1 (1+i) j k $! acc
+--    doit1 (1+i) j k $ acc
+        ++ "( get" ++ show i ++ " $ forcen " ++ show dep ++ " expBase" ++ show k ++ " )  "
+        ++ fexp ++ "\n"
+   where
+    exp = case k of
+            1 -> expBase1
+            2 -> expBase2
+            3 -> expBase3
+            4 -> expBase4
+            5 -> expBase5
+            6 -> expBase6
+    get = case i of
+           1 -> get1
+           2 -> get2
+--         3 -> unsafePerformIO . get3  -- yeesh!...
+--         3 -> get3
+           3 -> get3 (i,j,k)
+           4 -> get4
+    dep = j
+
+#if 0
+  -- XXX All this fuss to deal with the case that the
+  -- entire argument m is undefined (or whatever is going
+  -- for "undefined" at the moment...) -- but, none of
+  -- the expBase[1-5] have this! ch.
+  myFromJust :: Maybe a -> IO (Either () a)
+  myFromJust m = do
+                    putStrLn "Boo!"
+                    catch
+                      (myFromJust' m)
+                      (\e -> do putStrLn $! show (e::BottomedOut)
+                                putStrLn "HERE!"
+                                return $! Left ())
+  myFromJust' :: Maybe a -> IO (Either () a)
+  myFromJust' Nothing = do
+--                         throw BottomedOut
+                           return $! Left ()
+  myFromJust' (Just x) = return $! Right x
+--myFromJust _ = throw BottomedOut
+#endif
+
+--------------------------------
+
+#if 0
+  doit2 :: Int -> Int -> Int -> String -> IO String
+  doit2 i j k acc
+-- | k == 2  = {- trace (show (i,j,k)) $ -} return acc
+-- | k == 7  = return acc
+   | k == 27  = return acc
+-- | k == 21  = return acc
+-- | k == 5  = return acc
+-- | j == 15  = doit2 1 0 (1+k) acc
+   | j == 11  = {- trace (show (i,j,k)) $ -} doit2 1 0 (1+k) acc
+-- | j == 8  = {- trace (show (i,j,k)) $ -} doit2 1 0 (1+k) acc
+-- | j == 3  = {- trace (show (i,j,k)) $ -} doit2 1 0 (1+k) acc
+#if USE_TRACE
+   | i == 2  = trace ("End of " ++ show (i,j',k')) $ doit2 1 (1+j) k acc
+-- | i == 3  = trace ("End of " ++ show (i,j',k')) $ doit2 1 (1+j) k acc
+#else
+   | i == 2  = doit2 1 (1+j) k acc
+-- | i == 3  = doit2 1 (1+j) k acc
+#endif
+   | otherwise  = do
+      fexp <- catch
+               ( return $! get $! forcen dep exp )
+--             ( return $! get $! forcen dep exp )
+               -- ErrorCall if use __ = undefined
+               -- BottomedOut if use __ = throw BottomedOut
+               (\e -> do let err = show (e :: ErrorCall)
+--             (\e -> do let err = show (e :: BottomedOut)
+                         return err)
+      doit2 (1+i) j k $! acc
+        ++ "( getB_" ++ show i ++ " $ forcen " ++ show dep ++ (if dep < 10 then " " else "") ++ " expTB_" ++ show (k'-6) ++ " )  "
+--      ++ "( getB_" ++ show i ++ " $ forcen " ++ show dep ++ (if dep < 10 then " " else "") ++ " expBase" ++ show k' ++ " )  "
+        ++ fexp ++ "\n"
+   where
+    exp = case k' of
+            7 -> expBase7
+            8 -> expBase8
+            9 -> expBase9
+            10 -> expBase10
+            11 -> expBase11
+            12 -> expBase12
+            13 -> expBase13
+            14 -> expBase14
+            15 -> expBase15
+            16 -> expBase16
+            17 -> expBase17
+            18 -> expBase18
+            19 -> expBase19
+            20 -> expBase20
+            21 -> expBase20  -- fudge it!!
+            22 -> expBase22
+            23 -> expBase23
+            24 -> expBase24
+            25 -> expBase25
+            26 -> expBase26
+            27 -> expBase27
+            28 -> expBase28
+            29 -> expBase29
+            30 -> expBase30
+            31 -> expBase31
+            32 -> expBase32
+    get = case i of
+           1 -> if k' >= 27 then getB_3 else getB_1
+           2 -> getB_2
+    dep = j'
+    j' = j
+--  j' = j+11
+--  k' = k+26
+    k' = k+6
+#endif
+
+#if 0
+  doit3 :: Int -> Int -> Int -> String -> IO String
+  doit3 i j k acc
+   | k == 2  = return acc
+   | j == 8  = {- trace (show (i,j,k)) $ -} doit3 1 1 (1+k) acc
+#if USE_TRACE
+   | i == 2  = trace ("End of " ++ show (i,j',k')) $ doit3 1 (1+j) k acc
+#else
+   | i == 2  = doit3 1 (1+j) k acc
+#endif
+   | otherwise  = do
+      fexp <- catch
+               ( return $! get $! forcen dep exp )
+               -- ErrorCall if use __ = undefined
+               -- BottomedOut if use __ = throw BottomedOut
+               (\e -> do let err = show (e :: ErrorCall)
+--             (\e -> do let err = show (e :: BottomedOut)
+                         return err)
+      doit3 (1+i) j k $! acc
+        ++ "( getB_" ++ show i ++ " $ forcen " ++ show dep ++ " expBase" ++ show k' ++ " )  "
+        ++ fexp ++ "\n"
+   where
+    exp = case k' of
+            21 -> expBase21
+    get = case i of
+           1 -> getA
+    dep = j'
+    i' = i
+    j' = j
+    k' = k+20
+#endif
+
+#if 0
+  doit4 :: Int -> Int -> Int -> String -> IO String
+  doit4 i j k acc
+-- | k == 2  = return acc
+   | k == 4  = return acc
+   | j == 8  = {- trace (show (i,j,k)) $ -} doit4 1 0 (1+k) acc
+#if USE_TRACE
+   | i == 2  = trace ("End of " ++ show (i,j',k')) $ doit4 1 (1+j) k acc
+#else
+   | i == 2  = doit4 1 (1+j) k acc
+#endif
+   | otherwise  = do
+      fexp <- catch
+               ( return $! get $! forcen dep exp )
+               -- ErrorCall if use __ = undefined
+               -- BottomedOut if use __ = throw BottomedOut
+               (\e -> do let err = show (e :: ErrorCall)
+--             (\e -> do let err = show (e :: BottomedOut)
+                         return err)
+      doit4 (1+i) j k $! acc
+        ++ "( getE $ forcen " ++ show dep ++ " expTE_" ++ show k' ++ " )  "
+        ++ fexp ++ "\n"
+   where
+    exp = case k' of
+            1 -> expTE_1
+            2 -> expTE_2
+            3 -> expTE_3
+    get = case i of
+           1 -> getE
+    dep = j'
+    i' = i
+    j' = j
+    k' = k
+#endif
+
+-------------------------------------------------------------------------------
+
+  doit5 :: Int -> Int -> Int -> String -> IO String
+  doit5 i j k acc
+   | k == 2  = return acc
+   | j == 5  = {- trace (show (i,j,k)) $ -} doit5 1 0 (1+k) acc
+#if USE_TRACE
+   | i == 2  = trace ("End of " ++ show (i,j',k')) $ doit5 1 (1+j) k acc
+#else
+   | i == 2  = doit5 1 (1+j) k acc
+#endif
+   | otherwise  = do
+      fexp <- catch
+               ( return $! get $! forcen dep exp )
+               -- ErrorCall if use __ = undefined
+               -- BottomedOut if use __ = throw BottomedOut
+               (\e -> do let err = show (e :: ErrorCall)
+--             (\e -> do let err = show (e :: BottomedOut)
+                         return err)
+      doit5 (1+i) j k $! acc
+        ++ "forcen " ++ show dep ++ " expN_" ++ show k' ++ " `seq` ()  =  "
+        ++ fexp ++ "\n"
+   where
+    exp = case k' of
+            1 -> expN_1
+    get = case i of
+           1 -> getN_1
+    dep = j'
+    i' = i
+    j' = j
+    k' = k
+
+-------------------------------------------------------------------------------
+
+  doit6 :: Int -> Int -> Int -> String -> IO String
+  doit6 i j k acc
+   | k == 2  = return acc
+   | j == 5  = {- trace (show (i,j,k)) $ -} doit6 1 0 (1+k) acc
+#if USE_TRACE
+   | i == 2  = trace ("End of " ++ show (i',j',k')) $ doit6 1 (1+j) k acc
+#else
+   | i == 2  = doit6 1 (1+j) k acc
+#endif
+   | otherwise  = do
+      fexp <- catch
+               ( return $! get $! forcen dep exp )
+               -- ErrorCall if use __ = undefined
+               -- BottomedOut if use __ = throw BottomedOut
+               (\e -> do let err = show (e :: ErrorCall)
+--             (\e -> do let err = show (e :: BottomedOut)
+                         return err)
+      doit6 (1+i) j k $! acc
+        ++ "getN_" ++ show i' ++" $ forcen " ++ show dep ++ " expN_" ++ show k' ++ "  =  "
+        ++ fexp ++ "\n"
+   where
+    exp = case k' of
+            _ -> expN_2
+    get = case i of
+           _ -> getN_2
+    dep = j'
+    i' = i+1
+    j' = j
+    k' = k+1
+
+-------------------------------------------------------------------------------
+
+  doit7 :: Int -> Int -> Int -> String -> IO String
+  doit7 i j k acc
+   | k == 2  = return acc
+   | j == 5  = {- trace (show (i,j,k)) $ -} doit7 1 0 (1+k) acc
+#if USE_TRACE
+   | i == 2  = trace ("End of " ++ show (i',j',k')) $ doit7 1 (1+j) k acc
+#else
+   | i == 2  = doit7 1 (1+j) k acc
+#endif
+   | otherwise  = do
+      fexp <- catch
+               ( return $! get $! forcen dep exp )
+               -- ErrorCall if use __ = undefined
+               -- BottomedOut if use __ = throw BottomedOut
+               (\e -> do let err = show (e :: ErrorCall)
+--             (\e -> do let err = show (e :: BottomedOut)
+                         return err)
+      doit7 (1+i) j k $! acc
+        ++ "getN_" ++ show i' ++" $ forcen " ++ show dep ++ " expN_" ++ show k' ++ "  =  "
+        ++ fexp ++ "\n"
+   where
+    exp = case k' of
+            _ -> expN_3
+    get = case i of
+           _ -> getN_3
+    dep = j'
+    i' = i+2
+    j' = j
+    k' = k+2
+
+-------------------------------------------------------------------------------
+
+  doit8 :: Int -> Int -> Int -> String -> IO String
+  doit8 i j k acc
+   | k == 2  = return acc
+   | j == 5  = {- trace (show (i,j,k)) $ -} doit8 1 0 (1+k) acc
+#if USE_TRACE
+   | i == 2  = trace ("End of " ++ show (i',j',k')) $ doit8 1 (1+j) k acc
+#else
+   | i == 2  = doit8 1 (1+j) k acc
+#endif
+   | otherwise  = do
+      fexp <- catch
+               ( return $! get $! forcen dep exp )
+               -- ErrorCall if use __ = undefined
+               -- BottomedOut if use __ = throw BottomedOut
+               (\e -> do let err = show (e :: ErrorCall)
+--             (\e -> do let err = show (e :: BottomedOut)
+                         return err)
+      doit8 (1+i) j k $! acc
+        ++ "getN_" ++ show i' ++" $ forcen " ++ show dep ++ " expN_" ++ show k' ++ "  =  "
+        ++ fexp ++ "\n"
+   where
+    exp = case k' of
+            _ -> expN_4
+    get = case i of
+           _ -> getN_3
+    dep = j'
+    i' = i+2
+    j' = j
+    k' = k+3
+
+-------------------------------------------------------------------------------
+
+#if 0
+
+#if 0
+  expP_1 = (3.4, [5,__,7], __) :: (Float, [Int], Bool)
+  patP_1 = Node (TR [typeOf ((__,__,__)::(Float, [Int], Bool))])
+             [ Node (TR [typeOf (__::Bool)]) []
+--           [ Node (TR [typeOf (__::Float)]) []
+--           [ Node (NTR [typeOf (__::Bool)]) []
+--           [ Node (NTR [typeOf (__::Float)]) []
+--           , Node WS []
+             , Node (TW [typeOf ([__]::[Int])]) []
+--           , Node (TR [typeOf ([__]::[Int])]) []
+--           , Node (TR [typeOf ([__]::[Int])]) [ Node WS [], Node WS [] ]  -- why not?
+             , Node WW []
+--           , Node I []
+             ]
+  getP_1 (_,xs,_) = show $ (xs!!2)
+#endif
+
+  doit9 :: IO String
+  doit9 = do
+#if 0
+    putStrLn "\
+  expP_1 = (3.4, [5,__,7], __) :: (Float, [Int], Bool)\n\
+  patP_1 = Node (T [typeOf ((__,__,__)::(Float, [Int], Bool))])\n\
+             [ Node W []\n\
+             , Node (T [typeOf ([__]::[Int])]) []\n\
+             , Node I []\n\
+             ]\n\
+  getP_1 (_,xs,_) = show $ (xs!!2)\n"
+    putStrLn "getP_1 $ forcep patP_1 expP_1"
+#endif
+    s <- catch
+             ( return $! getP_1 $! forcep patP_1 expP_1 )
+--           ( return $! getP_2 $! forcep patP_2 expP_2 )
+--           ( return $! getP_3 $! forcep patP_3 expP_3 )
+             -- ErrorCall if use __ = undefined
+             -- BottomedOut if use __ = throw BottomedOut
+             (\e -> do let err = show (e :: ErrorCall)
+--           (\e -> do let err = show (e :: BottomedOut)
+                       return err)
+    return s
+
+#endif
+
+-------------------------------------------------------------------------------
+
+  doit10 :: Bool -> [(Int,String)] -> IO ()
+  doit10 _ [] = do
+                   putStrLn "----------------------------------------------------"
+                   return ()
+  doit10 b ((code,patstr):t) = do
+    let expect = case code of
+                  1 -> "7"
+                  2 -> "Prelude.undefined"
+                  3 -> "pattern-match failure"
+                  4 -> "syntax error"
+                  5 -> "7 (but \"# with subpattern\" warning)"
+                  6 -> "7 (but \"constraint/subpattern arity mismatch\" warning)"
+                  13 -> "7 (but with pattern-match failure warning)"
+                  23 -> "Prelude.undefined (but with pattern-match failure warning)"
+                  _ -> error $ "doit10: unexpected code " ++ show code
+    s <- catch
+           ( do
+                let exp = (3.4, [5,__,7], __) :: (Float, [Int], Bool)
+                let pat = compilePat patstr
+                let get (_,xs,_) = show $ (xs!!2)
+                if b
+                 then do
+                  putStrLn "===================================================="
+                  putStrLn "exp = (3.4, [5,__,7], __) :: (Float, [Int], Bool)"
+                  putStrLn "get (_,xs,_) = show $ (xs!!2)"
+                  putStrLn "? = get $ forcep patstr exp"
+                  putStrLn "===================================================="
+                 else do
+                  putStrLn "----------------------------------------------------"
+                putStrLn $ "patstr                   = " ++ patstr
+                if code > 4
+                 then putStrLn $  "expected value           = " ++ expect
+                 else return ()
+--              putStrLn $ "pat = " ++ show pat
+                putStrLn $ "showPat.compilePat       = " ++ showPat pat
+                if code <= 4
+                 then putStrLn $  "expected value           = " ++ expect
+                 else return ()
+                s1 <- catch
+                        ( return $! force $! get $! forcep patstr exp )
+                        (\e -> do let err = show (e :: ErrorCall)
+--                      (\e -> do let err = show (e :: BottomedOut)
+                                  return err)
+                putStr "actual value             = "
+                return $! s1
+           )
+           -- ErrorCall if use __ = undefined
+           -- BottomedOut if use __ = throw BottomedOut
+           (\e -> do let err = show (e :: ErrorCall)
+--         (\e -> do let err = show (e :: BottomedOut)
+                     return err)
+    putStrLn s
+    doit10 False t
+
+-------------------------------------------------------------------------------
+
+  doit11 :: Bool -> [(Int,String,String)] -> IO ()
+  doit11 _ [] = do
+                   putStrLn "----------------------------------------------------"
+                   return ()
+  doit11 b ((code,patstr1,patstr2):t) = do
+    let expect = case code of
+                  1 -> "7"
+                  2 -> "Prelude.undefined"
+                  3 -> "pattern-match failure"
+                  4 -> "syntax error"
+                  5 -> "7 (but \"# with subpattern\" warning)"
+                  6 -> "7 (but \"constraint/subpattern arity mismatch\" warning)"
+                  _ -> error $ "doit11: unexpected code " ++ show code
+    s <- catch
+           ( do
+                let exp = (3.4, [5,__,7], __) :: (Float, [Int], Bool)
+                let patstrU = showPat $ unionPats [compilePat patstr1, compilePat patstr2]
+                let pat1 = compilePat patstr1
+                let pat2 = compilePat patstr2
+                let patU = unionPats [pat1,pat2]
+                let get (_,xs,_) = show $ (xs!!2)
+                if b
+                 then do
+                  putStrLn "===================================================="
+                  putStrLn "exp = (3.4, [5,__,7], __) :: (Float, [Int], Bool)"
+                  putStrLn "get (_,xs,_) = show $ (xs!!2)"
+                  putStrLn "? = get $ ( forcep patstr2 . forcep patstr1 ) exp"
+--                putStrLn "? = get $ ( forcep ( unionPatsStr [ patstr1, patstr2 ] ) ) exp"
+                  putStrLn "? = get $! ( forcep_ ( unionPats [ pat1, pat2 ] ) ) exp"
+                  putStrLn "(Results were more interesting with a previous semantics...)."
+                  putStrLn "===================================================="
+                 else do
+                  putStrLn "----------------------------------------------------"
+                putStrLn $ "patstr1                     = " ++ patstr1
+                putStrLn $ "patstr2                     = " ++ patstr2
+                putStrLn $ "patstrU                     = " ++ patstrU
+                if code > 4
+                 then putStrLn $  "expected value              = " ++ expect
+                 else return ()
+--              putStrLn $ "pat = " ++ show pat
+                putStrLn $ "showPat.compilePat patstr1  = " ++ showPat pat1
+                putStrLn $ "showPat.compilePat patstr2  = " ++ showPat pat2
+                putStrLn $ "showPat.compilePat patstrU  = " ++ showPat patU
+                if code <= 4
+                 then putStrLn $  "expected value              = " ++ expect
+                 else return ()
+                putStr "actual value                = "
+                let s1 = get $! ( forcep patstr2 . forcep patstr1 ) exp
+                putStrLn s1
+                putStr "actual value                = "
+                let s2 = get $! forcep patstrU exp
+#if 1
+                let s3 = s2
+#else
+                putStrLn s2
+                let s3 = get $! forcep_ ( unionPats [ pat1, pat2 ] ) exp
+#endif
+                return $! s3
+           )
+           -- ErrorCall if use __ = undefined
+           -- BottomedOut if use __ = throw BottomedOut
+           (\e -> do let err = show (e :: ErrorCall)
+--         (\e -> do let err = show (e :: BottomedOut)
+                     return err)
+    putStrLn s
+    doit11 False t
+
+-------------------------------------------------------------------------------
+
+  doit12 :: Bool -> [(Int,String,[Int],[(Int,String)])] -> IO ()
+--doit12 :: Bool -> [(Int,String,String,[(Int,String)])] -> IO ()
+  doit12 _ [] = do
+                   return ()
+  doit12 b ((code,patstr1,path,isibs'):t) = do
+    let expect = case code of
+                  1 -> "7"
+                  2 -> "Prelude.undefined"
+                  3 -> "pattern-match failure"
+                  4 -> "syntax error"
+                  5 -> "7 (but \"# with subpattern\" warning)"
+                  6 -> "7 (but \"constraint/subpattern arity mismatch\" warning)"
+                  _ -> error $ "doit12: unexpected code " ++ show code
+    s <- catch
+           ( do
+                let target = compilePat patstr1
+--              let path = compilePat patstr2
+                let isibs = map (\ (x,y) -> (x,compilePat y)) isibs'
+                if b
+                 then do
+                  putStr hdline
+                  putStrLn "Testing splicePats."
+                  putStr hline
+                 else return ()
+                putStrLn $ "target       " ++ patstr1
+                putStrLn $ "path         " ++ show path
+--              putStrLn $ "path         " ++ patstr2
+                putStrLn $ "isibs        " ++ show isibs'
+                let s1 = force $ showPat $ splicePats target path isibs
+--              let s1 = showPat $! splicePats target path isibs
+--              let s1 = showPat $ splicePats target path isibs
+                putStr "result       "
+                return $! s1
+           )
+           -- ErrorCall if use __ = undefined
+           -- BottomedOut if use __ = throw BottomedOut
+           (\e -> do let err = show (e :: ErrorCall)
+--         (\e -> do let err = show (e :: BottomedOut)
+                     return err)
+    putStrLn s
+    if null t then return () else putStr hline
+    doit12 False t
+
+-------------------------------------------------------------------------------
+
+  doit13 :: Bool -> [(Int,[String],String)] -> IO ()
+  doit13 _ [] = do
+                   putStr hline
+                   return ()
+  doit13 b ((code,patstrlst,expectstr):t) = do
+    s <- catch
+           ( do
+                s1 <- case code of
+-- Where were they done already?
+-- Oh, in doit11 and doit12 above...
+                       1 -> error $ hline ++ "unionPats test already done test13-1!"
+--                     4 -> error $ hline ++ "unionPatsStr test already done test13-4!"
+                       10 -> error $ hline ++ "splicePats test already done test13-10!"
+                       11 -> error $ hline ++ "isPath test already done test13-11!"
+    --  1    unionPats        :: [ Pat ] -> Pat
+    --  2  * intersectPats :: [ Pat ] -> Pat
+    --  3  * isSubPatOf      :: Pat -> Pat -> Bool
+--  --  4    unionPatsStr     :: [ String ] -> String
+    --  5  * emptyPat        :: Pat
+--  --  6  * mkPat           :: forall d. Data d => d -> Pat
+--  --  7  * growPat         :: forall d. Data d => Pat -> d -> Pat
+    --  8  * shrinkPat       :: Pat -> Pat
+    --  9  * liftPats         :: [ Pat ] -> Pat
+    -- 10    splicePats       :: Pat -> Pat -> [(Int, Pat)] -> Pat
+    -- 11    isPath          :: Pat -> Bool
+                       2 -> do
+                               let patA = patstrlst!!0
+                               let patB = patstrlst!!1
+                               putStr hline
+                               putStrLn "Testing      intersectPats [patA, patB]"
+                               putStrLn $ "patA         " ++ patA
+                               putStrLn $ "patB         " ++ patB
+                               putStr $ "result       "
+                               let s1 = force $ showPat $ intersectPats [compilePat patA, compilePat patB]
+                               return s1
+                       3 -> do
+                               let patA = patstrlst!!0
+                               let patB = patstrlst!!1
+                               putStr hline
+                               putStrLn "Testing      isSubPatOf patA patB"
+                               putStrLn $ "patA         " ++ patA
+                               putStrLn $ "patB         " ++ patB
+                               let s1 = force $ show $ isSubPatOf (compilePat patA) (compilePat patB)
+                               if s1 /= expectstr
+                                then do putStrLn $ "expect       " ++ expectstr
+                                        putStr $ "result       "
+                                else putStr $ "as expected  "
+                               return s1
+                       5 -> do
+                               putStr hline
+                               putStrLn "Testing      emptyPat"
+                               putStr $ "result       "
+                               let s1 = force $ showPat $ emptyPat
+                               return s1
+                       6 -> do
+#if 0
+                               putStr hline
+                               putStrLn "Testing      mkPat ([1,2,3],(False,\"foo\"))"
+                               putStr $ "result       "
+                               let s1 = force $ showPat $ mkPat ([1,2,3::Int],(False,"foo"))
+                               return s1
+#else
+                               return ""
+#endif
+                       7 -> do
+#if 0
+                               let patA = patstrlst!!0
+                               putStr hline
+                               putStrLn "Testing      growPat patA ([1,2,3],(False,\"foo\"))"
+                               putStrLn $ "patA         " ++ patA
+                               putStr $ "result       "
+                               let s1 = force $ showPat $ growPat (compilePat patA) ([1,2,3::Int],(False,"foo"))
+                               return s1
+#else
+                               return ""
+#endif
+                       8 -> do
+                               let patA = patstrlst!!0
+                               putStr hline
+                               putStrLn "Testing      shrinkPat patA"
+                               putStrLn $ "patA         " ++ patA
+                               putStr $ "result       "
+                               let s1 = force $ showPat $ shrinkPat (compilePat patA)
+                               return s1
+                       9 -> do
+                               putStr hline
+                               putStrLn "Testing      liftPats patstrlst"
+                               putStrLn $ "patstrs      " ++ show patstrlst
+                               putStr $ "result       "
+                               let s1 = force $ showPat $ liftPats $ map compilePat patstrlst
+                               return s1
+                       _ -> error $ "doit13: unexpected code " ++ show code
+                return $! s1
+           )
+           -- ErrorCall if use __ = undefined
+           -- BottomedOut if use __ = throw BottomedOut
+           (\e -> do let err = show (e :: ErrorCall)
+--         (\e -> do let err = show (e :: BottomedOut)
+                     return err)
+    putStrLn s
+    doit13 False t
+
+-------------------------------------------------------------------------------
+
+  -- This is an adaptation of doit10 to user-defined datatypes,
+  -- for testing GNFDataP, which is finally within reach thanks
+  -- to SOP!
+  doit14 :: Bool -> [(Int,String)] -> IO ()
+  doit14 _ [] = do
+                   putStrLn "----------------------------------------------------"
+                   return ()
+  doit14 b ((code,patstr):t) = do
+    let expect = case code of
+                  1 -> "7"
+                  2 -> "Prelude.undefined"
+                  3 -> "pattern-match failure"
+                  4 -> "syntax error"
+                  5 -> "7 (but \"# with subpattern\" warning)"
+                  6 -> "7 (but \"constraint/subpattern arity mismatch\" warning)"
+                  13 -> "7 (but with pattern-match failure warning)"
+                  23 -> "Prelude.undefined (but with pattern-match failure warning)"
+                  _ -> error $ "doit14: unexpected code " ++ show code
+    s <- catch
+           ( do
+                let exp = (3.4, [5,__,7], __) :: (Float, [Int], Bool)
+                let pat = compilePat patstr
+                let get (_,xs,_) = show $ (xs!!2)
+                if b
+                 then do
+                  putStrLn "===================================================="
+                  putStrLn "exp = (3.4, [5,__,7], __) :: (Float, [Int], Bool)"
+                  putStrLn "get (_,xs,_) = show $ (xs!!2)"
+                  putStrLn "? = get $ forcep patstr exp"
+                  putStrLn "===================================================="
+                 else do
+                  putStrLn "----------------------------------------------------"
+                putStrLn $ "patstr                   = " ++ patstr
+                if code > 4
+                 then putStrLn $  "expected value           = " ++ expect
+                 else return ()
+--              putStrLn $ "pat = " ++ show pat
+                putStrLn $ "showPat.compilePat       = " ++ showPat pat
+                if code <= 4
+                 then putStrLn $  "expected value           = " ++ expect
+                 else return ()
+                s1 <- catch
+                        ( return $! force $! get $! forcep patstr exp )
+                        (\e -> do let err = show (e :: ErrorCall)
+--                      (\e -> do let err = show (e :: BottomedOut)
+                                  return err)
+                putStr "actual value             = "
+                return $! s1
+           )
+           -- ErrorCall if use __ = undefined
+           -- BottomedOut if use __ = throw BottomedOut
+           (\e -> do let err = show (e :: ErrorCall)
+--         (\e -> do let err = show (e :: BottomedOut)
+                     return err)
+    putStrLn s
+    doit14 False t
+
+-------------------------------------------------------------------------------
+
diff --git a/test/Bottom.hs b/test/Bottom.hs
new file mode 100644
--- /dev/null
+++ b/test/Bottom.hs
@@ -0,0 +1,52 @@
+
+-- XXX This file could be cleaned up a lot, but that's
+-- not quite a priority at this moment...
+
+  {-# LANGUAGE CPP #-}
+
+  {-# LANGUAGE DeriveDataTypeable #-}
+
+-------------------------------------------------------------------------------
+
+#define USE_TRACE 1
+-- This so can get an honest comparison for the user-defined datatypes;
+-- if this is 0, the NFDataN instances will be derived via GHC.Generics.
+-- (The NFData instances are derived in any case.)
+#define USE_MANUAL_INSTANCES 0
+
+-------------------------------------------------------------------------------
+
+  module Bottom where
+
+-------------------------------------------------------------------------------
+
+  import Data.Maybe
+
+  import Control.Exception
+--import Control.Monad ( guard )
+  import Data.Typeable ( Typeable )
+  import Data.Typeable ( typeOf )
+
+--import Util
+  import Debug.Trace ( trace )
+  import Control.DeepSeq
+
+  import System.IO.Unsafe ( unsafePerformIO )
+
+-------------------------------------------------------------------------------
+
+  __ :: a
+--bt'm = undefined
+  __ = undefined
+--__ = throw BottomedOut
+
+-------------------------------------------------------------------------------
+
+  data BottomedOut = BottomedOut
+--data BottomedOut = ThisException | ThatException
+    deriving (Show, Typeable)
+
+  instance Exception BottomedOut
+
+-------------------------------------------------------------------------------
+
diff --git a/test/Foo.hs b/test/Foo.hs
new file mode 100644
--- /dev/null
+++ b/test/Foo.hs
@@ -0,0 +1,265 @@
+
+-- XXX This file could be cleaned up a lot, but that's
+-- not quite a priority at this moment...
+
+  {-# LANGUAGE CPP #-}
+
+-------------------------------------------------------------------------------
+
+#define USE_TRACE 1
+-- This so can get an honest comparison for the user-defined datatypes;
+-- if this is 0, the NFDataN instances will be derived via GHC.Generics.
+-- (The NFData instances are derived in any case.)
+#define USE_MANUAL_INSTANCES 0
+
+-------------------------------------------------------------------------------
+
+  module Foo where
+
+-------------------------------------------------------------------------------
+
+-- TABLE OF EXPECTED AND ACTUAL RESULTS
+-- (Only recording "BOT" or "ok".)
+--
+-- The expressions and getters are effectively:
+--
+-- expBase1 = ([True,False],3,Just "fox")         :: ([Bool],Int,Maybe String)
+-- expBase2 = ([True,False],__,Just "fox")        :: ([Bool],Int,Maybe String)
+-- expBase3 = ([True,__],3,Just "fox")            :: ([Bool],Int,Maybe String)
+-- expBase4 = ([True,__],3,Just __)               :: ([Bool],Int,Maybe String)
+-- expBase5 = ([True,False],3,Just ['f',__,'x'])  :: ([Bool],Int,Maybe String)
+-- expBase6 = ([True,False],3,Just __)            :: ([Bool],Int,Maybe String)
+-- get1 ((x:_),_,_) = x           -- True
+-- get2 (_,x,_) = x               -- 3
+-- get3 (_,_,x) = fromJust x      -- "fox"
+-- get4 (_,_,Just (x:_)) = x      -- 'f'
+--
+-- These match like Haskell pattern-matching -- the higher will
+-- be matched first; the lower will pick up what trickles through.
+--
+--  (i,j,k)         Expected           Actual
+--   * * 1            ok                 ok
+--   2 1 2            BOT                BOT
+--   * 1 2            ok                 ok
+--   * * 2            BOT                BOT
+--   * 4 3            BOT                BOT
+--   * 5 3            BOT                BOT
+--   * * 3            ok                 ok
+--   1 1 4            ok                 ok
+--   1 2 4            ok                 ok
+--   * * 4            BOT                BOT
+--   3 * 5            BOT                BOT
+--   * 5 5            BOT                BOT
+--   * * 5            ok                 ok
+
+-- AND, SOLVED -- by forcing that show!
+-- Great! And it's the USE_EXCEPTION branch too, which I prefer
+-- in principle.  Now to consider the output...
+
+-- It seems that this difference decides whether escapee exception
+-- happens of (3,1,4) or (3,1,5):
+--     doit (1+i) j k $! acc
+--  -- doit (1+i) j k $ acc
+-- What I don't understand is why "show" which is part of get3
+-- doesn't force it where the handler can catch it...
+
+-- What a confusion!
+-- So, if you also insert some tracing, you can see all (i,j,k)
+-- indices traced, yet the exception still occurs.
+-- I suppose this is because the acc string isn't forced
+-- until later, and meanwhile the trace lines are free to
+-- be printed. (This is the explanation for sure.)
+--   But just forcing acc is not the same thing?...
+-- If force acc, you see nothing at all printed except the
+-- trace lines. All of [ABC](3,1,5) are printed, and then
+-- the escapee exception rises.
+
+-- And anyhow, now it passes 4 but not 5, and I don't even know
+-- how/why? I'm not using overridden fromJust anymore...
+-- (i=3 k=5 exception still escapes in any case!)
+
+-- By overriding fromJust I was able to get past expBase4,
+-- but i=3 k=5 exception still escapes!...
+
+-- STILL not getting it -- I can run the gamut, just using
+-- putStrLn (as we're in IO anyhow since started fussing
+-- with exception catching).  And it says we bottom out
+-- a few times, with proper interleaving -- but these are
+-- only when /get/ requests a __ value; it doesn't seem
+-- to do anything when forcen supposedly forces it.
+--   And yet, when run with USE_EXCEPTION, we do see these
+-- extra bottom-outs -- unfortunately, the "exceptional
+-- exception" occurs and the darned thing doesn't run to
+-- completion.
+
+-- Having some problems.
+-- Same results if use ErrorCall or use custom BottomedOut,
+-- namely, get as far as:
+--   ( get3 $ forcen 1 expBase4 )
+--   t: BottomedOut
+-- The "t: " is significant, since normally when hit
+-- the "potholes" my exception handler prints only "BottomedOut".
+-- And this also terminates the testing.
+-- So clearly, my (own, custom, even -- good to know) exception
+-- is escaping the handler.  How can this be?  Esp. as it seems
+-- nothing much changes from one test to another.
+-- The only thing that comes to mind is, we don't catch ASYNCHRONOUS
+-- exceptions this way? Why should an asynch. exception be raised
+-- in this case. Trying one more thing: define __ to be trace
+-- and just trace the fact it was evaluated...
+
+-- XXX Regarding the use of undefined, I think this is not
+-- working well for catching all exceptions? Would we have
+-- better luck throwing a custom exception type? How do you
+-- do that? "throw BottomedOut" in the component of the tuple?...
+
+  import Data.Maybe
+
+  import Control.Exception
+--import Control.Monad ( guard )
+  import Data.Typeable ( Typeable )
+  import Data.Typeable ( typeOf )
+
+--import Util
+  import Debug.Trace ( trace )
+  import Control.DeepSeq
+
+#if ! HASKELL98_FRAGMENT
+  -- Custom exception requires -XDerivingDataTypeable it seems. [?]
+  import Bottom
+#endif
+
+  import System.IO.Unsafe ( unsafePerformIO )
+
+-------------------------------------------------------------------------------
+
+#if HASKELL98_FRAGMENT
+  __ = undefined
+#else
+-- imported from Bottom (sorry)
+#endif
+
+-------------------------------------------------------------------------------
+
+  expN_1 = [__] :: [Int]
+  expN_2 = [0,1,__,3] :: [Int]
+  expN_3 = (3.4, [5,__,7], True) :: (Float, [Int], Bool)
+  expN_4 = (3.4, [5,__,7], __) :: (Float, [Int], Bool)
+
+  getN_1 xs = show $ ()
+--getN_1 xs = show $ head xs
+--getN_2 xs = show $ (xs!!1)
+  getN_2 xs = show $ (xs!!3)
+  getN_3 (_,xs,_) = show $ (xs!!2)
+
+-------------------------------------------------------------------------------
+
+#if 0
+
+  -- Should be able to dodge the third component with a pattern.
+--expP_1 = (3.4, [5,__,7], True) :: (Float, [Int], Bool)
+  expP_1 = (3.4, [5,__,7], __) :: (Float, [Int], Bool)
+  patP_1 = Node (TR [typeOf ((__,__,__)::(Float, [Int], Bool))])
+             [ Node (TR [typeOf (__::Bool)]) []
+--           [ Node (TR [typeOf (__::Float)]) []
+--           [ Node (NTR [typeOf (__::Bool)]) []
+--           [ Node (NTR [typeOf (__::Float)]) []
+--           , Node WS []
+             , Node (TW [typeOf ([__]::[Int])]) []
+--           , Node (TR [typeOf ([__]::[Int])]) []
+--           , Node (TR [typeOf ([__]::[Int])]) [ Node WS [], Node WS [] ]  -- why not?
+             , Node WW []
+--           , Node I []
+             ]
+  getP_1 (_,xs,_) = show $ (xs!!2)
+
+  expP_2 = 23 :: Int
+--expP_2 = [1,__,3] :: [Int]
+  patP_2 = Node WW []
+--patP_2 = Node (TR [typeOf ([__]::[Int])]) []
+  getP_2 x = show x
+
+#if 1
+-- Fuck, this works too... (the only one of all of 'em, except bare 23)
+-- See NFDataP.hs for expansion of PatNode constructors...
+-- (It's hardly going to be that useful if you have to specify
+-- one constructor per node in whole data structure, rather than
+-- just match the top bit you want as one expects with patterns.)
+-- So I'm basically committed to this expansion...
+  expP_3 = (3.4, (5,__), __) :: (Float, (Int,Int), Bool)
+  patP_3 = Node (TR [typeOf ((__,__,__)::(Float, (Int,Int), Bool))])
+#if 0
+             [ Node W []
+             , Node I [ Node W [], Node W [] ]  -- works
+--           , Node I []                        -- doesn't work
+             , Node W []
+             ]
+#else
+             [ Node WR []
+             , Node WR [ Node WR [], Node WR [] ]  -- works
+--           , Node WR []                        -- doesn't work
+             , Node WR []
+             ]
+#endif
+  getP_3 (_,(_,x),_) = show x
+#else
+  expP_3 = (3.4, (5,__), __) :: (Float, (Int,Int), Bool)
+  patP_3 = Node (T [typeOf ((__,__,__)::(Float, (Int,Int), Bool))])
+             [ Node (T [typeOf (__::Float)]) []
+--           [ Node W []
+             , Node (T [typeOf ((__,__)::(Int,Int))]) []
+             , Node I []
+             ]
+  getP_3 (_,(_,x),_) = show x
+#endif
+
+#endif
+
+-------------------------------------------------------------------------------
+
+  expBase1 = ([True,False],3,Just "fox")         :: ([Bool],Int,Maybe String)
+  expBase2 = ([True,False],__,Just "fox")        :: ([Bool],Int,Maybe String)
+  expBase3 = ([True,__],3,Just "fox")            :: ([Bool],Int,Maybe String)
+  expBase4 = ([True,__],3,Just __)               :: ([Bool],Int,Maybe String)
+  expBase5 = ([True,False],3,Just ['f',__,'x'])  :: ([Bool],Int,Maybe String)
+  expBase6 = ([True,False],3,Just __)            :: ([Bool],Int,Maybe String)
+
+#if 1
+  get1 ((x:_),_,_) = show x         -- True
+  get2 (_,x,_) = show x             -- 3
+#if 0
+#if 0
+  get3 (_,_,x) = do
+                    es <- myFromJust x  -- "fox"
+                    case es of
+                     Left () -> return ""
+                     Right s -> return $! show s
+--get3 (_,_,x) = show $! myFromJust x  -- "fox"
+#else
+  get3 (_,_,x) = return $! show $! fromJust x  -- "fox"
+--get3 (_,_,x) = return $ show $ fromJust x  -- "fox"
+#endif
+#else
+  get3 ijk (_,_,x) = force $ show $ fromJust x  -- "fox"
+--get3 ijk (_,_,x) = trace ("A"++show ijk) ( force $ show $! trace ("B"++show ijk) $ fromJust $! trace ("C"++show ijk) $ x )  -- "fox"
+--get3 (_,_,x) = show $! fromJust x  -- "fox"
+--get3 (_,_,x) = show $ fromJust x  -- "fox"
+#endif
+  get4 (_,_,Just (x:_)) = show x    -- 'f'
+#else
+  get1 ((x:_),_,_) = x       -- True
+  get2 (_,x,_) = x           -- 3
+  get3 (_,_,x) = fromJust x  -- "fox"
+  get4 (_,_,Just (x:_)) = x  -- 'f'
+#endif
+
+#if 0
+  -- oops, these are just what you DON'T want!
+  get1 (_,x,_) = x  -- 3
+  get2 (_:x:_) = x  -- False
+  get3 (_,_,x) = fromJust x  -- "fox"
+  get4 (_,_,(_:x:_)) = x  -- 'o'
+#endif
+
+-------------------------------------------------------------------------------
+
diff --git a/test/FooG.hs b/test/FooG.hs
new file mode 100644
--- /dev/null
+++ b/test/FooG.hs
@@ -0,0 +1,612 @@
+
+-- XXX This file could be cleaned up a lot, but that's
+-- not quite a priority at this moment...
+
+  {-# LANGUAGE CPP #-}
+
+-------------------------------------------------------------------------------
+
+#define USE_TRACE 1
+-- This so can get an honest comparison for the user-defined datatypes;
+-- if this is 0, the NFDataN instances will be derived via GHC.Generics.
+-- (The NFData instances are derived in any case.)
+#define USE_MANUAL_INSTANCES 0
+
+-------------------------------------------------------------------------------
+
+#if USE_SOP
+  {-# LANGUAGE DataKinds #-}
+  {-# LANGUAGE TypeFamilies #-}
+  {-# LANGUAGE TemplateHaskell #-}
+#else
+  {-# LANGUAGE DeriveGeneric #-}
+#endif
+
+  {-# LANGUAGE DeriveGeneric #-}  -- still needed to derive NFData...
+
+  {-# LANGUAGE DeriveDataTypeable #-}  -- to make BottomedOut
+
+-------------------------------------------------------------------------------
+
+  module FooG where
+
+-------------------------------------------------------------------------------
+
+--import     Control.DeepSeq.Generics
+  import Control.DeepSeq.Bounded hiding ( F )
+  import Control.DeepSeq.Bounded.Generics
+
+#if USE_SOP
+  import Generics.SOP.TH
+#else
+  import GHC.Generics
+--import GHC.Generics ( Generic )
+#endif
+
+  import GHC.Generics ( Generic ) -- still needed to derive NFData...
+  import Control.DeepSeq.Generics
+
+  import Data.Maybe
+
+  import Control.Exception
+--import Control.Monad ( guard )
+  import Data.Typeable ( Typeable )
+  import Data.Typeable ( typeOf )
+
+--import Util
+  import Debug.Trace ( trace )
+  import Control.DeepSeq
+
+  import Bottom
+
+  import System.IO.Unsafe ( unsafePerformIO )
+
+-------------------------------------------------------------------------------
+
+  data TA = A1 Bool Int
+          | A4 (Float,TB,Int)  -- (testing reordering!)
+          | A2 Int
+          | A3 TB Bool
+          | A5 (Int,Float)
+#if USE_SOP
+    deriving (Show)
+#else
+    deriving (Show,Generic)
+#endif
+--instance NFData TA where rnf = genericRnf
+#if USE_MANUAL_INSTANCES
+  instance NFDataN TA where
+    rnfn n (A1 x y)
+     | n <= 0     = ()
+     | otherwise  = let n' = -1+n in rnfn n' x `seq` rnfn n' y
+    rnfn n (A2 x)
+     | n <= 0     = ()
+     | otherwise  = rnfn (-1+n) x
+    rnfn n (A3 x y)
+     | n <= 0     = ()
+     | otherwise  = let n' = -1+n in rnfn n' x `seq` rnfn n' y
+    rnfn n (A4 x)
+     | n <= 0     = ()
+     | otherwise  = rnfn (-1+n) x
+#else
+#if USE_SOP
+  instance NFDataN TA where rnfn = grnfn
+#else
+  instance NFDataN TA where rnfn = genericRnfn
+#endif
+#endif
+  expTA = A1 __ 3
+
+  data TB = B1 Bool TA
+          | B2 TA TB
+          | B3 Bool TA Int
+          | B4 Bool Int TA
+          | B5 Bool Int Float
+          | B6 TA
+          | B7 TB
+          | B8 (Int,Float)
+          | B9 Bool (Int,Float) Int
+          | B10 (Int,Int,(Int,Int,Int,Int),Int)
+          | B11 Bool (Int,Int,(Int,Int,Int,Int),Int)
+#if USE_SOP
+    deriving (Show)
+#else
+    deriving (Show,Generic)
+#endif
+--instance NFData TB where rnf = genericRnf
+#if USE_MANUAL_INSTANCES
+  instance NFDataN TB where
+    rnfn n (B1 x y)
+     | n <= 0     = ()
+     | otherwise  = let n' = -1+n in rnfn n' x `seq` rnfn n' y
+    rnfn n (B2 x y)
+     | n <= 0     = ()
+     | otherwise  = let n' = -1+n in rnfn n' x `seq` rnfn n' y
+    rnfn n (B3 x y z)
+     | n <= 0     = ()
+     | otherwise  = let n' = -1+n in rnfn n' x `seq` rnfn n' y `seq` rnfn n' z
+    rnfn n (B4 x y z)
+     | n <= 0     = ()
+     | otherwise  = let n' = -1+n in rnfn n' x `seq` rnfn n' y `seq` rnfn n' z
+    rnfn n (B5 x y z)
+     | n <= 0     = ()
+     | otherwise  = let n' = -1+n in rnfn n' x `seq` rnfn n' y `seq` rnfn n' z
+    rnfn n (B6 x)
+     | n <= 0     = ()
+     | otherwise  = rnfn (-1+n) x
+#else
+#if USE_SOP
+  instance NFDataN TB where rnfn = grnfn
+#else
+  instance NFDataN TB where rnfn = genericRnfn
+#endif
+#endif
+
+#if USE_SOP
+  deriveGeneric ''TA
+  deriveGeneric ''TB
+#endif
+
+  expTB_1 = B2 (A1 True 4) (B1 True (A2 23))
+--expTB_1 = B2 (A1 True 4) (B1 True (A2 __))
+  expTB_2 = B2 (A1 __   4) (B1 True (A2 __))
+  expTB_3 = B2 (A1 __   4) (B1 __   (A2 __))
+--expTB_4 = B2 (A1 True 4) (B1 True (A2 __))
+--expTB_4 = B2 (A1 True 4) (B1 __   (A2 __))
+  expTB_4 = B2 (A1 True 4) (B1 __   (A2 23))
+  expTB_5
+   = B2
+        (A3 (B1 False (A2 __)) True)
+        (B1 True (A1 False 4))
+  expTB_6
+   = B2
+        (A3 (B1 __ (A2 3)) True)
+        (B1 True (A1 False 4))
+  expTB_7
+   = B2
+        (A3 (B1 False (A2 3)) True)
+        (B1 __ (A1 False 4))
+  expTB_8
+   = B2
+        (A3 (B1 False (A2 3)) True)
+        (B1 True (A1 __ 4))
+  expTB_9
+   = B2
+        (A3 (B3 False __ 5) True)
+        (B1 True (A1 False 4))
+  expTB_10                                                -- 5  .
+   = B2
+        (A3 (B3 False (A2 3) 5) True)
+        (B1 True (A4 (2.3, B1 False (A1 True 4), __)))
+  expTB_11
+   = B2
+        (A3 (B3 False (A2 3) 5) True)
+        (B1 True (A4 (__, B1 False (A1 True 4), 6)))
+  expTB_12
+   = B2
+        (A3 (B3 False (A2 3) 5) True)
+        (B1 True (A4 (2.3, B1 False (A1 __ 4), 6)))
+  expTB_13
+   = B2
+        (A3 (B3 False (A2 3) __) True)
+        (B1 True (A1 False 4))
+  expTB_14
+   = B2
+        (A3 (B3 False (A2 __) 5) True)
+        (B1 True (A1 False 4))
+  expTB_15 = A3 (B3 False __ 5) False  -- not expTB actually
+                             -- For the non-combinator SOP recursion version:
+  expTB_16 = B3 False (A2 __) 5   -- E/A =  3  .   B3 Bool TA Int
+--expTB_16 = B7 (B3 False __ 5)   -- E/A =  3  .   B3 Bool TA Int
+--expTB_16 = B3 False __ 5        -- E/A =  2  .   B3 Bool TA Int
+  expTB_17 = B4 False 5 __        -- E/A =  2  .   B4 Bool Int TA
+  expTB_18 = B5 False 5 __        -- E/A =  2  .   B5 Bool Int Float
+  expTB_19 = B1 False __          -- E/A =  2  .   B1 Bool TA
+  expTB_20 = B6 __                -- E/A =  2  .   B6 TA
+
+--data TA = A1 Bool Int
+--        | A4 (Float,TB,Int)
+--        | A2 Int
+--        | A3 TB Bool
+--        | A5 (Int,Float)
+--data TB = B1 Bool TA
+--        | B2 TA TB
+--        | B3 Bool TA Int
+--        | B4 Bool Int TA
+--        | B5 Bool Int Float
+--        | B6 TA
+--        | B7 TB
+--        | B8 (Int,Float)
+--        | B9 Bool (Int,Float) Int
+  expTB_21 = B7 (B7 (B5 __ 5 2.3))    -- E/A =  4  .
+  expTB_22 = B7 (B7 (B5 True 5 __))   -- E/A =  4  .
+  expTB_23 = B1
+                True
+                (A4
+                    ( 2.3
+                    , B2
+                         -- forcen 4 takes you to here (unwrapping B2).
+                                                     -- Bottoms-out at n=?
+                                                     -- (X Y) = SOP recurs.
+                                                     -- E(xpect) A(ctual)
+                                                     -- E  A (. if A=E)
+--                       (A3 (B6 (A2 __)) False)     -- 8  .
+                         (A3 (B6 (A2 7)) False)      -- never
+                         (B3 True (A2 5) __)         -- 6  8  ( 6  . )
+--                       (B9 True (2,__) 6)          -- 7  .  ( 7  . )
+--                       (B9 True (__,3.4) 6)        -- 7  .  ( 7  . )
+--                       (B9 True __ 6)              -- 6  7  ( 6  . )
+--                       (B3 True __ 6)              -- 6  7  ( 6  . )
+--                       (B3 True (A2 __) 6)         -- 7  .  ( 7  . )
+--                       (B3 __ (A2 5) 6)            -- 6  .  ( 6  . )
+--                       (B3 True (A2 5) 6)          -- never
+                    , 7))
+                                                           -- E  A
+--expTB_24 = B10 (1,2,(3,__,5,6),7)                        -- 4  .
+  expTB_24 = B11 False (1,2,(3,__,5,6),7)                  -- 4  .
+  expTB_25 = B9 True __ 6                                  -- 2  .
+--expTB_25 = B9 __ (1,2.3) 6                               -- 2  .
+--expTB_26 = B7 (B9 True __ 6)                             -- 3  .
+--expTB_26 = B7 (B7 (B7 (B7 (B9 True __ 6))))              -- 6  .
+  expTB_26 = B2 (A2 8) (B7 (B7 (B7 (B7 (B9 True __ 6)))))  -- 7  .
+
+  getA (A3 _ b) = show b
+
+  expBase7 = expTB_1
+  expBase8 = expTB_2
+  expBase9 = expTB_3
+  expBase10 = expTB_4
+  expBase11 = expTB_5
+  expBase12 = expTB_6
+  expBase13 = expTB_7
+  expBase14 = expTB_8
+  expBase15 = expTB_9
+  expBase16 = expTB_10
+  expBase17 = expTB_11
+  expBase18 = expTB_12
+  expBase19 = expTB_13
+  expBase20 = expTB_14
+  expBase21 = expTB_15
+  expBase22 = expTB_16
+  expBase23 = expTB_17
+  expBase24 = expTB_18
+  expBase25 = expTB_19
+  expBase26 = expTB_20
+
+  expBase27 = expTB_21
+  expBase28 = expTB_22
+  expBase29 = expTB_23
+  expBase30 = expTB_24
+  expBase31 = expTB_25
+  expBase32 = expTB_26
+
+-------------------------------------------------------------------------------
+
+#if 1
+  getB_1 :: TB -> String
+  getB_1 (B1 b _) = show b
+  getB_1 (B2 _ (B1 b _)) = show b
+  getB_1 (B3 _ _ n) = show n
+  getB_1 (B4 _ n _) = show n
+  getB_1 (B5 _ n _) = show n
+  getB_1 (B6 _) = "beesix"
+--getB_1 (B7 x) = getB_1 x
+  getB_1 _ = error "!"
+  getB_2 :: TB -> String
+  getB_2 (B1 b _) = show b
+  getB_2 (B2 (A1 _ n) _) = show n
+  getB_2 (B2 (A3 _ b) _) = show b
+  getB_2 (B3 _ _ n) = show n
+  getB_2 (B4 _ n _) = show n
+  getB_2 (B5 _ n _) = show n
+  getB_2 (B6 _) = "beesix"
+  getB_2 _ = error "!"
+  getB_3 _ = "<bah>"
+#else
+  getB_1 :: TB -> Bool
+  getB_1 (B2 _ (B1 b _)) = b
+  getB_1 _ = error "!"
+  getB_2 :: TB -> Int
+  getB_2 (B2 (A1 _ n) _) = n
+  getB_2 _ = error "!"
+#endif
+
+-------------------------------------------------------------------------------
+
+  data TC = C Int Bool
+#if USE_SOP
+    deriving (Show)
+#else
+    deriving (Show,Generic)
+#endif
+--instance NFData TC where rnf = genericRnf
+#if USE_MANUAL_INSTANCES
+  instance NFDataN TC where
+    rnfn n (C x y)
+     | n <= 0     = ()
+     | otherwise  = let n' = -1+n in rnfn n' x `seq` rnfn n' y
+#else
+#if USE_SOP
+  deriveGeneric ''TC
+  instance NFDataN TC where rnfn = grnfn
+#else
+  instance NFDataN TC where rnfn = genericRnfn
+#endif
+#endif
+  expTC = C __ True
+  getC (C _ x) = x
+
+  data TD = D1 Int Bool
+          | D2 Int Bool
+#if USE_SOP
+    deriving (Show)
+#else
+    deriving (Show,Generic)
+#endif
+--instance NFData TD where rnf = genericRnf
+#if USE_MANUAL_INSTANCES
+  instance NFDataN TD where
+    rnfn n (D1 x y)
+     | n <= 0     = ()
+     | otherwise  = let n' = -1+n in rnfn n' x `seq` rnfn n' y
+    rnfn n (D2 x y)
+     | n <= 0     = ()
+     | otherwise  = let n' = -1+n in rnfn n' x `seq` rnfn n' y
+#else
+#if USE_SOP
+  deriveGeneric ''TD
+  instance NFDataN TD where rnfn = grnfn
+#else
+  instance NFDataN TD where rnfn = genericRnfn
+#endif
+#endif
+  expTD_1 = D1 __ True
+  expTD_2 = D2 __ True
+  getD (D1 _ x) = x
+  getD (D2 _ x) = x
+
+-------------------------------------------------------------------------------
+
+  data TE = E TF
+#if USE_SOP
+    deriving (Show)
+#else
+    deriving (Show,Generic)
+#endif
+--instance NFData TE where rnf = genericRnf
+#if USE_MANUAL_INSTANCES
+  instance NFDataN TE where
+    rnfn n (E x)
+     | n <= 0     = ()
+     | otherwise  = rnfn (-1+n) x
+#else
+#if USE_SOP
+  instance NFDataN TE where rnfn = grnfn
+#else
+  instance NFDataN TE where rnfn = genericRnfn
+#endif
+#endif
+
+  data TF = F Int
+#if USE_SOP
+    deriving (Show)
+#else
+    deriving (Show,Generic)
+#endif
+--instance NFData TF where rnf = genericRnf
+#if USE_MANUAL_INSTANCES
+  instance NFDataN TF where
+    rnfn n (F x)
+     | n <= 0     = ()
+     | otherwise  = rnfn (-1+n) x
+#else
+#if USE_SOP
+  instance NFDataN TF where rnfn = grnfn
+#else
+  instance NFDataN TF where rnfn = genericRnfn
+#endif
+#endif
+
+#if USE_SOP
+  deriveGeneric ''TE
+  deriveGeneric ''TF
+#endif
+
+  expTE_1 = E (F 23)
+  expTE_2 = E (F __)
+  expTE_3 = E __
+
+#if 1
+  -- These all produce the same, unexpected result; so maybe the
+  -- pattern-matching isn't implicated?...
+  getE (E _) = "getee"
+--getE (E ~_) = "getee"
+--getE (E ~x) = "getee"
+#else
+  -- In order for this not to just print "getee" every time,
+  -- you need to make "get $ " to "get $! " everywhere it
+  -- occurs in Main.hs.
+  getE _ = "getee"  -- making sure the (E _) isn't triggering...
+#endif
+
+-------------------------------------------------------------------------------
+
+#if USE_SOP
+
+  -- Following the shape of the base-typed test expression
+  -- used in Blah.doit10:  (_, [_,_,_], _) :: (Float, [Int], Bool)
+
+  data TG = G1 | G2 Int Int Int
+    deriving (Show,Generic,Typeable)
+--  deriving (Show,Generic)
+--  deriving (Show)
+--instance NFData TG where rnf = genericRnf
+  instance NFDataP TG where rnfp = grnfp
+  instance NFDataN TG where rnfn = grnfn
+  instance NFData TG where rnf = genericRnf
+
+  deriveGeneric ''TG
+
+  expTG_1 = ( G1, G2 5 6 7, True )
+  expTG_2 = ( __, G2 __ __ 7, __ )
+  expTG_3 = ( G1, G2 __ __ 7, __ )
+  expTG_4 = ( G1, G2 5 6 7, __ )
+  expTG_5 = ( G1, G2 5 __ 7, __ )   -- this is the analogue of doit10 exp
+
+  getG :: (TG,TG,Bool) -> String
+  getG (_,(G2 _ _ n),_) = show n
+--getG (_,(G2 _ _ _),_) = "getG-G2"
+  getG _ = "getG-!"
+
+  expTG_6 = G2 5 __ 7
+  getG' :: TG -> String
+  getG' (G2 _ _ n) = show n
+
+#endif
+
+-------------------------------------------------------------------------------
+
+#if USE_SOP
+
+  -- A more elaborate shape for more thorough testing!
+
+  data TH = H1 Float | H2 Int [TH] Bool | H3 | H4 (TH,TI)
+    deriving (Show,Generic,Typeable)
+  instance NFDataP TH where rnfp = grnfp
+  instance NFDataN TH where rnfn = grnfn
+  instance NFData  TH where rnf  = genericRnf
+
+  data TI = I1 (Bool,TH) | I2 | I3 TI TH
+    deriving (Show,Generic,Typeable)
+  instance NFDataP TI where rnfp = grnfp
+  instance NFDataN TI where rnfn = grnfn
+  instance NFData  TI where rnf  = genericRnf
+
+  deriveGeneric ''TH
+  deriveGeneric ''TI
+
+  expTH_1 = H2 1 [H1 2.3, H3, H4 (H3, I3 I2 (H1 4.5))] False
+  expTH_2 = H2 1 [H1 2.3, H3, H4 (__, I3 I2 (H1 4.5))] False
+  expTH_3 = H2 1 [H1 2.3, H3, H4 (__, I3 I2 (H1 4.5))] __
+  expTH_4 = H2 1 [H1 2.3, H3, H4 (__, I3 __ (H1 4.5))] __
+
+  getH :: TH -> String
+  getH (H2 _ [_, _, H4 (_, I3 _ (H1 f))] _) = show f
+  getH _ = "getH-!"
+
+#endif
+
+-------------------------------------------------------------------------------
+
+#if USE_SOP
+
+  -- A more elaborate shape for more thorough testing!
+
+  data TJ = J1 Float | J2 (Int,TJ) Bool | J3 | J4 (TJ,TK) | J5 Int | J6 TK
+    deriving (Show,Generic,Typeable)
+  instance NFDataP TJ where rnfp = grnfp
+  instance NFDataN TJ where rnfn = grnfn
+  instance NFData  TJ where rnf  = genericRnf
+
+  data TK = K1 (Bool,TJ) | K2 | K3 TK TJ | K4 Int Bool | K5 TJ | K6 Float Int Bool | K7 TJ TJ
+    deriving (Show,Generic,Typeable)
+  instance NFDataP TK where rnfp = grnfp
+  instance NFDataN TK where rnfn = grnfn
+  instance NFData  TK where rnf  = genericRnf
+
+  deriveGeneric ''TJ
+  deriveGeneric ''TK
+
+  expTJ_1 = J2 (1, J4 (J3, K3 K2 (J1 4.5))) False
+  expTJ_2 = J2 (1, J4 (J3, K3 __ (J1 4.5))) False
+  expTJ_3 = J2 (1, J4 (__, K3 K2 (J1 4.5))) False
+  expTJ_4 = J2 (1, J4 (__, K3 __ (J1 4.5))) __
+
+  getJ :: TJ -> String
+  getJ (J2 (_, J4 (_, K3 _ (J1 f))) _) = show f
+  getJ _ = "getJ-!"
+  getJ' :: TJ -> String
+
+  expTJ_5 = J2 (1, J4 (__, K2)) False
+
+  getJ' ~_ = show 1
+--getJ' _ = show 1
+--getJ' (J2 ~(n, ~_) _) = show n
+--getJ' (J2 (n, _) _) = show n
+--getJ' (J2 (n, J4 (_, K2)) _) = show n
+--getJ' (J2 (n, J4 (_, K2)) False) = show n  -- most explicit
+  getJ' _ = "getJ'-!"
+
+  expTJ_6 = J4 (__, K2)
+  getJ6 ~_ = show 1
+
+  expTJ_7 = (__, K2) :: (TJ, TK)
+  getJ7 ~_ = show 1
+
+  expTJ_8 = __ :: TJ
+  getJ8 ~_ = show 1
+
+  expTK_1 = K3 K2 (J1 4.5)
+  expTK_2 = K3 __ (J1 4.5)
+
+  getK :: TK -> String
+  getK (K3 _ (J1 f)) = show f
+  getK _ = "getK-!"
+
+#endif
+
+-------------------------------------------------------------------------------
+
+#if USE_SOP
+
+  -- Trying to find a minimal failing case now...
+
+#if 1
+  data TL = L1 TM Float
+#else
+  data TL = L1 Float TM
+#endif
+    deriving (Show,Generic,Typeable)
+  instance NFDataP TL where rnfp = grnfp
+  instance NFDataN TL where rnfn = grnfn
+  instance NFData  TL where rnf  = genericRnf
+
+  data TM = M1 Bool
+    deriving (Show,Generic,Typeable)
+  instance NFDataP TM where rnfp = grnfp
+  instance NFDataN TM where rnfn = grnfn
+  instance NFData  TM where rnf  = genericRnf
+
+  deriveGeneric ''TL
+  deriveGeneric ''TM
+
+#if 1
+  expTL_1 = L1 (M1 True) 5.6
+  expTL_2 = L1 (M1 __) 5.6
+  expTL_3 = L1 __ 5.6
+  expTL_4 = L1 (M1 True) __
+
+  getL :: TL -> String
+  getL (L1 (M1 _) f) = show f
+  getL _ = "getL-!"
+  getL' :: TL -> String
+  getL' (L1 (M1 b) _) = show b
+  getL' _ = "getL'-!"
+#else
+  expTL_1 = L1 5.6 (M1 True)
+  expTL_2 = L1 5.6 (M1 __)
+  expTL_3 = L1 5.6 __
+  expTL_4 = L1 __ (M1 True)
+
+  getL :: TL -> String
+  getL (L1 f (M1 _)) = show f
+  getL _ = "getL-!"
+  getL' :: TL -> String
+  getL' (L1 _ (M1 b)) = show b
+  getL' _ = "getL'-!"
+#endif
+
+#endif
+
+-------------------------------------------------------------------------------
+
diff --git a/test/Main.hs b/test/Main.hs
new file mode 100644
--- /dev/null
+++ b/test/Main.hs
@@ -0,0 +1,36 @@
+
+-------------------------------------------------------------------------------
+
+  module Main ( main ) where
+
+-------------------------------------------------------------------------------
+
+  import Foo
+
+--import     Control.DeepSeq.Generics
+  import Control.DeepSeq.Bounded hiding ( F )
+  import Control.DeepSeq.Bounded.Generics
+
+  import GHC.Generics
+--import GHC.Generics ( Generic )
+
+  import Data.Maybe
+
+  import Control.Exception
+--import Control.Monad ( guard )
+  import Data.Typeable ( Typeable )
+  import Data.Typeable ( typeOf )
+
+--import Util ( spoor )
+  import Debug.Trace ( trace )
+
+  import System.IO.Unsafe ( unsafePerformIO )
+
+  import Blah ( run_tests )
+
+-------------------------------------------------------------------------------
+
+  main = run_tests
+
+-------------------------------------------------------------------------------
+
diff --git a/test/Suite.hs b/test/Suite.hs
new file mode 100644
--- /dev/null
+++ b/test/Suite.hs
@@ -0,0 +1,54 @@
+
+{-# LANGUAGE CPP, DeriveDataTypeable, DeriveGeneric #-}
+
+  module Main (main) where
+
+#if 0
+
+  import Control.Concurrent.MVar
+  import Control.DeepSeq
+  import Control.Exception
+  import Control.Monad
+  import Data.Bits
+  import Data.IORef
+  import Data.Typeable
+  import Data.Word
+  import GHC.Generics
+  import System.IO.Unsafe (unsafePerformIO)
+
+#if 0
+-- import Test.Framework (defaultMain, testGroup, testCase)
+  import Test.Framework
+  import Test.Framework.Providers.HUnit
+#endif
+  import Test.HUnit
+
+#endif
+
+-- IUT
+  import Control.DeepSeq.Bounded
+#if ! HASKELL98_FRAGMENT
+  import Control.DeepSeq.Bounded.Generics
+#endif
+
+  import Test.HUnit
+  import System.Exit
+  import System.IO ( stdout )
+  import Debug.Trace ( trace )
+
+  import qualified Tests
+
+--------------------------------------------
+
+  tests =
+    "All" ~: [ Tests.tests
+             ]
+
+  main = do
+            putStrLn "Running tests for deepseq-bounded..."
+--          putStrLn "Running tests for deepseq-bounded-generics..."
+            counts <- runTestTT tests
+            if failures counts > 0
+              then exitFailure
+                else exitSuccess
+
diff --git a/test/Tests.hs b/test/Tests.hs
new file mode 100644
--- /dev/null
+++ b/test/Tests.hs
@@ -0,0 +1,46 @@
+
+-- Refer to /work/Projects/MiniProjects/SybShape/tests for
+-- more code in first HUnit example (which itself is still
+-- just fudging it)!
+
+{-# LANGUAGE CPP #-}
+
+-------------------------------------------------------------------------------
+
+  module Tests ( tests, main_tests ) where
+
+-------------------------------------------------------------------------------
+
+  import Test.HUnit
+
+  import System.IO.Unsafe ( unsafePerformIO )
+
+#if HASKELL98_FRAGMENT
+  import qualified Blah98 as Blah ( run_tests )
+#else
+  import qualified Blah           ( run_tests )
+#endif
+
+-------------------------------------------------------------------------------
+
+  main_tests :: IO Int
+  main_tests = do
+    Blah.run_tests
+    return 0
+
+-------------------------------------------------------------------------------
+
+-- XXX A better way to "fail on purpose" is to have the test
+-- return ExitFailure, no?...
+--tests = (unsafePerformIO main_tests == output) ~? "FAILING ON PURPOSE TO DISPLAY THE LOGGED OUTPUT!"  -- yeah but it wasn't printed
+  tests = unsafePerformIO
+            ( do n <- main_tests
+                 putStrLn "FAILING ON PURPOSE TO DISPLAY THE LOGGED OUTPUT!\n"
+                 return n )
+            ~=? output
+  output = 1::Int  -- force test to fail! (so we see the output!)
+--output = 0::Int
+--output = ()
+
+-------------------------------------------------------------------------------
+
diff --git a/test/Util.hs b/test/Util.hs
new file mode 100644
--- /dev/null
+++ b/test/Util.hs
@@ -0,0 +1,112 @@
+
+-------------------------------------------------------------------------------
+
+{-  OPTIONS_GHC -O0 #-}  -- if want quick recompln.
+{-  OPTIONS_GHC -package ghc #-}  -- (done via command-line/cabal)
+{-# LANGUAGE CPP #-}
+
+#define USE_ANSI_COLOUR_TERMINAL 0
+
+-------------------------------------------------------------------------------
+
+  module Util (
+
+    show_list ,
+    trace ,
+    trace_ ,
+    trace' ,
+    myTrace ,
+    myTrace' ,
+    spoor ,
+    spoor' ,
+    spoorf ,
+#if 0
+    spoorNF ,
+#endif
+    trayceIO ,
+
+  ) where
+
+-------------------------------------------------------------------------------
+
+  import System.IO
+
+  import Data.List ( intersperse )
+
+#if 0
+  import Control.DeepSeq.Generics ( genericRnf )
+  import Control.DeepSeq.Generics ( force )
+  import Control.DeepSeq.Generics ( NFData(..) )
+#endif
+
+  import System.IO.Unsafe ( unsafePerformIO )  -- XXX for tracing only
+
+-------------------------------------------------------------------------------
+
+  show_list lst = concat $ intersperse "\n" $ map show lst
+
+-------------------------------------------------------------------------------
+
+  {-# NOINLINE trace #-}
+  trace :: String -> a -> a
+  trace s a = x `seq` a
+   where x = unsafePerformIO $ do hPutStr stdout (s++"\n") ; hFlush stdout
+
+  {-# NOINLINE trace_ #-}
+  trace_ :: String -> a -> a
+  trace_ s a = a
+
+  {-# NOINLINE trace' #-}
+  trace' :: String -> a -> a
+  trace' s a = x `seq` a
+   where x = unsafePerformIO $ do hPutStr stdout s ; hFlush stdout
+
+  {-# NOINLINE myTrace #-}
+  myTrace :: String -> a -> a
+  myTrace s a = x `seq` a
+   where x = unsafePerformIO $ do hPutStr stderr (s++"\n") ; hFlush stderr
+
+  {-# NOINLINE myTrace' #-}
+  myTrace' :: String -> a -> a
+  myTrace' s a = x `seq` a
+   where x = unsafePerformIO $ do hPutStr stderr s ; hFlush stderr
+
+  -- These work reasonably well, but sometimes string's
+  -- pile up, and then show expr's follow.  spoorNF is
+  -- provided for these cases...
+
+  {-# NOINLINE spoor #-}
+  spoor :: Show a => String -> a -> a
+  spoor string expr = unsafePerformIO $ do
+    trayceIO $ string ++ show expr ++ "\n"
+    return expr
+
+  {-# NOINLINE spoor' #-}
+  spoor' :: Show a => String -> a -> a
+  spoor' string expr = unsafePerformIO $ do
+    trayceIO $ string ++ show expr
+    return expr
+
+  {-# NOINLINE spoorf #-}
+  spoorf :: Show b => String -> (a -> b) -> a -> a
+  spoorf string f expr = unsafePerformIO $ do
+    trayceIO $ string ++ show (f expr) ++ "\n"
+    return expr
+
+#if 0
+  {-# NOINLINE spoorNF #-}
+  spoorNF :: (Show b, NFData b) => String -> (a -> b) -> a -> a
+  spoorNF string f expr = unsafePerformIO $ do
+    let ss = string ++ show (f expr)
+    trayceIO $ force ss
+    return expr
+#endif
+
+  -- (There is no NOINLINE on this in Common.Trace.  And the
+  -- code was templated from the Debug.Trace library.)
+  trayceIO :: String -> IO ()
+  trayceIO msg = do
+    hPutStr stderr msg
+
+-------------------------------------------------------------------------------
+
