diff --git a/ChangeLog b/ChangeLog
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,6 +1,7 @@
+2015-11-15 v0.4.2
+	* Fix round tripping of arrow notation using ">-" and ">>-".
 2015-09-28 v0.4.1
 	* Revert removing cast from markLocated until further inspection in HaRe.
-
 2015-09-28 v0.4.0.0
 	* Rework HasDecls so that there are only instances for which it is
 	idempotent. Provide functions for managing an LHsBind which is not
diff --git a/ghc-exactprint.cabal b/ghc-exactprint.cabal
--- a/ghc-exactprint.cabal
+++ b/ghc-exactprint.cabal
@@ -1,5 +1,5 @@
 name:                ghc-exactprint
-version:             0.4.1.0
+version:             0.4.2.0
 synopsis:            ExactPrint for GHC
 description:         Using the API Annotations available from GHC 7.10.2, this
                      library provides a means to round trip any code that can
diff --git a/src/Language/Haskell/GHC/ExactPrint/Annotate.hs b/src/Language/Haskell/GHC/ExactPrint/Annotate.hs
--- a/src/Language/Haskell/GHC/ExactPrint/Annotate.hs
+++ b/src/Language/Haskell/GHC/ExactPrint/Annotate.hs
@@ -1902,15 +1902,21 @@
     mark GHC.AnnStatic
     markLocated e
 
-  markAST _ (GHC.HsArrApp e1 e2 _ _ _) = do
-    markLocated e1
-    -- only one of the next 4 will be resent
+  markAST _ (GHC.HsArrApp e1 e2 _ _ isRightToLeft) = do
+        -- isRightToLeft True  => right-to-left (f -< arg)
+        --               False => left-to-right (arg >- f)
+    if isRightToLeft
+      then markLocated e1
+      else markLocated e2
+    -- only one of the next 4 will be present
     mark GHC.Annlarrowtail
     mark GHC.Annrarrowtail
     mark GHC.AnnLarrowtail
     mark GHC.AnnRarrowtail
 
-    markLocated e2
+    if isRightToLeft
+      then markLocated e2
+      else markLocated e1
 
   markAST _ (GHC.HsArrForm e _ cs) = do
     markWithString GHC.AnnOpen "(|"
@@ -1991,15 +1997,21 @@
 
 instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)
    => Annotate (GHC.HsCmd name) where
-  markAST _ (GHC.HsCmdArrApp e1 e2 _ _ _) = do
-    markLocated e1
-    -- only one of the next 4 will be resent
+  markAST _ (GHC.HsCmdArrApp e1 e2 _ _ isRightToLeft) = do
+        -- isRightToLeft True  => right-to-left (f -< arg)
+        --               False => left-to-right (arg >- f)
+    if isRightToLeft
+      then markLocated e1
+      else markLocated e2
+    -- only one of the next 4 will be present
     mark GHC.Annlarrowtail
     mark GHC.Annrarrowtail
     mark GHC.AnnLarrowtail
     mark GHC.AnnRarrowtail
 
-    markLocated e2
+    if isRightToLeft
+      then markLocated e2
+      else markLocated e1
 
   markAST _ (GHC.HsCmdArrForm e _mf cs) = do
     markWithString GHC.AnnOpen "(|"
diff --git a/src/Language/Haskell/GHC/ExactPrint/Delta.hs b/src/Language/Haskell/GHC/ExactPrint/Delta.hs
--- a/src/Language/Haskell/GHC/ExactPrint/Delta.hs
+++ b/src/Language/Haskell/GHC/ExactPrint/Delta.hs
@@ -494,7 +494,7 @@
       , GHC.Annlarrowtail
       , GHC.Annrarrowtail
       , GHC.AnnLarrowtail
-      , GHC.AnnLarrowtail]
+      , GHC.AnnRarrowtail]
 checkUnicode kwid _ = kwid
 
 -- ---------------------------------------------------------------------
diff --git a/src/Language/Haskell/GHC/ExactPrint/Lookup.hs b/src/Language/Haskell/GHC/ExactPrint/Lookup.hs
--- a/src/Language/Haskell/GHC/ExactPrint/Lookup.hs
+++ b/src/Language/Haskell/GHC/ExactPrint/Lookup.hs
@@ -96,7 +96,7 @@
       (G GHC.AnnVbar     ) -> "|"
       (G GHC.AnnWhere    ) -> "where"
       (G GHC.Annlarrowtail ) -> "-<"
-      (G GHC.Annrarrowtail ) -> "->"
+      (G GHC.Annrarrowtail ) -> ">-"
       (G GHC.AnnLarrowtail ) -> "-<<"
       (G GHC.AnnRarrowtail ) -> ">>-"
       (G GHC.AnnSimpleQuote ) -> "'"
diff --git a/tests/Test.hs b/tests/Test.hs
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -58,6 +58,7 @@
   , mkTestMod "Annotations.hs"           "Annotations"
   , mkTestMod "Arrow.hs"                 "Arrow"
   , mkParserTest "Arrows.hs"
+  , mkParserTest "Arrow2.hs"
   , mkTestMod "Associated.hs"            "Main"
   , mkTestMod "B.hs"                     "Main"
   , mkTestMod "C.hs"                     "C"
@@ -497,6 +498,7 @@
     -- , manipulateAstTestWFnameMod cloneDecl1    "CloneDecl1.hs"    "CloneDecl1"
     -- , manipulateAstTestWFname "SimpleDo.hs"                      "Main"
     -- , manipulateAstTestWFnameMod changeRename2    "Rename2.hs"  "Main"
+    , manipulateAstTestWFname "Arrow2.hs"                      "Arrow2"
     {-
     , manipulateAstTestWFname "Lhs.lhs"                  "Main"
     , manipulateAstTestWFname "Foo.hs"                   "Main"
diff --git a/tests/examples/AddLocalDecl7.hs b/tests/examples/AddLocalDecl7.hs
new file mode 100644
--- /dev/null
+++ b/tests/examples/AddLocalDecl7.hs
@@ -0,0 +1,9 @@
+module AddLocalDecl7 where
+
+toplevel :: Integer -> Integer
+toplevel x = c * x
+
+-- c,d :: Integer
+c = 7
+d = 9
+
diff --git a/tests/examples/AddLocalDecl7.hs.expected b/tests/examples/AddLocalDecl7.hs.expected
new file mode 100644
--- /dev/null
+++ b/tests/examples/AddLocalDecl7.hs.expected
@@ -0,0 +1,11 @@
+module AddLocalDecl7 where
+
+toplevel :: Integer -> Integer
+toplevel x = c * x
+  where
+    nn = nn2
+
+-- c,d :: Integer
+c = 7
+d = 9
+
diff --git a/tests/examples/Arrow2.hs b/tests/examples/Arrow2.hs
new file mode 100644
--- /dev/null
+++ b/tests/examples/Arrow2.hs
@@ -0,0 +1,53 @@
+{-# LANGUAGE Arrows #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE UnicodeSyntax #-}
+module Arrow2 where
+
+nonUnicode :: forall a . a -> IO Int
+nonUnicode _ = do
+  x <- readChar
+  return 4
+
+-- ^ An opaque ESD handle for recording data from the soundcard via ESD.
+data Recorder fr ch (r ∷ * -> *)
+    = Recorder {
+        reCloseH :: !(FinalizerHandle r)
+      }
+
+f :: Arrow a => a (Int,Int,Int) Int
+f = proc (x,y,z) -> returnA -< x+y
+
+f2 :: Arrow a => a (Int,Int,Int) Int
+f2 = proc (x,y,z) -> returnA >- x+y
+
+g :: ArrowApply a => Int -> a (a Int Int,Int) Int
+g y = proc (x,z) -> x -<< 2+y
+
+g2 :: ArrowApply a => Int -> a (a Int Int,Int) Int
+g2 y = proc (x,z) -> x >>- 2+y
+
+-- -------------------------------------
+
+unicode ∷ ∀ a . a → IO Int
+unicode _ = do
+  x ← readChar
+  return 4
+
+-- ^ An opaque ESD handle for recording data from the soundcard via ESD.
+-- data RecorderU fr ch (r ∷ ★ → ★)
+data RecorderU fr ch (r ∷ * → *)
+    = RecorderU {
+        reCloseHU ∷ !(FinalizerHandle r)
+      }
+
+fU :: Arrow a  ⇒ a (Int,Int,Int) Int
+fU = proc (x,y,z) -> returnA ⤙ x+y
+
+f2U :: Arrow a ⇒ a (Int,Int,Int) Int
+f2U = proc (x,y,z) -> returnA ⤚ x+y
+
+gU :: ArrowApply a ⇒ Int -> a (a Int Int,Int) Int
+gU y = proc (x,z) -> x ⤛ 2+y
+
+g2U :: ArrowApply a ⇒ Int -> a (a Int Int,Int) Int
+g2U y = proc (x,z) -> x ⤜ 2+y
diff --git a/tests/examples/Base.hs b/tests/examples/Base.hs
deleted file mode 100644
--- a/tests/examples/Base.hs
+++ /dev/null
@@ -1,26 +0,0 @@
-{-# LANGUAGE BangPatterns, CPP, RankNTypes, MagicHash, UnboxedTuples, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, DeriveDataTypeable, UnliftedFFITypes #-}
-#if __GLASGOW_HASKELL__ >= 708
-{-# LANGUAGE RoleAnnotations #-}
-#endif
-{-# OPTIONS_HADDOCK hide #-}
-
--- Flat unboxed arrays: instances
-
-instance IArray UArray Bool where
-    {-# INLINE bounds #-}
-    bounds (UArray l u _ _) = (l,u)
-    {-# INLINE numElements #-}
-    numElements (UArray _ _ n _) = n
-    {-# INLINE unsafeArray #-}
-    unsafeArray lu ies = runST (unsafeArrayUArray lu ies False)
-    {-# INLINE unsafeAt #-}
-    unsafeAt (UArray _ _ _ arr#) (I# i#) =
-        ((indexWordArray# arr# (bOOL_INDEX i#) `and#` bOOL_BIT i#)
-        `neWord#` int2Word# 0#)
-
-    {-# INLINE unsafeReplace #-}
-    unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
-    {-# INLINE unsafeAccum #-}
-    unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
-    {-# INLINE unsafeAccumArray #-}
-    unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies)
diff --git a/tests/examples/Error.hs b/tests/examples/Error.hs
deleted file mode 100644
--- a/tests/examples/Error.hs
+++ /dev/null
@@ -1,110 +0,0 @@
-
-module GameData.Data where
-#include "Utils.cpp"
-import qualified Data.List as L
-import qualified Data.List.Zipper as LZ
-import Gamgine.Control (applyIf)
-import qualified Gamgine.Zipper as GZ
-import qualified GameData.Level as LV
-import qualified GameData.Entity as E
-IMPORT_LENS_AS_LE
-
-
-data Data = Data {
-   levels :: LZ.Zipper LV.Level
-   }
-
-LENS(levels)
-
-instance E.ApplyToEntity Data where
-   eMap f = LE.modL currentLevelL (E.eMap f)
-   eFilter p = LE.modL currentLevelL (E.eFilter p)
-
-
-currentLevelL    = currentLevelLens
-currentLevelLens = LE.lens getCurrentLevel setCurrentLevel
-   where
-      getCurrentLevel       = LZ.cursor . levels
-      setCurrentLevel level = LE.modL levelsL $ LZ.replace level
-
-
-newData :: [LV.Level] -> Data
-newData = Data . LZ.fromList
-
-
-allLevels :: Data -> [LV.Level]
-allLevels = LZ.toList . levels
-
-
-atLastLevel :: Data -> Bool
-atLastLevel = GZ.atLast . levels
-
-
-atFirstLevel :: Data -> Bool
-atFirstLevel = GZ.atFirst . levels
-
-
-levelFinished :: Data -> Bool
-levelFinished = LV.allStarsCollected . LE.getL currentLevelL
-
-
-gameFinished :: Data -> Bool
-gameFinished d = levelFinished d && atLastLevel d
-
-
-toNextLevel :: Data -> Data
-toNextLevel d@Data {levels = lvs}
-   | LZ.emptyp lvs || GZ.atLast lvs = d
-   | otherwise =
-      let lvs      = levels d
-          (c', n') = LV.changeLevels (GZ.current lvs) (GZ.next lvs)
-          in d {levels = LZ.replace n' . LZ.right . LZ.replace c' $ lvs}
-
-
-toPreviousLevel :: Data -> Data
-toPreviousLevel d@Data {levels = lvs}
-   | LZ.emptyp lvs || GZ.atFirst lvs = d
-   | otherwise =
-      let (c', p') = LV.changeLevels (GZ.current lvs) (GZ.previous lvs)
-          in d {levels = LZ.replace p' . LZ.left . LZ.replace c' $ lvs}
-
-
-data AddLevel = BeforeCurrent | AfterCurrent | AfterLast
-
-addEmptyLevel :: AddLevel -> Data -> Data
-addEmptyLevel BeforeCurrent d@Data {levels = lvs} =
-   let (c', nlv') = LV.changeLevels (GZ.current lvs) LV.newEmptyLevel
-       in d {levels = LZ.insert nlv' . LZ.replace c' $ lvs}
-
-addEmptyLevel AfterCurrent d@Data {levels = lvs} =
-   let (c', nlv') = LV.changeLevels (GZ.current lvs) LV.newEmptyLevel
-       in d {levels = LZ.insert nlv' . LZ.right . LZ.replace c' $ lvs}
-
-addEmptyLevel AfterLast d@Data {levels = lvs} =
-   let (c', nlv') = LV.changeLevels (GZ.current lvs) LV.newEmptyLevel
-       in d {levels = LZ.insert nlv' . LZ.end . LZ.replace c' $ lvs}
-
-
-data MoveLevel = Forward | Backward
-
-moveCurrentLevel :: MoveLevel -> Data -> Data
-moveCurrentLevel Forward d@Data {levels = lvs}
-   | LZ.beginp lvs = d
-   | otherwise     =
-      let (p, c) = (GZ.previous lvs, GZ.current lvs)
-          in d {levels = LZ.replace c . LZ.left . LZ.replace p $ lvs}
-
-moveCurrentLevel Backward d@Data {levels = lvs}
-   | GZ.atLast lvs = d
-   | otherwise     =
-      let (c, n) = (GZ.current lvs, GZ.next lvs)
-          in d {levels = LZ.replace c . LZ.right . LZ.replace n $ lvs}
-
-
-removeCurrentLevel :: Data -> Data
-removeCurrentLevel d@Data {levels = lvs}
-   | GZ.atFirst lvs && GZ.atLast lvs =
-      let (_, nlv') = LV.changeLevels (GZ.current lvs) LV.newEmptyLevel
-          in d {levels = LZ.replace nlv' lvs}
-
-   | otherwise = d {levels = applyIf LZ.endp LZ.left . LZ.delete $ lvs}
diff --git a/tests/examples/Join.hs b/tests/examples/Join.hs
deleted file mode 100644
--- a/tests/examples/Join.hs
+++ /dev/null
@@ -1,7 +0,0 @@
-
-forkOS_entry :: StablePtr (IO ()) -> IO ()
-forkOS_entry stableAction = do
-        action <- deRefStablePtr stableAction
-        action
-
-
diff --git a/tests/examples/Lambda.hs b/tests/examples/Lambda.hs
deleted file mode 100644
--- a/tests/examples/Lambda.hs
+++ /dev/null
@@ -1,2 +0,0 @@
-
-i = \x -> x
diff --git a/tests/examples/NormaliseLayout.hs b/tests/examples/NormaliseLayout.hs
deleted file mode 100644
--- a/tests/examples/NormaliseLayout.hs
+++ /dev/null
@@ -1,5 +0,0 @@
-module Main where
-
-foo x = baz
-  where foo = 2
-        two = 4 where bax = 4
diff --git a/tests/examples/NormaliseLayout.hs.expected b/tests/examples/NormaliseLayout.hs.expected
deleted file mode 100644
--- a/tests/examples/NormaliseLayout.hs.expected
+++ /dev/null
@@ -1,1 +0,0 @@
-module Main where
diff --git a/tests/examples/SegFault.hs b/tests/examples/SegFault.hs
deleted file mode 100644
--- a/tests/examples/SegFault.hs
+++ /dev/null
@@ -1,133 +0,0 @@
-{-# INCLUDE "Parrot_hsc.h" #-}
-{-# LINE 1 "Parrot.hsc" #-}
-{-# OPTIONS_GHC -fglasgow-exts -cpp -fno-full-laziness -fno-cse #-}
-{-# LINE 2 "Parrot.hsc" #-}
-
-{-# LINE 3 "Parrot.hsc" #-}
-
-module Pugs.Embed.Parrot where
-import Data.IORef
-import System.Cmd
-import System.Process
-import System.Directory
-import System.IO
-import System.IO.Unsafe
-import Data.Maybe
-import Control.Monad
-import Pugs.Compat (getEnv, _PUGS_HAVE_POSIX)
-import Pugs.Internals (encodeUTF8)
-
-findExecutable' :: String -> IO (Maybe FilePath)
-findExecutable' cmd = do
-    dir <- getEnv "PARROT_PATH"
-    if isJust dir then (do
-        rv  <- findExecutableInDirectory (fromJust dir) cmd
-        if isJust rv then return rv else findExecutable'') else do
-    findExecutable''
-    where
-    findExecutable'' = do
-        rv  <- findExecutable cmd
-        if isJust rv then return rv else do
-        cwd <- getCurrentDirectory
-        rv  <- findExecutableInDirectory cwd cmd
-        if isJust rv then return rv else do
-        return Nothing
-
-findExecutableInDirectory :: FilePath -> FilePath -> IO (Maybe FilePath)
-findExecutableInDirectory dir cmd = do
-    let file | _PUGS_HAVE_POSIX = dir ++ ('/':cmd)
-             | otherwise        = dir ++ ('\\':cmd) ++ ".exe"
-    ok <- doesFileExist file
-    return $ if ok then (Just file) else Nothing
-
-findParrot :: IO FilePath
-findParrot = do
-    rv <- findExecutable' "parrot"
-    case rv of
-        Nothing     -> fail "Cannot find the parrot executable in PATH"
-        Just cmd    -> return cmd
-
-evalParrotFile :: FilePath -> IO ()
-evalParrotFile file = do
-    cmd <- findParrot
-    -- parrot -j is fatal on systems where jit is not supported,
-    -- so we use the next fastest CGP core.
-    args <- getEnv "PUGS_PARROT_OPTS"
-    let args' | isJust args && fromJust args /= "" = fromJust args
-              | otherwise                          = "-f"
-    rawSystem cmd [args', file]
-    return ()
-
-evalParrot :: String -> IO ()
-evalParrot str = do
-    tmp         <- getTemporaryDirectory
-    (file, fh)  <- openTempFile tmp "pugs.pir"
-    hPutStr fh str
-    hClose fh
-    evalParrotFile file
-    removeFile file
-
-evalPGE :: FilePath -> String -> String -> [(String, String)] -> IO String
-evalPGE path match rule subrules = do
-    (inp, out, err, pid) <- initPGE path
-    (`mapM` subrules) $ \(name, rule) -> do
-        let nameStr = escape name
-            ruleStr = escape rule
-        hPutStrLn inp $ unwords
-            ["add_rule", show (length nameStr), show (length ruleStr)]
-        hPutStrLn inp nameStr
-        hPutStrLn inp ruleStr
-    let matchStr = escape match
-        ruleStr  = escape rule
-    hPutStrLn inp $ unwords
-        ["match", show (length matchStr), show (length ruleStr)]
-    hPutStrLn inp $ matchStr
-    hPutStrLn inp $ ruleStr
-    hFlush inp
-    rv <- hGetLine out
-    case rv of
-        ('O':'K':' ':sizeStr) -> do
-            size <- readIO sizeStr
-            rv   <- sequence (replicate size (hGetChar out))
-            ln   <- hGetLine out
-            return $ rv ++ ln
-        _ -> do
-            errMsg  <- hGetContents err
-            rv      <- waitForProcess pid
-            writeIORef _ParrotInterp Nothing
-            let msg | null errMsg = show rv
-                    | otherwise   = errMsg
-            fail $ "*** Running external 'parrot' failed:\n" ++ msg
-    where
-    escape = escape . encodeUTF8
-    _escape "" = ""
-    _escape ('\\':xs) = "\\\\" ++ _escape xs
-    _escape ('\n':xs) = "\\n" ++ _escape xs
-    _escape (x:xs) = (x:_escape xs)
-
-initPGE :: FilePath -> IO ParrotInterp
-initPGE path = do
-    rv <- readIORef _ParrotInterp
-    case rv of
-        Just interp@(_, _, _, pid) -> do
-            gone <- getProcessExitCode pid
-            if isNothing gone then return interp else do
-            writeIORef _ParrotInterp Nothing
-            initPGE path
-        Nothing -> do
-            cmd <- findParrot
-            interp <- runInteractiveProcess cmd ["run_pge.pir"] (Just path) Nothing
-            writeIORef _ParrotInterp (Just interp)
-            return interp
-
-type ParrotInterp = (Handle, Handle, Handle, ProcessHandle)
-
-{-# NOINLINE _ParrotInterp #-}
-_ParrotInterp :: IORef (Maybe ParrotInterp)
-_ParrotInterp = unsafePerformIO $ newIORef Nothing
-
-_DoCompile :: Maybe (IORef (String -> FilePath -> String -> IO String))
-_DoCompile = Nothing
-
-
-{-# LINE 387 "Parrot.hsc" #-}
diff --git a/tests/examples/SegFault2.hs b/tests/examples/SegFault2.hs
deleted file mode 100644
--- a/tests/examples/SegFault2.hs
+++ /dev/null
@@ -1,202 +0,0 @@
-{-# LANGUAGE CPP #-}
-
-module UHC.Light.Compiler.CHR.Constraint
-( Constraint (..)
-, mkReduction
-, cnstrReducablePart
-, UnresolvedTrace (..)
-, cnstrMpSingletonL, cnstrMpFromList
-, ConstraintToInfoTraceMp
-, cnstrTraceMpSingleton, cnstrTraceMpLiftTrace, cnstrTraceMpElimTrace, cnstrTraceMpFromList
-, ConstraintToInfoMap
-, emptyCnstrMp
-, cnstrMpUnion, cnstrMpUnions
-, cnstrRequiresSolve )
-where
-import UHC.Light.Compiler.Base.Common
-import UHC.Light.Compiler.Ty
-import UHC.Light.Compiler.CHR
-import UHC.Light.Compiler.CHR.Key
-import UHC.Light.Compiler.Base.TreeTrie
-import UHC.Light.Compiler.Substitutable
-import UHC.Util.Pretty as PP
-import UHC.Util.Utils
-import qualified Data.Set as Set
-import qualified Data.Map as Map
-import UHC.Light.Compiler.VarMp
-import Control.Monad
-import UHC.Util.Binary
-import UHC.Util.Serialize
-import Data.Typeable
-import Data.Generics (Data)
-import UHC.Light.Compiler.Opts.Base
-
-
-
-
-{-# LINE 37 "src/ehc/CHR/Constraint.chs" #-}
--- | A Constraint is abstracted over the exact predicate, but differentiates on the role: to prove, can be assumed, and side effect of reduction
-data Constraint p info
-  = Prove           { cnstrPred :: !p }             -- proof obligation
-  | Assume          { cnstrPred :: !p }             -- assumed constraint
-  | Reduction                                       -- 'side effect', residual info used by (e.g.) codegeneration
-                    { cnstrPred :: !p               -- the pred to which reduction was done
-                    , cnstrInfo :: !info            -- additional reduction specific info w.r.t. codegeneration
-                    , cnstrFromPreds :: ![p]        -- the preds from which reduction was done
-                    , cnstrVarMp :: VarMp           -- additional bindings for type (etc.) variables, i.e. improving substitution
-                    }
-  deriving (Eq, Ord, Show)
-
-{-# LINE 53 "src/ehc/CHR/Constraint.chs" #-}
-mkReduction :: p -> info -> [p] -> Constraint p info
-mkReduction p i ps
-  = Reduction p i ps
-              varlookupEmpty
-
-{-# LINE 62 "src/ehc/CHR/Constraint.chs" #-}
-#if __GLASGOW_HASKELL__ >= 708
-deriving instance Typeable  Constraint
-#else
-deriving instance Typeable2 Constraint
-#endif
-deriving instance (Data x, Data y) => Data (Constraint x y)
-
-{-# LINE 71 "src/ehc/CHR/Constraint.chs" #-}
--- | Dissection of Constraint, including reconstruction function
-cnstrReducablePart :: Constraint p info -> Maybe (String,p,p->Constraint p info)
-cnstrReducablePart (Prove  p) = Just ("Prf",p,Prove)
-cnstrReducablePart (Assume p) = Just ("Ass",p,Assume)
-cnstrReducablePart _          = Nothing
-
-{-# LINE 84 "src/ehc/CHR/Constraint.chs" #-}
-instance (CHRMatchable env p s) => CHRMatchable env (Constraint p info) s where
-  chrMatchTo env s c1 c2
-    = do { (_,p1,_) <- cnstrReducablePart c1
-         ; (_,p2,_) <- cnstrReducablePart c2
-         ; chrMatchTo env s p1 p2
-         }
-
-{-# LINE 93 "src/ehc/CHR/Constraint.chs" #-}
-instance TTKeyable p => TTKeyable (Constraint p info) where
-  toTTKey' o c -- = maybe [] (\(s,p,_) -> ttkAdd (TT1K_One $ Key_Str s) [toTTKey' o p]) $ cnstrReducablePart c
-    = case cnstrReducablePart c of
-        Just (s,p,_) -> ttkAdd' (TT1K_One $ Key_Str s) cs
-                     where (_,cs) = toTTKeyParentChildren' o p
-        _            -> panic "TTKeyable (Constraint p info).toTTKey'" -- ttkEmpty
-
-{-# LINE 102 "src/ehc/CHR/Constraint.chs" #-}
-instance (VarExtractable p v,VarExtractable info v) => VarExtractable (Constraint p info) v where
-  varFreeSet c
-    = case cnstrReducablePart c of
-        Just (_,p,_) -> varFreeSet p
-        _            -> Set.empty
-
-instance (VarUpdatable p s,VarUpdatable info s) => VarUpdatable (Constraint p info) s where
-  varUpd s      (Prove     p       ) = Prove      (varUpd s p)
-  varUpd s      (Assume    p       ) = Assume     (varUpd s p)
-  varUpd s      r@(Reduction {cnstrPred=p, cnstrInfo=i, cnstrFromPreds=ps})
-                                     = r {cnstrPred=varUpd s p, cnstrInfo=varUpd s i, cnstrFromPreds=map (varUpd s) ps}
-
-{-# LINE 120 "src/ehc/CHR/Constraint.chs" #-}
--- | The trace of an unresolved predicate
-data UnresolvedTrace p info
-  = UnresolvedTrace_None                                    -- no trace required when all is resolved
-  | UnresolvedTrace_Red                                     -- ok reduction, with failure deeper down
-      { utraceRedFrom       :: p
-      , utraceInfoTo2From   :: info
-      , utraceRedTo         :: [UnresolvedTrace p info]
-      }
-  | UnresolvedTrace_Fail                                    -- failed reduction
-      { utraceRedFrom       :: p
-      -- , utraceInfoTo2From    :: info
-      , utraceRedTo         :: [UnresolvedTrace p info]
-      }
-  | UnresolvedTrace_Overlap                                 -- choice could not be made
-      { utraceRedFrom       :: p
-      , utraceRedChoices    :: [(info,[UnresolvedTrace p info])]
-      }
-  deriving Show
-
-instance Eq p => Eq (UnresolvedTrace p info) where
-  t1 == t2 = True -- utraceRedFrom t1 == utraceRedFrom t2
-
-instance (PP p, PP info) => PP (UnresolvedTrace p info) where
-  pp x = case x of
-           UnresolvedTrace_None             -> PP.empty
-           UnresolvedTrace_Red      p i us  -> p >|< ":" >#< i >-< indent 2 (vlist $ map pp us)
-           UnresolvedTrace_Fail     p   us  -> p >|< ": FAIL" >-< indent 2 (vlist $ map pp us)
-           UnresolvedTrace_Overlap  p uss   -> p >|< ": OVERLAP" >-< indent 2 (vlist $ map (\(i,u) -> i >-< indent 2 (vlist $ map pp u)) uss)
-
-{-# LINE 155 "src/ehc/CHR/Constraint.chs" #-}
--- | Map from constraint to something
-type ConstraintMp' p info x = Map.Map (Constraint p info) [x]
-
-{-# LINE 160 "src/ehc/CHR/Constraint.chs" #-}
-cnstrMpSingletonL :: Constraint p i -> [x] -> ConstraintMp' p i x
-cnstrMpSingletonL c xs = Map.singleton c xs
-
-cnstrMpSingleton :: Constraint p i -> x -> ConstraintMp' p i x
-cnstrMpSingleton c x = cnstrMpSingletonL c [x]
-
-cnstrMpFromList :: (Ord p, Ord i) => [(Constraint p i,x)] -> ConstraintMp' p i x
-cnstrMpFromList l = Map.fromListWith (++) [ (c,[x]) | (c,x) <- l ]
-
-cnstrMpMap :: (Ord p, Ord i) => (x -> y) -> ConstraintMp' p i x -> ConstraintMp' p i y
-cnstrMpMap f = Map.map (map f)
-
-{-# LINE 174 "src/ehc/CHR/Constraint.chs" #-}
--- | Map from constraint to info + trace
-type ConstraintToInfoTraceMp p info = ConstraintMp' p info (info,[UnresolvedTrace p info])
-
-{-# LINE 179 "src/ehc/CHR/Constraint.chs" #-}
-cnstrTraceMpFromList :: (Ord p, Ord i) => [(Constraint p i,(i,[UnresolvedTrace p i]))] -> ConstraintToInfoTraceMp p i
-cnstrTraceMpFromList = cnstrMpFromList
-
-cnstrTraceMpSingleton :: Constraint p i -> i -> [UnresolvedTrace p i] -> ConstraintToInfoTraceMp p i
-cnstrTraceMpSingleton c i ts = cnstrMpSingleton c (i,ts)
-
-cnstrTraceMpElimTrace :: (Ord p, Ord i) => ConstraintToInfoTraceMp p i -> ConstraintToInfoMap p i
-cnstrTraceMpElimTrace = cnstrMpMap fst
-
-cnstrTraceMpLiftTrace :: (Ord p, Ord i) => ConstraintToInfoMap p i -> ConstraintToInfoTraceMp p i
-cnstrTraceMpLiftTrace = cnstrMpMap (\x -> (x,[]))
-
-{-# LINE 193 "src/ehc/CHR/Constraint.chs" #-}
--- | Map from constraint to info
-type ConstraintToInfoMap     p info = ConstraintMp' p info info
-
-{-# LINE 198 "src/ehc/CHR/Constraint.chs" #-}
-emptyCnstrMp :: ConstraintMp' p info x
-emptyCnstrMp = Map.empty
-
-{-# LINE 208 "src/ehc/CHR/Constraint.chs" #-}
-cnstrMpUnion :: (Ord p, Ord i) => ConstraintMp' p i x -> ConstraintMp' p i x -> ConstraintMp' p i x
-cnstrMpUnion = Map.unionWith (++)
-
-cnstrMpUnions :: (Ord p, Ord i) => [ConstraintMp' p i x] -> ConstraintMp' p i x
-cnstrMpUnions = Map.unionsWith (++)
-
-{-# LINE 220 "src/ehc/CHR/Constraint.chs" #-}
--- | Predicate for whether solving is required
-cnstrRequiresSolve :: Constraint p info -> Bool
-cnstrRequiresSolve (Reduction {}) = False
-cnstrRequiresSolve _              = True
-
-{-# LINE 231 "src/ehc/CHR/Constraint.chs" #-}
-instance (PP p, PP info) => PP (Constraint p info) where
-  pp (Prove     p     ) = "Prove"  >#< p
-  pp (Assume    p     ) = "Assume" >#< p
-  pp (Reduction {cnstrPred=p, cnstrInfo=i, cnstrFromPreds=ps})
-                        = "Red"    >#< p >#< "<" >#< i >#< "<" >#< ppBracketsCommas ps
-
-{-# LINE 243 "src/ehc/CHR/Constraint.chs" #-}
-instance (Serialize p, Serialize i) => Serialize (Constraint p i) where
-  sput (Prove     a      ) = sputWord8 0 >> sput a
-  sput (Assume    a      ) = sputWord8 1 >> sput a
-  sput (Reduction a b c d) = sputWord8 2 >> sput a >> sput b >> sput c >> sput d
-  sget = do t <- sgetWord8
-            case t of
-              0 -> liftM  Prove     sget
-              1 -> liftM  Assume    sget
-              2 -> liftM4 Reduction sget sget sget sget
-