diff -ru regex-tdfa-1.1.3/regex-tdfa.cabal regex-tdfa-1.1.2/regex-tdfa.cabal
--- regex-tdfa-1.1.3/regex-tdfa.cabal	2010-06-12 00:02:12.000000000 +0100
+++ regex-tdfa-1.1.2/regex-tdfa.cabal	2009-05-05 17:33:45.000000000 +0100
@@ -39,6 +39,7 @@
 -- 1.0.7 make NewDFA directory and String_NC
 -- 1.1.0 NewDFA code working
 -- 1.1.1 add gnu escapes
+-- 1.1.2 fix fatal error with wrong "d_id" passed to compressOrbits
 License:                BSD3
 License-File:           LICENSE
 Copyright:              Copyright (c) 2007, Christopher Kuklewicz
diff -ru regex-tdfa-1.1.3/Text/Regex/TDFA/CorePattern.hs regex-tdfa-1.1.2/Text/Regex/TDFA/CorePattern.hs
--- regex-tdfa-1.1.3/Text/Regex/TDFA/CorePattern.hs	2010-06-12 00:02:12.000000000 +0100
+++ regex-tdfa-1.1.2/Text/Regex/TDFA/CorePattern.hs	2009-05-05 17:33:45.000000000 +0100
@@ -97,7 +97,7 @@
 -- (i.e. with a Test) or unconditionally accept 0 characters.  These
 -- are in the list in order of preference, with most preferred listed
 -- first.
-type NullView = [(SetTestInfo,TagList)]  -- Ordered list of null views, each is a set of tests and tags
+type NullView = [(SetTestInfo,TagTasks)]  -- Ordered list of null views, each is a set of tests and tags
 
 -- During the depth first traversal, children are told about tags by the parent.
 -- They may change Apply to Advice and they may generate new tags.
@@ -140,18 +140,19 @@
 -- preTags a b = promote a `mappend` promote b
 --   where promote = maybe [] (\x -> [(x,PreUpdate TagTask)])
 
-promotePreTag :: HandleTag -> TagList
-promotePreTag = maybe [] (\x -> [(x,PreUpdate TagTask)]) . apply
+promoteTag :: HandleTag -> TagTasks
+promoteTag = maybe [] (\x -> [(x,TagTask)]) . apply
 
 makeEmptyNullView :: HandleTag -> HandleTag -> NullView
-makeEmptyNullView a b = [(mempty, promotePreTag a ++ promotePreTag b)]
+makeEmptyNullView a b = [(mempty, promoteTag a ++ promoteTag b)]
 
 makeTestNullView ::  TestInfo -> HandleTag -> HandleTag -> NullView
-makeTestNullView (w,d) a b = [(SetTestInfo (Map.singleton w (Set.singleton d)), promotePreTag a ++ promotePreTag b)]
+makeTestNullView (w,d) a b = [(SetTestInfo (Map.singleton w (Set.singleton d))
+                              , promoteTag a ++ promoteTag b)]
 
 tagWrapNullView :: HandleTag -> HandleTag -> NullView -> NullView
 tagWrapNullView a b oldNV =
-  case (promotePreTag a, promotePreTag b) of
+  case (promoteTag a, promoteTag b) of
     ([],[]) -> oldNV
     (pre,post) -> do
       (oldTests,oldTasks) <- oldNV
@@ -160,8 +161,8 @@
 -- For PGroup, need to prepend reset tasks before others in nullView
 addGroupResetsToNullView :: [Tag] -> Tag -> NullView -> NullView
 addGroupResetsToNullView groupResets groupSet nv = [ (test, prepend (append tags) ) | (test,tags) <- nv ]
-  where prepend = foldr (\h t -> (h:).t) id . map (\tag->(tag,PreUpdate ResetGroupStopTask)) $ groupResets
-        append = (++[(groupSet,PreUpdate SetGroupStopTask)])
+  where prepend = foldr (\h t -> (h:).t) id . map (\tag->(tag,ResetGroupStopTask)) $ groupResets
+        append = (++[(groupSet,SetGroupStopTask)])
 
 -- For PStar, need to put in the orbit TagTasks
 orbitWrapNullView :: Maybe Tag -> [Tag] -> NullView -> NullView
@@ -171,8 +172,8 @@
     (Nothing,_) -> do (oldTests,oldTasks) <- oldNV
                       return (oldTests,prepend oldTasks)
     (Just o,_) -> do (oldTests,oldTasks) <- oldNV
-                     return (oldTests,prepend $ [(o,PreUpdate EnterOrbitTask)] ++ oldTasks ++ [(o,PreUpdate LeaveOrbitTask)])
-  where prepend = foldr (\h t -> (h:).t) id . map (\tag->(tag,PreUpdate ResetOrbitTask)) $ orbitResets
+                     return (oldTests,prepend $ [(o,EnterOrbitTask)] ++ oldTasks ++ [(o,LeaveOrbitTask)])
+  where prepend = foldr (\h t -> (h:).t) id . map (\tag->(tag,ResetOrbitTask)) $ orbitResets
 
 -- The NullViews are ordered, and later test sets that contain the
 -- tests from any earlier entry will never be chosen.  This function
@@ -385,19 +386,19 @@
                      (False,False,_,_) -> return (toAdvice a)
                      (_,_,False,False) -> return (toAdvice b)
                      _ -> if tagged qFront || tagged qEnd then uniq "combineSeq mid" else return NoTag
-      --      qFront <- pFront a mid
-      --      qEnd <- pEnd (toAdvice mid) b
+--            qFront <- pFront a mid
+--            qEnd <- pEnd (toAdvice mid) b
             (qFront,qEnd) <- front'end (pFront a mid) (pEnd (toAdvice mid) b)
             -- XXX: Perhaps a "produces" should be created to compliment "wants",
             -- then "produces qEnd" could be compared to "wants qFront"
             let wanted = if WantsEither == wants qEnd then wants qFront else wants qEnd
             return $ Q { nullQ = mergeNullViews (nullQ qFront) (nullQ qEnd)
-                             , takes = seqTake (takes qFront) (takes qEnd)
-                             , preReset = [], postSet = [], preTag = Nothing, postTag = Nothing
-                             , tagged = bothVary
-                             , childGroups = childGroups qFront || childGroups qEnd
-                             , wants = wanted
-                             , unQ = Seq qFront qEnd }
+                       , takes = seqTake (takes qFront) (takes qEnd)
+                       , preReset = [], postSet = [], preTag = Nothing, postTag = Nothing
+                       , tagged = bothVary
+                       , childGroups = childGroups qFront || childGroups qEnd
+                       , wants = wanted
+                       , unQ = Seq qFront qEnd }
                                    )
   go :: Pattern -> HHQ
   go pIn m1 m2 =
diff -ru regex-tdfa-1.1.3/Text/Regex/TDFA/NewDFA/Engine_FA.hs regex-tdfa-1.1.2/Text/Regex/TDFA/NewDFA/Engine_FA.hs
--- regex-tdfa-1.1.3/Text/Regex/TDFA/NewDFA/Engine_FA.hs	2010-06-12 00:02:12.000000000 +0100
+++ regex-tdfa-1.1.2/Text/Regex/TDFA/NewDFA/Engine_FA.hs	2009-05-05 17:33:45.000000000 +0100
@@ -48,7 +48,7 @@
 -- trace _ a = a
 
 err :: String -> a
-err s = common_error "Text.Regex.TDFA.NewDFA"  s
+err s = common_error "Text.Regex.TDFA.NewDFA.Engine_FA"  s
 
 {-# INLINE (!!) #-}
 (!!) :: (MArray a e (S.ST s),Ix i) => a i e -> Int -> S.ST s e
@@ -103,7 +103,7 @@
                   case CMap.findWithDefault o c t of
                     Transition {trans_single=DFA {d_id=did',d_dt=dt'},trans_how=dtrans}
                       | ISet.null did' -> finalizeWinner
-                      | otherwise -> findTrans s1 s2 did' dt' dtrans offset c input'
+                      | otherwise -> findTrans s1 s2 did did' dt' dtrans offset c input'
 
 -- compressOrbits gets all the current Tag-0 start information from
 -- the NFA states; then it loops through all the Orbit tags with
@@ -212,10 +212,10 @@
 -- "storeNext".  If no winners are ready to be released then the
 -- computation continues immediately.
 
-        findTrans s1 s2 did' dt' dtrans offset prev' input' =  {-# SCC "goNext.findTrans" #-} do
+        findTrans s1 s2 did did' dt' dtrans offset prev' input' =  {-# SCC "goNext.findTrans" #-} do
           -- findTrans part 0
           -- MAGIC TUNABLE CONSTANT 100 (and 100-1). TODO: (offset .&. 127 == 127) instead?
-          when (not (null orbitTags) && (offset `rem` 100 == 99)) (compressOrbits s1 did' offset)
+          when (not (null orbitTags) && (offset `rem` 100 == 99)) (compressOrbits s1 did offset)
           -- findTrans part 1
           let findTransTo (destIndex,sources) | IMap.null sources =
                 set which destIndex noSource
@@ -521,7 +521,7 @@
 {-# INLINE spawnAt #-}
 -- Reset the entry at "Index", or allocate such an entry.
 -- set tag 0 to the "Position"
-spawnAt :: (Tag,Tag) -> BlankScratch s -> Index -> MScratch s -> Position -> S.ST s ()
+spawnAt :: (Tag,Tag) -> BlankScratch s -> Index -> MScratch s -> Position -> S.ST s Position
 spawnAt b_tags (BlankScratch blankPos) i s1 thisPos = do
   oldPos <- m_pos s1 !! i
   pos <- case oldPos of
@@ -533,6 +533,7 @@
   copySTU blankPos pos
   set (m_orbit s1) i $! mempty
   set pos 0 thisPos
+  return thisPos
 
 {-# INLINE updateCopy #-}
 updateCopy :: ((Index, Instructions), STUArray s Tag Position, OrbitLog)
@@ -564,15 +565,15 @@
 -}
 -- This has been updated for ghc 6.8.3 and still works with ghc 6.10.1
 {-# INLINE copySTU #-}
-copySTU :: (Show i,Ix i,MArray (STUArray s) e (S.ST s)) => STUArray s i e -> STUArray s i e -> S.ST s () -- (STUArray s i e)
-copySTU _souce@(STUArray _ _ _ msource) _destination@(STUArray _ _ _ mdest) =
+copySTU :: (Show i,Ix i,MArray (STUArray s) e (S.ST s)) => STUArray s i e -> STUArray s i e -> S.ST s (STUArray s i e)
+copySTU _souce@(STUArray _ _ _ msource) destination@(STUArray _ _ _ mdest) =
 -- do b1 <- getBounds s1
 --  b2 <- getBounds s2
 --  when (b1/=b2) (error ("\n\nWTF copySTU: "++show (b1,b2)))
   ST $ \s1# ->
     case sizeofMutableByteArray# msource        of { n# ->
     case unsafeCoerce# memcpy mdest msource n# s1# of { (# s2#, () #) ->
-    (# s2#, () #) }}
+    (# s2#, destination #) }}
 {-
 #else /* !__GLASGOW_HASKELL__ */
 
diff -ru regex-tdfa-1.1.3/Text/Regex/TDFA/NewDFA/Engine.hs regex-tdfa-1.1.2/Text/Regex/TDFA/NewDFA/Engine.hs
--- regex-tdfa-1.1.3/Text/Regex/TDFA/NewDFA/Engine.hs	2010-06-12 00:02:12.000000000 +0100
+++ regex-tdfa-1.1.2/Text/Regex/TDFA/NewDFA/Engine.hs	2009-05-05 17:33:45.000000000 +0100
@@ -52,7 +52,7 @@
 -- trace _ a = a
 
 err :: String -> a
-err s = common_error "Text.Regex.TDFA.NewDFA"  s
+err s = common_error "Text.Regex.TDFA.NewDFA.Engine"  s
 
 {-# INLINE (!!) #-}
 (!!) :: (MArray a e (S.ST s),Ix i) => a i e -> Int -> S.ST s e
@@ -115,7 +115,7 @@
 
   goNext storeNext = {-# SCC "goNext" #-} do
     (SScratch s1In s2In (winQ,blank,which)) <- newScratch b_index b_tags
-    _ <- spawnStart b_tags blank startState s1In offsetIn
+    spawnStart b_tags blank startState s1In offsetIn
     eliminatedStateFlag <- newSTRef False
     eliminatedRespawnFlag <- newSTRef False
     let next s1 s2 did dt offset prev input = {-# SCC "goNext.next" #-}
@@ -131,7 +131,7 @@
                     Just (c,input') ->
                       case CMap.findWithDefault o c t of
                         Transition {trans_many=DFA {d_id=did',d_dt=dt'},trans_how=dtrans} ->
-                          findTrans s1 s2 did' dt' dtrans offset c input'
+                          findTrans s1 s2 did did' dt' dtrans offset c input'
               | otherwise -> do
                   (did',dt') <- processWinner s1 did dt w offset
                   next' s1 s2 did' dt' offset prev input
@@ -148,7 +148,7 @@
                 Just (c,input') ->
                   case CMap.findWithDefault o c t of
                     Transition {trans_many=DFA {d_id=did',d_dt=dt'},trans_how=dtrans} ->
-                      findTrans s1 s2 did' dt' dtrans offset c input'
+                      findTrans s1 s2 did did' dt' dtrans offset c input'
 
 -- compressOrbits gets all the current Tag-0 start information from
 -- the NFA states; then it loops through all the Orbit tags with
@@ -257,10 +257,10 @@
 -- "storeNext".  If no winners are ready to be released then the
 -- computation continues immediately.
 
-        findTrans s1 s2 did' dt' dtrans offset prev' input' =  {-# SCC "goNext.findTrans" #-} do
+        findTrans s1 s2 did did' dt' dtrans offset prev' input' =  {-# SCC "goNext.findTrans" #-} do
           -- findTrans part 0
           -- MAGIC TUNABLE CONSTANT 100 (and 100-1). TODO: (offset .&. 127 == 127) instead?
-          when (not (null orbitTags) && (offset `rem` 100 == 99)) (compressOrbits s1 did' offset)
+          when (not (null orbitTags) && (offset `rem` 100 == 99)) (compressOrbits s1 did offset)
           -- findTrans part 1
           let findTransTo (destIndex,sources) | IMap.null sources =
                 set which destIndex ((-1,Instructions { newPos = [(0,SetPost)], newOrbits = Nothing })
@@ -355,7 +355,7 @@
                 if respawn
                   then do
                     writeSTRef eliminatedRespawnFlag False
-                    _ <- spawnStart b_tags blank startState s1 (succ offset)
+                    spawnStart b_tags blank startState s1 (succ offset)
                     return (Trie.lookupAsc trie (sort (states'++[startState])))
                   else return (Trie.lookupAsc trie states')
               return (did',dt')
@@ -692,15 +692,15 @@
 -}
 -- This has been updated for ghc 6.8.3 and still works with ghc 6.10.1
 {-# INLINE copySTU #-}
-copySTU :: (Show i,Ix i,MArray (STUArray s) e (S.ST s)) => STUArray s i e -> STUArray s i e -> S.ST s () -- (STUArray s i e)
-copySTU _souce@(STUArray _ _ _ msource) _destination@(STUArray _ _ _ mdest) =
+copySTU :: (Show i,Ix i,MArray (STUArray s) e (S.ST s)) => STUArray s i e -> STUArray s i e -> S.ST s (STUArray s i e)
+copySTU _souce@(STUArray _ _ _ msource) destination@(STUArray _ _ _ mdest) =
 -- do b1 <- getBounds s1
 --  b2 <- getBounds s2
 --  when (b1/=b2) (error ("\n\nWTF copySTU: "++show (b1,b2)))
   ST $ \s1# ->
     case sizeofMutableByteArray# msource        of { n# ->
     case unsafeCoerce# memcpy mdest msource n# s1# of { (# s2#, () #) ->
-    (# s2#, () #) }}
+    (# s2#, destination #) }}
 {-
 #else /* !__GLASGOW_HASKELL__ */
 
diff -ru regex-tdfa-1.1.3/Text/Regex/TDFA/Pattern.hs regex-tdfa-1.1.2/Text/Regex/TDFA/Pattern.hs
--- regex-tdfa-1.1.3/Text/Regex/TDFA/Pattern.hs	2010-06-12 00:02:12.000000000 +0100
+++ regex-tdfa-1.1.2/Text/Regex/TDFA/Pattern.hs	2009-05-05 17:33:45.000000000 +0100
@@ -173,7 +173,7 @@
 {- The PStar should not capture 0 characters on its first iteration,
    so set its mayFirstBeNull flag to False
  -}
-    PPlus p | canOnlyMatchNull p -> p
+    PPlus p | canOnlyMatchNull p -> nullGroup p
             | otherwise -> asGroup $ PConcat [reGroup p,PStar False p]
 
 {- "An ERE matching a single character repeated by an '*' , '?' , or
@@ -261,7 +261,7 @@
                         | otherwise -> PStar True p
     PBound 0 (Just 1) p -> quest p
 -- Hard cases
-    PBound i Nothing  p | canOnlyMatchNull p -> p
+    PBound i Nothing  p | canOnlyMatchNull p -> nullGroup p
                         | otherwise -> asGroup . PConcat $ apply (nc'p:) (pred i) [reGroup p,PStar False p]
       where nc'p = nonCapture' p
     PBound 0 (Just j) p | canOnlyMatchNull p -> quest p
@@ -281,7 +281,7 @@
       where p' = nonCapture' p
 -}
 {- 0.99.7 add -}
-    PBound i (Just j) p | canOnlyMatchNull p -> p
+    PBound i (Just j) p | canOnlyMatchNull p -> nullGroup p
                         | i == j -> asGroup . PConcat $ apply (nc'p:) (pred i) [reGroup p]
                         | otherwise -> asGroup . PConcat $ apply (nc'p:) (pred i)
                                         [reGroup p,apply (nonEmpty' . (concat' p)) (j-i-1) (ne'p) ]
@@ -310,6 +310,7 @@
     PNonCapture {} -> pass
     PNonEmpty {} -> pass -- TODO : remove PNonEmpty from program
   where
+    nullGroup p = p
     quest = (\ p -> POr [p,PEmpty])  -- require p to have been simplified
 --    quest' = (\ p -> simplify' $ POr [p,PEmpty])  -- require p to have been simplified
     concat' a b = simplify' $ PConcat [reGroup a,reGroup b]      -- require a and b to have been simplified
diff -ru regex-tdfa-1.1.3/Text/Regex/TDFA/ReadRegex.hs regex-tdfa-1.1.2/Text/Regex/TDFA/ReadRegex.hs
--- regex-tdfa-1.1.3/Text/Regex/TDFA/ReadRegex.hs	2010-06-12 00:02:12.000000000 +0100
+++ regex-tdfa-1.1.2/Text/Regex/TDFA/ReadRegex.hs	2009-05-05 17:33:45.000000000 +0100
@@ -64,7 +64,7 @@
 p_bound_spec atom = do lowS <- many1 digit
                        let lowI = read lowS
                        highMI <- option (Just lowI) $ try $ do 
-                                   _ <- char ','
+                                   char ','
   -- parsec note: if 'many digits' fails below then the 'try' ensures
   -- that the ',' will not match the closing '}' in p_bound, same goes
   -- for any non '}' garbage after the 'many digits'.
@@ -78,7 +78,7 @@
 -- An anchor cannot be modified by a repetition specifier
 p_anchor = (char '^' >> liftM PCarat char_index)
        <|> (char '$' >> liftM PDollar char_index)
-       <|> try (do _ <- string "()" 
+       <|> try (do string "()" 
                    index <- group_index
                    return $ PGroup index PEmpty) 
        <?> "empty () or anchor ^ or $"
@@ -101,7 +101,7 @@
 -- p_set :: Bool -> GenParser Char st Pattern
 p_set invert = do initial <- (option "" ((char ']' >> return "]") <|> (char '-' >> return "-")))
                   values <- many1 p_set_elem
-                  _ <- char ']'
+                  char ']'
                   ci <- char_index
                   let chars = maybe'set $ initial
                                           ++ [c | BEChar c <- values ]
@@ -129,7 +129,7 @@
 
 p_set_elem_range = try $ do 
   start <- noneOf "]-"
-  _  <- char '-'
+  char '-'
   end <- noneOf "]"
   return (BEChars [start..end])
 
diff -ru regex-tdfa-1.1.3/Text/Regex/TDFA/TNFA.hs regex-tdfa-1.1.2/Text/Regex/TDFA/TNFA.hs
--- regex-tdfa-1.1.3/Text/Regex/TDFA/TNFA.hs	2010-06-12 00:02:12.000000000 +0100
+++ regex-tdfa-1.1.2/Text/Regex/TDFA/TNFA.hs	2009-05-05 17:33:45.000000000 +0100
@@ -52,7 +52,7 @@
 
 import Text.Regex.TDFA.Common(QT(..),QNFA(..),QTrans,TagTask(..),TagUpdate(..),DoPa(..)
                              ,CompOption(..)
-                             ,Tag,TagTasks,TagList,Index,WinTags,GroupIndex,GroupInfo(..)
+                             ,Tag,TagTasks,TagList,Index,GroupIndex,GroupInfo(..)
                              ,common_error,noWin,snd3,mapSnd)
 import Text.Regex.TDFA.CorePattern(Q(..),P(..),OP(..),WhichTest,cleanNullView,NullView
                                   ,SetTestInfo(..),Wanted(..),TestInfo
@@ -96,7 +96,7 @@
 notNullable = null . nullQ
 
 -- This asks if the preferred (i.e. first) NullView has no tests.
-maybeOnlyEmpty :: Q -> Maybe WinTags
+maybeOnlyEmpty :: Q -> Maybe TagTasks
 maybeOnlyEmpty (Q {nullQ = ((SetTestInfo sti,tags):_)}) = if EMap.null sti then Just tags else Nothing
 maybeOnlyEmpty _ = Nothing
 
@@ -167,9 +167,10 @@
 losing to a branch of "lose" and winning to a branch of "win".  Tests
 not in sti are unchanged (but the losing DoPa index might be added).
 -}
-dominate :: QT -> QT -> (SetTestInfo,WinTags) -> QT
-dominate win lose x@(SetTestInfo sti,tags) = debug ("dominate "++show x) $
+dominate :: QT -> QT -> (SetTestInfo,TagTasks) -> QT
+dominate win lose x@(SetTestInfo sti,tagTasks) = debug ("dominate "++show x) $
   let -- The winning states are reached through the SetTag
+      tags = [ (tag,PreUpdate task) | (tag,task) <- tagTasks ]
       win' = prependTags' tags win
       -- get the SetTestInfo 
       winTests = listTestInfo win $ mempty
@@ -241,7 +242,7 @@
 -- This takes a function which implements a policy on mergining
 -- winning transitions and then merges all the transitions.  It opens
 -- the CharMap newtype for more efficient operation, then rewraps it.
-mergeQTWith :: (WinTags -> WinTags -> WinTags) -> QT -> QT -> QT
+mergeQTWith :: (TagList -> TagList -> TagList) -> QT -> QT -> QT
 mergeQTWith mergeWins = merge where
   merge :: QT -> QT -> QT
   merge (Simple w1 t1 o1) (Simple w2 t2 o2) =
@@ -366,17 +367,10 @@
 promoteTasks :: (TagTask->TagUpdate) -> TagTasks -> TagList
 promoteTasks promote tags = map (\(tag,task) -> (tag,promote task)) tags
 
--- only used in addWinTags
-demoteTags :: TagList -> TagTasks
-demoteTags = map helper
-  where helper (tag,PreUpdate tt) = (tag,tt)
-        helper (tag,PostUpdate tt) = (tag,tt)
-
 -- This is polymorphic so addWinTags can be cute below
 {-# INLINE addWinTags #-}
-addWinTags :: WinTags -> (TagTasks,a) -> (TagTasks,a)
-addWinTags wtags (tags,cont) = (demoteTags wtags `mappend` tags
-                               ,cont)
+addWinTags :: TagTasks -> (TagTasks,a) -> (TagTasks,a)
+addWinTags wtags (tags,cont) = (wtags `mappend` tags,cont)
 
 {-# INLINE addTag' #-}
 -- This is polymorphic so addTagAC can be cute below
@@ -435,7 +429,7 @@
                                    ,fmap (addGroupSets tags) mE
                                    ,fmap (addGroupSets tags) mQNFA)
 
-addWinTagsAC :: WinTags -> ActCont -> ActCont
+addWinTagsAC :: TagTasks -> ActCont -> ActCont
 addWinTagsAC wtags (e,mE,mQNFA) = (addWinTags wtags e
                                   ,fmap (addWinTags wtags) mE
                                   ,fmap (addWinTags wtags) mQNFA)