<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html>
<head>
<!-- Generated by HsColour, http://www.cs.york.ac.uk/fp/darcs/hscolour/ -->
<title>Text/Regex/TDFA/CorePattern.hs</title>
<link type='text/css' rel='stylesheet' href='hscolour.css' />
</head>
<body>
<pre><a name="line-1"></a><span class='hs-comment'>-- | The CorePattern module deconstructs the Pattern tree created by</span>
<a name="line-2"></a><span class='hs-comment'>-- ReadRegex.parseRegex and returns a simpler Q/P tree with</span>
<a name="line-3"></a><span class='hs-comment'>-- annotations at each Q node. This will be converted by the TNFA</span>
<a name="line-4"></a><span class='hs-comment'>-- module into a QNFA finite automata.</span>
<a name="line-5"></a><span class='hs-comment'>--</span>
<a name="line-6"></a><span class='hs-comment'>-- Of particular note, this Pattern to Q/P conversion creates and</span>
<a name="line-7"></a><span class='hs-comment'>-- assigns all the internal Tags that will be used during the matching</span>
<a name="line-8"></a><span class='hs-comment'>-- process, and associates the captures groups with the tags that</span>
<a name="line-9"></a><span class='hs-comment'>-- represent their starting and ending locations and with their</span>
<a name="line-10"></a><span class='hs-comment'>-- immediate parent group.</span>
<a name="line-11"></a><span class='hs-comment'>--</span>
<a name="line-12"></a><span class='hs-comment'>-- Each Maximize and Minimize tag is held as either a preTag or a</span>
<a name="line-13"></a><span class='hs-comment'>-- postTag by one and only one location in the Q/P tree. The Orbit</span>
<a name="line-14"></a><span class='hs-comment'>-- tags are each held by one and only one Star node. Tags that stop a</span>
<a name="line-15"></a><span class='hs-comment'>-- Group are also held in perhaps numerous preReset lists.</span>
<a name="line-16"></a><span class='hs-comment'>--</span>
<a name="line-17"></a><span class='hs-comment'>-- The additional nullQ::nullView field of Q records the potentially</span>
<a name="line-18"></a><span class='hs-comment'>-- complex information about what tests and tags must be used if the</span>
<a name="line-19"></a><span class='hs-comment'>-- pattern unQ::P matches 0 zero characters. There can be redundancy</span>
<a name="line-20"></a><span class='hs-comment'>-- in nullView, which is eliminated by cleanNullView.</span>
<a name="line-21"></a><span class='hs-comment'>--</span>
<a name="line-22"></a><span class='hs-comment'>-- Uses recursive do notation.</span>
<a name="line-23"></a><span class='hs-comment'>--</span>
<a name="line-24"></a><span class='hs-comment'>-- 2009 XXX TODO: we can avoid needing tags in the part of the pattern</span>
<a name="line-25"></a><span class='hs-comment'>-- after the last capturing group (when right-associative). This is</span>
<a name="line-26"></a><span class='hs-comment'>-- flipped for left-associative where the front of the pattern before</span>
<a name="line-27"></a><span class='hs-comment'>-- the first capturing group needs no tags. The edge of these regions</span>
<a name="line-28"></a><span class='hs-comment'>-- is subtle: both case needs a Maximize tag. One ought to be able to</span>
<a name="line-29"></a><span class='hs-comment'>-- check the Pattern: if the root is PConcat then a scan from the end</span>
<a name="line-30"></a><span class='hs-comment'>-- (start) looking for the first with an embedded PGroup can be found</span>
<a name="line-31"></a><span class='hs-comment'>-- and the PGroup free elements can be wrapped in some new PNOTAG</span>
<a name="line-32"></a><span class='hs-comment'>-- semantic indicator.</span>
<a name="line-33"></a><span class='hs-keyword'>module</span> <span class='hs-conid'>Text</span><span class='hs-varop'>.</span><span class='hs-conid'>Regex</span><span class='hs-varop'>.</span><span class='hs-conid'>TDFA</span><span class='hs-varop'>.</span><span class='hs-conid'>CorePattern</span><span class='hs-layout'>(</span><span class='hs-conid'>Q</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span><span class='hs-conid'>P</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span><span class='hs-conid'>WhichTest</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span><span class='hs-conid'>Wanted</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span>
<a name="line-34"></a> <span class='hs-layout'>,</span><span class='hs-conid'>TestInfo</span><span class='hs-layout'>,</span><span class='hs-conid'>OP</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span><span class='hs-conid'>SetTestInfo</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span><span class='hs-conid'>NullView</span>
<a name="line-35"></a> <span class='hs-layout'>,</span><span class='hs-varid'>patternToQ</span><span class='hs-layout'>,</span><span class='hs-varid'>cleanNullView</span><span class='hs-layout'>,</span><span class='hs-varid'>cannotAccept</span><span class='hs-layout'>,</span><span class='hs-varid'>mustAccept</span><span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-36"></a>
<a name="line-37"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Monad</span><span class='hs-varop'>.</span><span class='hs-conid'>RWS</span> <span class='hs-comment'>{- all -}</span>
<a name="line-38"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Array</span><span class='hs-varop'>.</span><span class='hs-conid'>IArray</span><span class='hs-layout'>(</span><span class='hs-conid'>Array</span><span class='hs-layout'>,</span><span class='hs-layout'>(</span><span class='hs-varop'>!</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span><span class='hs-varid'>accumArray</span><span class='hs-layout'>,</span><span class='hs-varid'>listArray</span><span class='hs-layout'>)</span>
<a name="line-39"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>List</span><span class='hs-layout'>(</span><span class='hs-varid'>sort</span><span class='hs-layout'>)</span>
<a name="line-40"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>IntMap</span><span class='hs-varop'>.</span><span class='hs-conid'>EnumMap2</span><span class='hs-layout'>(</span><span class='hs-conid'>EnumMap</span><span class='hs-layout'>)</span>
<a name="line-41"></a><span class='hs-keyword'>import</span> <span class='hs-keyword'>qualified</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>IntMap</span><span class='hs-varop'>.</span><span class='hs-conid'>EnumMap2</span> <span class='hs-keyword'>as</span> <span class='hs-conid'>Map</span><span class='hs-layout'>(</span><span class='hs-varid'>singleton</span><span class='hs-layout'>,</span><span class='hs-varid'>null</span><span class='hs-layout'>,</span><span class='hs-varid'>assocs</span><span class='hs-layout'>,</span><span class='hs-varid'>keysSet</span><span class='hs-layout'>)</span>
<a name="line-42"></a><span class='hs-comment'>--import Data.Maybe(isNothing)</span>
<a name="line-43"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>IntSet</span><span class='hs-varop'>.</span><span class='hs-conid'>EnumSet2</span><span class='hs-layout'>(</span><span class='hs-conid'>EnumSet</span><span class='hs-layout'>)</span>
<a name="line-44"></a><span class='hs-keyword'>import</span> <span class='hs-keyword'>qualified</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>IntSet</span><span class='hs-varop'>.</span><span class='hs-conid'>EnumSet2</span> <span class='hs-keyword'>as</span> <span class='hs-conid'>Set</span><span class='hs-layout'>(</span><span class='hs-varid'>singleton</span><span class='hs-layout'>,</span><span class='hs-varid'>toList</span><span class='hs-layout'>,</span><span class='hs-varid'>isSubsetOf</span><span class='hs-layout'>)</span>
<a name="line-45"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Text</span><span class='hs-varop'>.</span><span class='hs-conid'>Regex</span><span class='hs-varop'>.</span><span class='hs-conid'>TDFA</span><span class='hs-varop'>.</span><span class='hs-conid'>Common</span> <span class='hs-comment'>{- all -}</span>
<a name="line-46"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Text</span><span class='hs-varop'>.</span><span class='hs-conid'>Regex</span><span class='hs-varop'>.</span><span class='hs-conid'>TDFA</span><span class='hs-varop'>.</span><span class='hs-conid'>Pattern</span><span class='hs-layout'>(</span><span class='hs-conid'>Pattern</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span><span class='hs-varid'>starTrans</span><span class='hs-layout'>)</span>
<a name="line-47"></a><span class='hs-comment'>-- import Debug.Trace</span>
<a name="line-48"></a>
<a name="line-49"></a><span class='hs-comment'>{- By Chris Kuklewicz, 2007. BSD License, see the LICENSE file. -}</span>
<a name="line-50"></a>
<a name="line-51"></a>
<a name="line-52"></a><span class='hs-comment'>--err :: String -> a</span>
<a name="line-53"></a><span class='hs-comment'>--err = common_error "Text.Regex.TDFA.CorePattern"</span>
<a name="line-54"></a>
<a name="line-55"></a><span class='hs-comment'>--debug :: (Show a) => a -> b -> b</span>
<a name="line-56"></a><span class='hs-comment'>--debug _ = id</span>
<a name="line-57"></a>
<a name="line-58"></a><a name="P"></a><span class='hs-comment'>-- Core Pattern Language</span>
<a name="line-59"></a><a name="P"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>P</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Empty</span> <span class='hs-comment'>-- Could be replaced by (Test Nothing)??</span>
<a name="line-60"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Or</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Q</span><span class='hs-keyglyph'>]</span>
<a name="line-61"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Seq</span> <span class='hs-conid'>Q</span> <span class='hs-conid'>Q</span>
<a name="line-62"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Star</span> <span class='hs-layout'>{</span> <span class='hs-varid'>getOrbit</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Maybe</span> <span class='hs-conid'>Tag</span> <span class='hs-comment'>-- tag to prioritize the need to keep track of length of each pass though q</span>
<a name="line-63"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>resetOrbits</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Tag</span><span class='hs-keyglyph'>]</span> <span class='hs-comment'>-- child star's orbits to reset (ResetOrbitTask) at all depths</span>
<a name="line-64"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>firstNull</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Bool</span> <span class='hs-comment'>-- Usually True to mean the first pass may match 0 characters</span>
<a name="line-65"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>unStar</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Q</span><span class='hs-layout'>}</span>
<a name="line-66"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Test</span> <span class='hs-conid'>TestInfo</span> <span class='hs-comment'>-- Require the test to be true (merge with empty as (Test (Maybe TestInfo)) ??)</span>
<a name="line-67"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>OneChar</span> <span class='hs-conid'>Pattern</span> <span class='hs-comment'>-- Bring the Pattern element that accepts a character</span>
<a name="line-68"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>NonEmpty</span> <span class='hs-conid'>Q</span> <span class='hs-comment'>-- Don't let the Q pattern match nothing</span>
<a name="line-69"></a> <span class='hs-keyword'>deriving</span> <span class='hs-layout'>(</span><span class='hs-conid'>Show</span><span class='hs-layout'>,</span><span class='hs-conid'>Eq</span><span class='hs-layout'>)</span>
<a name="line-70"></a>
<a name="line-71"></a><a name="Q"></a><span class='hs-comment'>-- The diagnostics about the pattern. Note that when unQ is 'Seq' the</span>
<a name="line-72"></a><a name="Q"></a><span class='hs-comment'>-- the preTag and postTag are Nothing but the preReset might have tags</span>
<a name="line-73"></a><a name="Q"></a><span class='hs-comment'>-- from PGroup injecting them.</span>
<a name="line-74"></a><a name="Q"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>Q</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Q</span> <span class='hs-layout'>{</span><span class='hs-varid'>nullQ</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>NullView</span> <span class='hs-comment'>-- Ordered list of nullable views</span>
<a name="line-75"></a> <span class='hs-layout'>,</span><span class='hs-varid'>takes</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Position</span><span class='hs-layout'>,</span><span class='hs-conid'>Maybe</span> <span class='hs-conid'>Position</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- Range of number of accepted characters</span>
<a name="line-76"></a> <span class='hs-layout'>,</span><span class='hs-varid'>preReset</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Tag</span><span class='hs-keyglyph'>]</span> <span class='hs-comment'>-- Tags to "reset" (ResetGroupStopTask) (Only immediate children for efficiency)</span>
<a name="line-77"></a> <span class='hs-layout'>,</span><span class='hs-varid'>postSet</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Tag</span><span class='hs-keyglyph'>]</span> <span class='hs-comment'>-- Tags to "set" (SetGroupStopTask)</span>
<a name="line-78"></a> <span class='hs-layout'>,</span><span class='hs-varid'>preTag</span><span class='hs-layout'>,</span><span class='hs-varid'>postTag</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Maybe</span> <span class='hs-conid'>Tag</span> <span class='hs-comment'>-- Tags assigned around this pattern (TagTask)</span>
<a name="line-79"></a> <span class='hs-layout'>,</span><span class='hs-varid'>tagged</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Bool</span> <span class='hs-comment'>-- Whether this node should be tagged -- patternToQ use only</span>
<a name="line-80"></a> <span class='hs-layout'>,</span><span class='hs-varid'>childGroups</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Bool</span> <span class='hs-comment'>-- Whether unQ has any PGroups -- patternToQ use only</span>
<a name="line-81"></a> <span class='hs-layout'>,</span><span class='hs-varid'>wants</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Wanted</span> <span class='hs-comment'>-- What kind of continuation is used by this pattern</span>
<a name="line-82"></a> <span class='hs-layout'>,</span><span class='hs-varid'>unQ</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>P</span><span class='hs-layout'>}</span> <span class='hs-keyword'>deriving</span> <span class='hs-layout'>(</span><span class='hs-conid'>Eq</span><span class='hs-layout'>)</span>
<a name="line-83"></a>
<a name="line-84"></a><a name="TestInfo"></a><span class='hs-keyword'>type</span> <span class='hs-conid'>TestInfo</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-conid'>WhichTest</span><span class='hs-layout'>,</span><span class='hs-conid'>DoPa</span><span class='hs-layout'>)</span>
<a name="line-85"></a>
<a name="line-86"></a><a name="SetTestInfo"></a><span class='hs-comment'>-- This is newtype'd to allow control over class instances</span>
<a name="line-87"></a><a name="SetTestInfo"></a><span class='hs-comment'>-- This is a set of WhichTest where each test has associated pattern location information</span>
<a name="line-88"></a><a name="SetTestInfo"></a><span class='hs-keyword'>newtype</span> <span class='hs-conid'>SetTestInfo</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>SetTestInfo</span> <span class='hs-layout'>{</span><span class='hs-varid'>getTests</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>EnumMap</span> <span class='hs-conid'>WhichTest</span> <span class='hs-layout'>(</span><span class='hs-conid'>EnumSet</span> <span class='hs-conid'>DoPa</span><span class='hs-layout'>)</span><span class='hs-layout'>}</span> <span class='hs-keyword'>deriving</span> <span class='hs-layout'>(</span><span class='hs-conid'>Eq</span><span class='hs-layout'>)</span>
<a name="line-89"></a>
<a name="line-90"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>Monoid</span> <span class='hs-conid'>SetTestInfo</span> <span class='hs-keyword'>where</span>
<a name="line-91"></a> <span class='hs-varid'>mempty</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>SetTestInfo</span> <span class='hs-varid'>mempty</span>
<a name="line-92"></a> <span class='hs-conid'>SetTestInfo</span> <span class='hs-varid'>x</span> <span class='hs-varop'>`mappend`</span> <span class='hs-conid'>SetTestInfo</span> <span class='hs-varid'>y</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>SetTestInfo</span> <span class='hs-layout'>(</span><span class='hs-varid'>x</span> <span class='hs-varop'>`mappend`</span> <span class='hs-varid'>y</span><span class='hs-layout'>)</span>
<a name="line-93"></a>
<a name="line-94"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>Show</span> <span class='hs-conid'>SetTestInfo</span> <span class='hs-keyword'>where</span>
<a name="line-95"></a> <span class='hs-varid'>show</span> <span class='hs-layout'>(</span><span class='hs-conid'>SetTestInfo</span> <span class='hs-varid'>sti</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-str'>"SetTestInfo "</span><span class='hs-varop'>++</span><span class='hs-varid'>show</span> <span class='hs-layout'>(</span><span class='hs-varid'>mapSnd</span> <span class='hs-layout'>(</span><span class='hs-conid'>Set</span><span class='hs-varop'>.</span><span class='hs-varid'>toList</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Map</span><span class='hs-varop'>.</span><span class='hs-varid'>assocs</span> <span class='hs-varid'>sti</span><span class='hs-layout'>)</span>
<a name="line-96"></a>
<a name="line-97"></a><a name="NullView"></a><span class='hs-comment'>-- There may be several distinct ways for a subtree to conditionally</span>
<a name="line-98"></a><a name="NullView"></a><span class='hs-comment'>-- (i.e. with a Test) or unconditionally accept 0 characters. These</span>
<a name="line-99"></a><a name="NullView"></a><span class='hs-comment'>-- are in the list in order of preference, with most preferred listed</span>
<a name="line-100"></a><a name="NullView"></a><span class='hs-comment'>-- first.</span>
<a name="line-101"></a><a name="NullView"></a><span class='hs-keyword'>type</span> <span class='hs-conid'>NullView</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-conid'>SetTestInfo</span><span class='hs-layout'>,</span><span class='hs-conid'>TagList</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span> <span class='hs-comment'>-- Ordered list of null views, each is a set of tests and tags</span>
<a name="line-102"></a>
<a name="line-103"></a><a name="HandleTag"></a><span class='hs-comment'>-- During the depth first traversal, children are told about tags by the parent.</span>
<a name="line-104"></a><a name="HandleTag"></a><span class='hs-comment'>-- They may change Apply to Advice and they may generate new tags.</span>
<a name="line-105"></a><a name="HandleTag"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>HandleTag</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>NoTag</span> <span class='hs-comment'>-- No tag at this boundary</span>
<a name="line-106"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Advice</span> <span class='hs-conid'>Tag</span> <span class='hs-comment'>-- tag at this boundary, applied at higher level in tree</span>
<a name="line-107"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Apply</span> <span class='hs-conid'>Tag</span> <span class='hs-comment'>-- tag at this boundary, may be applied at this node or passed to one child</span>
<a name="line-108"></a> <span class='hs-keyword'>deriving</span> <span class='hs-layout'>(</span><span class='hs-conid'>Show</span><span class='hs-layout'>)</span>
<a name="line-109"></a>
<a name="line-110"></a><a name="Wanted"></a><span class='hs-comment'>-- Nodes in the tree are labeled by the type kind of continuation they</span>
<a name="line-111"></a><a name="Wanted"></a><span class='hs-comment'>-- prefer to be passed when processing. This makes it possible to</span>
<a name="line-112"></a><a name="Wanted"></a><span class='hs-comment'>-- create a smaller number of QNFA states and avoid creating wasteful</span>
<a name="line-113"></a><a name="Wanted"></a><span class='hs-comment'>-- QNFA states that won't be reachable in the final automata.</span>
<a name="line-114"></a><a name="Wanted"></a><span class='hs-comment'>--</span>
<a name="line-115"></a><a name="Wanted"></a><span class='hs-comment'>-- In practice WantsBoth is treated identically to WantsQNFA and</span>
<a name="line-116"></a><a name="Wanted"></a><span class='hs-comment'>-- WantsBoth could be removed.</span>
<a name="line-117"></a><a name="Wanted"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>Wanted</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>WantsQNFA</span> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>WantsQT</span> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>WantsBoth</span> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>WantsEither</span> <span class='hs-keyword'>deriving</span> <span class='hs-layout'>(</span><span class='hs-conid'>Eq</span><span class='hs-layout'>,</span><span class='hs-conid'>Show</span><span class='hs-layout'>)</span>
<a name="line-118"></a>
<a name="line-119"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>Show</span> <span class='hs-conid'>Q</span> <span class='hs-keyword'>where</span>
<a name="line-120"></a> <span class='hs-varid'>show</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>showQ</span>
<a name="line-121"></a>
<a name="line-122"></a><a name="showQ"></a><span class='hs-definition'>showQ</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Q</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>String</span>
<a name="line-123"></a><span class='hs-definition'>showQ</span> <span class='hs-varid'>q</span> <span class='hs-keyglyph'>=</span> <span class='hs-str'>"Q { nullQ = "</span><span class='hs-varop'>++</span><span class='hs-varid'>show</span> <span class='hs-layout'>(</span><span class='hs-varid'>nullQ</span> <span class='hs-varid'>q</span><span class='hs-layout'>)</span><span class='hs-varop'>++</span>
<a name="line-124"></a> <span class='hs-str'>"\n , takes = "</span><span class='hs-varop'>++</span><span class='hs-varid'>show</span> <span class='hs-layout'>(</span><span class='hs-varid'>takes</span> <span class='hs-varid'>q</span><span class='hs-layout'>)</span><span class='hs-varop'>++</span>
<a name="line-125"></a> <span class='hs-str'>"\n , preReset = "</span><span class='hs-varop'>++</span><span class='hs-varid'>show</span> <span class='hs-layout'>(</span><span class='hs-varid'>preReset</span> <span class='hs-varid'>q</span><span class='hs-layout'>)</span><span class='hs-varop'>++</span>
<a name="line-126"></a> <span class='hs-str'>"\n , postSet = "</span><span class='hs-varop'>++</span><span class='hs-varid'>show</span> <span class='hs-layout'>(</span><span class='hs-varid'>postSet</span> <span class='hs-varid'>q</span><span class='hs-layout'>)</span><span class='hs-varop'>++</span>
<a name="line-127"></a> <span class='hs-str'>"\n , preTag = "</span><span class='hs-varop'>++</span><span class='hs-varid'>show</span> <span class='hs-layout'>(</span><span class='hs-varid'>preTag</span> <span class='hs-varid'>q</span><span class='hs-layout'>)</span><span class='hs-varop'>++</span>
<a name="line-128"></a> <span class='hs-str'>"\n , postTag = "</span><span class='hs-varop'>++</span><span class='hs-varid'>show</span> <span class='hs-layout'>(</span><span class='hs-varid'>postTag</span> <span class='hs-varid'>q</span><span class='hs-layout'>)</span><span class='hs-varop'>++</span>
<a name="line-129"></a> <span class='hs-str'>"\n , tagged = "</span><span class='hs-varop'>++</span><span class='hs-varid'>show</span> <span class='hs-layout'>(</span><span class='hs-varid'>tagged</span> <span class='hs-varid'>q</span><span class='hs-layout'>)</span><span class='hs-varop'>++</span>
<a name="line-130"></a> <span class='hs-str'>"\n , wants = "</span><span class='hs-varop'>++</span><span class='hs-varid'>show</span> <span class='hs-layout'>(</span><span class='hs-varid'>wants</span> <span class='hs-varid'>q</span><span class='hs-layout'>)</span><span class='hs-varop'>++</span>
<a name="line-131"></a> <span class='hs-str'>"\n , unQ = "</span><span class='hs-varop'>++</span> <span class='hs-varid'>indent'</span> <span class='hs-layout'>(</span><span class='hs-varid'>unQ</span> <span class='hs-varid'>q</span><span class='hs-layout'>)</span><span class='hs-varop'>++</span><span class='hs-str'>" }"</span>
<a name="line-132"></a> <span class='hs-keyword'>where</span> <span class='hs-varid'>indent'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>unlines</span> <span class='hs-varop'>.</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>s</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>case</span> <span class='hs-varid'>s</span> <span class='hs-keyword'>of</span>
<a name="line-133"></a> <span class='hs-conid'>[]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>[]</span>
<a name="line-134"></a> <span class='hs-layout'>(</span><span class='hs-varid'>h</span><span class='hs-conop'>:</span><span class='hs-varid'>t</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>h</span> <span class='hs-conop'>:</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-layout'>(</span><span class='hs-varid'>spaces</span> <span class='hs-varop'>++</span><span class='hs-layout'>)</span> <span class='hs-varid'>t</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varop'>.</span> <span class='hs-varid'>lines</span> <span class='hs-varop'>.</span> <span class='hs-varid'>show</span>
<a name="line-135"></a> <span class='hs-varid'>spaces</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>replicate</span> <span class='hs-num'>10</span> <span class='hs-chr'>' '</span>
<a name="line-136"></a>
<a name="line-137"></a><a name="notNull"></a><span class='hs-comment'>-- Smart constructors for NullView</span>
<a name="line-138"></a><span class='hs-definition'>notNull</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>NullView</span>
<a name="line-139"></a><span class='hs-definition'>notNull</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>[]</span>
<a name="line-140"></a>
<a name="line-141"></a><span class='hs-comment'>-- Shorthand for combining a preTag and a postTag</span>
<a name="line-142"></a><span class='hs-comment'>-- preTags :: Maybe Tag -> Maybe Tag -> TagList</span>
<a name="line-143"></a><span class='hs-comment'>-- preTags a b = promote a `mappend` promote b</span>
<a name="line-144"></a><span class='hs-comment'>-- where promote = maybe [] (\x -> [(x,PreUpdate TagTask)])</span>
<a name="line-145"></a>
<a name="line-146"></a><a name="promotePreTag"></a><span class='hs-definition'>promotePreTag</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>HandleTag</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TagList</span>
<a name="line-147"></a><span class='hs-definition'>promotePreTag</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>maybe</span> <span class='hs-conid'>[]</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>x</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-varid'>x</span><span class='hs-layout'>,</span><span class='hs-conid'>PreUpdate</span> <span class='hs-conid'>TagTask</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span> <span class='hs-varop'>.</span> <span class='hs-varid'>apply</span>
<a name="line-148"></a>
<a name="line-149"></a><a name="makeEmptyNullView"></a><span class='hs-definition'>makeEmptyNullView</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>HandleTag</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>HandleTag</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>NullView</span>
<a name="line-150"></a><span class='hs-definition'>makeEmptyNullView</span> <span class='hs-varid'>a</span> <span class='hs-varid'>b</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-varid'>mempty</span><span class='hs-layout'>,</span> <span class='hs-varid'>promotePreTag</span> <span class='hs-varid'>a</span> <span class='hs-varop'>++</span> <span class='hs-varid'>promotePreTag</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-151"></a>
<a name="line-152"></a><a name="makeTestNullView"></a><span class='hs-definition'>makeTestNullView</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TestInfo</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>HandleTag</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>HandleTag</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>NullView</span>
<a name="line-153"></a><span class='hs-definition'>makeTestNullView</span> <span class='hs-layout'>(</span><span class='hs-varid'>w</span><span class='hs-layout'>,</span><span class='hs-varid'>d</span><span class='hs-layout'>)</span> <span class='hs-varid'>a</span> <span class='hs-varid'>b</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-conid'>SetTestInfo</span> <span class='hs-layout'>(</span><span class='hs-conid'>Map</span><span class='hs-varop'>.</span><span class='hs-varid'>singleton</span> <span class='hs-varid'>w</span> <span class='hs-layout'>(</span><span class='hs-conid'>Set</span><span class='hs-varop'>.</span><span class='hs-varid'>singleton</span> <span class='hs-varid'>d</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>promotePreTag</span> <span class='hs-varid'>a</span> <span class='hs-varop'>++</span> <span class='hs-varid'>promotePreTag</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-154"></a>
<a name="line-155"></a><a name="tagWrapNullView"></a><span class='hs-definition'>tagWrapNullView</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>HandleTag</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>HandleTag</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>NullView</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>NullView</span>
<a name="line-156"></a><span class='hs-definition'>tagWrapNullView</span> <span class='hs-varid'>a</span> <span class='hs-varid'>b</span> <span class='hs-varid'>oldNV</span> <span class='hs-keyglyph'>=</span>
<a name="line-157"></a> <span class='hs-keyword'>case</span> <span class='hs-layout'>(</span><span class='hs-varid'>promotePreTag</span> <span class='hs-varid'>a</span><span class='hs-layout'>,</span> <span class='hs-varid'>promotePreTag</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span> <span class='hs-keyword'>of</span>
<a name="line-158"></a> <span class='hs-layout'>(</span><span class='hs-conid'>[]</span><span class='hs-layout'>,</span><span class='hs-conid'>[]</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>oldNV</span>
<a name="line-159"></a> <span class='hs-layout'>(</span><span class='hs-varid'>pre</span><span class='hs-layout'>,</span><span class='hs-varid'>post</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-160"></a> <span class='hs-layout'>(</span><span class='hs-varid'>oldTests</span><span class='hs-layout'>,</span><span class='hs-varid'>oldTasks</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>oldNV</span>
<a name="line-161"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>oldTests</span><span class='hs-layout'>,</span><span class='hs-varid'>pre</span><span class='hs-varop'>++</span><span class='hs-varid'>oldTasks</span><span class='hs-varop'>++</span><span class='hs-varid'>post</span><span class='hs-layout'>)</span>
<a name="line-162"></a>
<a name="line-163"></a><a name="addGroupResetsToNullView"></a><span class='hs-comment'>-- For PGroup, need to prepend reset tasks before others in nullView</span>
<a name="line-164"></a><span class='hs-definition'>addGroupResetsToNullView</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Tag</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Tag</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>NullView</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>NullView</span>
<a name="line-165"></a><span class='hs-definition'>addGroupResetsToNullView</span> <span class='hs-varid'>groupResets</span> <span class='hs-varid'>groupSet</span> <span class='hs-varid'>nv</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span> <span class='hs-layout'>(</span><span class='hs-varid'>test</span><span class='hs-layout'>,</span> <span class='hs-varid'>prepend</span> <span class='hs-layout'>(</span><span class='hs-varid'>append</span> <span class='hs-varid'>tags</span><span class='hs-layout'>)</span> <span class='hs-layout'>)</span> <span class='hs-keyglyph'>|</span> <span class='hs-layout'>(</span><span class='hs-varid'>test</span><span class='hs-layout'>,</span><span class='hs-varid'>tags</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>nv</span> <span class='hs-keyglyph'>]</span>
<a name="line-166"></a> <span class='hs-keyword'>where</span> <span class='hs-varid'>prepend</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>foldr</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>h</span> <span class='hs-varid'>t</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>h</span><span class='hs-conop'>:</span><span class='hs-layout'>)</span><span class='hs-varop'>.</span><span class='hs-varid'>t</span><span class='hs-layout'>)</span> <span class='hs-varid'>id</span> <span class='hs-varop'>.</span> <span class='hs-varid'>map</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>tag</span><span class='hs-keyglyph'>-></span><span class='hs-layout'>(</span><span class='hs-varid'>tag</span><span class='hs-layout'>,</span><span class='hs-conid'>PreUpdate</span> <span class='hs-conid'>ResetGroupStopTask</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span> <span class='hs-varid'>groupResets</span>
<a name="line-167"></a> <span class='hs-varid'>append</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varop'>++</span><span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-varid'>groupSet</span><span class='hs-layout'>,</span><span class='hs-conid'>PreUpdate</span> <span class='hs-conid'>SetGroupStopTask</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-168"></a>
<a name="line-169"></a><a name="orbitWrapNullView"></a><span class='hs-comment'>-- For PStar, need to put in the orbit TagTasks</span>
<a name="line-170"></a><span class='hs-definition'>orbitWrapNullView</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Maybe</span> <span class='hs-conid'>Tag</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Tag</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>NullView</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>NullView</span>
<a name="line-171"></a><span class='hs-definition'>orbitWrapNullView</span> <span class='hs-varid'>mOrbit</span> <span class='hs-varid'>orbitResets</span> <span class='hs-varid'>oldNV</span> <span class='hs-keyglyph'>=</span>
<a name="line-172"></a> <span class='hs-keyword'>case</span> <span class='hs-layout'>(</span><span class='hs-varid'>mOrbit</span><span class='hs-layout'>,</span><span class='hs-varid'>orbitResets</span><span class='hs-layout'>)</span> <span class='hs-keyword'>of</span>
<a name="line-173"></a> <span class='hs-layout'>(</span><span class='hs-conid'>Nothing</span><span class='hs-layout'>,</span><span class='hs-conid'>[]</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>oldNV</span>
<a name="line-174"></a> <span class='hs-layout'>(</span><span class='hs-conid'>Nothing</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span> <span class='hs-layout'>(</span><span class='hs-varid'>oldTests</span><span class='hs-layout'>,</span><span class='hs-varid'>oldTasks</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>oldNV</span>
<a name="line-175"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>oldTests</span><span class='hs-layout'>,</span><span class='hs-varid'>prepend</span> <span class='hs-varid'>oldTasks</span><span class='hs-layout'>)</span>
<a name="line-176"></a> <span class='hs-layout'>(</span><span class='hs-conid'>Just</span> <span class='hs-varid'>o</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span> <span class='hs-layout'>(</span><span class='hs-varid'>oldTests</span><span class='hs-layout'>,</span><span class='hs-varid'>oldTasks</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>oldNV</span>
<a name="line-177"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>oldTests</span><span class='hs-layout'>,</span><span class='hs-varid'>prepend</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-varid'>o</span><span class='hs-layout'>,</span><span class='hs-conid'>PreUpdate</span> <span class='hs-conid'>EnterOrbitTask</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span> <span class='hs-varop'>++</span> <span class='hs-varid'>oldTasks</span> <span class='hs-varop'>++</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-varid'>o</span><span class='hs-layout'>,</span><span class='hs-conid'>PreUpdate</span> <span class='hs-conid'>LeaveOrbitTask</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-178"></a> <span class='hs-keyword'>where</span> <span class='hs-varid'>prepend</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>foldr</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>h</span> <span class='hs-varid'>t</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>h</span><span class='hs-conop'>:</span><span class='hs-layout'>)</span><span class='hs-varop'>.</span><span class='hs-varid'>t</span><span class='hs-layout'>)</span> <span class='hs-varid'>id</span> <span class='hs-varop'>.</span> <span class='hs-varid'>map</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>tag</span><span class='hs-keyglyph'>-></span><span class='hs-layout'>(</span><span class='hs-varid'>tag</span><span class='hs-layout'>,</span><span class='hs-conid'>PreUpdate</span> <span class='hs-conid'>ResetOrbitTask</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span> <span class='hs-varid'>orbitResets</span>
<a name="line-179"></a>
<a name="line-180"></a><a name="cleanNullView"></a><span class='hs-comment'>-- The NullViews are ordered, and later test sets that contain the</span>
<a name="line-181"></a><span class='hs-comment'>-- tests from any earlier entry will never be chosen. This function</span>
<a name="line-182"></a><span class='hs-comment'>-- returns a list with these redundant elements removed. Note that</span>
<a name="line-183"></a><span class='hs-comment'>-- the first unconditional entry in the list will be the last entry of</span>
<a name="line-184"></a><span class='hs-comment'>-- the returned list since the empty set is a subset of any other set.</span>
<a name="line-185"></a><span class='hs-definition'>cleanNullView</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>NullView</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>NullView</span>
<a name="line-186"></a><span class='hs-definition'>cleanNullView</span> <span class='hs-conid'>[]</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>[]</span>
<a name="line-187"></a><span class='hs-definition'>cleanNullView</span> <span class='hs-layout'>(</span><span class='hs-varid'>first</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>SetTestInfo</span> <span class='hs-varid'>sti</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span><span class='hs-conop'>:</span><span class='hs-varid'>rest</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Map</span><span class='hs-varop'>.</span><span class='hs-varid'>null</span> <span class='hs-varid'>sti</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>first</span> <span class='hs-conop'>:</span> <span class='hs-conid'>[]</span> <span class='hs-comment'>-- optimization</span>
<a name="line-188"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span>
<a name="line-189"></a> <span class='hs-varid'>first</span> <span class='hs-conop'>:</span> <span class='hs-varid'>cleanNullView</span> <span class='hs-layout'>(</span><span class='hs-varid'>filter</span> <span class='hs-layout'>(</span><span class='hs-varid'>not</span> <span class='hs-varop'>.</span> <span class='hs-layout'>(</span><span class='hs-varid'>setTI</span> <span class='hs-varop'>`</span><span class='hs-conid'>Set</span><span class='hs-varop'>.</span><span class='hs-varid'>isSubsetOf</span><span class='hs-varop'>`</span><span class='hs-layout'>)</span> <span class='hs-varop'>.</span> <span class='hs-conid'>Map</span><span class='hs-varop'>.</span><span class='hs-varid'>keysSet</span> <span class='hs-varop'>.</span> <span class='hs-varid'>getTests</span> <span class='hs-varop'>.</span> <span class='hs-varid'>fst</span><span class='hs-layout'>)</span> <span class='hs-varid'>rest</span><span class='hs-layout'>)</span>
<a name="line-190"></a> <span class='hs-keyword'>where</span> <span class='hs-varid'>setTI</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Map</span><span class='hs-varop'>.</span><span class='hs-varid'>keysSet</span> <span class='hs-varid'>sti</span>
<a name="line-191"></a>
<a name="line-192"></a><a name="mergeNullViews"></a><span class='hs-comment'>-- Ordered Sequence of two NullViews: all ordered combinations of tests and tags.</span>
<a name="line-193"></a><span class='hs-comment'>-- Order of <- s1 and <- s2 is deliberately chosen to maintain preference priority</span>
<a name="line-194"></a><span class='hs-definition'>mergeNullViews</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>NullView</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>NullView</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>NullView</span>
<a name="line-195"></a><span class='hs-definition'>mergeNullViews</span> <span class='hs-varid'>s1</span> <span class='hs-varid'>s2</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>cleanNullView</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>do</span>
<a name="line-196"></a> <span class='hs-layout'>(</span><span class='hs-varid'>test1</span><span class='hs-layout'>,</span><span class='hs-varid'>tag1</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>s1</span>
<a name="line-197"></a> <span class='hs-layout'>(</span><span class='hs-varid'>test2</span><span class='hs-layout'>,</span><span class='hs-varid'>tag2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>s2</span>
<a name="line-198"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>mappend</span> <span class='hs-varid'>test1</span> <span class='hs-varid'>test2</span><span class='hs-layout'>,</span><span class='hs-varid'>mappend</span> <span class='hs-varid'>tag1</span> <span class='hs-varid'>tag2</span><span class='hs-layout'>)</span>
<a name="line-199"></a><span class='hs-comment'>-- mergeNullViews = cleanNullView $ liftM2 (mappend *** mappend)</span>
<a name="line-200"></a>
<a name="line-201"></a><a name="seqTake"></a><span class='hs-comment'>-- Concatenated two ranges of number of accepted characters</span>
<a name="line-202"></a><span class='hs-definition'>seqTake</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Int</span><span class='hs-layout'>,</span> <span class='hs-conid'>Maybe</span> <span class='hs-conid'>Int</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>Int</span><span class='hs-layout'>,</span> <span class='hs-conid'>Maybe</span> <span class='hs-conid'>Int</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>Int</span><span class='hs-layout'>,</span> <span class='hs-conid'>Maybe</span> <span class='hs-conid'>Int</span><span class='hs-layout'>)</span>
<a name="line-203"></a><span class='hs-definition'>seqTake</span> <span class='hs-layout'>(</span><span class='hs-varid'>x1</span><span class='hs-layout'>,</span><span class='hs-varid'>y1</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>x2</span><span class='hs-layout'>,</span><span class='hs-varid'>y2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>x1</span><span class='hs-varop'>+</span><span class='hs-varid'>x2</span><span class='hs-layout'>,</span><span class='hs-varid'>liftM2</span> <span class='hs-layout'>(</span><span class='hs-varop'>+</span><span class='hs-layout'>)</span> <span class='hs-varid'>y1</span> <span class='hs-varid'>y2</span><span class='hs-layout'>)</span>
<a name="line-204"></a>
<a name="line-205"></a><a name="orTakes"></a><span class='hs-comment'>-- Parallel combination of list of ranges of number of accepted characters</span>
<a name="line-206"></a><span class='hs-definition'>orTakes</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-conid'>Int</span><span class='hs-layout'>,</span> <span class='hs-conid'>Maybe</span> <span class='hs-conid'>Int</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>Int</span><span class='hs-layout'>,</span><span class='hs-conid'>Maybe</span> <span class='hs-conid'>Int</span><span class='hs-layout'>)</span>
<a name="line-207"></a><span class='hs-definition'>orTakes</span> <span class='hs-conid'>[]</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-num'>0</span><span class='hs-layout'>,</span><span class='hs-conid'>Just</span> <span class='hs-num'>0</span><span class='hs-layout'>)</span>
<a name="line-208"></a><span class='hs-definition'>orTakes</span> <span class='hs-varid'>ts</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>let</span> <span class='hs-layout'>(</span><span class='hs-varid'>xs</span><span class='hs-layout'>,</span><span class='hs-varid'>ys</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>unzip</span> <span class='hs-varid'>ts</span>
<a name="line-209"></a> <span class='hs-keyword'>in</span> <span class='hs-layout'>(</span><span class='hs-varid'>minimum</span> <span class='hs-varid'>xs</span><span class='hs-layout'>,</span> <span class='hs-varid'>foldl1</span> <span class='hs-layout'>(</span><span class='hs-varid'>liftM2</span> <span class='hs-varid'>max</span><span class='hs-layout'>)</span> <span class='hs-varid'>ys</span><span class='hs-layout'>)</span>
<a name="line-210"></a>
<a name="line-211"></a><a name="apply"></a><span class='hs-comment'>-- Invariant: apply (toAdvice _ ) == mempty</span>
<a name="line-212"></a><span class='hs-definition'>apply</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>HandleTag</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Maybe</span> <span class='hs-conid'>Tag</span>
<a name="line-213"></a><span class='hs-definition'>apply</span> <span class='hs-layout'>(</span><span class='hs-conid'>Apply</span> <span class='hs-varid'>tag</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Just</span> <span class='hs-varid'>tag</span>
<a name="line-214"></a><span class='hs-definition'>apply</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Nothing</span>
<a name="line-215"></a><a name="toAdvice"></a><span class='hs-definition'>toAdvice</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>HandleTag</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>HandleTag</span>
<a name="line-216"></a><span class='hs-definition'>toAdvice</span> <span class='hs-layout'>(</span><span class='hs-conid'>Apply</span> <span class='hs-varid'>tag</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Advice</span> <span class='hs-varid'>tag</span>
<a name="line-217"></a><span class='hs-definition'>toAdvice</span> <span class='hs-varid'>s</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>s</span>
<a name="line-218"></a><a name="noTag"></a><span class='hs-definition'>noTag</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>HandleTag</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span>
<a name="line-219"></a><span class='hs-definition'>noTag</span> <span class='hs-conid'>NoTag</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span>
<a name="line-220"></a><span class='hs-definition'>noTag</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span>
<a name="line-221"></a><a name="fromHandleTag"></a><span class='hs-definition'>fromHandleTag</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>HandleTag</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Tag</span>
<a name="line-222"></a><span class='hs-definition'>fromHandleTag</span> <span class='hs-layout'>(</span><span class='hs-conid'>Apply</span> <span class='hs-varid'>tag</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tag</span>
<a name="line-223"></a><span class='hs-definition'>fromHandleTag</span> <span class='hs-layout'>(</span><span class='hs-conid'>Advice</span> <span class='hs-varid'>tag</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tag</span>
<a name="line-224"></a><span class='hs-definition'>fromHandleTag</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>error</span> <span class='hs-str'>"fromHandleTag"</span>
<a name="line-225"></a>
<a name="line-226"></a><a name="varies"></a><span class='hs-comment'>-- Predicates on the range of number of accepted characters</span>
<a name="line-227"></a><span class='hs-definition'>varies</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Q</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span>
<a name="line-228"></a><span class='hs-definition'>varies</span> <span class='hs-conid'>Q</span> <span class='hs-layout'>{</span><span class='hs-varid'>takes</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-conid'>Nothing</span><span class='hs-layout'>)</span><span class='hs-layout'>}</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span>
<a name="line-229"></a><span class='hs-definition'>varies</span> <span class='hs-conid'>Q</span> <span class='hs-layout'>{</span><span class='hs-varid'>takes</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>x</span><span class='hs-layout'>,</span><span class='hs-conid'>Just</span> <span class='hs-varid'>y</span><span class='hs-layout'>)</span><span class='hs-layout'>}</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>x</span><span class='hs-varop'>/=</span><span class='hs-varid'>y</span>
<a name="line-230"></a>
<a name="line-231"></a><a name="mustAccept"></a><span class='hs-definition'>mustAccept</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Q</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span>
<a name="line-232"></a><span class='hs-definition'>mustAccept</span> <span class='hs-varid'>q</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-num'>0</span><span class='hs-varop'>/=</span><span class='hs-layout'>)</span> <span class='hs-varop'>.</span> <span class='hs-varid'>fst</span> <span class='hs-varop'>.</span> <span class='hs-varid'>takes</span> <span class='hs-varop'>$</span> <span class='hs-varid'>q</span>
<a name="line-233"></a>
<a name="line-234"></a><a name="canAccept"></a><span class='hs-definition'>canAccept</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Q</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span>
<a name="line-235"></a><span class='hs-definition'>canAccept</span> <span class='hs-varid'>q</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>maybe</span> <span class='hs-conid'>True</span> <span class='hs-layout'>(</span><span class='hs-num'>0</span><span class='hs-varop'>/=</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span> <span class='hs-varid'>snd</span> <span class='hs-varop'>.</span> <span class='hs-varid'>takes</span> <span class='hs-varop'>$</span> <span class='hs-varid'>q</span>
<a name="line-236"></a>
<a name="line-237"></a><a name="cannotAccept"></a><span class='hs-definition'>cannotAccept</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Q</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span>
<a name="line-238"></a><span class='hs-definition'>cannotAccept</span> <span class='hs-varid'>q</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>maybe</span> <span class='hs-conid'>False</span> <span class='hs-layout'>(</span><span class='hs-num'>0</span><span class='hs-varop'>==</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span> <span class='hs-varid'>snd</span> <span class='hs-varop'>.</span> <span class='hs-varid'>takes</span> <span class='hs-varop'>$</span> <span class='hs-varid'>q</span>
<a name="line-239"></a>
<a name="line-240"></a><span class='hs-comment'>-- This converts then input Pattern to an analyzed Q structure with</span>
<a name="line-241"></a><span class='hs-comment'>-- the tags assigned.</span>
<a name="line-242"></a><span class='hs-comment'>--</span>
<a name="line-243"></a><span class='hs-comment'>-- The analysis is filled in by a depth first search and the tags are</span>
<a name="line-244"></a><span class='hs-comment'>-- created top down and passed to children. Thus information flows up</span>
<a name="line-245"></a><span class='hs-comment'>-- from the dfs of the children and simultaneously down in the form of</span>
<a name="line-246"></a><span class='hs-comment'>-- pre and post HandleTag data. This bidirectional flow is handled</span>
<a name="line-247"></a><span class='hs-comment'>-- declaratively by using the MonadFix (i.e. mdo).</span>
<a name="line-248"></a><span class='hs-comment'>-- </span>
<a name="line-249"></a><span class='hs-comment'>-- Invariant: A tag should exist in Q in exactly one place (and will</span>
<a name="line-250"></a><span class='hs-comment'>-- be in a preTag,postTag, or getOrbit field). This is partly because</span>
<a name="line-251"></a><span class='hs-comment'>-- PGroup needs to know the tags are around precisely the expression</span>
<a name="line-252"></a><span class='hs-comment'>-- that it wants to record. If the same tag were in other branches</span>
<a name="line-253"></a><span class='hs-comment'>-- then this would no longer be true. The tag may or may not also</span>
<a name="line-254"></a><span class='hs-comment'>-- show up in one or more preReset list or resetOrbits list.</span>
<a name="line-255"></a><span class='hs-comment'>--</span>
<a name="line-256"></a><span class='hs-comment'>-- This invariant is enforced by each node either taking</span>
<a name="line-257"></a><span class='hs-comment'>-- responsibility (apply) for a passed in / created tag or sending it</span>
<a name="line-258"></a><span class='hs-comment'>-- to exactly one child node. Other child nodes need to receive it</span>
<a name="line-259"></a><span class='hs-comment'>-- via toAdvice. Leaf nodes are forced to apply any passed tags.</span>
<a name="line-260"></a><span class='hs-comment'>--</span>
<a name="line-261"></a><span class='hs-comment'>-- There is a final "qwin of Q {postTag=ISet.singleton 1}" and an</span>
<a name="line-262"></a><span class='hs-comment'>-- implied initial index tag of 0.</span>
<a name="line-263"></a><span class='hs-comment'>-- </span>
<a name="line-264"></a><span class='hs-comment'>-- favoring pushing Apply into the child postTag makes PGroup happier</span>
<a name="line-265"></a>
<a name="line-266"></a><a name="PM"></a><span class='hs-keyword'>type</span> <span class='hs-conid'>PM</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>RWS</span> <span class='hs-layout'>(</span><span class='hs-conid'>Maybe</span> <span class='hs-conid'>GroupIndex</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Either</span> <span class='hs-conid'>Tag</span> <span class='hs-conid'>GroupInfo</span><span class='hs-keyglyph'>]</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>[</span><span class='hs-conid'>OP</span><span class='hs-keyglyph'>]</span><span class='hs-keyglyph'>-></span><span class='hs-keyglyph'>[</span><span class='hs-conid'>OP</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span><span class='hs-conid'>Tag</span><span class='hs-layout'>)</span>
<a name="line-267"></a><a name="HHQ"></a><span class='hs-keyword'>type</span> <span class='hs-conid'>HHQ</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>HandleTag</span> <span class='hs-comment'>-- m1 : info about left boundaary / preTag</span>
<a name="line-268"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>HandleTag</span> <span class='hs-comment'>-- m2 : info about right boundary / postTag</span>
<a name="line-269"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>PM</span> <span class='hs-conid'>Q</span>
<a name="line-270"></a>
<a name="line-271"></a><a name="makeGroupArray"></a><span class='hs-comment'>-- There is no group 0 here, since it is always the whole match and has no parent of its own</span>
<a name="line-272"></a><span class='hs-definition'>makeGroupArray</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>GroupIndex</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>GroupInfo</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Array</span> <span class='hs-conid'>GroupIndex</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>GroupInfo</span><span class='hs-keyglyph'>]</span>
<a name="line-273"></a><span class='hs-definition'>makeGroupArray</span> <span class='hs-varid'>maxGroupIndex</span> <span class='hs-varid'>groups</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>accumArray</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>earlier</span> <span class='hs-varid'>later</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>later</span><span class='hs-conop'>:</span><span class='hs-varid'>earlier</span><span class='hs-layout'>)</span> <span class='hs-conid'>[]</span> <span class='hs-layout'>(</span><span class='hs-num'>1</span><span class='hs-layout'>,</span><span class='hs-varid'>maxGroupIndex</span><span class='hs-layout'>)</span> <span class='hs-varid'>filler</span>
<a name="line-274"></a> <span class='hs-keyword'>where</span> <span class='hs-varid'>filler</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>gi</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>thisIndex</span> <span class='hs-varid'>gi</span><span class='hs-layout'>,</span><span class='hs-varid'>gi</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varid'>groups</span>
<a name="line-275"></a>
<a name="line-276"></a><a name="fromRight"></a><span class='hs-definition'>fromRight</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Either</span> <span class='hs-conid'>Tag</span> <span class='hs-conid'>GroupInfo</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>GroupInfo</span><span class='hs-keyglyph'>]</span>
<a name="line-277"></a><span class='hs-definition'>fromRight</span> <span class='hs-conid'>[]</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>[]</span>
<a name="line-278"></a><span class='hs-definition'>fromRight</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-conid'>Right</span> <span class='hs-varid'>x</span><span class='hs-layout'>)</span><span class='hs-conop'>:</span><span class='hs-varid'>xs</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>x</span><span class='hs-conop'>:</span><span class='hs-varid'>fromRight</span> <span class='hs-varid'>xs</span>
<a name="line-279"></a><span class='hs-definition'>fromRight</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-conid'>Left</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span><span class='hs-conop'>:</span><span class='hs-varid'>xs</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fromRight</span> <span class='hs-varid'>xs</span>
<a name="line-280"></a>
<a name="line-281"></a><a name="partitionEither"></a><span class='hs-definition'>partitionEither</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Either</span> <span class='hs-conid'>Tag</span> <span class='hs-conid'>GroupInfo</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>[</span><span class='hs-conid'>Tag</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span><span class='hs-keyglyph'>[</span><span class='hs-conid'>GroupInfo</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-282"></a><span class='hs-definition'>partitionEither</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>helper</span> <span class='hs-varid'>id</span> <span class='hs-varid'>id</span> <span class='hs-keyword'>where</span>
<a name="line-283"></a> <span class='hs-varid'>helper</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>[</span><span class='hs-conid'>Tag</span><span class='hs-keyglyph'>]</span><span class='hs-keyglyph'>-></span><span class='hs-keyglyph'>[</span><span class='hs-conid'>Tag</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>[</span><span class='hs-conid'>GroupInfo</span><span class='hs-keyglyph'>]</span><span class='hs-keyglyph'>-></span><span class='hs-keyglyph'>[</span><span class='hs-conid'>GroupInfo</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Either</span> <span class='hs-conid'>Tag</span> <span class='hs-conid'>GroupInfo</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>[</span><span class='hs-conid'>Tag</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span><span class='hs-keyglyph'>[</span><span class='hs-conid'>GroupInfo</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-284"></a> <span class='hs-varid'>helper</span> <span class='hs-varid'>ls</span> <span class='hs-varid'>rs</span> <span class='hs-conid'>[]</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>ls</span> <span class='hs-conid'>[]</span><span class='hs-layout'>,</span><span class='hs-varid'>rs</span> <span class='hs-conid'>[]</span><span class='hs-layout'>)</span>
<a name="line-285"></a> <span class='hs-varid'>helper</span> <span class='hs-varid'>ls</span> <span class='hs-varid'>rs</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-conid'>Right</span> <span class='hs-varid'>x</span><span class='hs-layout'>)</span><span class='hs-conop'>:</span><span class='hs-varid'>xs</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>helper</span> <span class='hs-varid'>ls</span> <span class='hs-layout'>(</span><span class='hs-varid'>rs</span><span class='hs-varop'>.</span><span class='hs-layout'>(</span><span class='hs-varid'>x</span><span class='hs-conop'>:</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varid'>xs</span>
<a name="line-286"></a> <span class='hs-varid'>helper</span> <span class='hs-varid'>ls</span> <span class='hs-varid'>rs</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-conid'>Left</span> <span class='hs-varid'>x</span><span class='hs-layout'>)</span><span class='hs-conop'>:</span><span class='hs-varid'>xs</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>helper</span> <span class='hs-layout'>(</span><span class='hs-varid'>ls</span><span class='hs-varop'>.</span><span class='hs-layout'>(</span><span class='hs-varid'>x</span><span class='hs-conop'>:</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varid'>rs</span> <span class='hs-varid'>xs</span>
<a name="line-287"></a>
<a name="line-288"></a><a name="patternToQ"></a><span class='hs-comment'>-- Partial function: assumes starTrans has been run on the Pattern</span>
<a name="line-289"></a><span class='hs-comment'>-- Note that the lazy dependency chain for this very zigzag:</span>
<a name="line-290"></a><span class='hs-comment'>-- varies information is sent up the tree</span>
<a name="line-291"></a><span class='hs-comment'>-- handle tags depend on that and sends m1 m2 down the tree</span>
<a name="line-292"></a><span class='hs-comment'>-- makeGroup sends some tags to the writer (Right _)</span>
<a name="line-293"></a><span class='hs-comment'>-- withParent listens to children send group info to writer</span>
<a name="line-294"></a><span class='hs-comment'>-- and lazily looks resetGroupTags from aGroups, the result of all writer (Right _)</span>
<a name="line-295"></a><span class='hs-comment'>-- preReset stores the resetGroupTags result of the lookup in the tree</span>
<a name="line-296"></a><span class='hs-comment'>-- makeOrbit sends some tags to the writer (Left _)</span>
<a name="line-297"></a><span class='hs-comment'>-- withOrbit listens to children send orbit info to writer for resetOrbitTags </span>
<a name="line-298"></a><span class='hs-comment'>-- nullQ depends m1 m2 and resetOrbitTags and resetGroupTags and is sent up the tree</span>
<a name="line-299"></a><span class='hs-definition'>patternToQ</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>CompOption</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>Pattern</span><span class='hs-layout'>,</span><span class='hs-layout'>(</span><span class='hs-conid'>GroupIndex</span><span class='hs-layout'>,</span><span class='hs-conid'>DoPa</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>Q</span><span class='hs-layout'>,</span><span class='hs-conid'>Array</span> <span class='hs-conid'>Tag</span> <span class='hs-conid'>OP</span><span class='hs-layout'>,</span><span class='hs-conid'>Array</span> <span class='hs-conid'>GroupIndex</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>GroupInfo</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-300"></a><span class='hs-definition'>patternToQ</span> <span class='hs-varid'>compOpt</span> <span class='hs-layout'>(</span><span class='hs-varid'>pOrig</span><span class='hs-layout'>,</span><span class='hs-layout'>(</span><span class='hs-varid'>maxGroupIndex</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>tnfa</span><span class='hs-layout'>,</span><span class='hs-varid'>aTags</span><span class='hs-layout'>,</span><span class='hs-varid'>aGroups</span><span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-301"></a> <span class='hs-layout'>(</span><span class='hs-varid'>tnfa</span><span class='hs-layout'>,</span><span class='hs-layout'>(</span><span class='hs-varid'>tag_dlist</span><span class='hs-layout'>,</span><span class='hs-varid'>nextTag</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span><span class='hs-varid'>groups</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>runRWS</span> <span class='hs-varid'>monad</span> <span class='hs-varid'>startReader</span> <span class='hs-varid'>startState</span>
<a name="line-302"></a> <span class='hs-varid'>aTags</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>listArray</span> <span class='hs-layout'>(</span><span class='hs-num'>0</span><span class='hs-layout'>,</span><span class='hs-varid'>pred</span> <span class='hs-varid'>nextTag</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>tag_dlist</span> <span class='hs-conid'>[]</span><span class='hs-layout'>)</span>
<a name="line-303"></a> <span class='hs-varid'>aGroups</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>makeGroupArray</span> <span class='hs-varid'>maxGroupIndex</span> <span class='hs-layout'>(</span><span class='hs-varid'>fromRight</span> <span class='hs-varid'>groups</span><span class='hs-layout'>)</span>
<a name="line-304"></a>
<a name="line-305"></a> <span class='hs-comment'>-- implicitly inside a PGroup 0 converted into a GroupInfo 0 undefined 0 1</span>
<a name="line-306"></a> <span class='hs-varid'>monad</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>go</span> <span class='hs-layout'>(</span><span class='hs-varid'>starTrans</span> <span class='hs-varid'>pOrig</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>Advice</span> <span class='hs-num'>0</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>Advice</span> <span class='hs-num'>1</span><span class='hs-layout'>)</span>
<a name="line-307"></a> <span class='hs-comment'>-- startReader is accessed by getParentIndex and changed by nonCapture and withParent</span>
<a name="line-308"></a> <span class='hs-varid'>startReader</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Maybe</span> <span class='hs-conid'>GroupIndex</span>
<a name="line-309"></a> <span class='hs-varid'>startReader</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Just</span> <span class='hs-num'>0</span> <span class='hs-comment'>-- start inside group 0, capturing enabled</span>
<a name="line-310"></a> <span class='hs-comment'>-- The startState is only acted upon in the "uniq" command</span>
<a name="line-311"></a> <span class='hs-comment'>-- Tag 0 is Minimized and Tag 1 is maximized, next tag has value of 2</span>
<a name="line-312"></a> <span class='hs-comment'>-- This is regardless of right or left associativity</span>
<a name="line-313"></a> <span class='hs-varid'>startState</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>[</span><span class='hs-conid'>OP</span><span class='hs-keyglyph'>]</span><span class='hs-keyglyph'>-></span><span class='hs-keyglyph'>[</span><span class='hs-conid'>OP</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span><span class='hs-conid'>Tag</span><span class='hs-layout'>)</span>
<a name="line-314"></a> <span class='hs-varid'>startState</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span> <span class='hs-layout'>(</span><span class='hs-conid'>Minimize</span><span class='hs-conop'>:</span><span class='hs-layout'>)</span> <span class='hs-varop'>.</span> <span class='hs-layout'>(</span><span class='hs-conid'>Maximize</span><span class='hs-conop'>:</span><span class='hs-layout'>)</span> <span class='hs-layout'>,</span> <span class='hs-num'>2</span><span class='hs-layout'>)</span>
<a name="line-315"></a>
<a name="line-316"></a> <span class='hs-comment'>-- uniq uses MonadState and always returns an "Apply _" tag</span>
<a name="line-317"></a> <span class='hs-comment'>{-# INLINE uniq #-}</span>
<a name="line-318"></a> <span class='hs-varid'>uniq</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>String</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>PM</span> <span class='hs-conid'>HandleTag</span>
<a name="line-319"></a> <span class='hs-varid'>uniq</span> <span class='hs-sel'>_msg</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fmap</span> <span class='hs-conid'>Apply</span> <span class='hs-layout'>(</span><span class='hs-varid'>uniq'</span> <span class='hs-conid'>Maximize</span><span class='hs-layout'>)</span>
<a name="line-320"></a><span class='hs-comment'>-- uniq _msg = do x <- fmap Apply (uniq' Maximize)</span>
<a name="line-321"></a><span class='hs-comment'>-- trace ('\n':msg ++ " Maximize "++show x) $ return x</span>
<a name="line-322"></a><span class='hs-comment'>-- return x</span>
<a name="line-323"></a>
<a name="line-324"></a> <span class='hs-varid'>ignore</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>String</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>PM</span> <span class='hs-conid'>Tag</span>
<a name="line-325"></a> <span class='hs-varid'>ignore</span> <span class='hs-sel'>_msg</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>uniq'</span> <span class='hs-conid'>Ignore</span>
<a name="line-326"></a><span class='hs-comment'>-- ignore _msg = do x <- uniq' Ignore</span>
<a name="line-327"></a><span class='hs-comment'>-- trace ('\n':msg ++ " Ignore "++show x) $ return x</span>
<a name="line-328"></a><span class='hs-comment'>-- return x</span>
<a name="line-329"></a>
<a name="line-330"></a> <span class='hs-comment'>{-# NOINLINE uniq' #-}</span>
<a name="line-331"></a> <span class='hs-varid'>uniq'</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>OP</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>PM</span> <span class='hs-conid'>Tag</span>
<a name="line-332"></a> <span class='hs-varid'>uniq'</span> <span class='hs-varid'>newOp</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-333"></a> <span class='hs-layout'>(</span><span class='hs-varid'>op</span><span class='hs-layout'>,</span><span class='hs-varid'>s</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>get</span> <span class='hs-comment'>-- generate the next tag with bias newOp</span>
<a name="line-334"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>op'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>op</span> <span class='hs-varop'>.</span> <span class='hs-layout'>(</span><span class='hs-varid'>newOp</span><span class='hs-conop'>:</span><span class='hs-layout'>)</span>
<a name="line-335"></a> <span class='hs-varid'>s'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>succ</span> <span class='hs-varid'>s</span>
<a name="line-336"></a> <span class='hs-varid'>put</span> <span class='hs-varop'>$!</span> <span class='hs-layout'>(</span><span class='hs-varid'>op'</span><span class='hs-layout'>,</span><span class='hs-varid'>s'</span><span class='hs-layout'>)</span>
<a name="line-337"></a> <span class='hs-varid'>return</span> <span class='hs-varid'>s</span>
<a name="line-338"></a>
<a name="line-339"></a> <span class='hs-comment'>{-# INLINE makeOrbit #-}</span>
<a name="line-340"></a> <span class='hs-comment'>-- Specialize the monad operations and give more meaningful names</span>
<a name="line-341"></a> <span class='hs-comment'>-- makeOrbit uses MonadState(uniq) and MonadWriter(tell/Left)</span>
<a name="line-342"></a> <span class='hs-varid'>makeOrbit</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>PM</span> <span class='hs-layout'>(</span><span class='hs-conid'>Maybe</span> <span class='hs-conid'>Tag</span><span class='hs-layout'>)</span>
<a name="line-343"></a> <span class='hs-varid'>makeOrbit</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>uniq'</span> <span class='hs-conid'>Orbit</span>
<a name="line-344"></a><span class='hs-comment'>-- trace ('\n':"PStar Orbit "++show x) $ do</span>
<a name="line-345"></a> <span class='hs-varid'>tell</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Left</span> <span class='hs-varid'>x</span><span class='hs-keyglyph'>]</span>
<a name="line-346"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>Just</span> <span class='hs-varid'>x</span><span class='hs-layout'>)</span>
<a name="line-347"></a>
<a name="line-348"></a> <span class='hs-comment'>{-# INLINE withOrbit #-}</span>
<a name="line-349"></a> <span class='hs-comment'>-- withOrbit uses MonadWriter(listens to makeOrbit/Left), collects</span>
<a name="line-350"></a> <span class='hs-comment'>-- children at all depths</span>
<a name="line-351"></a> <span class='hs-varid'>withOrbit</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>PM</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>PM</span> <span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span><span class='hs-keyglyph'>[</span><span class='hs-conid'>Tag</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-352"></a> <span class='hs-varid'>withOrbit</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>listens</span> <span class='hs-varid'>childStars</span>
<a name="line-353"></a> <span class='hs-keyword'>where</span> <span class='hs-varid'>childStars</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>let</span> <span class='hs-layout'>(</span><span class='hs-varid'>ts</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>partitionEither</span> <span class='hs-varid'>x</span> <span class='hs-keyword'>in</span> <span class='hs-varid'>ts</span>
<a name="line-354"></a>
<a name="line-355"></a> <span class='hs-comment'>{-# INLINE makeGroup #-}</span>
<a name="line-356"></a> <span class='hs-comment'>-- makeGroup usesMonadWriter(tell/Right)</span>
<a name="line-357"></a> <span class='hs-varid'>makeGroup</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>GroupInfo</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>PM</span> <span class='hs-conid'>()</span>
<a name="line-358"></a> <span class='hs-varid'>makeGroup</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tell</span> <span class='hs-varop'>.</span> <span class='hs-layout'>(</span><span class='hs-conop'>:</span><span class='hs-conid'>[]</span><span class='hs-layout'>)</span> <span class='hs-varop'>.</span> <span class='hs-conid'>Right</span>
<a name="line-359"></a>
<a name="line-360"></a> <span class='hs-comment'>{-# INLINE getParentIndex #-}</span>
<a name="line-361"></a> <span class='hs-comment'>-- getParentIndex uses MonadReader(ask)</span>
<a name="line-362"></a> <span class='hs-varid'>getParentIndex</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>PM</span> <span class='hs-layout'>(</span><span class='hs-conid'>Maybe</span> <span class='hs-conid'>GroupIndex</span><span class='hs-layout'>)</span>
<a name="line-363"></a> <span class='hs-varid'>getParentIndex</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ask</span>
<a name="line-364"></a>
<a name="line-365"></a> <span class='hs-comment'>{-# INLINE nonCapture #-}</span>
<a name="line-366"></a> <span class='hs-comment'>-- nonCapture uses MonadReader(local) to suppress getParentIndex to return Nothing</span>
<a name="line-367"></a> <span class='hs-varid'>nonCapture</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>PM</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>PM</span> <span class='hs-varid'>a</span>
<a name="line-368"></a> <span class='hs-varid'>nonCapture</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>local</span> <span class='hs-layout'>(</span><span class='hs-varid'>const</span> <span class='hs-conid'>Nothing</span><span class='hs-layout'>)</span>
<a name="line-369"></a>
<a name="line-370"></a> <span class='hs-comment'>-- withParent uses MonadReader(local) to set getParentIndex to return (Just this)</span>
<a name="line-371"></a> <span class='hs-comment'>-- withParent uses MonadWriter(listens to makeGroup/Right) to return contained group indices (stopTag)</span>
<a name="line-372"></a> <span class='hs-comment'>-- withParent is only safe if getParentIndex has been checked to be not equal to Nothing (see PGroup below)</span>
<a name="line-373"></a> <span class='hs-comment'>-- Note use of laziness: the immediate children's group index is used to look up all copies of the </span>
<a name="line-374"></a> <span class='hs-comment'>-- group in aGroups, including copies that are not immediate children.</span>
<a name="line-375"></a> <span class='hs-varid'>withParent</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>GroupIndex</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>PM</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>PM</span> <span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span><span class='hs-keyglyph'>[</span><span class='hs-conid'>Tag</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-376"></a> <span class='hs-varid'>withParent</span> <span class='hs-varid'>this</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>local</span> <span class='hs-layout'>(</span><span class='hs-varid'>const</span> <span class='hs-layout'>(</span><span class='hs-conid'>Just</span> <span class='hs-varid'>this</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varop'>.</span> <span class='hs-varid'>listens</span> <span class='hs-varid'>childGroupInfo</span>
<a name="line-377"></a> <span class='hs-keyword'>where</span> <span class='hs-varid'>childGroupInfo</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span>
<a name="line-378"></a> <span class='hs-keyword'>let</span> <span class='hs-layout'>(</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-varid'>gs</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>partitionEither</span> <span class='hs-varid'>x</span>
<a name="line-379"></a> <span class='hs-varid'>children</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>GroupIndex</span><span class='hs-keyglyph'>]</span>
<a name="line-380"></a> <span class='hs-varid'>children</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>norep</span> <span class='hs-varop'>.</span> <span class='hs-varid'>sort</span> <span class='hs-varop'>.</span> <span class='hs-varid'>map</span> <span class='hs-varid'>thisIndex</span>
<a name="line-381"></a> <span class='hs-comment'>-- filter to get only immediate children (efficiency)</span>
<a name="line-382"></a> <span class='hs-varop'>.</span> <span class='hs-varid'>filter</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>this</span><span class='hs-varop'>==</span><span class='hs-layout'>)</span><span class='hs-varop'>.</span><span class='hs-varid'>parentIndex</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span> <span class='hs-varid'>gs</span>
<a name="line-383"></a> <span class='hs-keyword'>in</span> <span class='hs-varid'>concatMap</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>flagTag</span> <span class='hs-varop'>.</span> <span class='hs-layout'>(</span><span class='hs-varid'>aGroups</span><span class='hs-varop'>!</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>this</span><span class='hs-conop'>:</span><span class='hs-varid'>children</span><span class='hs-layout'>)</span>
<a name="line-384"></a>
<a name="line-385"></a> <span class='hs-comment'>-- combineConcat is a partial function: Must not pass in an empty list</span>
<a name="line-386"></a> <span class='hs-comment'>-- Policy choices:</span>
<a name="line-387"></a> <span class='hs-comment'>-- * pass tags to apply to children and have no preTag or postTag here (so none addded to nullQ)</span>
<a name="line-388"></a> <span class='hs-comment'>-- * middle 'mid' tag: give to left/front child as postTag so a Group there might claim it as a stopTag</span>
<a name="line-389"></a> <span class='hs-comment'>-- * if parent is Group then preReset will become non-empty</span>
<a name="line-390"></a> <span class='hs-varid'>combineConcat</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Pattern</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>HHQ</span>
<a name="line-391"></a> <span class='hs-varid'>combineConcat</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>rightAssoc</span> <span class='hs-varid'>compOpt</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>foldr1</span> <span class='hs-varid'>combineSeq</span> <span class='hs-varop'>.</span> <span class='hs-varid'>map</span> <span class='hs-varid'>go</span>
<a name="line-392"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>foldl1</span> <span class='hs-varid'>combineSeq</span> <span class='hs-varop'>.</span> <span class='hs-varid'>map</span> <span class='hs-varid'>go</span> <span class='hs-comment'>-- libtre default</span>
<a name="line-393"></a> <span class='hs-keyword'>where</span> <span class='hs-comment'>{-# INLINE front'end #-}</span>
<a name="line-394"></a> <span class='hs-varid'>front'end</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>rightAssoc</span> <span class='hs-varid'>compOpt</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>liftM2</span> <span class='hs-conid'>(,)</span>
<a name="line-395"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>flip</span> <span class='hs-layout'>(</span><span class='hs-varid'>liftM2</span> <span class='hs-layout'>(</span><span class='hs-varid'>flip</span> <span class='hs-conid'>(,)</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-396"></a> <span class='hs-varid'>combineSeq</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>HHQ</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>HHQ</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>HHQ</span>
<a name="line-397"></a> <span class='hs-varid'>combineSeq</span> <span class='hs-varid'>pFront</span> <span class='hs-varid'>pEnd</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span> <span class='hs-varid'>m1</span> <span class='hs-varid'>m2</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>mdo</span>
<a name="line-398"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>bothVary</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>varies</span> <span class='hs-varid'>qFront</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>varies</span> <span class='hs-varid'>qEnd</span>
<a name="line-399"></a> <span class='hs-varid'>a</span> <span class='hs-keyglyph'><-</span> <span class='hs-keyword'>if</span> <span class='hs-varid'>noTag</span> <span class='hs-varid'>m1</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>bothVary</span> <span class='hs-keyword'>then</span> <span class='hs-varid'>uniq</span> <span class='hs-str'>"combineSeq start"</span> <span class='hs-keyword'>else</span> <span class='hs-varid'>return</span> <span class='hs-varid'>m1</span>
<a name="line-400"></a> <span class='hs-varid'>b</span> <span class='hs-keyglyph'><-</span> <span class='hs-keyword'>if</span> <span class='hs-varid'>noTag</span> <span class='hs-varid'>m2</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>bothVary</span> <span class='hs-keyword'>then</span> <span class='hs-varid'>uniq</span> <span class='hs-str'>"combineSeq stop"</span> <span class='hs-keyword'>else</span> <span class='hs-varid'>return</span> <span class='hs-varid'>m2</span>
<a name="line-401"></a> <span class='hs-varid'>mid</span> <span class='hs-keyglyph'><-</span> <span class='hs-keyword'>case</span> <span class='hs-layout'>(</span><span class='hs-varid'>noTag</span> <span class='hs-varid'>a</span><span class='hs-layout'>,</span><span class='hs-varid'>canAccept</span> <span class='hs-varid'>qFront</span><span class='hs-layout'>,</span><span class='hs-varid'>noTag</span> <span class='hs-varid'>b</span><span class='hs-layout'>,</span><span class='hs-varid'>canAccept</span> <span class='hs-varid'>qEnd</span><span class='hs-layout'>)</span> <span class='hs-keyword'>of</span>
<a name="line-402"></a> <span class='hs-layout'>(</span><span class='hs-conid'>False</span><span class='hs-layout'>,</span><span class='hs-conid'>False</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>toAdvice</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span>
<a name="line-403"></a> <span class='hs-layout'>(</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-conid'>False</span><span class='hs-layout'>,</span><span class='hs-conid'>False</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>toAdvice</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span>
<a name="line-404"></a> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>if</span> <span class='hs-varid'>tagged</span> <span class='hs-varid'>qFront</span> <span class='hs-varop'>||</span> <span class='hs-varid'>tagged</span> <span class='hs-varid'>qEnd</span> <span class='hs-keyword'>then</span> <span class='hs-varid'>uniq</span> <span class='hs-str'>"combineSeq mid"</span> <span class='hs-keyword'>else</span> <span class='hs-varid'>return</span> <span class='hs-conid'>NoTag</span>
<a name="line-405"></a> <span class='hs-comment'>-- qFront <- pFront a mid</span>
<a name="line-406"></a> <span class='hs-comment'>-- qEnd <- pEnd (toAdvice mid) b</span>
<a name="line-407"></a> <span class='hs-layout'>(</span><span class='hs-varid'>qFront</span><span class='hs-layout'>,</span><span class='hs-varid'>qEnd</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>front'end</span> <span class='hs-layout'>(</span><span class='hs-varid'>pFront</span> <span class='hs-varid'>a</span> <span class='hs-varid'>mid</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>pEnd</span> <span class='hs-layout'>(</span><span class='hs-varid'>toAdvice</span> <span class='hs-varid'>mid</span><span class='hs-layout'>)</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span>
<a name="line-408"></a> <span class='hs-comment'>-- XXX: Perhaps a "produces" should be created to compliment "wants",</span>
<a name="line-409"></a> <span class='hs-comment'>-- then "produces qEnd" could be compared to "wants qFront"</span>
<a name="line-410"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>wanted</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>if</span> <span class='hs-conid'>WantsEither</span> <span class='hs-varop'>==</span> <span class='hs-varid'>wants</span> <span class='hs-varid'>qEnd</span> <span class='hs-keyword'>then</span> <span class='hs-varid'>wants</span> <span class='hs-varid'>qFront</span> <span class='hs-keyword'>else</span> <span class='hs-varid'>wants</span> <span class='hs-varid'>qEnd</span>
<a name="line-411"></a> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Q</span> <span class='hs-layout'>{</span> <span class='hs-varid'>nullQ</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mergeNullViews</span> <span class='hs-layout'>(</span><span class='hs-varid'>nullQ</span> <span class='hs-varid'>qFront</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>nullQ</span> <span class='hs-varid'>qEnd</span><span class='hs-layout'>)</span>
<a name="line-412"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>takes</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>seqTake</span> <span class='hs-layout'>(</span><span class='hs-varid'>takes</span> <span class='hs-varid'>qFront</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>takes</span> <span class='hs-varid'>qEnd</span><span class='hs-layout'>)</span>
<a name="line-413"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>preReset</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>[]</span><span class='hs-layout'>,</span> <span class='hs-varid'>postSet</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>[]</span><span class='hs-layout'>,</span> <span class='hs-varid'>preTag</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Nothing</span><span class='hs-layout'>,</span> <span class='hs-varid'>postTag</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Nothing</span>
<a name="line-414"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>tagged</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>bothVary</span>
<a name="line-415"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>childGroups</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>childGroups</span> <span class='hs-varid'>qFront</span> <span class='hs-varop'>||</span> <span class='hs-varid'>childGroups</span> <span class='hs-varid'>qEnd</span>
<a name="line-416"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>wants</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>wanted</span>
<a name="line-417"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>unQ</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Seq</span> <span class='hs-varid'>qFront</span> <span class='hs-varid'>qEnd</span> <span class='hs-layout'>}</span>
<a name="line-418"></a> <span class='hs-layout'>)</span>
<a name="line-419"></a> <span class='hs-varid'>go</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Pattern</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>HHQ</span>
<a name="line-420"></a> <span class='hs-varid'>go</span> <span class='hs-varid'>pIn</span> <span class='hs-varid'>m1</span> <span class='hs-varid'>m2</span> <span class='hs-keyglyph'>=</span>
<a name="line-421"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>die</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>error</span> <span class='hs-varop'>$</span> <span class='hs-str'>"patternToQ cannot handle "</span><span class='hs-varop'>++</span><span class='hs-varid'>show</span> <span class='hs-varid'>pIn</span>
<a name="line-422"></a> <span class='hs-varid'>nil</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Q</span> <span class='hs-layout'>{</span><span class='hs-varid'>nullQ</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>makeEmptyNullView</span> <span class='hs-varid'>m1</span> <span class='hs-varid'>m2</span>
<a name="line-423"></a> <span class='hs-layout'>,</span><span class='hs-varid'>takes</span><span class='hs-keyglyph'>=</span><span class='hs-layout'>(</span><span class='hs-num'>0</span><span class='hs-layout'>,</span><span class='hs-conid'>Just</span> <span class='hs-num'>0</span><span class='hs-layout'>)</span>
<a name="line-424"></a> <span class='hs-layout'>,</span><span class='hs-varid'>preReset</span><span class='hs-keyglyph'>=</span><span class='hs-conid'>[]</span><span class='hs-layout'>,</span><span class='hs-varid'>postSet</span><span class='hs-keyglyph'>=</span><span class='hs-conid'>[]</span><span class='hs-layout'>,</span><span class='hs-varid'>preTag</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>apply</span> <span class='hs-varid'>m1</span><span class='hs-layout'>,</span><span class='hs-varid'>postTag</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>apply</span> <span class='hs-varid'>m2</span>
<a name="line-425"></a> <span class='hs-layout'>,</span><span class='hs-varid'>tagged</span><span class='hs-keyglyph'>=</span><span class='hs-conid'>False</span><span class='hs-layout'>,</span><span class='hs-varid'>childGroups</span><span class='hs-keyglyph'>=</span><span class='hs-conid'>False</span><span class='hs-layout'>,</span><span class='hs-varid'>wants</span><span class='hs-keyglyph'>=</span><span class='hs-conid'>WantsEither</span>
<a name="line-426"></a> <span class='hs-layout'>,</span><span class='hs-varid'>unQ</span><span class='hs-keyglyph'>=</span><span class='hs-conid'>Empty</span><span class='hs-layout'>}</span>
<a name="line-427"></a> <span class='hs-varid'>one</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Q</span> <span class='hs-layout'>{</span><span class='hs-varid'>nullQ</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>notNull</span>
<a name="line-428"></a> <span class='hs-layout'>,</span><span class='hs-varid'>takes</span><span class='hs-keyglyph'>=</span><span class='hs-layout'>(</span><span class='hs-num'>1</span><span class='hs-layout'>,</span><span class='hs-conid'>Just</span> <span class='hs-num'>1</span><span class='hs-layout'>)</span>
<a name="line-429"></a> <span class='hs-layout'>,</span><span class='hs-varid'>preReset</span><span class='hs-keyglyph'>=</span><span class='hs-conid'>[]</span><span class='hs-layout'>,</span><span class='hs-varid'>postSet</span><span class='hs-keyglyph'>=</span><span class='hs-conid'>[]</span><span class='hs-layout'>,</span><span class='hs-varid'>preTag</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>apply</span> <span class='hs-varid'>m1</span><span class='hs-layout'>,</span><span class='hs-varid'>postTag</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>apply</span> <span class='hs-varid'>m2</span>
<a name="line-430"></a> <span class='hs-layout'>,</span><span class='hs-varid'>tagged</span><span class='hs-keyglyph'>=</span><span class='hs-conid'>False</span><span class='hs-layout'>,</span><span class='hs-varid'>childGroups</span><span class='hs-keyglyph'>=</span><span class='hs-conid'>False</span><span class='hs-layout'>,</span><span class='hs-varid'>wants</span><span class='hs-keyglyph'>=</span><span class='hs-conid'>WantsQNFA</span>
<a name="line-431"></a> <span class='hs-layout'>,</span><span class='hs-varid'>unQ</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>OneChar</span> <span class='hs-varid'>pIn</span><span class='hs-layout'>}</span>
<a name="line-432"></a> <span class='hs-varid'>test</span> <span class='hs-varid'>myTest</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Q</span> <span class='hs-layout'>{</span><span class='hs-varid'>nullQ</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>makeTestNullView</span> <span class='hs-varid'>myTest</span> <span class='hs-varid'>m1</span> <span class='hs-varid'>m2</span>
<a name="line-433"></a> <span class='hs-layout'>,</span><span class='hs-varid'>takes</span><span class='hs-keyglyph'>=</span><span class='hs-layout'>(</span><span class='hs-num'>0</span><span class='hs-layout'>,</span><span class='hs-conid'>Just</span> <span class='hs-num'>0</span><span class='hs-layout'>)</span>
<a name="line-434"></a> <span class='hs-layout'>,</span><span class='hs-varid'>preReset</span><span class='hs-keyglyph'>=</span><span class='hs-conid'>[]</span><span class='hs-layout'>,</span><span class='hs-varid'>postSet</span><span class='hs-keyglyph'>=</span><span class='hs-conid'>[]</span><span class='hs-layout'>,</span><span class='hs-varid'>preTag</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>apply</span> <span class='hs-varid'>m1</span><span class='hs-layout'>,</span><span class='hs-varid'>postTag</span><span class='hs-keyglyph'>=</span><span class='hs-varid'>apply</span> <span class='hs-varid'>m2</span>
<a name="line-435"></a> <span class='hs-layout'>,</span><span class='hs-varid'>tagged</span><span class='hs-keyglyph'>=</span><span class='hs-conid'>False</span><span class='hs-layout'>,</span><span class='hs-varid'>childGroups</span><span class='hs-keyglyph'>=</span><span class='hs-conid'>False</span><span class='hs-layout'>,</span><span class='hs-varid'>wants</span><span class='hs-keyglyph'>=</span><span class='hs-conid'>WantsQT</span>
<a name="line-436"></a> <span class='hs-layout'>,</span><span class='hs-varid'>unQ</span><span class='hs-keyglyph'>=</span><span class='hs-conid'>Test</span> <span class='hs-varid'>myTest</span> <span class='hs-layout'>}</span>
<a name="line-437"></a> <span class='hs-varid'>xtra</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>newSyntax</span> <span class='hs-varid'>compOpt</span>
<a name="line-438"></a> <span class='hs-keyword'>in</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>pIn</span> <span class='hs-keyword'>of</span>
<a name="line-439"></a> <span class='hs-conid'>PEmpty</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>nil</span>
<a name="line-440"></a> <span class='hs-conid'>POr</span> <span class='hs-conid'>[]</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>nil</span>
<a name="line-441"></a> <span class='hs-conid'>POr</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>branch</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>go</span> <span class='hs-varid'>branch</span> <span class='hs-varid'>m1</span> <span class='hs-varid'>m2</span>
<a name="line-442"></a> <span class='hs-conid'>POr</span> <span class='hs-varid'>branches</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>mdo</span>
<a name="line-443"></a> <span class='hs-comment'>-- 2009 : The PNonEmpty p as POr [PEmpty,p] takes no branch tracking tag.</span>
<a name="line-444"></a> <span class='hs-comment'>-- I claim this is because only accepting branches need tags,</span>
<a name="line-445"></a> <span class='hs-comment'>-- and the last accepting branch does not need a tag.</span>
<a name="line-446"></a> <span class='hs-comment'>-- Non-accepting possibilities can all commute to the front and</span>
<a name="line-447"></a> <span class='hs-comment'>-- become part of the nullQ. The accepting bits then need prioritizing.</span>
<a name="line-448"></a> <span class='hs-comment'>-- Does the above require changes in POr handling in TNFA? Yes.</span>
<a name="line-449"></a> <span class='hs-comment'>-- Have to always use nullQ instead of "recapitulating" it.</span>
<a name="line-450"></a> <span class='hs-comment'>-- Could also create a constant-writing tag instead of many index tags.</span>
<a name="line-451"></a> <span class='hs-comment'>-- Exasperation: This POr recursive mdo is very easy to make loop and lockup the program</span>
<a name="line-452"></a> <span class='hs-comment'>-- if needTags is False then there is no way to disambiguate branches so fewer tags are needed</span>
<a name="line-453"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>needUniqTags</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>childGroups</span> <span class='hs-varid'>ans</span>
<a name="line-454"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>needTags</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>varies</span> <span class='hs-varid'>ans</span> <span class='hs-varop'>||</span> <span class='hs-varid'>childGroups</span> <span class='hs-varid'>ans</span> <span class='hs-comment'>-- childGroups detects that "abc|a(b)c" needs tags</span>
<a name="line-455"></a> <span class='hs-varid'>a</span> <span class='hs-keyglyph'><-</span> <span class='hs-keyword'>if</span> <span class='hs-varid'>noTag</span> <span class='hs-varid'>m1</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>needTags</span> <span class='hs-keyword'>then</span> <span class='hs-varid'>uniq</span> <span class='hs-str'>"POr start"</span> <span class='hs-keyword'>else</span> <span class='hs-varid'>return</span> <span class='hs-varid'>m1</span> <span class='hs-comment'>-- whole POr</span>
<a name="line-456"></a> <span class='hs-varid'>b</span> <span class='hs-keyglyph'><-</span> <span class='hs-keyword'>if</span> <span class='hs-varid'>noTag</span> <span class='hs-varid'>m2</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>needTags</span> <span class='hs-keyword'>then</span> <span class='hs-varid'>uniq</span> <span class='hs-str'>"POr stop"</span> <span class='hs-keyword'>else</span> <span class='hs-varid'>return</span> <span class='hs-varid'>m2</span> <span class='hs-comment'>-- whole POr</span>
<a name="line-457"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>aAdvice</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>toAdvice</span> <span class='hs-varid'>a</span> <span class='hs-comment'>-- all branches share 'aAdvice'</span>
<a name="line-458"></a> <span class='hs-varid'>bAdvice</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>toAdvice</span> <span class='hs-varid'>b</span> <span class='hs-comment'>-- last branch gets 'bAdvice', others may get own tag</span>
<a name="line-459"></a> <span class='hs-comment'>-- Due to the recursive-do, it seems that I have to put the if needTags into the op'</span>
<a name="line-460"></a> <span class='hs-varid'>newUniq</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>if</span> <span class='hs-varid'>needUniqTags</span> <span class='hs-keyword'>then</span> <span class='hs-varid'>uniq</span> <span class='hs-str'>"POr branch"</span> <span class='hs-keyword'>else</span> <span class='hs-varid'>return</span> <span class='hs-varid'>bAdvice</span>
<a name="line-461"></a><span class='hs-comment'>-- trace ("\nPOr sub "++show aAdvice++" "++show bAdvice++"needsTags is "++show needTags) $ return ()</span>
<a name="line-462"></a> <span class='hs-comment'>-- The "bs" values are allocated in left-to-right order before the children in "qs"</span>
<a name="line-463"></a> <span class='hs-comment'>-- optimiztion: low priority for last branch is implicit, do not create separate tag here.</span>
<a name="line-464"></a> <span class='hs-varid'>bs</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>fmap</span> <span class='hs-layout'>(</span><span class='hs-varop'>++</span><span class='hs-keyglyph'>[</span><span class='hs-varid'>bAdvice</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span> <span class='hs-varid'>replicateM</span> <span class='hs-layout'>(</span><span class='hs-varid'>pred</span> <span class='hs-varop'>$</span> <span class='hs-varid'>length</span> <span class='hs-varid'>branches</span><span class='hs-layout'>)</span> <span class='hs-varid'>newUniq</span> <span class='hs-comment'>-- 2 <= length ps</span>
<a name="line-465"></a> <span class='hs-comment'>-- create all the child branches in left-to-right order after the "bs"</span>
<a name="line-466"></a> <span class='hs-varid'>qs</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>forM</span> <span class='hs-layout'>(</span><span class='hs-varid'>zip</span> <span class='hs-varid'>branches</span> <span class='hs-varid'>bs</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-layout'>(</span><span class='hs-varid'>branch</span><span class='hs-layout'>,</span><span class='hs-varid'>bTag</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>go</span> <span class='hs-varid'>branch</span> <span class='hs-varid'>aAdvice</span> <span class='hs-varid'>bTag</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-467"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>wqs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-varid'>wants</span> <span class='hs-varid'>qs</span>
<a name="line-468"></a> <span class='hs-varid'>wanted</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>if</span> <span class='hs-varid'>any</span> <span class='hs-layout'>(</span><span class='hs-conid'>WantsBoth</span><span class='hs-varop'>==</span><span class='hs-layout'>)</span> <span class='hs-varid'>wqs</span> <span class='hs-keyword'>then</span> <span class='hs-conid'>WantsBoth</span>
<a name="line-469"></a> <span class='hs-keyword'>else</span> <span class='hs-keyword'>case</span> <span class='hs-layout'>(</span><span class='hs-varid'>any</span> <span class='hs-layout'>(</span><span class='hs-conid'>WantsQNFA</span><span class='hs-varop'>==</span><span class='hs-layout'>)</span> <span class='hs-varid'>wqs</span><span class='hs-layout'>,</span><span class='hs-varid'>any</span> <span class='hs-layout'>(</span><span class='hs-conid'>WantsQT</span><span class='hs-varop'>==</span><span class='hs-layout'>)</span> <span class='hs-varid'>wqs</span><span class='hs-layout'>)</span> <span class='hs-keyword'>of</span>
<a name="line-470"></a> <span class='hs-layout'>(</span><span class='hs-conid'>True</span><span class='hs-layout'>,</span><span class='hs-conid'>True</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>WantsBoth</span>
<a name="line-471"></a> <span class='hs-layout'>(</span><span class='hs-conid'>True</span><span class='hs-layout'>,</span><span class='hs-conid'>False</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>WantsQNFA</span>
<a name="line-472"></a> <span class='hs-layout'>(</span><span class='hs-conid'>False</span><span class='hs-layout'>,</span><span class='hs-conid'>True</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>WantsQT</span>
<a name="line-473"></a> <span class='hs-layout'>(</span><span class='hs-conid'>False</span><span class='hs-layout'>,</span><span class='hs-conid'>False</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>WantsEither</span>
<a name="line-474"></a> <span class='hs-varid'>nullView</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>cleanNullView</span> <span class='hs-varop'>.</span> <span class='hs-varid'>tagWrapNullView</span> <span class='hs-varid'>a</span> <span class='hs-varid'>b</span> <span class='hs-varop'>.</span> <span class='hs-varid'>concatMap</span> <span class='hs-varid'>nullQ</span> <span class='hs-varop'>$</span> <span class='hs-varid'>qs</span>
<a name="line-475"></a> <span class='hs-comment'>-- The nullView computed above takes the nullQ of the branches and combines them. This</span>
<a name="line-476"></a> <span class='hs-comment'>-- assumes that the pre/post tags of the children are also part of the nullQ values. So</span>
<a name="line-477"></a> <span class='hs-comment'>-- for consistency, POr must then add its own pre/post tags to its nullQ value. Note that</span>
<a name="line-478"></a> <span class='hs-comment'>-- concatMap sets the left-to-right preference when choosing the null views.</span>
<a name="line-479"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>ans</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Q</span> <span class='hs-layout'>{</span> <span class='hs-varid'>nullQ</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>nullView</span>
<a name="line-480"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>takes</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>orTakes</span> <span class='hs-varop'>.</span> <span class='hs-varid'>map</span> <span class='hs-varid'>takes</span> <span class='hs-varop'>$</span> <span class='hs-varid'>qs</span>
<a name="line-481"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>preReset</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>[]</span><span class='hs-layout'>,</span> <span class='hs-varid'>postSet</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>[]</span>
<a name="line-482"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>preTag</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>apply</span> <span class='hs-varid'>a</span><span class='hs-layout'>,</span> <span class='hs-varid'>postTag</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>apply</span> <span class='hs-varid'>b</span>
<a name="line-483"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>tagged</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>needTags</span>
<a name="line-484"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>childGroups</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>any</span> <span class='hs-varid'>childGroups</span> <span class='hs-varid'>qs</span>
<a name="line-485"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>wants</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>wanted</span>
<a name="line-486"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>unQ</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Or</span> <span class='hs-varid'>qs</span> <span class='hs-layout'>}</span>
<a name="line-487"></a> <span class='hs-varid'>return</span> <span class='hs-varid'>ans</span>
<a name="line-488"></a> <span class='hs-conid'>PConcat</span> <span class='hs-conid'>[]</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>nil</span> <span class='hs-comment'>-- fatal to pass [] to combineConcat</span>
<a name="line-489"></a> <span class='hs-conid'>PConcat</span> <span class='hs-varid'>ps</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>combineConcat</span> <span class='hs-varid'>ps</span> <span class='hs-varid'>m1</span> <span class='hs-varid'>m2</span>
<a name="line-490"></a> <span class='hs-conid'>PStar</span> <span class='hs-varid'>mayFirstBeNull</span> <span class='hs-varid'>p</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>mdo</span>
<a name="line-491"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>accepts</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>canAccept</span> <span class='hs-varid'>q</span>
<a name="line-492"></a> <span class='hs-comment'>-- if needsOrbit is False then there is no need to disambiguate captures on each orbit</span>
<a name="line-493"></a> <span class='hs-comment'>-- Both checks are useful because (varies q) of True does not imply (childGroups q) of True when under PNonCapture</span>
<a name="line-494"></a> <span class='hs-varid'>needsOrbit</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>varies</span> <span class='hs-varid'>q</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>childGroups</span> <span class='hs-varid'>q</span>
<a name="line-495"></a> <span class='hs-comment'>-- if needsOrbit then must check start/stop before the Orbit tag</span>
<a name="line-496"></a> <span class='hs-comment'>-- if accepts then must check start/stop of whole pattern</span>
<a name="line-497"></a> <span class='hs-varid'>needsTags</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>needsOrbit</span> <span class='hs-varop'>||</span> <span class='hs-varid'>accepts</span> <span class='hs-comment'>-- important that needsOrbit implies needsTags</span>
<a name="line-498"></a> <span class='hs-varid'>a</span> <span class='hs-keyglyph'><-</span> <span class='hs-keyword'>if</span> <span class='hs-varid'>noTag</span> <span class='hs-varid'>m1</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>needsTags</span> <span class='hs-keyword'>then</span> <span class='hs-varid'>uniq</span> <span class='hs-str'>"PStar start"</span> <span class='hs-keyword'>else</span> <span class='hs-varid'>return</span> <span class='hs-varid'>m1</span>
<a name="line-499"></a> <span class='hs-varid'>b</span> <span class='hs-keyglyph'><-</span> <span class='hs-keyword'>if</span> <span class='hs-varid'>noTag</span> <span class='hs-varid'>m2</span> <span class='hs-varop'>&&</span> <span class='hs-varid'>needsTags</span> <span class='hs-keyword'>then</span> <span class='hs-varid'>uniq</span> <span class='hs-str'>"PStar stop"</span> <span class='hs-keyword'>else</span> <span class='hs-varid'>return</span> <span class='hs-varid'>m2</span>
<a name="line-500"></a> <span class='hs-varid'>mOrbit</span> <span class='hs-keyglyph'><-</span> <span class='hs-keyword'>if</span> <span class='hs-varid'>needsOrbit</span> <span class='hs-keyword'>then</span> <span class='hs-varid'>makeOrbit</span> <span class='hs-keyword'>else</span> <span class='hs-varid'>return</span> <span class='hs-conid'>Nothing</span> <span class='hs-comment'>-- any Orbit tag is created after the pre and post tags</span>
<a name="line-501"></a><span class='hs-comment'>-- test1 <- if tagged q then uniq "not-TEST1" Minimize else return NoTag</span>
<a name="line-502"></a><span class='hs-comment'>-- XXX XXX 1.1.5 testing second NoTag replaced with (toAdvice b)</span>
<a name="line-503"></a> <span class='hs-layout'>(</span><span class='hs-varid'>q</span><span class='hs-layout'>,</span><span class='hs-varid'>resetOrbitTags</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>withOrbit</span> <span class='hs-layout'>(</span><span class='hs-varid'>go</span> <span class='hs-varid'>p</span> <span class='hs-conid'>NoTag</span> <span class='hs-layout'>(</span><span class='hs-varid'>toAdvice</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- all contained orbit tags get listened to (not including this one).</span>
<a name="line-504"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>nullView</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>mayFirstBeNull</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>cleanNullView</span> <span class='hs-varop'>$</span> <span class='hs-varid'>childViews</span> <span class='hs-varop'>++</span> <span class='hs-varid'>skipView</span>
<a name="line-505"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>skipView</span>
<a name="line-506"></a> <span class='hs-keyword'>where</span> <span class='hs-varid'>childViews</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tagWrapNullView</span> <span class='hs-varid'>a</span> <span class='hs-varid'>b</span> <span class='hs-varop'>.</span> <span class='hs-varid'>orbitWrapNullView</span> <span class='hs-varid'>mOrbit</span> <span class='hs-varid'>resetOrbitTags</span> <span class='hs-varop'>$</span> <span class='hs-varid'>nullQ</span> <span class='hs-varid'>q</span>
<a name="line-507"></a> <span class='hs-varid'>skipView</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>makeEmptyNullView</span> <span class='hs-varid'>a</span> <span class='hs-varid'>b</span>
<a name="line-508"></a> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Q</span> <span class='hs-layout'>{</span> <span class='hs-varid'>nullQ</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>nullView</span>
<a name="line-509"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>takes</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-num'>0</span><span class='hs-layout'>,</span><span class='hs-keyword'>if</span> <span class='hs-varid'>accepts</span> <span class='hs-keyword'>then</span> <span class='hs-conid'>Nothing</span> <span class='hs-keyword'>else</span> <span class='hs-layout'>(</span><span class='hs-conid'>Just</span> <span class='hs-num'>0</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-510"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>preReset</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>[]</span><span class='hs-layout'>,</span> <span class='hs-varid'>postSet</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>[]</span>
<a name="line-511"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>preTag</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>apply</span> <span class='hs-varid'>a</span><span class='hs-layout'>,</span> <span class='hs-varid'>postTag</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>apply</span> <span class='hs-varid'>b</span>
<a name="line-512"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>tagged</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>needsTags</span>
<a name="line-513"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>childGroups</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>childGroups</span> <span class='hs-varid'>q</span>
<a name="line-514"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>wants</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>WantsQT</span>
<a name="line-515"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>unQ</span> <span class='hs-keyglyph'>=</span><span class='hs-conid'>Star</span> <span class='hs-layout'>{</span> <span class='hs-varid'>getOrbit</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mOrbit</span>
<a name="line-516"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>resetOrbits</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>resetOrbitTags</span>
<a name="line-517"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>firstNull</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mayFirstBeNull</span>
<a name="line-518"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>unStar</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>q</span> <span class='hs-layout'>}</span> <span class='hs-layout'>}</span>
<a name="line-519"></a> <span class='hs-conid'>PCarat</span> <span class='hs-varid'>dopa</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>test</span> <span class='hs-layout'>(</span><span class='hs-conid'>Test_BOL</span><span class='hs-layout'>,</span><span class='hs-varid'>dopa</span><span class='hs-layout'>)</span>
<a name="line-520"></a> <span class='hs-conid'>PDollar</span> <span class='hs-varid'>dopa</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>test</span> <span class='hs-layout'>(</span><span class='hs-conid'>Test_EOL</span><span class='hs-layout'>,</span><span class='hs-varid'>dopa</span><span class='hs-layout'>)</span>
<a name="line-521"></a> <span class='hs-conid'>PChar</span> <span class='hs-layout'>{</span><span class='hs-layout'>}</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>one</span>
<a name="line-522"></a> <span class='hs-conid'>PDot</span> <span class='hs-layout'>{</span><span class='hs-layout'>}</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>one</span>
<a name="line-523"></a> <span class='hs-conid'>PAny</span> <span class='hs-layout'>{</span><span class='hs-layout'>}</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>one</span>
<a name="line-524"></a> <span class='hs-conid'>PAnyNot</span> <span class='hs-layout'>{</span><span class='hs-layout'>}</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>one</span>
<a name="line-525"></a> <span class='hs-comment'>-- CompOption's newSyntax enables these escaped anchors</span>
<a name="line-526"></a> <span class='hs-conid'>PEscape</span> <span class='hs-varid'>dopa</span> <span class='hs-chr'>'`'</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>xtra</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>test</span> <span class='hs-layout'>(</span><span class='hs-conid'>Test_BOB</span><span class='hs-layout'>,</span><span class='hs-varid'>dopa</span><span class='hs-layout'>)</span>
<a name="line-527"></a> <span class='hs-conid'>PEscape</span> <span class='hs-varid'>dopa</span> <span class='hs-chr'>'\''</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>xtra</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>test</span> <span class='hs-layout'>(</span><span class='hs-conid'>Test_EOB</span><span class='hs-layout'>,</span><span class='hs-varid'>dopa</span><span class='hs-layout'>)</span>
<a name="line-528"></a> <span class='hs-conid'>PEscape</span> <span class='hs-varid'>dopa</span> <span class='hs-chr'>'<'</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>xtra</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>test</span> <span class='hs-layout'>(</span><span class='hs-conid'>Test_BOW</span><span class='hs-layout'>,</span><span class='hs-varid'>dopa</span><span class='hs-layout'>)</span>
<a name="line-529"></a> <span class='hs-conid'>PEscape</span> <span class='hs-varid'>dopa</span> <span class='hs-chr'>'>'</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>xtra</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>test</span> <span class='hs-layout'>(</span><span class='hs-conid'>Test_EOW</span><span class='hs-layout'>,</span><span class='hs-varid'>dopa</span><span class='hs-layout'>)</span>
<a name="line-530"></a> <span class='hs-conid'>PEscape</span> <span class='hs-varid'>dopa</span> <span class='hs-chr'>'b'</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>xtra</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>test</span> <span class='hs-layout'>(</span><span class='hs-conid'>Test_EdgeWord</span><span class='hs-layout'>,</span><span class='hs-varid'>dopa</span><span class='hs-layout'>)</span>
<a name="line-531"></a> <span class='hs-conid'>PEscape</span> <span class='hs-varid'>dopa</span> <span class='hs-chr'>'B'</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>xtra</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>test</span> <span class='hs-layout'>(</span><span class='hs-conid'>Test_NotEdgeWord</span><span class='hs-layout'>,</span><span class='hs-varid'>dopa</span><span class='hs-layout'>)</span>
<a name="line-532"></a> <span class='hs-comment'>-- otherwise escape codes are just the escaped character</span>
<a name="line-533"></a> <span class='hs-conid'>PEscape</span> <span class='hs-layout'>{</span><span class='hs-layout'>}</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>one</span>
<a name="line-534"></a>
<a name="line-535"></a> <span class='hs-comment'>-- A PGroup node in the Pattern tree does not become a node</span>
<a name="line-536"></a> <span class='hs-comment'>-- in the Q/P tree. A PGroup can share and pass along a</span>
<a name="line-537"></a> <span class='hs-comment'>-- preTag (with Advice) with other branches, but will pass</span>
<a name="line-538"></a> <span class='hs-comment'>-- down an Apply postTag.</span>
<a name="line-539"></a> <span class='hs-comment'>--</span>
<a name="line-540"></a> <span class='hs-comment'>-- If the parent index is Nothing then this is part of a</span>
<a name="line-541"></a> <span class='hs-comment'>-- non-capturing subtree and ignored. This is a lazy and</span>
<a name="line-542"></a> <span class='hs-comment'>-- efficient alternative to rebuidling the tree with PGroup</span>
<a name="line-543"></a> <span class='hs-comment'>-- Nothing replacing PGroup (Just _).</span>
<a name="line-544"></a> <span class='hs-comment'>--</span>
<a name="line-545"></a> <span class='hs-comment'>-- Guarded by the getParentIndex /= Nothing check is the</span>
<a name="line-546"></a> <span class='hs-comment'>-- withParent command.</span>
<a name="line-547"></a> <span class='hs-comment'>--</span>
<a name="line-548"></a> <span class='hs-conid'>PGroup</span> <span class='hs-conid'>Nothing</span> <span class='hs-varid'>p</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>go</span> <span class='hs-varid'>p</span> <span class='hs-varid'>m1</span> <span class='hs-varid'>m2</span>
<a name="line-549"></a> <span class='hs-conid'>PGroup</span> <span class='hs-layout'>(</span><span class='hs-conid'>Just</span> <span class='hs-varid'>this</span><span class='hs-layout'>)</span> <span class='hs-varid'>p</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-550"></a> <span class='hs-varid'>mParent</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getParentIndex</span>
<a name="line-551"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>mParent</span> <span class='hs-keyword'>of</span>
<a name="line-552"></a> <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>go</span> <span class='hs-varid'>p</span> <span class='hs-varid'>m1</span> <span class='hs-varid'>m2</span> <span class='hs-comment'>-- just like PGroup Nothing p</span>
<a name="line-553"></a> <span class='hs-conid'>Just</span> <span class='hs-varid'>parent</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-554"></a> <span class='hs-comment'>-- 'a' may be Advice or Apply from parent or Apply created here</span>
<a name="line-555"></a> <span class='hs-varid'>a</span> <span class='hs-keyglyph'><-</span> <span class='hs-keyword'>if</span> <span class='hs-varid'>noTag</span> <span class='hs-varid'>m1</span> <span class='hs-keyword'>then</span> <span class='hs-varid'>uniq</span> <span class='hs-str'>"PGroup start"</span> <span class='hs-keyword'>else</span> <span class='hs-varid'>return</span> <span class='hs-varid'>m1</span>
<a name="line-556"></a> <span class='hs-varid'>b</span> <span class='hs-keyglyph'><-</span> <span class='hs-keyword'>if</span> <span class='hs-varid'>noTag</span> <span class='hs-varid'>m2</span> <span class='hs-keyword'>then</span> <span class='hs-varid'>uniq</span> <span class='hs-str'>"PGroup stop"</span> <span class='hs-keyword'>else</span> <span class='hs-varid'>return</span> <span class='hs-varid'>m2</span>
<a name="line-557"></a> <span class='hs-varid'>flag</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>ignore</span> <span class='hs-str'>"PGroup ignore"</span>
<a name="line-558"></a><span class='hs-comment'>{-
<a name="line-559"></a> -- 'b' may be Apply from parent or Apply created here
<a name="line-560"></a> b <- if isNothing (apply m2) then uniq "PGroup" else return m2
<a name="line-561"></a>-}</span>
<a name="line-562"></a> <span class='hs-layout'>(</span><span class='hs-varid'>q</span><span class='hs-layout'>,</span><span class='hs-varid'>resetGroupTags</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>withParent</span> <span class='hs-varid'>this</span> <span class='hs-layout'>(</span><span class='hs-varid'>go</span> <span class='hs-varid'>p</span> <span class='hs-varid'>a</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- all immediate child groups stop tags get listened to.</span>
<a name="line-563"></a> <span class='hs-comment'>-- 2009: makeGroup performs a tell, why after withParent? I am no longer sure.</span>
<a name="line-564"></a> <span class='hs-varid'>makeGroup</span> <span class='hs-layout'>(</span><span class='hs-conid'>GroupInfo</span> <span class='hs-varid'>this</span> <span class='hs-varid'>parent</span> <span class='hs-layout'>(</span><span class='hs-varid'>fromHandleTag</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>fromHandleTag</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span> <span class='hs-varid'>flag</span><span class='hs-layout'>)</span>
<a name="line-565"></a> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-varid'>q</span> <span class='hs-layout'>{</span> <span class='hs-varid'>nullQ</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>addGroupResetsToNullView</span> <span class='hs-varid'>resetGroupTags</span> <span class='hs-varid'>flag</span> <span class='hs-layout'>(</span><span class='hs-varid'>nullQ</span> <span class='hs-varid'>q</span><span class='hs-layout'>)</span>
<a name="line-566"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>tagged</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span>
<a name="line-567"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>childGroups</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>True</span>
<a name="line-568"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>preReset</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>resetGroupTags</span> <span class='hs-varop'>`mappend`</span> <span class='hs-layout'>(</span><span class='hs-varid'>preReset</span> <span class='hs-varid'>q</span><span class='hs-layout'>)</span>
<a name="line-569"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>postSet</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>postSet</span> <span class='hs-varid'>q</span><span class='hs-layout'>)</span> <span class='hs-varop'>`mappend`</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>flag</span><span class='hs-keyglyph'>]</span>
<a name="line-570"></a> <span class='hs-layout'>}</span>
<a name="line-571"></a>
<a name="line-572"></a> <span class='hs-comment'>-- A PNonCapture node in the Pattern tree does not become a</span>
<a name="line-573"></a> <span class='hs-comment'>-- node in the Q/P tree. It sets the parent to Nothing while</span>
<a name="line-574"></a> <span class='hs-comment'>-- processing the sub-tree.</span>
<a name="line-575"></a> <span class='hs-conid'>PNonCapture</span> <span class='hs-varid'>p</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>nonCapture</span> <span class='hs-layout'>(</span><span class='hs-varid'>go</span> <span class='hs-varid'>p</span> <span class='hs-varid'>m1</span> <span class='hs-varid'>m2</span><span class='hs-layout'>)</span>
<a name="line-576"></a>
<a name="line-577"></a> <span class='hs-comment'>-- these are here for completeness of the case branches, currently starTrans replaces them all</span>
<a name="line-578"></a> <span class='hs-conid'>PPlus</span> <span class='hs-layout'>{</span><span class='hs-layout'>}</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>die</span>
<a name="line-579"></a> <span class='hs-conid'>PQuest</span> <span class='hs-layout'>{</span><span class='hs-layout'>}</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>die</span>
<a name="line-580"></a> <span class='hs-conid'>PBound</span> <span class='hs-layout'>{</span><span class='hs-layout'>}</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>die</span>
<a name="line-581"></a> <span class='hs-comment'>-- PNonEmpty is deprecated, and not produced in Pattern by starTrans anymore</span>
<a name="line-582"></a> <span class='hs-conid'>PNonEmpty</span> <span class='hs-layout'>{</span><span class='hs-layout'>}</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>die</span>
<a name="line-583"></a>
<a name="line-584"></a><span class='hs-comment'>{-
<a name="line-585"></a>Similar to change in WinTags for QT/QNFA:
<a name="line-586"></a>Change the NullView to use a tasktags instead of wintags since they are all PreUpdate
<a name="line-587"></a>
<a name="line-588"></a> -- PNonEmpty means the child pattern p can be skipped by
<a name="line-589"></a> -- bypassing the pattern. This is only used in the case p
<a name="line-590"></a> -- can accept 0 and can accept more than zero characters
<a name="line-591"></a> -- (thus the assertions, enforcted by CorePattern.starTrans).
<a name="line-592"></a> -- The important thing about this case is intercept the
<a name="line-593"></a> -- "accept 0" possibility and replace with "skip".
<a name="line-594"></a> PNonEmpty p -> mdo
<a name="line-595"></a> let needsTags = canAccept q
<a name="line-596"></a> a <- if noTag m1 && needsTags then uniq Minimize else return m1
<a name="line-597"></a> b <- if noTag m2 && needsTags then uniq Maximize else return m2
<a name="line-598"></a> q <- go p (toAdvice a) (toAdvice b)
<a name="line-599"></a> when (not needsTags) (err $ "PNonEmpty could not accept characters: "++show (p,pOrig))
<a name="line-600"></a> when (mustAccept q) (err $ "patternToQ : PNonEmpty provided with a *mustAccept* pattern: "++show (p,pOrig))
<a name="line-601"></a> return $ Q { nullQ = emptyNull (preTags (apply a) (apply b)) -- The meaning of NonEmpty
<a name="line-602"></a> , takes = (0,snd (takes q)) -- like Or, drop lower bound to 0
<a name="line-603"></a> , preReset = []
<a name="line-604"></a> , preTag = apply a, postTag = apply b -- own the closing tag so it will not end a PGroup
<a name="line-605"></a> , tagged = needsTags
<a name="line-606"></a> , childGroups = childGroups q
<a name="line-607"></a> , wants = wants q -- the test case is "x" =~ "(.|$){1,3}"
<a name="line-608"></a> , unQ = NonEmpty q }
<a name="line-609"></a>
<a name="line-610"></a>-}</span>
<a name="line-611"></a><span class='hs-comment'>{-
<a name="line-612"></a>emptyNull :: TagList -> NullView
<a name="line-613"></a>emptyNull tags = (mempty, tags) : []
<a name="line-614"></a>
<a name="line-615"></a>testNull :: TestInfo -> TagList -> NullView
<a name="line-616"></a>testNull (w,d) tags = (SetTestInfo (Map.singleton w (Set.singleton d)), tags) : []
<a name="line-617"></a>
<a name="line-618"></a>-- Prepend tags to nullView
<a name="line-619"></a>addTagsToNullView :: TagList -> NullView -> NullView
<a name="line-620"></a>addTagsToNullView [] oldNV = oldNV
<a name="line-621"></a>addTagsToNullView tags oldNV= do
<a name="line-622"></a> (oldTest,oldTags) <- oldNV
<a name="line-623"></a> return (oldTest,tags `mappend` oldTags)
<a name="line-624"></a>
<a name="line-625"></a>-}</span>
<a name="line-626"></a>
<a name="line-627"></a>
<a name="line-628"></a><span class='hs-comment'>-- xxx todo</span>
<a name="line-629"></a><span class='hs-comment'>-- </span>
<a name="line-630"></a><span class='hs-comment'>-- see of PNonEmpty -> NonEmpty -> TNFA is really smarter than POr about tags</span>
</pre></body>
</html>
