From 93b9e285c281c24026e6d990994cef6c11889c05 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 9 Mar 2017 10:10:13 -0500
Subject: [PATCH 001/294] SES.Myers
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Stub in a module for Myers’ algorithm.
---
 semantic-diff.cabal | 1 +
 src/SES/Myers.hs    | 1 +
 2 files changed, 2 insertions(+)
 create mode 100644 src/SES/Myers.hs

diff --git a/semantic-diff.cabal b/semantic-diff.cabal
index 46026583a..8534f6d59 100644
--- a/semantic-diff.cabal
+++ b/semantic-diff.cabal
@@ -51,6 +51,7 @@ library
                      , Renderer.TOC
                      , SemanticDiff
                      , SES
+                     , SES.Myers
                      , Source
                      , SourceSpan
                      , SplitDiff
diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
new file mode 100644
index 000000000..349ce6d72
--- /dev/null
+++ b/src/SES/Myers.hs
@@ -0,0 +1 @@
+module SES.Myers where

From 9e8f6f75b37dcf87094fc9b322c8f865aa24c8ab Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 9 Mar 2017 10:12:30 -0500
Subject: [PATCH 002/294] Define a Snake datatype.

---
 src/SES/Myers.hs | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 349ce6d72..1cd6cdee6 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -1 +1,5 @@
 module SES.Myers where
+
+import Prologue
+
+data Snake = Snake { x :: Int, y :: Int, u :: Int, v :: Int }

From ac8b2865cf632411a9ef4d057519fac95b66a306 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 9 Mar 2017 10:12:41 -0500
Subject: [PATCH 003/294] Define a MyersF datatype with a single constructor.

---
 src/SES/Myers.hs | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 1cd6cdee6..a39f9cc1b 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -1,5 +1,10 @@
+{-# LANGUAGE GADTs #-}
 module SES.Myers where
 
+import qualified Data.Vector as Vector
 import Prologue
 
+data MyersF a where
+  MiddleSnake :: Vector.Vector a -> Vector.Vector a -> MyersF Snake
+
 data Snake = Snake { x :: Int, y :: Int, u :: Int, v :: Int }

From 1aebf61954090a6db8b678a3d583727a38a767d0 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 9 Mar 2017 10:13:47 -0500
Subject: [PATCH 004/294] Report the edit distance alongside the middle snake.

---
 src/SES/Myers.hs | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index a39f9cc1b..bf3e611a5 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -5,6 +5,8 @@ import qualified Data.Vector as Vector
 import Prologue
 
 data MyersF a where
-  MiddleSnake :: Vector.Vector a -> Vector.Vector a -> MyersF Snake
+  MiddleSnake :: Vector.Vector a -> Vector.Vector a -> MyersF (Snake, EditDistance)
 
 data Snake = Snake { x :: Int, y :: Int, u :: Int, v :: Int }
+
+newtype EditDistance = EditDistance { unEditDistance :: Int }

From acf68d4a4336465a64d6b9d53748b65f57b296a7 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 9 Mar 2017 10:17:43 -0500
Subject: [PATCH 005/294] Stub in a constructor for the furthest-reaching
 D-path in a given diagonal.

---
 src/SES/Myers.hs | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index bf3e611a5..af0ad5666 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -6,7 +6,9 @@ import Prologue
 
 data MyersF a where
   MiddleSnake :: Vector.Vector a -> Vector.Vector a -> MyersF (Snake, EditDistance)
+  FindDPath :: EditDistance -> Diagonal -> MyersF Int
 
 data Snake = Snake { x :: Int, y :: Int, u :: Int, v :: Int }
 
 newtype EditDistance = EditDistance { unEditDistance :: Int }
+newtype Diagonal = Diagonal { unDiagonal :: Int }

From 2eb5c5183d146f5a1c30a8015b726c1f5570a5b2 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 9 Mar 2017 10:18:50 -0500
Subject: [PATCH 006/294] Stub in a constructor for the top-level SES
 operation.

---
 src/SES/Myers.hs | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index af0ad5666..67c3fd2d7 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -1,10 +1,12 @@
 {-# LANGUAGE GADTs #-}
 module SES.Myers where
 
+import Data.These
 import qualified Data.Vector as Vector
 import Prologue
 
 data MyersF a where
+  SES :: [a] -> [a] -> MyersF [These a a]
   MiddleSnake :: Vector.Vector a -> Vector.Vector a -> MyersF (Snake, EditDistance)
   FindDPath :: EditDistance -> Diagonal -> MyersF Int
 

From aed09c20db1b3406620e1fc9cb8fdb0be3f2281a Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 9 Mar 2017 10:20:10 -0500
Subject: [PATCH 007/294] =?UTF-8?q?Add=20a=20type=20synonym=20for=20Myers?=
 =?UTF-8?q?=E2=80=99=20algorithm.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/SES/Myers.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 67c3fd2d7..27d26da74 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE GADTs #-}
 module SES.Myers where
 
+import Control.Monad.Free.Freer
 import Data.These
 import qualified Data.Vector as Vector
 import Prologue
@@ -10,6 +11,8 @@ data MyersF a where
   MiddleSnake :: Vector.Vector a -> Vector.Vector a -> MyersF (Snake, EditDistance)
   FindDPath :: EditDistance -> Diagonal -> MyersF Int
 
+type Myers = Freer MyersF
+
 data Snake = Snake { x :: Int, y :: Int, u :: Int, v :: Int }
 
 newtype EditDistance = EditDistance { unEditDistance :: Int }

From f6ada9b44193f3adbfb4d054b9727dcfbcbbf1bf Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 9 Mar 2017 10:22:36 -0500
Subject: [PATCH 008/294] =?UTF-8?q?Stub=20in=20the=20decomposition=20of=20?=
 =?UTF-8?q?steps=20in=20Myers=E2=80=99=20algorithm.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/SES/Myers.hs | 9 +++++++++
 1 file changed, 9 insertions(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 27d26da74..3fee069eb 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -17,3 +17,12 @@ data Snake = Snake { x :: Int, y :: Int, u :: Int, v :: Int }
 
 newtype EditDistance = EditDistance { unEditDistance :: Int }
 newtype Diagonal = Diagonal { unDiagonal :: Int }
+
+
+decompose :: MyersF a -> Myers a
+decompose myers = case myers of
+  SES _ _ -> return []
+
+  MiddleSnake _ _ -> return (Snake 0 0 0 0, EditDistance 0)
+
+  FindDPath _ _ -> return 0

From 7889f1481b6bb946456ea59a6db33db3cb540a89 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 9 Mar 2017 10:23:33 -0500
Subject: [PATCH 009/294] Stub in a type of endpoints.

---
 src/SES/Myers.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 3fee069eb..ccf2db33a 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -17,6 +17,7 @@ data Snake = Snake { x :: Int, y :: Int, u :: Int, v :: Int }
 
 newtype EditDistance = EditDistance { unEditDistance :: Int }
 newtype Diagonal = Diagonal { unDiagonal :: Int }
+newtype Endpoint = Endpoint { unEndpoint :: (Int, Int) }
 
 
 decompose :: MyersF a -> Myers a

From 911e03f761f42656465c5e94d92ed4bbc831748b Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 9 Mar 2017 10:24:06 -0500
Subject: [PATCH 010/294] Snakes are composed of endpoints.

---
 src/SES/Myers.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index ccf2db33a..eff0dc11d 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -13,7 +13,7 @@ data MyersF a where
 
 type Myers = Freer MyersF
 
-data Snake = Snake { x :: Int, y :: Int, u :: Int, v :: Int }
+data Snake = Snake { xy :: Endpoint, uv :: Endpoint }
 
 newtype EditDistance = EditDistance { unEditDistance :: Int }
 newtype Diagonal = Diagonal { unDiagonal :: Int }
@@ -24,6 +24,6 @@ decompose :: MyersF a -> Myers a
 decompose myers = case myers of
   SES _ _ -> return []
 
-  MiddleSnake _ _ -> return (Snake 0 0 0 0, EditDistance 0)
+  MiddleSnake _ _ -> return (Snake (Endpoint (0, 0)) (Endpoint (0, 0)), EditDistance 0)
 
   FindDPath _ _ -> return 0

From aa01343a95a5fc659bfde959c7fd7c3b9ba77dab Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 9 Mar 2017 10:24:37 -0500
Subject: [PATCH 011/294] D-paths are reported as endpoints.

---
 src/SES/Myers.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index eff0dc11d..9a9348b35 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -9,7 +9,7 @@ import Prologue
 data MyersF a where
   SES :: [a] -> [a] -> MyersF [These a a]
   MiddleSnake :: Vector.Vector a -> Vector.Vector a -> MyersF (Snake, EditDistance)
-  FindDPath :: EditDistance -> Diagonal -> MyersF Int
+  FindDPath :: EditDistance -> Diagonal -> MyersF Endpoint
 
 type Myers = Freer MyersF
 
@@ -26,4 +26,4 @@ decompose myers = case myers of
 
   MiddleSnake _ _ -> return (Snake (Endpoint (0, 0)) (Endpoint (0, 0)), EditDistance 0)
 
-  FindDPath _ _ -> return 0
+  FindDPath _ _ -> return (Endpoint (0, 0))

From a2ef23491c568300956d0f72d980e6c935e5637d Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 9 Mar 2017 10:25:08 -0500
Subject: [PATCH 012/294] Add a Direction type.

---
 src/SES/Myers.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 9a9348b35..2fccd4343 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -18,6 +18,7 @@ data Snake = Snake { xy :: Endpoint, uv :: Endpoint }
 newtype EditDistance = EditDistance { unEditDistance :: Int }
 newtype Diagonal = Diagonal { unDiagonal :: Int }
 newtype Endpoint = Endpoint { unEndpoint :: (Int, Int) }
+data Direction = Forward | Reverse
 
 
 decompose :: MyersF a -> Myers a

From 384e0162626757deade6f31807a5fef0cc54dd67 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 9 Mar 2017 10:25:46 -0500
Subject: [PATCH 013/294] D-paths can be found in either direction.

---
 src/SES/Myers.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 2fccd4343..cd49d22ff 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -9,7 +9,7 @@ import Prologue
 data MyersF a where
   SES :: [a] -> [a] -> MyersF [These a a]
   MiddleSnake :: Vector.Vector a -> Vector.Vector a -> MyersF (Snake, EditDistance)
-  FindDPath :: EditDistance -> Diagonal -> MyersF Endpoint
+  FindDPath :: Direction -> EditDistance -> Diagonal -> MyersF Endpoint
 
 type Myers = Freer MyersF
 
@@ -23,8 +23,8 @@ data Direction = Forward | Reverse
 
 decompose :: MyersF a -> Myers a
 decompose myers = case myers of
-  SES _ _ -> return []
+  SES {} -> return []
 
-  MiddleSnake _ _ -> return (Snake (Endpoint (0, 0)) (Endpoint (0, 0)), EditDistance 0)
+  MiddleSnake {} -> return (Snake (Endpoint (0, 0)) (Endpoint (0, 0)), EditDistance 0)
 
-  FindDPath _ _ -> return (Endpoint (0, 0))
+  FindDPath {} -> return (Endpoint (0, 0))

From a400c8f2aff3f331000e8d153a50c2df70a1bc75 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 9 Mar 2017 10:30:42 -0500
Subject: [PATCH 014/294] =?UTF-8?q?Model=20the=20state=20in=20Myers?=
 =?UTF-8?q?=E2=80=99=20algorithm.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/SES/Myers.hs | 8 +++++++-
 1 file changed, 7 insertions(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index cd49d22ff..8d77c6aae 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -11,7 +11,13 @@ data MyersF a where
   MiddleSnake :: Vector.Vector a -> Vector.Vector a -> MyersF (Snake, EditDistance)
   FindDPath :: Direction -> EditDistance -> Diagonal -> MyersF Endpoint
 
-type Myers = Freer MyersF
+data StepF a where
+  M :: MyersF a -> StepF a
+  S :: State (MyersState a) a -> StepF a
+
+data MyersState a = MyersState { forward :: !(Vector.Vector a), backward :: !(Vector.Vector a) }
+
+type Myers = Freer StepF
 
 data Snake = Snake { xy :: Endpoint, uv :: Endpoint }
 

From 2c2ab0337c4f4b84412c6b9214439aa4a5c7f192 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 9 Mar 2017 10:38:57 -0500
Subject: [PATCH 015/294] Define a MonadState instance for Myers.

---
 src/SES/Myers.hs | 18 ++++++++++++++----
 1 file changed, 14 insertions(+), 4 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 8d77c6aae..11cd23a86 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE GADTs #-}
+{-# LANGUAGE GADTs, MultiParamTypeClasses #-}
 module SES.Myers where
 
 import Control.Monad.Free.Freer
@@ -13,9 +13,7 @@ data MyersF a where
 
 data StepF a where
   M :: MyersF a -> StepF a
-  S :: State (MyersState a) a -> StepF a
-
-data MyersState a = MyersState { forward :: !(Vector.Vector a), backward :: !(Vector.Vector a) }
+  S :: State MyersState a -> StepF a
 
 type Myers = Freer StepF
 
@@ -34,3 +32,15 @@ decompose myers = case myers of
   MiddleSnake {} -> return (Snake (Endpoint (0, 0)) (Endpoint (0, 0)), EditDistance 0)
 
   FindDPath {} -> return (Endpoint (0, 0))
+
+
+-- Implementation details
+
+data MyersState = MyersState { forward :: !(Vector.Vector Int), backward :: !(Vector.Vector Int), offset :: Diagonal }
+
+
+-- Instances
+
+instance MonadState MyersState Myers where
+  get = S get `Then` return
+  put a = S (put a) `Then` return

From 1a45bfcdd8c786aff38f6aef7787227f5b283162 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 9 Mar 2017 10:39:28 -0500
Subject: [PATCH 016/294] Compute the endpoint at some diagonal.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

It currently doesn’t report the correct vertical index.
---
 src/SES/Myers.hs | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 11cd23a86..3e5232a84 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -38,6 +38,11 @@ decompose myers = case myers of
 
 data MyersState = MyersState { forward :: !(Vector.Vector Int), backward :: !(Vector.Vector Int), offset :: Diagonal }
 
+at :: Vector.Vector Int -> Diagonal -> Myers Endpoint
+at v (Diagonal k) = do
+  Diagonal o <- gets offset
+  return (Endpoint (v Vector.! o + k, 0))
+
 
 -- Instances
 

From 4ad49d4f82c7425411f5d310599921ba0ac19559 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 9 Mar 2017 10:39:49 -0500
Subject: [PATCH 017/294] Get the endpoint at diagonal _k_.

---
 src/SES/Myers.hs | 6 ++++++
 1 file changed, 6 insertions(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 3e5232a84..1037a893f 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -38,6 +38,12 @@ decompose myers = case myers of
 
 data MyersState = MyersState { forward :: !(Vector.Vector Int), backward :: !(Vector.Vector Int), offset :: Diagonal }
 
+getK :: Direction -> Diagonal -> Myers Endpoint
+getK direction diagonal = do
+  state <- get
+  let v = (case direction of { Forward -> forward ; Reverse -> backward }) state
+  v `at` diagonal
+
 at :: Vector.Vector Int -> Diagonal -> Myers Endpoint
 at v (Diagonal k) = do
   Diagonal o <- gets offset

From 0624d24aa7eb9e9d20fc138c2b9bfd5573f924f1 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 9 Mar 2017 10:48:11 -0500
Subject: [PATCH 018/294] Define a test of endpoint overlap.

---
 src/SES/Myers.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 1037a893f..c0136800f 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -49,6 +49,9 @@ at v (Diagonal k) = do
   Diagonal o <- gets offset
   return (Endpoint (v Vector.! o + k, 0))
 
+overlaps :: Endpoint -> Endpoint -> Bool
+overlaps (Endpoint (x, y)) (Endpoint (u, v)) = x - y == u - v && x <= u
+
 
 -- Instances
 

From 6b696876ce540e6e0837713afb57f830337a1df9 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 9 Mar 2017 10:49:32 -0500
Subject: [PATCH 019/294] Endpoint fields are strict.

---
 src/SES/Myers.hs | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index c0136800f..44fa93454 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -21,7 +21,7 @@ data Snake = Snake { xy :: Endpoint, uv :: Endpoint }
 
 newtype EditDistance = EditDistance { unEditDistance :: Int }
 newtype Diagonal = Diagonal { unDiagonal :: Int }
-newtype Endpoint = Endpoint { unEndpoint :: (Int, Int) }
+data Endpoint = Endpoint { x :: !Int, y :: !Int }
 data Direction = Forward | Reverse
 
 
@@ -29,9 +29,9 @@ decompose :: MyersF a -> Myers a
 decompose myers = case myers of
   SES {} -> return []
 
-  MiddleSnake {} -> return (Snake (Endpoint (0, 0)) (Endpoint (0, 0)), EditDistance 0)
+  MiddleSnake {} -> return (Snake (Endpoint 0 0) (Endpoint 0 0), EditDistance 0)
 
-  FindDPath {} -> return (Endpoint (0, 0))
+  FindDPath {} -> return (Endpoint 0 0)
 
 
 -- Implementation details
@@ -47,10 +47,10 @@ getK direction diagonal = do
 at :: Vector.Vector Int -> Diagonal -> Myers Endpoint
 at v (Diagonal k) = do
   Diagonal o <- gets offset
-  return (Endpoint (v Vector.! o + k, 0))
+  return (Endpoint (v Vector.! o + k) 0)
 
 overlaps :: Endpoint -> Endpoint -> Bool
-overlaps (Endpoint (x, y)) (Endpoint (u, v)) = x - y == u - v && x <= u
+overlaps (Endpoint x y) (Endpoint u v) = x - y == u - v && x <= u
 
 
 -- Instances

From 0e7667bac56dc8b0eaee97f5482c366f43069b54 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 9 Mar 2017 12:19:58 -0500
Subject: [PATCH 020/294] Add a smart constructor for FindDPath.

---
 src/SES/Myers.hs | 6 ++++++
 1 file changed, 6 insertions(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 44fa93454..3b85389af 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -34,6 +34,12 @@ decompose myers = case myers of
   FindDPath {} -> return (Endpoint 0 0)
 
 
+-- Smart constructors
+
+findDPath :: Direction -> EditDistance -> Diagonal -> Myers Endpoint
+findDPath direction d k = M (FindDPath direction d k) `Then` return
+
+
 -- Implementation details
 
 data MyersState = MyersState { forward :: !(Vector.Vector Int), backward :: !(Vector.Vector Int), offset :: Diagonal }

From 0e76f5a5cb46e419560de5396f3e24bcfbe63509 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 9 Mar 2017 12:20:06 -0500
Subject: [PATCH 021/294] Add a section header for evaluation.

---
 src/SES/Myers.hs | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 3b85389af..574c60a2d 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -25,6 +25,8 @@ data Endpoint = Endpoint { x :: !Int, y :: !Int }
 data Direction = Forward | Reverse
 
 
+-- Evaluation
+
 decompose :: MyersF a -> Myers a
 decompose myers = case myers of
   SES {} -> return []

From e57fb3cf844f874863764c8a97fe3e47040227cc Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 9 Mar 2017 12:20:19 -0500
Subject: [PATCH 022/294] Stub in the outer loop of middle snake.

---
 src/SES/Myers.hs | 11 ++++++++++-
 1 file changed, 10 insertions(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 574c60a2d..25d3b5d07 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -31,7 +31,16 @@ decompose :: MyersF a -> Myers a
 decompose myers = case myers of
   SES {} -> return []
 
-  MiddleSnake {} -> return (Snake (Endpoint 0 0) (Endpoint 0 0), EditDistance 0)
+  MiddleSnake as bs -> do
+    for 0 ((m + n) `ceilDiv` 2) 1 $ \ _ -> return ()
+    return (Snake (Endpoint 0 0) (Endpoint 0 0), EditDistance 0)
+    where ceilDiv = (uncurry (+) .) . divMod
+          n = length as
+          m = length bs
+
+          for from to by with
+            | from >= to = with from >> for (from + by) to by with
+            | otherwise = return ()
 
   FindDPath {} -> return (Endpoint 0 0)
 

From defd4a14ed9efdc9f57962520a6b20682ab73814 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 9 Mar 2017 12:21:16 -0500
Subject: [PATCH 023/294] Stub in the inner loop of middle snake.

---
 src/SES/Myers.hs | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 25d3b5d07..c1f4a56fd 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -32,7 +32,9 @@ decompose myers = case myers of
   SES {} -> return []
 
   MiddleSnake as bs -> do
-    for 0 ((m + n) `ceilDiv` 2) 1 $ \ _ -> return ()
+    for 0 ((m + n) `ceilDiv` 2) 1 $ \ d ->
+      for (negate d) d 2 $ \ _k ->
+        return ()
     return (Snake (Endpoint 0 0) (Endpoint 0 0), EditDistance 0)
     where ceilDiv = (uncurry (+) .) . divMod
           n = length as

From faa70963683c0e72a2732e8f43b0a374b2149a1d Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 9 Mar 2017 12:24:11 -0500
Subject: [PATCH 024/294] Give a type for `for`.

---
 src/SES/Myers.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index c1f4a56fd..abc6cd3a8 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -40,6 +40,7 @@ decompose myers = case myers of
           n = length as
           m = length bs
 
+          for :: (Real a, Monad m) => a -> a -> a -> (a -> m b) -> m ()
           for from to by with
             | from >= to = with from >> for (from + by) to by with
             | otherwise = return ()

From 8907ebbf8a0346e36b2bb80829b80d40a1fc4870 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 9 Mar 2017 12:26:44 -0500
Subject: [PATCH 025/294] Stub in the computation of the furthest d-path along
 k.

---
 src/SES/Myers.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index abc6cd3a8..fab1f0211 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -33,7 +33,8 @@ decompose myers = case myers of
 
   MiddleSnake as bs -> do
     for 0 ((m + n) `ceilDiv` 2) 1 $ \ d ->
-      for (negate d) d 2 $ \ _k ->
+      for (negate d) d 2 $ \ k -> do
+        Endpoint x y <- findDPath Forward (EditDistance d) (Diagonal k)
         return ()
     return (Snake (Endpoint 0 0) (Endpoint 0 0), EditDistance 0)
     where ceilDiv = (uncurry (+) .) . divMod

From 99069c36465ce49a6129003e44dd6bfc78600b03 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 9 Mar 2017 12:28:05 -0500
Subject: [PATCH 026/294] Stub in the computation of the furthest reverse
 d-path along k.

---
 src/SES/Myers.hs | 7 ++++++-
 1 file changed, 6 insertions(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index fab1f0211..6586335c5 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -32,14 +32,19 @@ decompose myers = case myers of
   SES {} -> return []
 
   MiddleSnake as bs -> do
-    for 0 ((m + n) `ceilDiv` 2) 1 $ \ d ->
+    for 0 ((m + n) `ceilDiv` 2) 1 $ \ d -> do
       for (negate d) d 2 $ \ k -> do
         Endpoint x y <- findDPath Forward (EditDistance d) (Diagonal k)
         return ()
+
+      for (negate d) d 2 $ \ k -> do
+        Endpoint x y <- findDPath Reverse (EditDistance d) (Diagonal (k + delta))
+        return ()
     return (Snake (Endpoint 0 0) (Endpoint 0 0), EditDistance 0)
     where ceilDiv = (uncurry (+) .) . divMod
           n = length as
           m = length bs
+          delta = n - m
 
           for :: (Real a, Monad m) => a -> a -> a -> (a -> m b) -> m ()
           for from to by with

From abb71497da2d1726247fdeb90b89bb09bfd14192 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 9 Mar 2017 12:32:37 -0500
Subject: [PATCH 027/294] Add a helper to test whether an integer is odd.

---
 src/SES/Myers.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 6586335c5..2279494f3 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -78,6 +78,9 @@ at v (Diagonal k) = do
 overlaps :: Endpoint -> Endpoint -> Bool
 overlaps (Endpoint x y) (Endpoint u v) = x - y == u - v && x <= u
 
+isOdd :: Integral a => a -> Bool
+isOdd = (== 1) . (`mod` 2)
+
 
 -- Instances
 

From 6917ca8f9e4a30ea6b1eb4ecb8e5ca6d4ea9d5b2 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 9 Mar 2017 12:34:50 -0500
Subject: [PATCH 028/294] Add a helper to test whether a value is within an
 interval.

---
 src/SES/Myers.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 2279494f3..c9ff1577a 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -81,6 +81,9 @@ overlaps (Endpoint x y) (Endpoint u v) = x - y == u - v && x <= u
 isOdd :: Integral a => a -> Bool
 isOdd = (== 1) . (`mod` 2)
 
+inInterval :: Ord a => a -> (a, a) -> Bool
+inInterval k (lower, upper) = k >= lower && k <= upper
+
 
 -- Instances
 

From ca9539c9cb8140eb73054059ef059fa37819c0b4 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 9 Mar 2017 13:48:16 -0500
Subject: [PATCH 029/294] :fire: isOdd in favour of odd.

:tophat: @tclem.
---
 src/SES/Myers.hs | 3 ---
 1 file changed, 3 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index c9ff1577a..626de8183 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -78,9 +78,6 @@ at v (Diagonal k) = do
 overlaps :: Endpoint -> Endpoint -> Bool
 overlaps (Endpoint x y) (Endpoint u v) = x - y == u - v && x <= u
 
-isOdd :: Integral a => a -> Bool
-isOdd = (== 1) . (`mod` 2)
-
 inInterval :: Ord a => a -> (a, a) -> Bool
 inInterval k (lower, upper) = k >= lower && k <= upper
 

From 9ab575b264d21a82cd154f7d85bb9092fbf98433 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 9 Mar 2017 13:53:49 -0500
Subject: [PATCH 030/294] at does not return in Myers.

---
 src/SES/Myers.hs | 14 ++++++--------
 1 file changed, 6 insertions(+), 8 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 626de8183..84ab8b943 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -65,15 +65,13 @@ findDPath direction d k = M (FindDPath direction d k) `Then` return
 data MyersState = MyersState { forward :: !(Vector.Vector Int), backward :: !(Vector.Vector Int), offset :: Diagonal }
 
 getK :: Direction -> Diagonal -> Myers Endpoint
-getK direction diagonal = do
-  state <- get
-  let v = (case direction of { Forward -> forward ; Reverse -> backward }) state
-  v `at` diagonal
+getK direction (Diagonal diagonal) = do
+  MyersState forward backward (Diagonal offset) <- get
+  let v = case direction of { Forward -> forward ; Reverse -> backward }
+  return $! v `at` Diagonal (offset + diagonal)
 
-at :: Vector.Vector Int -> Diagonal -> Myers Endpoint
-at v (Diagonal k) = do
-  Diagonal o <- gets offset
-  return (Endpoint (v Vector.! o + k) 0)
+at :: Vector.Vector Int -> Diagonal -> Endpoint
+at v (Diagonal k) = Endpoint (v Vector.! k) 0
 
 overlaps :: Endpoint -> Endpoint -> Bool
 overlaps (Endpoint x y) (Endpoint u v) = x - y == u - v && x <= u

From ad217cda68d2674c05f31fdd2af5a6d50433e8f0 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 9 Mar 2017 14:01:52 -0500
Subject: [PATCH 031/294] Take an Int instead of a Diagonal.

---
 src/SES/Myers.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 84ab8b943..0c426e3ff 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -68,10 +68,10 @@ getK :: Direction -> Diagonal -> Myers Endpoint
 getK direction (Diagonal diagonal) = do
   MyersState forward backward (Diagonal offset) <- get
   let v = case direction of { Forward -> forward ; Reverse -> backward }
-  return $! v `at` Diagonal (offset + diagonal)
+  return $! v `at` (offset + diagonal)
 
-at :: Vector.Vector Int -> Diagonal -> Endpoint
-at v (Diagonal k) = Endpoint (v Vector.! k) 0
+at :: Vector.Vector Int -> Int -> Endpoint
+at v k = Endpoint (v Vector.! k) 0
 
 overlaps :: Endpoint -> Endpoint -> Bool
 overlaps (Endpoint x y) (Endpoint u v) = x - y == u - v && x <= u

From 34abcdcf0c6a90bf7161f29bb634872a4177a95d Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 9 Mar 2017 14:02:16 -0500
Subject: [PATCH 032/294] Extract maxD.

---
 src/SES/Myers.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 0c426e3ff..5ea8405e6 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -32,7 +32,7 @@ decompose myers = case myers of
   SES {} -> return []
 
   MiddleSnake as bs -> do
-    for 0 ((m + n) `ceilDiv` 2) 1 $ \ d -> do
+    for 0 maxD 1 $ \ d -> do
       for (negate d) d 2 $ \ k -> do
         Endpoint x y <- findDPath Forward (EditDistance d) (Diagonal k)
         return ()
@@ -45,6 +45,7 @@ decompose myers = case myers of
           n = length as
           m = length bs
           delta = n - m
+          maxD = (m + n) `ceilDiv` 2
 
           for :: (Real a, Monad m) => a -> a -> a -> (a -> m b) -> m ()
           for from to by with

From 31df8f05ad202dbc2b5a83595df38c45b0a67f5e Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 9 Mar 2017 14:17:33 -0500
Subject: [PATCH 033/294] Define a For effect.

---
 src/SES/Myers.hs | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 5ea8405e6..a419c6508 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -11,6 +11,10 @@ data MyersF a where
   MiddleSnake :: Vector.Vector a -> Vector.Vector a -> MyersF (Snake, EditDistance)
   FindDPath :: Direction -> EditDistance -> Diagonal -> MyersF Endpoint
 
+data For a where
+  For :: [a] -> For a
+  Continue :: For a
+
 data StepF a where
   M :: MyersF a -> StepF a
   S :: State MyersState a -> StepF a

From cb3e69c8452683c60d8fe035c3e4b2a75c990588 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 9 Mar 2017 14:17:56 -0500
Subject: [PATCH 034/294] Myers performs For steps.

---
 src/SES/Myers.hs | 7 +++++++
 1 file changed, 7 insertions(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index a419c6508..e8955896a 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -18,6 +18,7 @@ data For a where
 data StepF a where
   M :: MyersF a -> StepF a
   S :: State MyersState a -> StepF a
+  F :: For a -> StepF a
 
 type Myers = Freer StepF
 
@@ -64,6 +65,12 @@ decompose myers = case myers of
 findDPath :: Direction -> EditDistance -> Diagonal -> Myers Endpoint
 findDPath direction d k = M (FindDPath direction d k) `Then` return
 
+for :: [a] -> (a -> Myers b) -> Myers b
+for all run = F (For all) `Then` run
+
+continue :: Myers a
+continue = F Continue `Then` return
+
 
 -- Implementation details
 

From 69a1199268252d7996d28e3b1a61de75b5dedc47 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 9 Mar 2017 14:18:17 -0500
Subject: [PATCH 035/294] Middle snake uses for.

---
 src/SES/Myers.hs | 33 ++++++++++++++++++---------------
 1 file changed, 18 insertions(+), 15 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index e8955896a..000f1d87c 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -4,7 +4,7 @@ module SES.Myers where
 import Control.Monad.Free.Freer
 import Data.These
 import qualified Data.Vector as Vector
-import Prologue
+import Prologue hiding (for)
 
 data MyersF a where
   SES :: [a] -> [a] -> MyersF [These a a]
@@ -36,27 +36,30 @@ decompose :: MyersF a -> Myers a
 decompose myers = case myers of
   SES {} -> return []
 
-  MiddleSnake as bs -> do
-    for 0 maxD 1 $ \ d -> do
-      for (negate d) d 2 $ \ k -> do
-        Endpoint x y <- findDPath Forward (EditDistance d) (Diagonal k)
-        return ()
+  MiddleSnake as bs ->
+    for [0..maxD] $ \ d -> do
+      for [negate d, negate d + 2 .. d] $ \ k -> do
+        forwardEndpoint <- findDPath Forward (EditDistance d) (Diagonal k)
+        backwardV <- gets backward
+        let reverseEndpoint = backwardV `at` (maxD + k)
+        if odd delta && k `inInterval` (delta - pred d, delta + pred d) && overlaps forwardEndpoint reverseEndpoint
+          then return (Snake reverseEndpoint forwardEndpoint, EditDistance $ 2 * d - 1)
+          else continue
+
+      for [negate d, negate d + 2 .. d] $ \ k -> do
+        reverseEndpoint <- findDPath Reverse (EditDistance d) (Diagonal (k + delta))
+        forwardV <- gets forward
+        let forwardEndpoint = forwardV `at` (maxD + k + delta)
+        if even delta && k `inInterval` (negate d, d) && overlaps forwardEndpoint reverseEndpoint
+          then return (Snake reverseEndpoint forwardEndpoint, EditDistance $ 2 * d)
+          else continue
 
-      for (negate d) d 2 $ \ k -> do
-        Endpoint x y <- findDPath Reverse (EditDistance d) (Diagonal (k + delta))
-        return ()
-    return (Snake (Endpoint 0 0) (Endpoint 0 0), EditDistance 0)
     where ceilDiv = (uncurry (+) .) . divMod
           n = length as
           m = length bs
           delta = n - m
           maxD = (m + n) `ceilDiv` 2
 
-          for :: (Real a, Monad m) => a -> a -> a -> (a -> m b) -> m ()
-          for from to by with
-            | from >= to = with from >> for (from + by) to by with
-            | otherwise = return ()
-
   FindDPath {} -> return (Endpoint 0 0)
 
 

From b81959ac7201db7a538bfd6d0751af81fb585414 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 9 Mar 2017 14:21:59 -0500
Subject: [PATCH 036/294] Define our own State type.

---
 src/SES/Myers.hs | 10 +++++++---
 1 file changed, 7 insertions(+), 3 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 000f1d87c..ae64a57f0 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -4,13 +4,17 @@ module SES.Myers where
 import Control.Monad.Free.Freer
 import Data.These
 import qualified Data.Vector as Vector
-import Prologue hiding (for)
+import Prologue hiding (for, State)
 
 data MyersF a where
   SES :: [a] -> [a] -> MyersF [These a a]
   MiddleSnake :: Vector.Vector a -> Vector.Vector a -> MyersF (Snake, EditDistance)
   FindDPath :: Direction -> EditDistance -> Diagonal -> MyersF Endpoint
 
+data State s a where
+  Get :: State s s
+  Put :: s -> State s ()
+
 data For a where
   For :: [a] -> For a
   Continue :: For a
@@ -98,5 +102,5 @@ inInterval k (lower, upper) = k >= lower && k <= upper
 -- Instances
 
 instance MonadState MyersState Myers where
-  get = S get `Then` return
-  put a = S (put a) `Then` return
+  get = S Get `Then` return
+  put a = S (Put a) `Then` return

From 5a7cd8d6aba705397b105c177bed3f6e5a785f52 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 9 Mar 2017 15:34:02 -0500
Subject: [PATCH 037/294] :fire: For, compute fors as folds.

---
 src/SES/Myers.hs | 22 ++++++++--------------
 1 file changed, 8 insertions(+), 14 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index ae64a57f0..d4408b8cb 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -15,14 +15,9 @@ data State s a where
   Get :: State s s
   Put :: s -> State s ()
 
-data For a where
-  For :: [a] -> For a
-  Continue :: For a
-
 data StepF a where
   M :: MyersF a -> StepF a
   S :: State MyersState a -> StepF a
-  F :: For a -> StepF a
 
 type Myers = Freer StepF
 
@@ -40,14 +35,14 @@ decompose :: MyersF a -> Myers a
 decompose myers = case myers of
   SES {} -> return []
 
-  MiddleSnake as bs ->
+  MiddleSnake as bs -> fmap (fromMaybe (error "bleah")) $
     for [0..maxD] $ \ d -> do
       for [negate d, negate d + 2 .. d] $ \ k -> do
         forwardEndpoint <- findDPath Forward (EditDistance d) (Diagonal k)
         backwardV <- gets backward
         let reverseEndpoint = backwardV `at` (maxD + k)
         if odd delta && k `inInterval` (delta - pred d, delta + pred d) && overlaps forwardEndpoint reverseEndpoint
-          then return (Snake reverseEndpoint forwardEndpoint, EditDistance $ 2 * d - 1)
+          then return (Just (Snake reverseEndpoint forwardEndpoint, EditDistance $ 2 * d - 1))
           else continue
 
       for [negate d, negate d + 2 .. d] $ \ k -> do
@@ -55,7 +50,7 @@ decompose myers = case myers of
         forwardV <- gets forward
         let forwardEndpoint = forwardV `at` (maxD + k + delta)
         if even delta && k `inInterval` (negate d, d) && overlaps forwardEndpoint reverseEndpoint
-          then return (Snake reverseEndpoint forwardEndpoint, EditDistance $ 2 * d)
+          then return (Just (Snake reverseEndpoint forwardEndpoint, EditDistance $ 2 * d))
           else continue
 
     where ceilDiv = (uncurry (+) .) . divMod
@@ -64,6 +59,11 @@ decompose myers = case myers of
           delta = n - m
           maxD = (m + n) `ceilDiv` 2
 
+          for :: [a] -> (a -> Myers (Maybe b)) -> Myers (Maybe b)
+          for all run = foldr (\ a b -> (<|>) <$> run a <*> b) (return Nothing) all
+
+          continue = return Nothing
+
   FindDPath {} -> return (Endpoint 0 0)
 
 
@@ -72,12 +72,6 @@ decompose myers = case myers of
 findDPath :: Direction -> EditDistance -> Diagonal -> Myers Endpoint
 findDPath direction d k = M (FindDPath direction d k) `Then` return
 
-for :: [a] -> (a -> Myers b) -> Myers b
-for all run = F (For all) `Then` run
-
-continue :: Myers a
-continue = F Continue `Then` return
-
 
 -- Implementation details
 

From 532b402d34559cfb009815cc7cf8c413382e0bb8 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 9 Mar 2017 15:34:14 -0500
Subject: [PATCH 038/294] =?UTF-8?q?Step-by-step=20computation=20of=20Myers?=
 =?UTF-8?q?=E2=80=99=20algorithm.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/SES/Myers.hs | 10 ++++++++++
 1 file changed, 10 insertions(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index d4408b8cb..d8c63ff68 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -31,6 +31,16 @@ data Direction = Forward | Reverse
 
 -- Evaluation
 
+runMyersStep :: MyersState -> Myers a -> Either a (MyersState, Myers a)
+runMyersStep state step = case step of
+  Return a -> Left a
+  Then step cont -> case step of
+    M myers -> Right (state, decompose myers >>= cont)
+
+    S Get -> Right (state, cont state)
+    S (Put state') -> Right (state', cont ())
+
+
 decompose :: MyersF a -> Myers a
 decompose myers = case myers of
   SES {} -> return []

From c1ababe068ae62d1955ef59b30e786382e56bdc2 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 9 Mar 2017 15:36:04 -0500
Subject: [PATCH 039/294] Parenthesize the lambdas.

---
 src/SES/Myers.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index d8c63ff68..670af265b 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -47,21 +47,21 @@ decompose myers = case myers of
 
   MiddleSnake as bs -> fmap (fromMaybe (error "bleah")) $
     for [0..maxD] $ \ d -> do
-      for [negate d, negate d + 2 .. d] $ \ k -> do
+      for [negate d, negate d + 2 .. d] (\ k -> do
         forwardEndpoint <- findDPath Forward (EditDistance d) (Diagonal k)
         backwardV <- gets backward
         let reverseEndpoint = backwardV `at` (maxD + k)
         if odd delta && k `inInterval` (delta - pred d, delta + pred d) && overlaps forwardEndpoint reverseEndpoint
           then return (Just (Snake reverseEndpoint forwardEndpoint, EditDistance $ 2 * d - 1))
-          else continue
+          else continue)
 
-      for [negate d, negate d + 2 .. d] $ \ k -> do
+      for [negate d, negate d + 2 .. d] (\ k -> do
         reverseEndpoint <- findDPath Reverse (EditDistance d) (Diagonal (k + delta))
         forwardV <- gets forward
         let forwardEndpoint = forwardV `at` (maxD + k + delta)
         if even delta && k `inInterval` (negate d, d) && overlaps forwardEndpoint reverseEndpoint
           then return (Just (Snake reverseEndpoint forwardEndpoint, EditDistance $ 2 * d))
-          else continue
+          else continue)
 
     where ceilDiv = (uncurry (+) .) . divMod
           n = length as

From d762cb78664541402c53b9b8d9cb2b5f7ce9b2a4 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 9 Mar 2017 15:38:13 -0500
Subject: [PATCH 040/294] Take the alternation of the for loops.

---
 src/SES/Myers.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 670af265b..778769337 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -46,16 +46,16 @@ decompose myers = case myers of
   SES {} -> return []
 
   MiddleSnake as bs -> fmap (fromMaybe (error "bleah")) $
-    for [0..maxD] $ \ d -> do
-      for [negate d, negate d + 2 .. d] (\ k -> do
+    for [0..maxD] $ \ d ->
+      (<|>)
+      <$> for [negate d, negate d + 2 .. d] (\ k -> do
         forwardEndpoint <- findDPath Forward (EditDistance d) (Diagonal k)
         backwardV <- gets backward
         let reverseEndpoint = backwardV `at` (maxD + k)
         if odd delta && k `inInterval` (delta - pred d, delta + pred d) && overlaps forwardEndpoint reverseEndpoint
           then return (Just (Snake reverseEndpoint forwardEndpoint, EditDistance $ 2 * d - 1))
           else continue)
-
-      for [negate d, negate d + 2 .. d] (\ k -> do
+      <*> for [negate d, negate d + 2 .. d] (\ k -> do
         reverseEndpoint <- findDPath Reverse (EditDistance d) (Diagonal (k + delta))
         forwardV <- gets forward
         let forwardEndpoint = forwardV `at` (maxD + k + delta)

From 9a6cac6241b8605db4d3d649faee322bc5b40e6d Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 9 Mar 2017 15:42:18 -0500
Subject: [PATCH 041/294] Special-case handling of SES for empty lists on
 either side.

---
 src/SES/Myers.hs | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 778769337..7ead2b15b 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -43,6 +43,8 @@ runMyersStep state step = case step of
 
 decompose :: MyersF a -> Myers a
 decompose myers = case myers of
+  SES as [] -> return (This <$> as)
+  SES [] bs -> return (That <$> bs)
   SES {} -> return []
 
   MiddleSnake as bs -> fmap (fromMaybe (error "bleah")) $

From 5a6bd8c547b5bfa12bec5cfc0363052fde320b98 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 9 Mar 2017 15:44:51 -0500
Subject: [PATCH 042/294] Define a smart constructor for the middle snake
 algorithm.

---
 src/SES/Myers.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 7ead2b15b..c00dbbc6e 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -84,6 +84,9 @@ decompose myers = case myers of
 findDPath :: Direction -> EditDistance -> Diagonal -> Myers Endpoint
 findDPath direction d k = M (FindDPath direction d k) `Then` return
 
+middleSnake :: Vector.Vector a -> Vector.Vector a -> Myers (Snake, EditDistance)
+middleSnake as bs = M (MiddleSnake as bs) `Then` return
+
 
 -- Implementation details
 

From 8ca75fb09283871a24bfc8abf6d6fc904b5c7c81 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 10:21:38 -0500
Subject: [PATCH 043/294] SES operates on Vectors.

---
 src/SES/Myers.hs | 10 ++++++----
 1 file changed, 6 insertions(+), 4 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index c00dbbc6e..147a01508 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -7,7 +7,7 @@ import qualified Data.Vector as Vector
 import Prologue hiding (for, State)
 
 data MyersF a where
-  SES :: [a] -> [a] -> MyersF [These a a]
+  SES :: Vector.Vector a -> Vector.Vector a -> MyersF [These a a]
   MiddleSnake :: Vector.Vector a -> Vector.Vector a -> MyersF (Snake, EditDistance)
   FindDPath :: Direction -> EditDistance -> Diagonal -> MyersF Endpoint
 
@@ -43,9 +43,11 @@ runMyersStep state step = case step of
 
 decompose :: MyersF a -> Myers a
 decompose myers = case myers of
-  SES as [] -> return (This <$> as)
-  SES [] bs -> return (That <$> bs)
-  SES {} -> return []
+  SES as bs
+    | null bs -> return (This <$> toList as)
+    | null as -> return (That <$> toList bs)
+    | otherwise -> do
+      return []
 
   MiddleSnake as bs -> fmap (fromMaybe (error "bleah")) $
     for [0..maxD] $ \ d ->

From 7f932559cf9d9cf9a837e2e38ae9b50f84092279 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 10:25:25 -0500
Subject: [PATCH 044/294] Extract for & continue to the top level.

---
 src/SES/Myers.hs | 10 ++++++----
 1 file changed, 6 insertions(+), 4 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 147a01508..0f8869c0f 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -73,10 +73,6 @@ decompose myers = case myers of
           delta = n - m
           maxD = (m + n) `ceilDiv` 2
 
-          for :: [a] -> (a -> Myers (Maybe b)) -> Myers (Maybe b)
-          for all run = foldr (\ a b -> (<|>) <$> run a <*> b) (return Nothing) all
-
-          continue = return Nothing
 
   FindDPath {} -> return (Endpoint 0 0)
 
@@ -109,6 +105,12 @@ overlaps (Endpoint x y) (Endpoint u v) = x - y == u - v && x <= u
 inInterval :: Ord a => a -> (a, a) -> Bool
 inInterval k (lower, upper) = k >= lower && k <= upper
 
+for :: [a] -> (a -> Myers (Maybe b)) -> Myers (Maybe b)
+for all run = foldr (\ a b -> (<|>) <$> run a <*> b) (return Nothing) all
+
+continue :: Myers (Maybe a)
+continue = return Nothing
+
 
 -- Instances
 

From d582bcb4359319da2e363122aadf2b896ed96a89 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 10:35:23 -0500
Subject: [PATCH 045/294] :fire: getK.

---
 src/SES/Myers.hs | 6 ------
 1 file changed, 6 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 0f8869c0f..d674cda8e 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -90,12 +90,6 @@ middleSnake as bs = M (MiddleSnake as bs) `Then` return
 
 data MyersState = MyersState { forward :: !(Vector.Vector Int), backward :: !(Vector.Vector Int), offset :: Diagonal }
 
-getK :: Direction -> Diagonal -> Myers Endpoint
-getK direction (Diagonal diagonal) = do
-  MyersState forward backward (Diagonal offset) <- get
-  let v = case direction of { Forward -> forward ; Reverse -> backward }
-  return $! v `at` (offset + diagonal)
-
 at :: Vector.Vector Int -> Int -> Endpoint
 at v k = Endpoint (v Vector.! k) 0
 

From dd594dbea9539eee955c41b9b2a4e8d8b49cee9c Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 10:35:33 -0500
Subject: [PATCH 046/294] :fire: offset state.

---
 src/SES/Myers.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index d674cda8e..5de3d9baf 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -88,7 +88,7 @@ middleSnake as bs = M (MiddleSnake as bs) `Then` return
 
 -- Implementation details
 
-data MyersState = MyersState { forward :: !(Vector.Vector Int), backward :: !(Vector.Vector Int), offset :: Diagonal }
+data MyersState = MyersState { forward :: !(Vector.Vector Int), backward :: !(Vector.Vector Int) }
 
 at :: Vector.Vector Int -> Int -> Endpoint
 at v k = Endpoint (v Vector.! k) 0

From 96d3a4dcaa1be2c2ae8cd69716c470ee9e8a5cb4 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 10:37:30 -0500
Subject: [PATCH 047/294] Separate forward/reverse d-path finding.

---
 src/SES/Myers.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 5de3d9baf..d315d5534 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -74,7 +74,8 @@ decompose myers = case myers of
           maxD = (m + n) `ceilDiv` 2
 
 
-  FindDPath {} -> return (Endpoint 0 0)
+  FindDPath Forward (EditDistance d) (Diagonal k) -> return (Endpoint 0 0)
+  FindDPath Reverse (EditDistance d) (Diagonal k) -> return (Endpoint 0 0)
 
 
 -- Smart constructors

From 02ad162ccafca21322aa5d49f1f82f2899f81c15 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 10:50:01 -0500
Subject: [PATCH 048/294] Note bogosity.

---
 src/SES/Myers.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index d315d5534..902482b1e 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -92,7 +92,7 @@ middleSnake as bs = M (MiddleSnake as bs) `Then` return
 data MyersState = MyersState { forward :: !(Vector.Vector Int), backward :: !(Vector.Vector Int) }
 
 at :: Vector.Vector Int -> Int -> Endpoint
-at v k = Endpoint (v Vector.! k) 0
+at v k = Endpoint (v Vector.! k) 0 -- FIXME: Bogus.
 
 overlaps :: Endpoint -> Endpoint -> Bool
 overlaps (Endpoint x y) (Endpoint u v) = x - y == u - v && x <= u

From 486b284c502297d466e58a5d410be58d659fe133 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 10:50:13 -0500
Subject: [PATCH 049/294] Add helpers for setting the forward/backward vectors.

---
 src/SES/Myers.hs | 6 ++++++
 1 file changed, 6 insertions(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 902482b1e..23633eddd 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -91,6 +91,12 @@ middleSnake as bs = M (MiddleSnake as bs) `Then` return
 
 data MyersState = MyersState { forward :: !(Vector.Vector Int), backward :: !(Vector.Vector Int) }
 
+setForward :: Vector.Vector Int -> Myers ()
+setForward v = modify (\ s -> s { forward = v })
+
+setBackward :: Vector.Vector Int -> Myers ()
+setBackward v = modify (\ s -> s { backward = v })
+
 at :: Vector.Vector Int -> Int -> Endpoint
 at v k = Endpoint (v Vector.! k) 0 -- FIXME: Bogus.
 

From bcb2f374e3d40baa0d5caa733f28e667ad9056c5 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 10:50:54 -0500
Subject: [PATCH 050/294] Fix bogosity.

---
 src/SES/Myers.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 23633eddd..16a8aebd5 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -98,7 +98,7 @@ setBackward :: Vector.Vector Int -> Myers ()
 setBackward v = modify (\ s -> s { backward = v })
 
 at :: Vector.Vector Int -> Int -> Endpoint
-at v k = Endpoint (v Vector.! k) 0 -- FIXME: Bogus.
+at v k = let x = v Vector.! k in Endpoint x (x - k)
 
 overlaps :: Endpoint -> Endpoint -> Bool
 overlaps (Endpoint x y) (Endpoint u v) = x - y == u - v && x <= u

From a7e4ed80157e119331c37a4de5fdda1f9a727cde Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 10:56:32 -0500
Subject: [PATCH 051/294] Extract ceilDiv.

---
 src/SES/Myers.hs | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 16a8aebd5..b93602d62 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -66,9 +66,7 @@ decompose myers = case myers of
         if even delta && k `inInterval` (negate d, d) && overlaps forwardEndpoint reverseEndpoint
           then return (Just (Snake reverseEndpoint forwardEndpoint, EditDistance $ 2 * d))
           else continue)
-
-    where ceilDiv = (uncurry (+) .) . divMod
-          n = length as
+    where n = length as
           m = length bs
           delta = n - m
           maxD = (m + n) `ceilDiv` 2
@@ -112,6 +110,9 @@ for all run = foldr (\ a b -> (<|>) <$> run a <*> b) (return Nothing) all
 continue :: Myers (Maybe a)
 continue = return Nothing
 
+ceilDiv :: Integral a => a -> a -> a
+ceilDiv = (uncurry (+) .) . divMod
+
 
 -- Instances
 

From bf7ea522486ab7d8bf88d05289f4e8d91991f459 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 11:02:08 -0500
Subject: [PATCH 052/294] Add the input vectors to findDPath.

---
 src/SES/Myers.hs | 14 +++++++-------
 1 file changed, 7 insertions(+), 7 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index b93602d62..c69893ab9 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -9,7 +9,7 @@ import Prologue hiding (for, State)
 data MyersF a where
   SES :: Vector.Vector a -> Vector.Vector a -> MyersF [These a a]
   MiddleSnake :: Vector.Vector a -> Vector.Vector a -> MyersF (Snake, EditDistance)
-  FindDPath :: Direction -> EditDistance -> Diagonal -> MyersF Endpoint
+  FindDPath :: Vector.Vector a -> Vector.Vector a -> Direction -> EditDistance -> Diagonal -> MyersF Endpoint
 
 data State s a where
   Get :: State s s
@@ -53,14 +53,14 @@ decompose myers = case myers of
     for [0..maxD] $ \ d ->
       (<|>)
       <$> for [negate d, negate d + 2 .. d] (\ k -> do
-        forwardEndpoint <- findDPath Forward (EditDistance d) (Diagonal k)
+        forwardEndpoint <- findDPath as bs Forward (EditDistance d) (Diagonal k)
         backwardV <- gets backward
         let reverseEndpoint = backwardV `at` (maxD + k)
         if odd delta && k `inInterval` (delta - pred d, delta + pred d) && overlaps forwardEndpoint reverseEndpoint
           then return (Just (Snake reverseEndpoint forwardEndpoint, EditDistance $ 2 * d - 1))
           else continue)
       <*> for [negate d, negate d + 2 .. d] (\ k -> do
-        reverseEndpoint <- findDPath Reverse (EditDistance d) (Diagonal (k + delta))
+        reverseEndpoint <- findDPath as bs Reverse (EditDistance d) (Diagonal (k + delta))
         forwardV <- gets forward
         let forwardEndpoint = forwardV `at` (maxD + k + delta)
         if even delta && k `inInterval` (negate d, d) && overlaps forwardEndpoint reverseEndpoint
@@ -72,14 +72,14 @@ decompose myers = case myers of
           maxD = (m + n) `ceilDiv` 2
 
 
-  FindDPath Forward (EditDistance d) (Diagonal k) -> return (Endpoint 0 0)
-  FindDPath Reverse (EditDistance d) (Diagonal k) -> return (Endpoint 0 0)
+  FindDPath as bs Forward (EditDistance d) (Diagonal k) -> return (Endpoint 0 0)
+  FindDPath as bs Reverse (EditDistance d) (Diagonal k) -> return (Endpoint 0 0)
 
 
 -- Smart constructors
 
-findDPath :: Direction -> EditDistance -> Diagonal -> Myers Endpoint
-findDPath direction d k = M (FindDPath direction d k) `Then` return
+findDPath :: Vector.Vector a -> Vector.Vector a -> Direction -> EditDistance -> Diagonal -> Myers Endpoint
+findDPath as bs direction d k = M (FindDPath as bs direction d k) `Then` return
 
 middleSnake :: Vector.Vector a -> Vector.Vector a -> Myers (Snake, EditDistance)
 middleSnake as bs = M (MiddleSnake as bs) `Then` return

From 48f27267b48c59cd1ba082a775c145c8c067b277 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 11:03:21 -0500
Subject: [PATCH 053/294] Add a type representing an edit graph.

---
 src/SES/Myers.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index c69893ab9..be006f45a 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -21,6 +21,7 @@ data StepF a where
 
 type Myers = Freer StepF
 
+data EditGraph a = EditGraph { as :: !(Vector.Vector a), bs :: !(Vector.Vector a), eq :: !(a -> a -> Bool) }
 data Snake = Snake { xy :: Endpoint, uv :: Endpoint }
 
 newtype EditDistance = EditDistance { unEditDistance :: Int }

From fb7bdef52371a374ea7e4f0c54ec27cf7d7ebf68 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 11:08:16 -0500
Subject: [PATCH 054/294] Pass edit graphs around.

---
 src/SES/Myers.hs | 50 ++++++++++++++++++++++++++++++++----------------
 1 file changed, 33 insertions(+), 17 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index be006f45a..a2a637ad1 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -7,9 +7,9 @@ import qualified Data.Vector as Vector
 import Prologue hiding (for, State)
 
 data MyersF a where
-  SES :: Vector.Vector a -> Vector.Vector a -> MyersF [These a a]
-  MiddleSnake :: Vector.Vector a -> Vector.Vector a -> MyersF (Snake, EditDistance)
-  FindDPath :: Vector.Vector a -> Vector.Vector a -> Direction -> EditDistance -> Diagonal -> MyersF Endpoint
+  SES :: EditGraph a -> MyersF [These a a]
+  MiddleSnake :: EditGraph a -> MyersF (Snake, EditDistance)
+  FindDPath :: EditGraph a -> Direction -> EditDistance -> Diagonal -> MyersF Endpoint
 
 data State s a where
   Get :: State s s
@@ -44,46 +44,62 @@ runMyersStep state step = case step of
 
 decompose :: MyersF a -> Myers a
 decompose myers = case myers of
-  SES as bs
-    | null bs -> return (This <$> toList as)
-    | null as -> return (That <$> toList bs)
+  SES graph
+    | null (bs graph) -> return (This <$> toList (as graph))
+    | null (as graph) -> return (That <$> toList (bs graph))
     | otherwise -> do
       return []
 
-  MiddleSnake as bs -> fmap (fromMaybe (error "bleah")) $
+  MiddleSnake graph -> fmap (fromMaybe (error "bleah")) $
     for [0..maxD] $ \ d ->
       (<|>)
       <$> for [negate d, negate d + 2 .. d] (\ k -> do
-        forwardEndpoint <- findDPath as bs Forward (EditDistance d) (Diagonal k)
+        forwardEndpoint <- findDPath graph Forward (EditDistance d) (Diagonal k)
         backwardV <- gets backward
         let reverseEndpoint = backwardV `at` (maxD + k)
         if odd delta && k `inInterval` (delta - pred d, delta + pred d) && overlaps forwardEndpoint reverseEndpoint
           then return (Just (Snake reverseEndpoint forwardEndpoint, EditDistance $ 2 * d - 1))
           else continue)
       <*> for [negate d, negate d + 2 .. d] (\ k -> do
-        reverseEndpoint <- findDPath as bs Reverse (EditDistance d) (Diagonal (k + delta))
+        reverseEndpoint <- findDPath graph Reverse (EditDistance d) (Diagonal (k + delta))
         forwardV <- gets forward
         let forwardEndpoint = forwardV `at` (maxD + k + delta)
         if even delta && k `inInterval` (negate d, d) && overlaps forwardEndpoint reverseEndpoint
           then return (Just (Snake reverseEndpoint forwardEndpoint, EditDistance $ 2 * d))
           else continue)
-    where n = length as
-          m = length bs
+    where n = length (as graph)
+          m = length (bs graph)
           delta = n - m
           maxD = (m + n) `ceilDiv` 2
 
+  FindDPath (EditGraph as bs eq) Forward (EditDistance d) (Diagonal k) -> do
+    v <- gets forward
+    let prev = v `at` (maxD + pred k)
+    let next = v `at` (maxD + succ k)
+    let xy = if k == negate d || k /= d && x prev < x next
+          then next
+          else let x' = succ (x prev) in Endpoint x' (x' - k)
+    let Endpoint x' y' = slide xy
+    setForward (v Vector.// [(maxD + k, x')])
+    return (Endpoint x' y')
+    where n = length as
+          m = length bs
+          maxD = (m + n) `ceilDiv` 2
 
-  FindDPath as bs Forward (EditDistance d) (Diagonal k) -> return (Endpoint 0 0)
-  FindDPath as bs Reverse (EditDistance d) (Diagonal k) -> return (Endpoint 0 0)
+          slide (Endpoint x y)
+            | (as Vector.! x) `eq` (bs Vector.! y) = slide (Endpoint (succ x) (succ y))
+            | otherwise = Endpoint x y
+
+  FindDPath (EditGraph as bs eq) Reverse (EditDistance d) (Diagonal k) -> return (Endpoint 0 0)
 
 
 -- Smart constructors
 
-findDPath :: Vector.Vector a -> Vector.Vector a -> Direction -> EditDistance -> Diagonal -> Myers Endpoint
-findDPath as bs direction d k = M (FindDPath as bs direction d k) `Then` return
+findDPath :: EditGraph a -> Direction -> EditDistance -> Diagonal -> Myers Endpoint
+findDPath graph direction d k = M (FindDPath graph direction d k) `Then` return
 
-middleSnake :: Vector.Vector a -> Vector.Vector a -> Myers (Snake, EditDistance)
-middleSnake as bs = M (MiddleSnake as bs) `Then` return
+middleSnake :: EditGraph a -> Myers (Snake, EditDistance)
+middleSnake graph = M (MiddleSnake graph) `Then` return
 
 
 -- Implementation details

From 3885f2df11b74547dc196af4d87508c6a889070a Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 11:44:35 -0500
Subject: [PATCH 055/294] Stub in an LCS command.

---
 src/SES/Myers.hs | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index a2a637ad1..6e9969a9e 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -8,6 +8,7 @@ import Prologue hiding (for, State)
 
 data MyersF a where
   SES :: EditGraph a -> MyersF [These a a]
+  LCS :: EditGraph a -> MyersF [a]
   MiddleSnake :: EditGraph a -> MyersF (Snake, EditDistance)
   FindDPath :: EditGraph a -> Direction -> EditDistance -> Diagonal -> MyersF Endpoint
 
@@ -44,6 +45,10 @@ runMyersStep state step = case step of
 
 decompose :: MyersF a -> Myers a
 decompose myers = case myers of
+  LCS graph
+    | null (as graph) || null (bs graph) -> return []
+    | otherwise -> return []
+
   SES graph
     | null (bs graph) -> return (This <$> toList (as graph))
     | null (as graph) -> return (That <$> toList (bs graph))

From d64ecd672d58bde387db2b55d2e5da3030f59aef Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 11:45:32 -0500
Subject: [PATCH 056/294] Add a smart constructor for LCS.

---
 src/SES/Myers.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 6e9969a9e..fd8b9ea25 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -100,6 +100,9 @@ decompose myers = case myers of
 
 -- Smart constructors
 
+lcs :: EditGraph a -> Myers [a]
+lcs graph = M (LCS graph) `Then` return
+
 findDPath :: EditGraph a -> Direction -> EditDistance -> Diagonal -> Myers Endpoint
 findDPath graph direction d k = M (FindDPath graph direction d k) `Then` return
 

From ec33d16355494552dc7f7223cff2c132b7fb72f2 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 11:51:03 -0500
Subject: [PATCH 057/294] Pass the relation around separately from the graph.

---
 src/SES/Myers.hs | 36 ++++++++++++++++++------------------
 1 file changed, 18 insertions(+), 18 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index fd8b9ea25..70508f4b5 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -7,10 +7,10 @@ import qualified Data.Vector as Vector
 import Prologue hiding (for, State)
 
 data MyersF a where
-  SES :: EditGraph a -> MyersF [These a a]
-  LCS :: EditGraph a -> MyersF [a]
-  MiddleSnake :: EditGraph a -> MyersF (Snake, EditDistance)
-  FindDPath :: EditGraph a -> Direction -> EditDistance -> Diagonal -> MyersF Endpoint
+  SES :: (a -> a -> Bool) -> EditGraph a -> MyersF [These a a]
+  LCS :: (a -> a -> Bool) -> EditGraph a -> MyersF [a]
+  MiddleSnake :: (a -> a -> Bool) -> EditGraph a -> MyersF (Snake, EditDistance)
+  FindDPath :: (a -> a -> Bool) -> EditGraph a -> Direction -> EditDistance -> Diagonal -> MyersF Endpoint
 
 data State s a where
   Get :: State s s
@@ -22,7 +22,7 @@ data StepF a where
 
 type Myers = Freer StepF
 
-data EditGraph a = EditGraph { as :: !(Vector.Vector a), bs :: !(Vector.Vector a), eq :: !(a -> a -> Bool) }
+data EditGraph a = EditGraph { as :: !(Vector.Vector a), bs :: !(Vector.Vector a) }
 data Snake = Snake { xy :: Endpoint, uv :: Endpoint }
 
 newtype EditDistance = EditDistance { unEditDistance :: Int }
@@ -45,28 +45,28 @@ runMyersStep state step = case step of
 
 decompose :: MyersF a -> Myers a
 decompose myers = case myers of
-  LCS graph
+  LCS eq graph
     | null (as graph) || null (bs graph) -> return []
     | otherwise -> return []
 
-  SES graph
+  SES eq graph
     | null (bs graph) -> return (This <$> toList (as graph))
     | null (as graph) -> return (That <$> toList (bs graph))
     | otherwise -> do
       return []
 
-  MiddleSnake graph -> fmap (fromMaybe (error "bleah")) $
+  MiddleSnake eq graph -> fmap (fromMaybe (error "bleah")) $
     for [0..maxD] $ \ d ->
       (<|>)
       <$> for [negate d, negate d + 2 .. d] (\ k -> do
-        forwardEndpoint <- findDPath graph Forward (EditDistance d) (Diagonal k)
+        forwardEndpoint <- findDPath eq graph Forward (EditDistance d) (Diagonal k)
         backwardV <- gets backward
         let reverseEndpoint = backwardV `at` (maxD + k)
         if odd delta && k `inInterval` (delta - pred d, delta + pred d) && overlaps forwardEndpoint reverseEndpoint
           then return (Just (Snake reverseEndpoint forwardEndpoint, EditDistance $ 2 * d - 1))
           else continue)
       <*> for [negate d, negate d + 2 .. d] (\ k -> do
-        reverseEndpoint <- findDPath graph Reverse (EditDistance d) (Diagonal (k + delta))
+        reverseEndpoint <- findDPath eq graph Reverse (EditDistance d) (Diagonal (k + delta))
         forwardV <- gets forward
         let forwardEndpoint = forwardV `at` (maxD + k + delta)
         if even delta && k `inInterval` (negate d, d) && overlaps forwardEndpoint reverseEndpoint
@@ -77,7 +77,7 @@ decompose myers = case myers of
           delta = n - m
           maxD = (m + n) `ceilDiv` 2
 
-  FindDPath (EditGraph as bs eq) Forward (EditDistance d) (Diagonal k) -> do
+  FindDPath eq (EditGraph as bs) Forward (EditDistance d) (Diagonal k) -> do
     v <- gets forward
     let prev = v `at` (maxD + pred k)
     let next = v `at` (maxD + succ k)
@@ -95,19 +95,19 @@ decompose myers = case myers of
             | (as Vector.! x) `eq` (bs Vector.! y) = slide (Endpoint (succ x) (succ y))
             | otherwise = Endpoint x y
 
-  FindDPath (EditGraph as bs eq) Reverse (EditDistance d) (Diagonal k) -> return (Endpoint 0 0)
+  FindDPath eq (EditGraph as bs) Reverse (EditDistance d) (Diagonal k) -> return (Endpoint 0 0)
 
 
 -- Smart constructors
 
-lcs :: EditGraph a -> Myers [a]
-lcs graph = M (LCS graph) `Then` return
+lcs :: (a -> a -> Bool) -> EditGraph a -> Myers [a]
+lcs eq graph = M (LCS eq graph) `Then` return
 
-findDPath :: EditGraph a -> Direction -> EditDistance -> Diagonal -> Myers Endpoint
-findDPath graph direction d k = M (FindDPath graph direction d k) `Then` return
+findDPath :: (a -> a -> Bool) -> EditGraph a -> Direction -> EditDistance -> Diagonal -> Myers Endpoint
+findDPath eq graph direction d k = M (FindDPath eq graph direction d k) `Then` return
 
-middleSnake :: EditGraph a -> Myers (Snake, EditDistance)
-middleSnake graph = M (MiddleSnake graph) `Then` return
+middleSnake :: (a -> a -> Bool) -> EditGraph a -> Myers (Snake, EditDistance)
+middleSnake eq graph = M (MiddleSnake eq graph) `Then` return
 
 
 -- Implementation details

From 0e2f57821efd4e49d7019d5aae95f29625c87a3e Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 11:55:46 -0500
Subject: [PATCH 058/294] Add a function dividing a graph in two.

---
 src/SES/Myers.hs | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 70508f4b5..275736098 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -138,6 +138,11 @@ continue = return Nothing
 ceilDiv :: Integral a => a -> a -> a
 ceilDiv = (uncurry (+) .) . divMod
 
+divideGraph :: EditGraph a -> Endpoint -> (EditGraph a, EditGraph a)
+divideGraph (EditGraph as bs) (Endpoint x y) =
+  ( EditGraph (Vector.slice 0  x              as) (Vector.slice 0  y              bs)
+  , EditGraph (Vector.slice x (length as - x) as) (Vector.slice y (length bs - y) bs) )
+
 
 -- Instances
 

From 6a6759949e7ee295b0cf3ddda2f4377d5c1f2c3f Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 12:01:08 -0500
Subject: [PATCH 059/294] Stub in the recursive construction of the LCS.

---
 src/SES/Myers.hs | 13 ++++++++++++-
 1 file changed, 12 insertions(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 275736098..9749faf07 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -47,7 +47,18 @@ decompose :: MyersF a -> Myers a
 decompose myers = case myers of
   LCS eq graph
     | null (as graph) || null (bs graph) -> return []
-    | otherwise -> return []
+    | otherwise -> do
+      (Snake xy uv, EditDistance d) <- middleSnake eq graph
+      if d > 1 then do
+        let (before, _) = divideGraph graph xy
+        let (_, after) = divideGraph graph uv
+        before' <- lcs eq before
+        after' <- lcs eq after
+        return $! before' <> toList [] <> after'
+      else if length (bs graph) > length (as graph) then
+        return []
+      else
+        return []
 
   SES eq graph
     | null (bs graph) -> return (This <$> toList (as graph))

From 34b2f0271bb2186324adc7ec273fc44d9b36842b Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 12:02:45 -0500
Subject: [PATCH 060/294] Get the middle elements in LCS.

---
 src/SES/Myers.hs | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 9749faf07..48ceef13f 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -51,10 +51,11 @@ decompose myers = case myers of
       (Snake xy uv, EditDistance d) <- middleSnake eq graph
       if d > 1 then do
         let (before, _) = divideGraph graph xy
-        let (_, after) = divideGraph graph uv
+        let (start, after) = divideGraph graph uv
+        let (mid, _) = divideGraph start xy
         before' <- lcs eq before
         after' <- lcs eq after
-        return $! before' <> toList [] <> after'
+        return $! before' <> toList (as mid) <> after'
       else if length (bs graph) > length (as graph) then
         return []
       else

From 607e6cd63eb1e222e9a02d86c929e4c5123e6be3 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 12:04:09 -0500
Subject: [PATCH 061/294] Return the correct subsequences at the ends.

---
 src/SES/Myers.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 48ceef13f..30941a4f2 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -57,9 +57,9 @@ decompose myers = case myers of
         after' <- lcs eq after
         return $! before' <> toList (as mid) <> after'
       else if length (bs graph) > length (as graph) then
-        return []
+        return (toList (as graph))
       else
-        return []
+        return (toList (bs graph))
 
   SES eq graph
     | null (bs graph) -> return (This <$> toList (as graph))

From 737ab8924d04f5e21934ba19075a9a8e0c7732c6 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 12:52:09 -0500
Subject: [PATCH 062/294] Add a convenience to run LCS in its entirety.

---
 src/SES/Myers.hs | 6 ++++++
 1 file changed, 6 insertions(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 30941a4f2..aa65c2e7a 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -33,6 +33,12 @@ data Direction = Forward | Reverse
 
 -- Evaluation
 
+runMyers :: Myers a -> a
+runMyers = runAll $ MyersState (Vector.replicate 100 0) (Vector.replicate 100 0)
+  where runAll state step = case runMyersStep state step of
+          Left a -> a
+          Right next -> uncurry runAll next
+
 runMyersStep :: MyersState -> Myers a -> Either a (MyersState, Myers a)
 runMyersStep state step = case step of
   Return a -> Left a

From b373e4c63e0088d26def8abb0ca18566df0f32d9 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 13:02:12 -0500
Subject: [PATCH 063/294] Add the element type parameter to Myers.

---
 src/SES/Myers.hs | 40 ++++++++++++++++++++--------------------
 1 file changed, 20 insertions(+), 20 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index aa65c2e7a..542c95dd4 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -6,21 +6,21 @@ import Data.These
 import qualified Data.Vector as Vector
 import Prologue hiding (for, State)
 
-data MyersF a where
-  SES :: (a -> a -> Bool) -> EditGraph a -> MyersF [These a a]
-  LCS :: (a -> a -> Bool) -> EditGraph a -> MyersF [a]
-  MiddleSnake :: (a -> a -> Bool) -> EditGraph a -> MyersF (Snake, EditDistance)
-  FindDPath :: (a -> a -> Bool) -> EditGraph a -> Direction -> EditDistance -> Diagonal -> MyersF Endpoint
+data MyersF element result where
+  SES :: (a -> a -> Bool) -> EditGraph a -> MyersF a [These a a]
+  LCS :: (a -> a -> Bool) -> EditGraph a -> MyersF a [a]
+  MiddleSnake :: (a -> a -> Bool) -> EditGraph a -> MyersF a (Snake, EditDistance)
+  FindDPath :: (a -> a -> Bool) -> EditGraph a -> Direction -> EditDistance -> Diagonal -> MyersF a Endpoint
 
 data State s a where
   Get :: State s s
   Put :: s -> State s ()
 
-data StepF a where
-  M :: MyersF a -> StepF a
-  S :: State MyersState a -> StepF a
+data StepF element result where
+  M :: MyersF a b -> StepF a b
+  S :: State MyersState b -> StepF a b
 
-type Myers = Freer StepF
+type Myers a = Freer (StepF a)
 
 data EditGraph a = EditGraph { as :: !(Vector.Vector a), bs :: !(Vector.Vector a) }
 data Snake = Snake { xy :: Endpoint, uv :: Endpoint }
@@ -33,13 +33,13 @@ data Direction = Forward | Reverse
 
 -- Evaluation
 
-runMyers :: Myers a -> a
+runMyers :: Myers a b -> b
 runMyers = runAll $ MyersState (Vector.replicate 100 0) (Vector.replicate 100 0)
   where runAll state step = case runMyersStep state step of
           Left a -> a
           Right next -> uncurry runAll next
 
-runMyersStep :: MyersState -> Myers a -> Either a (MyersState, Myers a)
+runMyersStep :: MyersState -> Myers a b -> Either b (MyersState, Myers a b)
 runMyersStep state step = case step of
   Return a -> Left a
   Then step cont -> case step of
@@ -49,7 +49,7 @@ runMyersStep state step = case step of
     S (Put state') -> Right (state', cont ())
 
 
-decompose :: MyersF a -> Myers a
+decompose :: MyersF a b -> Myers a b
 decompose myers = case myers of
   LCS eq graph
     | null (as graph) || null (bs graph) -> return []
@@ -118,13 +118,13 @@ decompose myers = case myers of
 
 -- Smart constructors
 
-lcs :: (a -> a -> Bool) -> EditGraph a -> Myers [a]
+lcs :: (a -> a -> Bool) -> EditGraph a -> Myers a [a]
 lcs eq graph = M (LCS eq graph) `Then` return
 
-findDPath :: (a -> a -> Bool) -> EditGraph a -> Direction -> EditDistance -> Diagonal -> Myers Endpoint
+findDPath :: (a -> a -> Bool) -> EditGraph a -> Direction -> EditDistance -> Diagonal -> Myers a Endpoint
 findDPath eq graph direction d k = M (FindDPath eq graph direction d k) `Then` return
 
-middleSnake :: (a -> a -> Bool) -> EditGraph a -> Myers (Snake, EditDistance)
+middleSnake :: (a -> a -> Bool) -> EditGraph a -> Myers a (Snake, EditDistance)
 middleSnake eq graph = M (MiddleSnake eq graph) `Then` return
 
 
@@ -132,10 +132,10 @@ middleSnake eq graph = M (MiddleSnake eq graph) `Then` return
 
 data MyersState = MyersState { forward :: !(Vector.Vector Int), backward :: !(Vector.Vector Int) }
 
-setForward :: Vector.Vector Int -> Myers ()
+setForward :: Vector.Vector Int -> Myers a ()
 setForward v = modify (\ s -> s { forward = v })
 
-setBackward :: Vector.Vector Int -> Myers ()
+setBackward :: Vector.Vector Int -> Myers a ()
 setBackward v = modify (\ s -> s { backward = v })
 
 at :: Vector.Vector Int -> Int -> Endpoint
@@ -147,10 +147,10 @@ overlaps (Endpoint x y) (Endpoint u v) = x - y == u - v && x <= u
 inInterval :: Ord a => a -> (a, a) -> Bool
 inInterval k (lower, upper) = k >= lower && k <= upper
 
-for :: [a] -> (a -> Myers (Maybe b)) -> Myers (Maybe b)
+for :: [a] -> (a -> Myers c (Maybe b)) -> Myers c (Maybe b)
 for all run = foldr (\ a b -> (<|>) <$> run a <*> b) (return Nothing) all
 
-continue :: Myers (Maybe a)
+continue :: Myers b (Maybe a)
 continue = return Nothing
 
 ceilDiv :: Integral a => a -> a -> a
@@ -164,6 +164,6 @@ divideGraph (EditGraph as bs) (Endpoint x y) =
 
 -- Instances
 
-instance MonadState MyersState Myers where
+instance MonadState MyersState (Myers a) where
   get = S Get `Then` return
   put a = S (Put a) `Then` return

From cd61576be97c3c68ed2d9af05874c8b8158aa1ab Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 13:03:09 -0500
Subject: [PATCH 064/294] Add constructors to retrieve the edit graph &
 equality function.

---
 src/SES/Myers.hs | 15 ++++++++++-----
 1 file changed, 10 insertions(+), 5 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 542c95dd4..f35c56a78 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -19,6 +19,8 @@ data State s a where
 data StepF element result where
   M :: MyersF a b -> StepF a b
   S :: State MyersState b -> StepF a b
+  GetGraph :: StepF a (EditGraph a)
+  GetEq :: StepF a (a -> a -> Bool)
 
 type Myers a = Freer (StepF a)
 
@@ -33,14 +35,14 @@ data Direction = Forward | Reverse
 
 -- Evaluation
 
-runMyers :: Myers a b -> b
-runMyers = runAll $ MyersState (Vector.replicate 100 0) (Vector.replicate 100 0)
-  where runAll state step = case runMyersStep state step of
+runMyers :: (a -> a -> Bool) -> EditGraph a -> Myers a b -> b
+runMyers eq graph = runAll $ MyersState (Vector.replicate 100 0) (Vector.replicate 100 0)
+  where runAll state step = case runMyersStep eq graph state step of
           Left a -> a
           Right next -> uncurry runAll next
 
-runMyersStep :: MyersState -> Myers a b -> Either b (MyersState, Myers a b)
-runMyersStep state step = case step of
+runMyersStep :: (a -> a -> Bool) -> EditGraph a -> MyersState -> Myers a b -> Either b (MyersState, Myers a b)
+runMyersStep eq graph state step = case step of
   Return a -> Left a
   Then step cont -> case step of
     M myers -> Right (state, decompose myers >>= cont)
@@ -48,6 +50,9 @@ runMyersStep state step = case step of
     S Get -> Right (state, cont state)
     S (Put state') -> Right (state', cont ())
 
+    GetGraph -> Right (state, cont graph)
+    GetEq -> Right (state, cont eq)
+
 
 decompose :: MyersF a b -> Myers a b
 decompose myers = case myers of

From f00987fe89f6ceaabe990a937f2c2c0e38dae96f Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 13:04:08 -0500
Subject: [PATCH 065/294] Add smart constructors for the reader parameters.

---
 src/SES/Myers.hs | 6 ++++++
 1 file changed, 6 insertions(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index f35c56a78..7448d996b 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -132,6 +132,12 @@ findDPath eq graph direction d k = M (FindDPath eq graph direction d k) `Then` r
 middleSnake :: (a -> a -> Bool) -> EditGraph a -> Myers a (Snake, EditDistance)
 middleSnake eq graph = M (MiddleSnake eq graph) `Then` return
 
+getEditGraph :: Myers a (EditGraph a)
+getEditGraph = GetGraph `Then` return
+
+getEq :: Myers a (a -> a -> Bool)
+getEq = GetEq `Then` return
+
 
 -- Implementation details
 

From 6e2f098029d1c3f0f7137e87b023eb9f9051f456 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 13:07:11 -0500
Subject: [PATCH 066/294] =?UTF-8?q?Don=E2=80=99t=20pass=20eq=20around.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/SES/Myers.hs | 47 ++++++++++++++++++++++++-----------------------
 1 file changed, 24 insertions(+), 23 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 7448d996b..7c9ee91f2 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -7,10 +7,10 @@ import qualified Data.Vector as Vector
 import Prologue hiding (for, State)
 
 data MyersF element result where
-  SES :: (a -> a -> Bool) -> EditGraph a -> MyersF a [These a a]
-  LCS :: (a -> a -> Bool) -> EditGraph a -> MyersF a [a]
-  MiddleSnake :: (a -> a -> Bool) -> EditGraph a -> MyersF a (Snake, EditDistance)
-  FindDPath :: (a -> a -> Bool) -> EditGraph a -> Direction -> EditDistance -> Diagonal -> MyersF a Endpoint
+  SES :: EditGraph a -> MyersF a [These a a]
+  LCS :: EditGraph a -> MyersF a [a]
+  MiddleSnake :: EditGraph a -> MyersF a (Snake, EditDistance)
+  FindDPath :: EditGraph a -> Direction -> EditDistance -> Diagonal -> MyersF a Endpoint
 
 data State s a where
   Get :: State s s
@@ -56,40 +56,40 @@ runMyersStep eq graph state step = case step of
 
 decompose :: MyersF a b -> Myers a b
 decompose myers = case myers of
-  LCS eq graph
+  LCS graph
     | null (as graph) || null (bs graph) -> return []
     | otherwise -> do
-      (Snake xy uv, EditDistance d) <- middleSnake eq graph
+      (Snake xy uv, EditDistance d) <- middleSnake graph
       if d > 1 then do
         let (before, _) = divideGraph graph xy
         let (start, after) = divideGraph graph uv
         let (mid, _) = divideGraph start xy
-        before' <- lcs eq before
-        after' <- lcs eq after
+        before' <- lcs before
+        after' <- lcs after
         return $! before' <> toList (as mid) <> after'
       else if length (bs graph) > length (as graph) then
         return (toList (as graph))
       else
         return (toList (bs graph))
 
-  SES eq graph
+  SES graph
     | null (bs graph) -> return (This <$> toList (as graph))
     | null (as graph) -> return (That <$> toList (bs graph))
     | otherwise -> do
       return []
 
-  MiddleSnake eq graph -> fmap (fromMaybe (error "bleah")) $
+  MiddleSnake graph -> fmap (fromMaybe (error "bleah")) $
     for [0..maxD] $ \ d ->
       (<|>)
       <$> for [negate d, negate d + 2 .. d] (\ k -> do
-        forwardEndpoint <- findDPath eq graph Forward (EditDistance d) (Diagonal k)
+        forwardEndpoint <- findDPath graph Forward (EditDistance d) (Diagonal k)
         backwardV <- gets backward
         let reverseEndpoint = backwardV `at` (maxD + k)
         if odd delta && k `inInterval` (delta - pred d, delta + pred d) && overlaps forwardEndpoint reverseEndpoint
           then return (Just (Snake reverseEndpoint forwardEndpoint, EditDistance $ 2 * d - 1))
           else continue)
       <*> for [negate d, negate d + 2 .. d] (\ k -> do
-        reverseEndpoint <- findDPath eq graph Reverse (EditDistance d) (Diagonal (k + delta))
+        reverseEndpoint <- findDPath graph Reverse (EditDistance d) (Diagonal (k + delta))
         forwardV <- gets forward
         let forwardEndpoint = forwardV `at` (maxD + k + delta)
         if even delta && k `inInterval` (negate d, d) && overlaps forwardEndpoint reverseEndpoint
@@ -100,37 +100,38 @@ decompose myers = case myers of
           delta = n - m
           maxD = (m + n) `ceilDiv` 2
 
-  FindDPath eq (EditGraph as bs) Forward (EditDistance d) (Diagonal k) -> do
+  FindDPath (EditGraph as bs) Forward (EditDistance d) (Diagonal k) -> do
     v <- gets forward
+    eq <- getEq
     let prev = v `at` (maxD + pred k)
     let next = v `at` (maxD + succ k)
     let xy = if k == negate d || k /= d && x prev < x next
           then next
           else let x' = succ (x prev) in Endpoint x' (x' - k)
-    let Endpoint x' y' = slide xy
+    let Endpoint x' y' = slide eq xy
     setForward (v Vector.// [(maxD + k, x')])
     return (Endpoint x' y')
     where n = length as
           m = length bs
           maxD = (m + n) `ceilDiv` 2
 
-          slide (Endpoint x y)
-            | (as Vector.! x) `eq` (bs Vector.! y) = slide (Endpoint (succ x) (succ y))
+          slide eq (Endpoint x y)
+            | (as Vector.! x) `eq` (bs Vector.! y) = slide eq (Endpoint (succ x) (succ y))
             | otherwise = Endpoint x y
 
-  FindDPath eq (EditGraph as bs) Reverse (EditDistance d) (Diagonal k) -> return (Endpoint 0 0)
+  FindDPath (EditGraph as bs) Reverse (EditDistance d) (Diagonal k) -> return (Endpoint 0 0)
 
 
 -- Smart constructors
 
-lcs :: (a -> a -> Bool) -> EditGraph a -> Myers a [a]
-lcs eq graph = M (LCS eq graph) `Then` return
+lcs :: EditGraph a -> Myers a [a]
+lcs graph = M (LCS graph) `Then` return
 
-findDPath :: (a -> a -> Bool) -> EditGraph a -> Direction -> EditDistance -> Diagonal -> Myers a Endpoint
-findDPath eq graph direction d k = M (FindDPath eq graph direction d k) `Then` return
+findDPath :: EditGraph a -> Direction -> EditDistance -> Diagonal -> Myers a Endpoint
+findDPath graph direction d k = M (FindDPath graph direction d k) `Then` return
 
-middleSnake :: (a -> a -> Bool) -> EditGraph a -> Myers a (Snake, EditDistance)
-middleSnake eq graph = M (MiddleSnake eq graph) `Then` return
+middleSnake :: EditGraph a -> Myers a (Snake, EditDistance)
+middleSnake graph = M (MiddleSnake graph) `Then` return
 
 getEditGraph :: Myers a (EditGraph a)
 getEditGraph = GetGraph `Then` return

From a8222cf0d856295570637f7bb2a7b73f9ffabf8a Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 13:09:21 -0500
Subject: [PATCH 067/294] :fire: GetGraph.

---
 src/SES/Myers.hs | 15 +++++----------
 1 file changed, 5 insertions(+), 10 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 7c9ee91f2..770c0bb5b 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -19,7 +19,6 @@ data State s a where
 data StepF element result where
   M :: MyersF a b -> StepF a b
   S :: State MyersState b -> StepF a b
-  GetGraph :: StepF a (EditGraph a)
   GetEq :: StepF a (a -> a -> Bool)
 
 type Myers a = Freer (StepF a)
@@ -35,14 +34,14 @@ data Direction = Forward | Reverse
 
 -- Evaluation
 
-runMyers :: (a -> a -> Bool) -> EditGraph a -> Myers a b -> b
-runMyers eq graph = runAll $ MyersState (Vector.replicate 100 0) (Vector.replicate 100 0)
-  where runAll state step = case runMyersStep eq graph state step of
+runMyers :: (a -> a -> Bool) -> Myers a b -> b
+runMyers eq = runAll $ MyersState (Vector.replicate 100 0) (Vector.replicate 100 0)
+  where runAll state step = case runMyersStep eq state step of
           Left a -> a
           Right next -> uncurry runAll next
 
-runMyersStep :: (a -> a -> Bool) -> EditGraph a -> MyersState -> Myers a b -> Either b (MyersState, Myers a b)
-runMyersStep eq graph state step = case step of
+runMyersStep :: (a -> a -> Bool) -> MyersState -> Myers a b -> Either b (MyersState, Myers a b)
+runMyersStep eq state step = case step of
   Return a -> Left a
   Then step cont -> case step of
     M myers -> Right (state, decompose myers >>= cont)
@@ -50,7 +49,6 @@ runMyersStep eq graph state step = case step of
     S Get -> Right (state, cont state)
     S (Put state') -> Right (state', cont ())
 
-    GetGraph -> Right (state, cont graph)
     GetEq -> Right (state, cont eq)
 
 
@@ -133,9 +131,6 @@ findDPath graph direction d k = M (FindDPath graph direction d k) `Then` return
 middleSnake :: EditGraph a -> Myers a (Snake, EditDistance)
 middleSnake graph = M (MiddleSnake graph) `Then` return
 
-getEditGraph :: Myers a (EditGraph a)
-getEditGraph = GetGraph `Then` return
-
 getEq :: Myers a (a -> a -> Bool)
 getEq = GetEq `Then` return
 

From 91694c49994a330c520ff96e67c8ed24415f3010 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 13:12:05 -0500
Subject: [PATCH 068/294] Maintain call-stacks.

---
 src/SES/Myers.hs | 21 +++++++++++----------
 1 file changed, 11 insertions(+), 10 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 770c0bb5b..ec3627a2f 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -1,9 +1,10 @@
-{-# LANGUAGE GADTs, MultiParamTypeClasses #-}
+{-# LANGUAGE GADTs, ImplicitParams, MultiParamTypeClasses #-}
 module SES.Myers where
 
 import Control.Monad.Free.Freer
 import Data.These
 import qualified Data.Vector as Vector
+import GHC.Stack
 import Prologue hiding (for, State)
 
 data MyersF element result where
@@ -34,14 +35,14 @@ data Direction = Forward | Reverse
 
 -- Evaluation
 
-runMyers :: (a -> a -> Bool) -> Myers a b -> b
+runMyers :: HasCallStack => (a -> a -> Bool) -> Myers a b -> b
 runMyers eq = runAll $ MyersState (Vector.replicate 100 0) (Vector.replicate 100 0)
   where runAll state step = case runMyersStep eq state step of
           Left a -> a
           Right next -> uncurry runAll next
 
-runMyersStep :: (a -> a -> Bool) -> MyersState -> Myers a b -> Either b (MyersState, Myers a b)
-runMyersStep eq state step = case step of
+runMyersStep :: HasCallStack => (a -> a -> Bool) -> MyersState -> Myers a b -> Either b (MyersState, Myers a b)
+runMyersStep eq state step = let ?callStack = popCallStack callStack in case step of
   Return a -> Left a
   Then step cont -> case step of
     M myers -> Right (state, decompose myers >>= cont)
@@ -52,8 +53,8 @@ runMyersStep eq state step = case step of
     GetEq -> Right (state, cont eq)
 
 
-decompose :: MyersF a b -> Myers a b
-decompose myers = case myers of
+decompose :: HasCallStack => MyersF a b -> Myers a b
+decompose myers = let ?callStack = popCallStack callStack in case myers of
   LCS graph
     | null (as graph) || null (bs graph) -> return []
     | otherwise -> do
@@ -122,16 +123,16 @@ decompose myers = case myers of
 
 -- Smart constructors
 
-lcs :: EditGraph a -> Myers a [a]
+lcs :: HasCallStack => EditGraph a -> Myers a [a]
 lcs graph = M (LCS graph) `Then` return
 
-findDPath :: EditGraph a -> Direction -> EditDistance -> Diagonal -> Myers a Endpoint
+findDPath :: HasCallStack => EditGraph a -> Direction -> EditDistance -> Diagonal -> Myers a Endpoint
 findDPath graph direction d k = M (FindDPath graph direction d k) `Then` return
 
-middleSnake :: EditGraph a -> Myers a (Snake, EditDistance)
+middleSnake :: HasCallStack => EditGraph a -> Myers a (Snake, EditDistance)
 middleSnake graph = M (MiddleSnake graph) `Then` return
 
-getEq :: Myers a (a -> a -> Bool)
+getEq :: HasCallStack => Myers a (a -> a -> Bool)
 getEq = GetEq `Then` return
 
 

From a15ae4b2e0a1a7066d763e383b1bf56d4fb39f1b Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 13:13:47 -0500
Subject: [PATCH 069/294] Bounds check x & y.

---
 src/SES/Myers.hs | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index ec3627a2f..cee5bfbe7 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -115,7 +115,9 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
           maxD = (m + n) `ceilDiv` 2
 
           slide eq (Endpoint x y)
-            | (as Vector.! x) `eq` (bs Vector.! y) = slide eq (Endpoint (succ x) (succ y))
+            | x < length as
+            , y < length bs
+            , (as Vector.! x) `eq` (bs Vector.! y) = slide eq (Endpoint (succ x) (succ y))
             | otherwise = Endpoint x y
 
   FindDPath (EditGraph as bs) Reverse (EditDistance d) (Diagonal k) -> return (Endpoint 0 0)

From 9bb0ae2f5aea61ae8415e8c4f63e412c8f5558ec Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 13:18:59 -0500
Subject: [PATCH 070/294] Bind ! locally.

---
 src/SES/Myers.hs | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index cee5bfbe7..b5a300c77 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -117,11 +117,13 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
           slide eq (Endpoint x y)
             | x < length as
             , y < length bs
-            , (as Vector.! x) `eq` (bs Vector.! y) = slide eq (Endpoint (succ x) (succ y))
+            , (as ! x) `eq` (bs ! y) = slide eq (Endpoint (succ x) (succ y))
             | otherwise = Endpoint x y
 
   FindDPath (EditGraph as bs) Reverse (EditDistance d) (Diagonal k) -> return (Endpoint 0 0)
 
+  where (!) = (Vector.!)
+
 
 -- Smart constructors
 

From f739d4e0b21ecdc1e98938b5e001f7b26330d4fd Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 13:21:44 -0500
Subject: [PATCH 071/294] y is independent of maxD.

---
 src/SES/Myers.hs | 15 ++++++++-------
 1 file changed, 8 insertions(+), 7 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index b5a300c77..b35acc07c 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -83,14 +83,14 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
       <$> for [negate d, negate d + 2 .. d] (\ k -> do
         forwardEndpoint <- findDPath graph Forward (EditDistance d) (Diagonal k)
         backwardV <- gets backward
-        let reverseEndpoint = backwardV `at` (maxD + k)
+        let reverseEndpoint = backwardV `at` k
         if odd delta && k `inInterval` (delta - pred d, delta + pred d) && overlaps forwardEndpoint reverseEndpoint
           then return (Just (Snake reverseEndpoint forwardEndpoint, EditDistance $ 2 * d - 1))
           else continue)
       <*> for [negate d, negate d + 2 .. d] (\ k -> do
         reverseEndpoint <- findDPath graph Reverse (EditDistance d) (Diagonal (k + delta))
         forwardV <- gets forward
-        let forwardEndpoint = forwardV `at` (maxD + k + delta)
+        let forwardEndpoint = forwardV `at` (k + delta)
         if even delta && k `inInterval` (negate d, d) && overlaps forwardEndpoint reverseEndpoint
           then return (Just (Snake reverseEndpoint forwardEndpoint, EditDistance $ 2 * d))
           else continue)
@@ -99,11 +99,13 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
           delta = n - m
           maxD = (m + n) `ceilDiv` 2
 
+          at v k = let x = v ! maxD + k in Endpoint x (x - k)
+
   FindDPath (EditGraph as bs) Forward (EditDistance d) (Diagonal k) -> do
     v <- gets forward
     eq <- getEq
-    let prev = v `at` (maxD + pred k)
-    let next = v `at` (maxD + succ k)
+    let prev = v `at` pred k
+    let next = v `at` succ k
     let xy = if k == negate d || k /= d && x prev < x next
           then next
           else let x' = succ (x prev) in Endpoint x' (x' - k)
@@ -120,6 +122,8 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
             , (as ! x) `eq` (bs ! y) = slide eq (Endpoint (succ x) (succ y))
             | otherwise = Endpoint x y
 
+          at v k = let x = v ! maxD + k in Endpoint x (x - k)
+
   FindDPath (EditGraph as bs) Reverse (EditDistance d) (Diagonal k) -> return (Endpoint 0 0)
 
   where (!) = (Vector.!)
@@ -150,9 +154,6 @@ setForward v = modify (\ s -> s { forward = v })
 setBackward :: Vector.Vector Int -> Myers a ()
 setBackward v = modify (\ s -> s { backward = v })
 
-at :: Vector.Vector Int -> Int -> Endpoint
-at v k = let x = v Vector.! k in Endpoint x (x - k)
-
 overlaps :: Endpoint -> Endpoint -> Bool
 overlaps (Endpoint x y) (Endpoint u v) = x - y == u - v && x <= u
 

From 1117208430762a753cbc55e19bb0d3cddf078fc5 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 13:29:32 -0500
Subject: [PATCH 072/294] Bind the as/bs vectors.

---
 src/SES/Myers.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index b35acc07c..d63a7eaa3 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -77,7 +77,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     | otherwise -> do
       return []
 
-  MiddleSnake graph -> fmap (fromMaybe (error "bleah")) $
+  MiddleSnake graph@(EditGraph as bs) -> fmap (fromMaybe (error "bleah")) $
     for [0..maxD] $ \ d ->
       (<|>)
       <$> for [negate d, negate d + 2 .. d] (\ k -> do
@@ -94,8 +94,8 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         if even delta && k `inInterval` (negate d, d) && overlaps forwardEndpoint reverseEndpoint
           then return (Just (Snake reverseEndpoint forwardEndpoint, EditDistance $ 2 * d))
           else continue)
-    where n = length (as graph)
-          m = length (bs graph)
+    where n = length as
+          m = length bs
           delta = n - m
           maxD = (m + n) `ceilDiv` 2
 

From 351fef725e6998bd24705a59a7438534344f3a81 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 13:32:15 -0500
Subject: [PATCH 073/294] =?UTF-8?q?Early=20return=20if=20we=E2=80=99ve=20e?=
 =?UTF-8?q?xhausted=20the=20inputs.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/SES/Myers.hs | 9 ++++++---
 1 file changed, 6 insertions(+), 3 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index d63a7eaa3..abb0d9155 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -84,9 +84,12 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         forwardEndpoint <- findDPath graph Forward (EditDistance d) (Diagonal k)
         backwardV <- gets backward
         let reverseEndpoint = backwardV `at` k
-        if odd delta && k `inInterval` (delta - pred d, delta + pred d) && overlaps forwardEndpoint reverseEndpoint
-          then return (Just (Snake reverseEndpoint forwardEndpoint, EditDistance $ 2 * d - 1))
-          else continue)
+        if x forwardEndpoint >= n && y forwardEndpoint >= m then
+          return (Just (Snake reverseEndpoint forwardEndpoint, EditDistance 0))
+        else if odd delta && k `inInterval` (delta - pred d, delta + pred d) && overlaps forwardEndpoint reverseEndpoint then
+          return (Just (Snake reverseEndpoint forwardEndpoint, EditDistance $ 2 * d - 1))
+        else
+          continue)
       <*> for [negate d, negate d + 2 .. d] (\ k -> do
         reverseEndpoint <- findDPath graph Reverse (EditDistance d) (Diagonal (k + delta))
         forwardV <- gets forward

From a1ceb3dca4e6a60d3ba111042203c9428299e044 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 13:33:47 -0500
Subject: [PATCH 074/294] =?UTF-8?q?Don=E2=80=99t=20access=20out=20of=20bou?=
 =?UTF-8?q?nds=20elements.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/SES/Myers.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index abb0d9155..292cefa81 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -120,8 +120,8 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
           maxD = (m + n) `ceilDiv` 2
 
           slide eq (Endpoint x y)
-            | x < length as
-            , y < length bs
+            | x > 0, x < length as
+            , y > 0, y < length bs
             , (as ! x) `eq` (bs ! y) = slide eq (Endpoint (succ x) (succ y))
             | otherwise = Endpoint x y
 

From d176490171db8ad53b41ff6e7fdd5d5faa94d22b Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 13:36:23 -0500
Subject: [PATCH 075/294] Ill-advised symmetry.

---
 src/SES/Myers.hs | 9 ++++++---
 1 file changed, 6 insertions(+), 3 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 292cefa81..d1e5d12f3 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -94,9 +94,12 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         reverseEndpoint <- findDPath graph Reverse (EditDistance d) (Diagonal (k + delta))
         forwardV <- gets forward
         let forwardEndpoint = forwardV `at` (k + delta)
-        if even delta && k `inInterval` (negate d, d) && overlaps forwardEndpoint reverseEndpoint
-          then return (Just (Snake reverseEndpoint forwardEndpoint, EditDistance $ 2 * d))
-          else continue)
+        if x reverseEndpoint <= 0 && y forwardEndpoint <= 0 then
+          return (Just (Snake reverseEndpoint forwardEndpoint, EditDistance $ 2 * d))
+        else if even delta && k `inInterval` (negate d, d) && overlaps forwardEndpoint reverseEndpoint then
+          return (Just (Snake reverseEndpoint forwardEndpoint, EditDistance $ 2 * d))
+        else
+          continue)
     where n = length as
           m = length bs
           delta = n - m

From 960cb3537c927927f83090f5c7a9852ab5a27081 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 13:38:29 -0500
Subject: [PATCH 076/294] Stub out setup for reverse d-path finding.

---
 src/SES/Myers.hs | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index d1e5d12f3..948a24caf 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -130,7 +130,10 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
 
           at v k = let x = v ! maxD + k in Endpoint x (x - k)
 
-  FindDPath (EditGraph as bs) Reverse (EditDistance d) (Diagonal k) -> return (Endpoint 0 0)
+  FindDPath (EditGraph as bs) Reverse (EditDistance d) (Diagonal k) -> do
+    v <- gets backward
+    eq <- getEq
+    return (Endpoint 0 0)
 
   where (!) = (Vector.!)
 

From f5ddc911d73bba15f5dbb1ff50be84f338bf1485 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 13:43:03 -0500
Subject: [PATCH 077/294] Bind a bunch of the relevant values & functions for
 all constructors.

---
 src/SES/Myers.hs | 59 +++++++++++++++++++++++++-----------------------
 1 file changed, 31 insertions(+), 28 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 948a24caf..76439c38c 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -13,6 +13,13 @@ data MyersF element result where
   MiddleSnake :: EditGraph a -> MyersF a (Snake, EditDistance)
   FindDPath :: EditGraph a -> Direction -> EditDistance -> Diagonal -> MyersF a Endpoint
 
+editGraph :: MyersF a b -> EditGraph a
+editGraph myers = case myers of
+  SES g -> g
+  LCS g -> g
+  MiddleSnake g -> g
+  FindDPath g _ _ _ -> g
+
 data State s a where
   Get :: State s s
   Put :: s -> State s ()
@@ -56,28 +63,28 @@ runMyersStep eq state step = let ?callStack = popCallStack callStack in case ste
 decompose :: HasCallStack => MyersF a b -> Myers a b
 decompose myers = let ?callStack = popCallStack callStack in case myers of
   LCS graph
-    | null (as graph) || null (bs graph) -> return []
+    | null as || null bs -> return []
     | otherwise -> do
       (Snake xy uv, EditDistance d) <- middleSnake graph
       if d > 1 then do
         let (before, _) = divideGraph graph xy
         let (start, after) = divideGraph graph uv
-        let (mid, _) = divideGraph start xy
+        let (EditGraph mid _, _) = divideGraph start xy
         before' <- lcs before
         after' <- lcs after
-        return $! before' <> toList (as mid) <> after'
-      else if length (bs graph) > length (as graph) then
-        return (toList (as graph))
+        return $! before' <> toList mid <> after'
+      else if length bs > length as then
+        return (toList as)
       else
-        return (toList (bs graph))
+        return (toList bs)
 
   SES graph
-    | null (bs graph) -> return (This <$> toList (as graph))
-    | null (as graph) -> return (That <$> toList (bs graph))
+    | null bs -> return (This <$> toList as)
+    | null as -> return (That <$> toList bs)
     | otherwise -> do
       return []
 
-  MiddleSnake graph@(EditGraph as bs) -> fmap (fromMaybe (error "bleah")) $
+  MiddleSnake graph -> fmap (fromMaybe (error "bleah")) $
     for [0..maxD] $ \ d ->
       (<|>)
       <$> for [negate d, negate d + 2 .. d] (\ k -> do
@@ -100,14 +107,8 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
           return (Just (Snake reverseEndpoint forwardEndpoint, EditDistance $ 2 * d))
         else
           continue)
-    where n = length as
-          m = length bs
-          delta = n - m
-          maxD = (m + n) `ceilDiv` 2
 
-          at v k = let x = v ! maxD + k in Endpoint x (x - k)
-
-  FindDPath (EditGraph as bs) Forward (EditDistance d) (Diagonal k) -> do
+  FindDPath _ Forward (EditDistance d) (Diagonal k) -> do
     v <- gets forward
     eq <- getEq
     let prev = v `at` pred k
@@ -118,24 +119,26 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     let Endpoint x' y' = slide eq xy
     setForward (v Vector.// [(maxD + k, x')])
     return (Endpoint x' y')
-    where n = length as
-          m = length bs
-          maxD = (m + n) `ceilDiv` 2
 
-          slide eq (Endpoint x y)
-            | x > 0, x < length as
-            , y > 0, y < length bs
-            , (as ! x) `eq` (bs ! y) = slide eq (Endpoint (succ x) (succ y))
-            | otherwise = Endpoint x y
-
-          at v k = let x = v ! maxD + k in Endpoint x (x - k)
-
-  FindDPath (EditGraph as bs) Reverse (EditDistance d) (Diagonal k) -> do
+  FindDPath _ Reverse (EditDistance d) (Diagonal k) -> do
     v <- gets backward
     eq <- getEq
     return (Endpoint 0 0)
 
   where (!) = (Vector.!)
+        EditGraph as bs = editGraph myers
+        n = length as
+        m = length bs
+        delta = n - m
+        maxD = (m + n) `ceilDiv` 2
+
+        at v k = let x = v ! maxD + k in Endpoint x (x - k)
+
+        slide eq (Endpoint x y)
+          | x > 0, x < length as
+          , y > 0, y < length bs
+          , (as ! x) `eq` (bs ! y) = slide eq (Endpoint (succ x) (succ y))
+          | otherwise = Endpoint x y
 
 
 -- Smart constructors

From 8aea2f6d0f172c02a68380b329ad8ce8ee8dfaba Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 13:45:36 -0500
Subject: [PATCH 078/294] Sliding can go in either direction.

---
 src/SES/Myers.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 76439c38c..0d97daf1f 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -116,7 +116,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     let xy = if k == negate d || k /= d && x prev < x next
           then next
           else let x' = succ (x prev) in Endpoint x' (x' - k)
-    let Endpoint x' y' = slide eq xy
+    let Endpoint x' y' = slide 1 eq xy
     setForward (v Vector.// [(maxD + k, x')])
     return (Endpoint x' y')
 
@@ -134,10 +134,10 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
 
         at v k = let x = v ! maxD + k in Endpoint x (x - k)
 
-        slide eq (Endpoint x y)
+        slide by eq (Endpoint x y)
           | x > 0, x < length as
           , y > 0, y < length bs
-          , (as ! x) `eq` (bs ! y) = slide eq (Endpoint (succ x) (succ y))
+          , (as ! x) `eq` (bs ! y) = slide by eq (Endpoint (x + by) (y + by))
           | otherwise = Endpoint x y
 
 

From e2b4b654234b1c28ed590473ec31340507fc1147 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 13:51:46 -0500
Subject: [PATCH 079/294] Derive Eq & Show instances for some of the types.

---
 src/SES/Myers.hs | 7 +++++++
 1 file changed, 7 insertions(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 0d97daf1f..416d7de83 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -35,9 +35,16 @@ data EditGraph a = EditGraph { as :: !(Vector.Vector a), bs :: !(Vector.Vector a
 data Snake = Snake { xy :: Endpoint, uv :: Endpoint }
 
 newtype EditDistance = EditDistance { unEditDistance :: Int }
+  deriving (Eq, Show)
+
 newtype Diagonal = Diagonal { unDiagonal :: Int }
+  deriving (Eq, Show)
+
 data Endpoint = Endpoint { x :: !Int, y :: !Int }
+  deriving (Eq, Show)
+
 data Direction = Forward | Reverse
+  deriving (Eq, Show)
 
 
 -- Evaluation

From 28b5a99333819b08b1eab9ad8fba97a4f7ff1993 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 13:52:40 -0500
Subject: [PATCH 080/294] Try to implement reverse d-path endpoint finding.

---
 src/SES/Myers.hs | 10 +++++++++-
 1 file changed, 9 insertions(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 416d7de83..0f9705082 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -130,7 +130,15 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
   FindDPath _ Reverse (EditDistance d) (Diagonal k) -> do
     v <- gets backward
     eq <- getEq
-    return (Endpoint 0 0)
+    let prev = v `at` pred k
+    let next = v `at` succ k
+    let xy = if k == negate d || k /= d && x prev < x next
+          then next
+          else let x' = succ (x prev) in Endpoint x' (x' - k)
+    let Endpoint x' y' = slide (negate 1) eq xy
+    setBackward (v Vector.// [(maxD + k, x')])
+    return (Endpoint x' y')
+    where at v k = let x = v ! maxD + delta + k in Endpoint x (x - k)
 
   where (!) = (Vector.!)
         EditGraph as bs = editGraph myers

From c4a7f35d46606cd76aa30f45864339a8bb9d297f Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 13:52:56 -0500
Subject: [PATCH 081/294] Sliding can operate at the zeroth index.

---
 src/SES/Myers.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 0f9705082..0b0bd46d7 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -150,8 +150,8 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         at v k = let x = v ! maxD + k in Endpoint x (x - k)
 
         slide by eq (Endpoint x y)
-          | x > 0, x < length as
-          , y > 0, y < length bs
+          | x >= 0, x < length as
+          , y >= 0, y < length bs
           , (as ! x) `eq` (bs ! y) = slide by eq (Endpoint (x + by) (y + by))
           | otherwise = Endpoint x y
 

From 7231c64bdd24d278e9e958234cc1bf17c399200b Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 13:53:16 -0500
Subject: [PATCH 082/294] Set the backwards vector with the delta.

---
 src/SES/Myers.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 0b0bd46d7..515fd9a29 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -136,7 +136,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
           then next
           else let x' = succ (x prev) in Endpoint x' (x' - k)
     let Endpoint x' y' = slide (negate 1) eq xy
-    setBackward (v Vector.// [(maxD + k, x')])
+    setBackward (v Vector.// [(maxD + delta + k, x')])
     return (Endpoint x' y')
     where at v k = let x = v ! maxD + delta + k in Endpoint x (x - k)
 

From d419e9aa9a6f766756dd7aeacda5ee7c2c687af6 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 13:57:41 -0500
Subject: [PATCH 083/294] Offset given the delta.

---
 src/SES/Myers.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 515fd9a29..e056ee900 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -136,7 +136,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
           then next
           else let x' = succ (x prev) in Endpoint x' (x' - k)
     let Endpoint x' y' = slide (negate 1) eq xy
-    setBackward (v Vector.// [(maxD + delta + k, x')])
+    setBackward (v Vector.// [(maxD - delta + k, x')])
     return (Endpoint x' y')
     where at v k = let x = v ! maxD + delta + k in Endpoint x (x - k)
 

From eaf898dc4a535a834a7ea6927a812db37200670a Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 13:58:35 -0500
Subject: [PATCH 084/294] Test for inclusion in the interval given the delta.

---
 src/SES/Myers.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index e056ee900..4cedd2562 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -110,7 +110,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         let forwardEndpoint = forwardV `at` (k + delta)
         if x reverseEndpoint <= 0 && y forwardEndpoint <= 0 then
           return (Just (Snake reverseEndpoint forwardEndpoint, EditDistance $ 2 * d))
-        else if even delta && k `inInterval` (negate d, d) && overlaps forwardEndpoint reverseEndpoint then
+        else if even delta && (k + delta) `inInterval` (negate d, d) && overlaps forwardEndpoint reverseEndpoint then
           return (Just (Snake reverseEndpoint forwardEndpoint, EditDistance $ 2 * d))
         else
           continue)

From e74119d3de9c8c883fb059dc9407cee3d2b182bb Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 14:01:51 -0500
Subject: [PATCH 085/294] :fire: the bogus shortcuts.

---
 src/SES/Myers.hs | 8 ++------
 1 file changed, 2 insertions(+), 6 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 4cedd2562..2768a1a35 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -98,9 +98,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         forwardEndpoint <- findDPath graph Forward (EditDistance d) (Diagonal k)
         backwardV <- gets backward
         let reverseEndpoint = backwardV `at` k
-        if x forwardEndpoint >= n && y forwardEndpoint >= m then
-          return (Just (Snake reverseEndpoint forwardEndpoint, EditDistance 0))
-        else if odd delta && k `inInterval` (delta - pred d, delta + pred d) && overlaps forwardEndpoint reverseEndpoint then
+        if odd delta && k `inInterval` (delta - pred d, delta + pred d) && overlaps forwardEndpoint reverseEndpoint then
           return (Just (Snake reverseEndpoint forwardEndpoint, EditDistance $ 2 * d - 1))
         else
           continue)
@@ -108,9 +106,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         reverseEndpoint <- findDPath graph Reverse (EditDistance d) (Diagonal (k + delta))
         forwardV <- gets forward
         let forwardEndpoint = forwardV `at` (k + delta)
-        if x reverseEndpoint <= 0 && y forwardEndpoint <= 0 then
-          return (Just (Snake reverseEndpoint forwardEndpoint, EditDistance $ 2 * d))
-        else if even delta && (k + delta) `inInterval` (negate d, d) && overlaps forwardEndpoint reverseEndpoint then
+        if even delta && (k + delta) `inInterval` (negate d, d) && overlaps forwardEndpoint reverseEndpoint then
           return (Just (Snake reverseEndpoint forwardEndpoint, EditDistance $ 2 * d))
         else
           continue)

From 438dc91672b1d2550047d36beb8d1bf6dca7395e Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 14:14:04 -0500
Subject: [PATCH 086/294] Try to implement SES recursively.

---
 src/SES/Myers.hs | 14 +++++++++++++-
 1 file changed, 13 insertions(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 2768a1a35..7ba3eda89 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -89,7 +89,16 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     | null bs -> return (This <$> toList as)
     | null as -> return (That <$> toList bs)
     | otherwise -> do
-      return []
+      (Snake xy uv, EditDistance d) <- middleSnake graph
+      if d > 1 then do
+        let (before, _) = divideGraph graph xy
+        let (start, after) = divideGraph graph uv
+        let (EditGraph midAs midBs, _) = divideGraph start xy
+        before' <- ses before
+        after' <- ses after
+        return $! before' <> zipWith These (toList midAs) (toList midBs) <> after'
+      else
+        return (zipWith These (toList as) (toList bs))
 
   MiddleSnake graph -> fmap (fromMaybe (error "bleah")) $
     for [0..maxD] $ \ d ->
@@ -154,6 +163,9 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
 
 -- Smart constructors
 
+ses :: HasCallStack => EditGraph a -> Myers a [These a a]
+ses graph = M (SES graph) `Then` return
+
 lcs :: HasCallStack => EditGraph a -> Myers a [a]
 lcs graph = M (LCS graph) `Then` return
 

From b81db6886769fbb48e1ba40b714213b743d15ff8 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 14:18:47 -0500
Subject: [PATCH 087/294] =?UTF-8?q?Don=E2=80=99t=20use=20the=20delta=20at?=
 =?UTF-8?q?=20all.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/SES/Myers.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 7ba3eda89..15e39464a 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -141,9 +141,9 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
           then next
           else let x' = succ (x prev) in Endpoint x' (x' - k)
     let Endpoint x' y' = slide (negate 1) eq xy
-    setBackward (v Vector.// [(maxD - delta + k, x')])
+    setBackward (v Vector.// [(maxD + k, x')])
     return (Endpoint x' y')
-    where at v k = let x = v ! maxD + delta + k in Endpoint x (x - k)
+    where at v k = let x = v ! maxD + k in Endpoint x (x - k)
 
   where (!) = (Vector.!)
         EditGraph as bs = editGraph myers

From 781a525f87dee639ffdd45e91f1c11b8c2531c0a Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 15:23:43 -0500
Subject: [PATCH 088/294] :fire: the custom definition of `at`.

---
 src/SES/Myers.hs | 1 -
 1 file changed, 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 15e39464a..4094cd50c 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -143,7 +143,6 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     let Endpoint x' y' = slide (negate 1) eq xy
     setBackward (v Vector.// [(maxD + k, x')])
     return (Endpoint x' y')
-    where at v k = let x = v ! maxD + k in Endpoint x (x - k)
 
   where (!) = (Vector.!)
         EditGraph as bs = editGraph myers

From f1ad91a3467360f8f51854a6f5b775225c3bca51 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 10 Mar 2017 16:15:50 -0500
Subject: [PATCH 089/294] Compute reverse d-paths in the same manner as forward
 ones.

---
 src/SES/Myers.hs | 33 ++++++++++++++++++---------------
 1 file changed, 18 insertions(+), 15 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 4094cd50c..a98a9a187 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -106,16 +106,16 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
       <$> for [negate d, negate d + 2 .. d] (\ k -> do
         forwardEndpoint <- findDPath graph Forward (EditDistance d) (Diagonal k)
         backwardV <- gets backward
-        let reverseEndpoint = backwardV `at` k
-        if odd delta && k `inInterval` (delta - pred d, delta + pred d) && overlaps forwardEndpoint reverseEndpoint then
+        let reverseEndpoint = let x = backwardV `at` k in Endpoint x (x - k)
+        if odd delta && k `inInterval` (delta - pred d, delta + pred d) && overlaps graph forwardEndpoint reverseEndpoint then
           return (Just (Snake reverseEndpoint forwardEndpoint, EditDistance $ 2 * d - 1))
         else
           continue)
       <*> for [negate d, negate d + 2 .. d] (\ k -> do
         reverseEndpoint <- findDPath graph Reverse (EditDistance d) (Diagonal (k + delta))
         forwardV <- gets forward
-        let forwardEndpoint = forwardV `at` (k + delta)
-        if even delta && (k + delta) `inInterval` (negate d, d) && overlaps forwardEndpoint reverseEndpoint then
+        let forwardEndpoint = let x = forwardV `at` (k + delta) in Endpoint x (x - k)
+        if even delta && (k + delta) `inInterval` (negate d, d) && overlaps graph forwardEndpoint reverseEndpoint then
           return (Just (Snake reverseEndpoint forwardEndpoint, EditDistance $ 2 * d))
         else
           continue)
@@ -125,10 +125,10 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     eq <- getEq
     let prev = v `at` pred k
     let next = v `at` succ k
-    let xy = if k == negate d || k /= d && x prev < x next
+    let x = if k == negate d || k /= d && prev < next
           then next
-          else let x' = succ (x prev) in Endpoint x' (x' - k)
-    let Endpoint x' y' = slide 1 eq xy
+          else succ prev
+    let Endpoint x' y' = slide Reverse eq (Endpoint x (x - k))
     setForward (v Vector.// [(maxD + k, x')])
     return (Endpoint x' y')
 
@@ -137,10 +137,10 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     eq <- getEq
     let prev = v `at` pred k
     let next = v `at` succ k
-    let xy = if k == negate d || k /= d && x prev < x next
+    let x = if k == negate d || k /= d && prev < next
           then next
-          else let x' = succ (x prev) in Endpoint x' (x' - k)
-    let Endpoint x' y' = slide (negate 1) eq xy
+          else succ prev
+    let Endpoint x' y' = slide Reverse eq (Endpoint x (x - k))
     setBackward (v Vector.// [(maxD + k, x')])
     return (Endpoint x' y')
 
@@ -151,14 +151,17 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         delta = n - m
         maxD = (m + n) `ceilDiv` 2
 
-        at v k = let x = v ! maxD + k in Endpoint x (x - k)
+        at v k = v ! maxD + k
 
-        slide by eq (Endpoint x y)
+        slide dir eq (Endpoint x y)
           | x >= 0, x < length as
           , y >= 0, y < length bs
-          , (as ! x) `eq` (bs ! y) = slide by eq (Endpoint (x + by) (y + by))
+          , nth dir as x `eq` nth dir bs y = slide dir eq (Endpoint (succ x) (succ y))
           | otherwise = Endpoint x y
 
+        nth Forward v i = v ! i
+        nth Reverse v i = v ! (length v - 1 - i)
+
 
 -- Smart constructors
 
@@ -188,8 +191,8 @@ setForward v = modify (\ s -> s { forward = v })
 setBackward :: Vector.Vector Int -> Myers a ()
 setBackward v = modify (\ s -> s { backward = v })
 
-overlaps :: Endpoint -> Endpoint -> Bool
-overlaps (Endpoint x y) (Endpoint u v) = x - y == u - v && x <= u
+overlaps :: EditGraph a -> Endpoint -> Endpoint -> Bool
+overlaps (EditGraph as _) (Endpoint x y) (Endpoint u v) = x - y == u - v && x <= length as - u
 
 inInterval :: Ord a => a -> (a, a) -> Bool
 inInterval k (lower, upper) = k >= lower && k <= upper

From 14f96d8bf0e22e8f004c22a0c438d328ec2210ac Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 11:22:43 -0400
Subject: [PATCH 090/294] Invert reverse d-paths as appropriate.

---
 src/SES/Myers.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index a98a9a187..f73e31bd6 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -108,7 +108,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         backwardV <- gets backward
         let reverseEndpoint = let x = backwardV `at` k in Endpoint x (x - k)
         if odd delta && k `inInterval` (delta - pred d, delta + pred d) && overlaps graph forwardEndpoint reverseEndpoint then
-          return (Just (Snake reverseEndpoint forwardEndpoint, EditDistance $ 2 * d - 1))
+          return (Just (Snake (Endpoint (n - x reverseEndpoint) (m - y reverseEndpoint)) forwardEndpoint, EditDistance $ 2 * d - 1))
         else
           continue)
       <*> for [negate d, negate d + 2 .. d] (\ k -> do
@@ -116,7 +116,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         forwardV <- gets forward
         let forwardEndpoint = let x = forwardV `at` (k + delta) in Endpoint x (x - k)
         if even delta && (k + delta) `inInterval` (negate d, d) && overlaps graph forwardEndpoint reverseEndpoint then
-          return (Just (Snake reverseEndpoint forwardEndpoint, EditDistance $ 2 * d))
+          return (Just (Snake (Endpoint (n - x reverseEndpoint) (m - y reverseEndpoint)) forwardEndpoint, EditDistance $ 2 * d))
         else
           continue)
 

From c9354e38ff9bebbc0dec350dab34689c1ba45610 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 11:23:10 -0400
Subject: [PATCH 091/294] Clamp graph division to the size of the inputs.

---
 src/SES/Myers.hs | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index f73e31bd6..90bde67b8 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -208,8 +208,9 @@ ceilDiv = (uncurry (+) .) . divMod
 
 divideGraph :: EditGraph a -> Endpoint -> (EditGraph a, EditGraph a)
 divideGraph (EditGraph as bs) (Endpoint x y) =
-  ( EditGraph (Vector.slice 0  x              as) (Vector.slice 0  y              bs)
-  , EditGraph (Vector.slice x (length as - x) as) (Vector.slice y (length bs - y) bs) )
+  ( EditGraph (slice 0  x              as) (slice 0  y              bs)
+  , EditGraph (slice x (length as - x) as) (slice y (length bs - y) bs) )
+  where slice from to v = Vector.slice (max 0 (min from (length v))) (max 0 (min to (length v))) v
 
 
 -- Instances

From 6aab59ba18fcca8038962c39a92e3f8062358f2c Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 11:28:23 -0400
Subject: [PATCH 092/294] Add a function to run all the steps in a myers
 algorithm.

---
 src/SES/Myers.hs | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 90bde67b8..7d02581c8 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -55,6 +55,11 @@ runMyers eq = runAll $ MyersState (Vector.replicate 100 0) (Vector.replicate 100
           Left a -> a
           Right next -> uncurry runAll next
 
+runMyersSteps :: HasCallStack => (a -> a -> Bool) -> MyersState -> Myers a b -> [(MyersState, Myers a b)]
+runMyersSteps eq state step = let ?callStack = popCallStack callStack in (state, step) : case runMyersStep eq state step of
+  Left result -> [ (state, return result) ]
+  Right next -> uncurry (runMyersSteps eq) next
+
 runMyersStep :: HasCallStack => (a -> a -> Bool) -> MyersState -> Myers a b -> Either b (MyersState, Myers a b)
 runMyersStep eq state step = let ?callStack = popCallStack callStack in case step of
   Return a -> Left a

From 315927763f27801d239215d904366bfa3ec9557d Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 11:32:54 -0400
Subject: [PATCH 093/294] Move editGraph to the implementation details section.

---
 src/SES/Myers.hs | 15 ++++++++-------
 1 file changed, 8 insertions(+), 7 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 7d02581c8..4130b4a1a 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -13,13 +13,6 @@ data MyersF element result where
   MiddleSnake :: EditGraph a -> MyersF a (Snake, EditDistance)
   FindDPath :: EditGraph a -> Direction -> EditDistance -> Diagonal -> MyersF a Endpoint
 
-editGraph :: MyersF a b -> EditGraph a
-editGraph myers = case myers of
-  SES g -> g
-  LCS g -> g
-  MiddleSnake g -> g
-  FindDPath g _ _ _ -> g
-
 data State s a where
   Get :: State s s
   Put :: s -> State s ()
@@ -218,6 +211,14 @@ divideGraph (EditGraph as bs) (Endpoint x y) =
   where slice from to v = Vector.slice (max 0 (min from (length v))) (max 0 (min to (length v))) v
 
 
+editGraph :: MyersF a b -> EditGraph a
+editGraph myers = case myers of
+  SES g -> g
+  LCS g -> g
+  MiddleSnake g -> g
+  FindDPath g _ _ _ -> g
+
+
 -- Instances
 
 instance MonadState MyersState (Myers a) where

From beefe1ac20bff0a804ca7214a84fa96c4d4ef479 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 11:33:46 -0400
Subject: [PATCH 094/294] Extract the definition of the empty state.

---
 src/SES/Myers.hs | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 4130b4a1a..b3795229e 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -43,7 +43,7 @@ data Direction = Forward | Reverse
 -- Evaluation
 
 runMyers :: HasCallStack => (a -> a -> Bool) -> Myers a b -> b
-runMyers eq = runAll $ MyersState (Vector.replicate 100 0) (Vector.replicate 100 0)
+runMyers eq = runAll emptyState
   where runAll state step = case runMyersStep eq state step of
           Left a -> a
           Right next -> uncurry runAll next
@@ -183,6 +183,9 @@ getEq = GetEq `Then` return
 
 data MyersState = MyersState { forward :: !(Vector.Vector Int), backward :: !(Vector.Vector Int) }
 
+emptyState :: MyersState
+emptyState = MyersState (Vector.replicate 100 0) (Vector.replicate 100 0)
+
 setForward :: Vector.Vector Int -> Myers a ()
 setForward v = modify (\ s -> s { forward = v })
 

From 8998884e51a22b259cd612b0af91d3affc409734 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 11:34:50 -0400
Subject: [PATCH 095/294] Select the empty state specific to a given step.

---
 src/SES/Myers.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index b3795229e..cf8107d03 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -43,7 +43,7 @@ data Direction = Forward | Reverse
 -- Evaluation
 
 runMyers :: HasCallStack => (a -> a -> Bool) -> Myers a b -> b
-runMyers eq = runAll emptyState
+runMyers eq step = runAll (emptyStateForStep step) step
   where runAll state step = case runMyersStep eq state step of
           Left a -> a
           Right next -> uncurry runAll next
@@ -183,8 +183,8 @@ getEq = GetEq `Then` return
 
 data MyersState = MyersState { forward :: !(Vector.Vector Int), backward :: !(Vector.Vector Int) }
 
-emptyState :: MyersState
-emptyState = MyersState (Vector.replicate 100 0) (Vector.replicate 100 0)
+emptyStateForStep :: Myers a b -> MyersState
+emptyStateForStep _ = MyersState (Vector.replicate 100 0) (Vector.replicate 100 0)
 
 setForward :: Vector.Vector Int -> Myers a ()
 setForward v = modify (\ s -> s { forward = v })

From 95a800660e04aa696e9eb899ed539eaabbc4cf31 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 11:35:11 -0400
Subject: [PATCH 096/294] runMyersSteps constructs the initial state itself.

---
 src/SES/Myers.hs | 9 +++++----
 1 file changed, 5 insertions(+), 4 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index cf8107d03..df1705851 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -48,10 +48,11 @@ runMyers eq step = runAll (emptyStateForStep step) step
           Left a -> a
           Right next -> uncurry runAll next
 
-runMyersSteps :: HasCallStack => (a -> a -> Bool) -> MyersState -> Myers a b -> [(MyersState, Myers a b)]
-runMyersSteps eq state step = let ?callStack = popCallStack callStack in (state, step) : case runMyersStep eq state step of
-  Left result -> [ (state, return result) ]
-  Right next -> uncurry (runMyersSteps eq) next
+runMyersSteps :: HasCallStack => (a -> a -> Bool) -> Myers a b -> [(MyersState, Myers a b)]
+runMyersSteps eq step = go (emptyStateForStep step) step
+  where go state step = let ?callStack = popCallStack callStack in (state, step) : case runMyersStep eq state step of
+          Left result -> [ (state, return result) ]
+          Right next -> uncurry go next
 
 runMyersStep :: HasCallStack => (a -> a -> Bool) -> MyersState -> Myers a b -> Either b (MyersState, Myers a b)
 runMyersStep eq state step = let ?callStack = popCallStack callStack in case step of

From a59f657b0893000de3485c979e6cb3d563e31b43 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 11:35:37 -0400
Subject: [PATCH 097/294] Derive Eq & Show instances of MyersState.

---
 src/SES/Myers.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index df1705851..644e7ed0c 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -183,6 +183,7 @@ getEq = GetEq `Then` return
 -- Implementation details
 
 data MyersState = MyersState { forward :: !(Vector.Vector Int), backward :: !(Vector.Vector Int) }
+  deriving (Eq, Show)
 
 emptyStateForStep :: Myers a b -> MyersState
 emptyStateForStep _ = MyersState (Vector.replicate 100 0) (Vector.replicate 100 0)

From 2e843a1a166e93d4970397d1e88018c0c0fa4f96 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 11:38:01 -0400
Subject: [PATCH 098/294] Define a Show2 instance of State.

---
 src/SES/Myers.hs | 7 +++++++
 1 file changed, 7 insertions(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 644e7ed0c..3fb536c27 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -2,8 +2,10 @@
 module SES.Myers where
 
 import Control.Monad.Free.Freer
+import Data.Functor.Classes
 import Data.These
 import qualified Data.Vector as Vector
+import GHC.Show
 import GHC.Stack
 import Prologue hiding (for, State)
 
@@ -229,3 +231,8 @@ editGraph myers = case myers of
 instance MonadState MyersState (Myers a) where
   get = S Get `Then` return
   put a = S (Put a) `Then` return
+
+instance Show2 State where
+  liftShowsPrec2 sp1 _ _ _ d state = case state of
+    Get -> showString "Get"
+    Put s -> showsUnaryWith sp1 "Put" d s

From cd0466dceceb84b7f78bf494209be3882456ac56 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 11:39:40 -0400
Subject: [PATCH 099/294] Define a Show1 instance of State.

---
 src/SES/Myers.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 3fb536c27..bd0d98372 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -236,3 +236,6 @@ instance Show2 State where
   liftShowsPrec2 sp1 _ _ _ d state = case state of
     Get -> showString "Get"
     Put s -> showsUnaryWith sp1 "Put" d s
+
+instance Show s => Show1 (State s) where
+  liftShowsPrec = liftShowsPrec2 showsPrec showList

From a24c35e5ce437c4e3967f609006c64611485554f Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 11:41:37 -0400
Subject: [PATCH 100/294] Define a Show instance of State s a.

---
 src/SES/Myers.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index bd0d98372..93b95883b 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -239,3 +239,6 @@ instance Show2 State where
 
 instance Show s => Show1 (State s) where
   liftShowsPrec = liftShowsPrec2 showsPrec showList
+
+instance Show s => Show (State s a) where
+  showsPrec = liftShowsPrec2 showsPrec showList (const (const identity)) (const identity)

From 39e1cb06c40a21886f45ef56272155521b641798 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 11:47:38 -0400
Subject: [PATCH 101/294] Derive Eq & Show instances for EditGraph & Snake.

---
 src/SES/Myers.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 93b95883b..6adf4ffc1 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -27,7 +27,10 @@ data StepF element result where
 type Myers a = Freer (StepF a)
 
 data EditGraph a = EditGraph { as :: !(Vector.Vector a), bs :: !(Vector.Vector a) }
+  deriving (Eq, Show)
+
 data Snake = Snake { xy :: Endpoint, uv :: Endpoint }
+  deriving (Eq, Show)
 
 newtype EditDistance = EditDistance { unEditDistance :: Int }
   deriving (Eq, Show)

From d4b0633117f7e9bfd09fa41ed0ca5901665a3ef8 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 11:52:59 -0400
Subject: [PATCH 102/294] =?UTF-8?q?Define=20a=20helper=20to=20show=20a=20v?=
 =?UTF-8?q?ector=E2=80=99s=20contents=20parametrically.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/SES/Myers.hs | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 6adf4ffc1..7d084e122 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -229,6 +229,10 @@ editGraph myers = case myers of
   FindDPath g _ _ _ -> g
 
 
+liftShowsVector :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Vector.Vector a -> ShowS
+liftShowsVector sp sl d = liftShowsPrec sp sl d . toList
+
+
 -- Instances
 
 instance MonadState MyersState (Myers a) where

From 48e51196795acdb90c60dc30bf5bbab9d6aace68 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 11:53:06 -0400
Subject: [PATCH 103/294] Define a Show1 instance for EditGraph.

---
 src/SES/Myers.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 7d084e122..a3fc60d9d 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -249,3 +249,6 @@ instance Show s => Show1 (State s) where
 
 instance Show s => Show (State s a) where
   showsPrec = liftShowsPrec2 showsPrec showList (const (const identity)) (const identity)
+
+instance Show1 EditGraph where
+  liftShowsPrec sp sl d (EditGraph as bs) = showsBinaryWith (liftShowsVector sp sl) (liftShowsVector sp sl) "EditGraph" d as bs

From e6f89c9266164d66e7ce99db572f501123bc1f27 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 11:56:29 -0400
Subject: [PATCH 104/294] Define a Show2 instance for MyersF.

---
 src/SES/Myers.hs | 11 +++++++++++
 1 file changed, 11 insertions(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index a3fc60d9d..71402f7f7 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -3,6 +3,7 @@ module SES.Myers where
 
 import Control.Monad.Free.Freer
 import Data.Functor.Classes
+import Data.String
 import Data.These
 import qualified Data.Vector as Vector
 import GHC.Show
@@ -252,3 +253,13 @@ instance Show s => Show (State s a) where
 
 instance Show1 EditGraph where
   liftShowsPrec sp sl d (EditGraph as bs) = showsBinaryWith (liftShowsVector sp sl) (liftShowsVector sp sl) "EditGraph" d as bs
+
+instance Show2 MyersF where
+  liftShowsPrec2 sp1 sl1 _ _ d m = case m of
+    SES graph -> showsUnaryWith (liftShowsPrec sp1 sl1) "SES" d graph
+    LCS graph -> showsUnaryWith (liftShowsPrec sp1 sl1) "LCS" d graph
+    MiddleSnake graph -> showsUnaryWith (liftShowsPrec sp1 sl1) "MiddleSnake" d graph
+    FindDPath graph direction distance diagonal -> showsQuaternaryWith (liftShowsPrec sp1 sl1) showsPrec showsPrec showsPrec "FindDPath" d graph direction distance diagonal
+    where showsQuaternaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> (Int -> c -> ShowS) -> (Int -> d -> ShowS) -> String -> Int -> a -> b -> c -> d -> ShowS
+          showsQuaternaryWith sp1 sp2 sp3 sp4 name d x y z w = showParen (d > 10) $
+            showString name . showChar ' ' . sp1 11 x . showChar ' ' . sp2 11 y . showChar ' ' . sp3 11 z . showChar ' ' . sp4 11 w

From 6b5c9df8e641d62c7f961d8bde2887dc32f1bbcb Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 11:57:12 -0400
Subject: [PATCH 105/294] Define a Show1 instance for MyersF a.

---
 src/SES/Myers.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 71402f7f7..a030faf4e 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -263,3 +263,6 @@ instance Show2 MyersF where
     where showsQuaternaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> (Int -> c -> ShowS) -> (Int -> d -> ShowS) -> String -> Int -> a -> b -> c -> d -> ShowS
           showsQuaternaryWith sp1 sp2 sp3 sp4 name d x y z w = showParen (d > 10) $
             showString name . showChar ' ' . sp1 11 x . showChar ' ' . sp2 11 y . showChar ' ' . sp3 11 z . showChar ' ' . sp4 11 w
+
+instance Show a => Show1 (MyersF a) where
+  liftShowsPrec = liftShowsPrec2 showsPrec showList

From 92bb79a7a6d1d3a8d2f7833102e55ae171472beb Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 11:58:28 -0400
Subject: [PATCH 106/294] Define a Show instance for MyersF a b.

---
 src/SES/Myers.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index a030faf4e..2e7e51843 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -266,3 +266,6 @@ instance Show2 MyersF where
 
 instance Show a => Show1 (MyersF a) where
   liftShowsPrec = liftShowsPrec2 showsPrec showList
+
+instance Show a => Show (MyersF a b) where
+  showsPrec = liftShowsPrec (const (const identity)) (const identity)

From 1f56cd5b9dd19b262755a0c5f4f49b8eef1a50b4 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 12:01:03 -0400
Subject: [PATCH 107/294] Simplify the Show instance for State s a.

---
 src/SES/Myers.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 2e7e51843..0f6f7c7b3 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -249,7 +249,7 @@ instance Show s => Show1 (State s) where
   liftShowsPrec = liftShowsPrec2 showsPrec showList
 
 instance Show s => Show (State s a) where
-  showsPrec = liftShowsPrec2 showsPrec showList (const (const identity)) (const identity)
+  showsPrec = liftShowsPrec (const (const identity)) (const identity)
 
 instance Show1 EditGraph where
   liftShowsPrec sp sl d (EditGraph as bs) = showsBinaryWith (liftShowsVector sp sl) (liftShowsVector sp sl) "EditGraph" d as bs

From 853c275b51b63690f47d7b14d30cb3b81dde878e Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 12:01:10 -0400
Subject: [PATCH 108/294] Define a Show2 instance for StepF.

---
 src/SES/Myers.hs | 6 ++++++
 1 file changed, 6 insertions(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 0f6f7c7b3..b0dfe39ac 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -269,3 +269,9 @@ instance Show a => Show1 (MyersF a) where
 
 instance Show a => Show (MyersF a b) where
   showsPrec = liftShowsPrec (const (const identity)) (const identity)
+
+instance Show2 StepF where
+  liftShowsPrec2 sp1 sl1 sp2 sl2 d step = case step of
+    M m -> showsUnaryWith (liftShowsPrec2 sp1 sl1 sp2 sl2) "M" d m
+    S s -> showsUnaryWith (liftShowsPrec2 showsPrec showList sp2 sl2) "S" d s
+    GetEq -> showString "GetEq"

From 62170ff44be0eafc75531bee37bccde3ece2fd34 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 12:01:41 -0400
Subject: [PATCH 109/294] Define a Show1 instance for StepF.

---
 src/SES/Myers.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index b0dfe39ac..dd218b1fb 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -275,3 +275,6 @@ instance Show2 StepF where
     M m -> showsUnaryWith (liftShowsPrec2 sp1 sl1 sp2 sl2) "M" d m
     S s -> showsUnaryWith (liftShowsPrec2 showsPrec showList sp2 sl2) "S" d s
     GetEq -> showString "GetEq"
+
+instance Show a => Show1 (StepF a) where
+  liftShowsPrec = liftShowsPrec2 showsPrec showList

From 1972dd7753567a90372deb45b1d206918875bae1 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 12:02:20 -0400
Subject: [PATCH 110/294] Define a Show instance for StepF a b.

---
 src/SES/Myers.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index dd218b1fb..6e07f7d5d 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -278,3 +278,6 @@ instance Show2 StepF where
 
 instance Show a => Show1 (StepF a) where
   liftShowsPrec = liftShowsPrec2 showsPrec showList
+
+instance Show a => Show (StepF a b) where
+  showsPrec = liftShowsPrec (const (const identity)) (const identity)

From e7eb4aab0f5db372143f9ee8452d60ccdec9a2dc Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 12:05:04 -0400
Subject: [PATCH 111/294] =?UTF-8?q?Returns=20don=E2=80=99t=20need=20state?=
 =?UTF-8?q?=20at=20all.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/SES/Myers.hs | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 6e07f7d5d..c66bc5b3e 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -192,7 +192,9 @@ data MyersState = MyersState { forward :: !(Vector.Vector Int), backward :: !(Ve
   deriving (Eq, Show)
 
 emptyStateForStep :: Myers a b -> MyersState
-emptyStateForStep _ = MyersState (Vector.replicate 100 0) (Vector.replicate 100 0)
+emptyStateForStep step = case step of
+  Return _ -> MyersState Vector.empty Vector.empty
+  Then _ _ -> MyersState (Vector.replicate 100 0) (Vector.replicate 100 0)
 
 setForward :: Vector.Vector Int -> Myers a ()
 setForward v = modify (\ s -> s { forward = v })

From c2a3649cff2a6b0cde886f5857a82da701916a5c Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 12:11:31 -0400
Subject: [PATCH 112/294] Compute accurately-sized empty state for diff steps.

---
 src/SES/Myers.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index c66bc5b3e..eb8e20500 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -193,8 +193,8 @@ data MyersState = MyersState { forward :: !(Vector.Vector Int), backward :: !(Ve
 
 emptyStateForStep :: Myers a b -> MyersState
 emptyStateForStep step = case step of
-  Return _ -> MyersState Vector.empty Vector.empty
-  Then _ _ -> MyersState (Vector.replicate 100 0) (Vector.replicate 100 0)
+  Then (M m) _ -> let EditGraph as bs = editGraph m in MyersState (Vector.replicate (length as) 0) (Vector.replicate (length bs) 0)
+  _ -> MyersState Vector.empty Vector.empty
 
 setForward :: Vector.Vector Int -> Myers a ()
 setForward v = modify (\ s -> s { forward = v })

From 84360367f7c42c1d09a9aa39f5a560dd9aa997b1 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 12:15:01 -0400
Subject: [PATCH 113/294] Allocate the correct size for the state vectors.

---
 src/SES/Myers.hs | 7 ++++++-
 1 file changed, 6 insertions(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index eb8e20500..b0a732cfc 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -193,7 +193,12 @@ data MyersState = MyersState { forward :: !(Vector.Vector Int), backward :: !(Ve
 
 emptyStateForStep :: Myers a b -> MyersState
 emptyStateForStep step = case step of
-  Then (M m) _ -> let EditGraph as bs = editGraph m in MyersState (Vector.replicate (length as) 0) (Vector.replicate (length bs) 0)
+  Then (M myers) _ ->
+    let EditGraph as bs = editGraph myers
+        n = length as
+        m = length bs
+        maxD = (m + n) `ceilDiv` 2
+    in MyersState (Vector.replicate (maxD * 2) 0) (Vector.replicate (maxD * 2) 0)
   _ -> MyersState Vector.empty Vector.empty
 
 setForward :: Vector.Vector Int -> Myers a ()

From 05f187d288059d3b045215b25945ef3874eb3ffd Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 13:21:39 -0400
Subject: [PATCH 114/294] Swap the edit distance and direction parameters.

---
 src/SES/Myers.hs | 16 ++++++++--------
 1 file changed, 8 insertions(+), 8 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index b0a732cfc..dc27e85cc 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -14,7 +14,7 @@ data MyersF element result where
   SES :: EditGraph a -> MyersF a [These a a]
   LCS :: EditGraph a -> MyersF a [a]
   MiddleSnake :: EditGraph a -> MyersF a (Snake, EditDistance)
-  FindDPath :: EditGraph a -> Direction -> EditDistance -> Diagonal -> MyersF a Endpoint
+  FindDPath :: EditGraph a -> EditDistance -> Direction -> Diagonal -> MyersF a Endpoint
 
 data State s a where
   Get :: State s s
@@ -109,7 +109,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     for [0..maxD] $ \ d ->
       (<|>)
       <$> for [negate d, negate d + 2 .. d] (\ k -> do
-        forwardEndpoint <- findDPath graph Forward (EditDistance d) (Diagonal k)
+        forwardEndpoint <- findDPath graph (EditDistance d) Forward (Diagonal k)
         backwardV <- gets backward
         let reverseEndpoint = let x = backwardV `at` k in Endpoint x (x - k)
         if odd delta && k `inInterval` (delta - pred d, delta + pred d) && overlaps graph forwardEndpoint reverseEndpoint then
@@ -117,7 +117,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         else
           continue)
       <*> for [negate d, negate d + 2 .. d] (\ k -> do
-        reverseEndpoint <- findDPath graph Reverse (EditDistance d) (Diagonal (k + delta))
+        reverseEndpoint <- findDPath graph (EditDistance d) Reverse (Diagonal (k + delta))
         forwardV <- gets forward
         let forwardEndpoint = let x = forwardV `at` (k + delta) in Endpoint x (x - k)
         if even delta && (k + delta) `inInterval` (negate d, d) && overlaps graph forwardEndpoint reverseEndpoint then
@@ -125,7 +125,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         else
           continue)
 
-  FindDPath _ Forward (EditDistance d) (Diagonal k) -> do
+  FindDPath _ (EditDistance d) Forward (Diagonal k) -> do
     v <- gets forward
     eq <- getEq
     let prev = v `at` pred k
@@ -137,7 +137,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     setForward (v Vector.// [(maxD + k, x')])
     return (Endpoint x' y')
 
-  FindDPath _ Reverse (EditDistance d) (Diagonal k) -> do
+  FindDPath _ (EditDistance d) Reverse (Diagonal k) -> do
     v <- gets backward
     eq <- getEq
     let prev = v `at` pred k
@@ -176,8 +176,8 @@ ses graph = M (SES graph) `Then` return
 lcs :: HasCallStack => EditGraph a -> Myers a [a]
 lcs graph = M (LCS graph) `Then` return
 
-findDPath :: HasCallStack => EditGraph a -> Direction -> EditDistance -> Diagonal -> Myers a Endpoint
-findDPath graph direction d k = M (FindDPath graph direction d k) `Then` return
+findDPath :: HasCallStack => EditGraph a -> EditDistance -> Direction -> Diagonal -> Myers a Endpoint
+findDPath graph d direction k = M (FindDPath graph d direction k) `Then` return
 
 middleSnake :: HasCallStack => EditGraph a -> Myers a (Snake, EditDistance)
 middleSnake graph = M (MiddleSnake graph) `Then` return
@@ -266,7 +266,7 @@ instance Show2 MyersF where
     SES graph -> showsUnaryWith (liftShowsPrec sp1 sl1) "SES" d graph
     LCS graph -> showsUnaryWith (liftShowsPrec sp1 sl1) "LCS" d graph
     MiddleSnake graph -> showsUnaryWith (liftShowsPrec sp1 sl1) "MiddleSnake" d graph
-    FindDPath graph direction distance diagonal -> showsQuaternaryWith (liftShowsPrec sp1 sl1) showsPrec showsPrec showsPrec "FindDPath" d graph direction distance diagonal
+    FindDPath graph distance direction diagonal -> showsQuaternaryWith (liftShowsPrec sp1 sl1) showsPrec showsPrec showsPrec "FindDPath" d graph direction distance diagonal
     where showsQuaternaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> (Int -> c -> ShowS) -> (Int -> d -> ShowS) -> String -> Int -> a -> b -> c -> d -> ShowS
           showsQuaternaryWith sp1 sp2 sp3 sp4 name d x y z w = showParen (d > 10) $
             showString name . showChar ' ' . sp1 11 x . showChar ' ' . sp2 11 y . showChar ' ' . sp3 11 z . showChar ' ' . sp4 11 w

From 96136c36471bde0ad93eb9e74b17cdc6928adee9 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 14:48:46 -0400
Subject: [PATCH 115/294] Reorder the smart constructors.

---
 src/SES/Myers.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index dc27e85cc..d3330279b 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -176,12 +176,12 @@ ses graph = M (SES graph) `Then` return
 lcs :: HasCallStack => EditGraph a -> Myers a [a]
 lcs graph = M (LCS graph) `Then` return
 
-findDPath :: HasCallStack => EditGraph a -> EditDistance -> Direction -> Diagonal -> Myers a Endpoint
-findDPath graph d direction k = M (FindDPath graph d direction k) `Then` return
-
 middleSnake :: HasCallStack => EditGraph a -> Myers a (Snake, EditDistance)
 middleSnake graph = M (MiddleSnake graph) `Then` return
 
+findDPath :: HasCallStack => EditGraph a -> EditDistance -> Direction -> Diagonal -> Myers a Endpoint
+findDPath graph d direction k = M (FindDPath graph d direction k) `Then` return
+
 getEq :: HasCallStack => Myers a (a -> a -> Bool)
 getEq = GetEq `Then` return
 

From 72cb2192c924ddf22665f71cedf0583559bd7e5e Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 14:52:47 -0400
Subject: [PATCH 116/294] Extract an operation searching up to a given edit
 distance.

---
 src/SES/Myers.hs | 13 ++++++++++---
 1 file changed, 10 insertions(+), 3 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index d3330279b..73e82154c 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -14,6 +14,7 @@ data MyersF element result where
   SES :: EditGraph a -> MyersF a [These a a]
   LCS :: EditGraph a -> MyersF a [a]
   MiddleSnake :: EditGraph a -> MyersF a (Snake, EditDistance)
+  SearchUpToD :: EditGraph a -> EditDistance -> MyersF a (Maybe (Snake, EditDistance))
   FindDPath :: EditGraph a -> EditDistance -> Direction -> Diagonal -> MyersF a Endpoint
 
 data State s a where
@@ -105,9 +106,10 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
       else
         return (zipWith These (toList as) (toList bs))
 
-  MiddleSnake graph -> fmap (fromMaybe (error "bleah")) $
-    for [0..maxD] $ \ d ->
-      (<|>)
+  MiddleSnake graph -> fmap (fromMaybe (error "bleah")) (for [0..maxD] (searchUpToD graph . EditDistance))
+
+  SearchUpToD graph (EditDistance d) ->
+    (<|>)
       <$> for [negate d, negate d + 2 .. d] (\ k -> do
         forwardEndpoint <- findDPath graph (EditDistance d) Forward (Diagonal k)
         backwardV <- gets backward
@@ -179,6 +181,9 @@ lcs graph = M (LCS graph) `Then` return
 middleSnake :: HasCallStack => EditGraph a -> Myers a (Snake, EditDistance)
 middleSnake graph = M (MiddleSnake graph) `Then` return
 
+searchUpToD :: HasCallStack => EditGraph a -> EditDistance -> Myers a (Maybe (Snake, EditDistance))
+searchUpToD graph distance = M (SearchUpToD graph distance) `Then` return
+
 findDPath :: HasCallStack => EditGraph a -> EditDistance -> Direction -> Diagonal -> Myers a Endpoint
 findDPath graph d direction k = M (FindDPath graph d direction k) `Then` return
 
@@ -234,6 +239,7 @@ editGraph myers = case myers of
   SES g -> g
   LCS g -> g
   MiddleSnake g -> g
+  SearchUpToD g _ -> g
   FindDPath g _ _ _ -> g
 
 
@@ -266,6 +272,7 @@ instance Show2 MyersF where
     SES graph -> showsUnaryWith (liftShowsPrec sp1 sl1) "SES" d graph
     LCS graph -> showsUnaryWith (liftShowsPrec sp1 sl1) "LCS" d graph
     MiddleSnake graph -> showsUnaryWith (liftShowsPrec sp1 sl1) "MiddleSnake" d graph
+    SearchUpToD graph distance -> showsBinaryWith (liftShowsPrec sp1 sl1) showsPrec "SearchUpToD" d graph distance
     FindDPath graph distance direction diagonal -> showsQuaternaryWith (liftShowsPrec sp1 sl1) showsPrec showsPrec showsPrec "FindDPath" d graph direction distance diagonal
     where showsQuaternaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> (Int -> c -> ShowS) -> (Int -> d -> ShowS) -> String -> Int -> a -> b -> c -> d -> ShowS
           showsQuaternaryWith sp1 sp2 sp3 sp4 name d x y z w = showParen (d > 10) $

From c27b271acfa769451f762f240410ecaebf147ea0 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 14:56:59 -0400
Subject: [PATCH 117/294] Extract an operation searching along a given
 diagonal.

---
 src/SES/Myers.hs | 42 ++++++++++++++++++++++++++----------------
 1 file changed, 26 insertions(+), 16 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 73e82154c..6216a64c1 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -15,6 +15,7 @@ data MyersF element result where
   LCS :: EditGraph a -> MyersF a [a]
   MiddleSnake :: EditGraph a -> MyersF a (Snake, EditDistance)
   SearchUpToD :: EditGraph a -> EditDistance -> MyersF a (Maybe (Snake, EditDistance))
+  SearchAlongK :: EditGraph a -> EditDistance -> Direction -> Diagonal -> MyersF a (Maybe (Snake, EditDistance))
   FindDPath :: EditGraph a -> EditDistance -> Direction -> Diagonal -> MyersF a Endpoint
 
 data State s a where
@@ -110,22 +111,26 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
 
   SearchUpToD graph (EditDistance d) ->
     (<|>)
-      <$> for [negate d, negate d + 2 .. d] (\ k -> do
-        forwardEndpoint <- findDPath graph (EditDistance d) Forward (Diagonal k)
-        backwardV <- gets backward
-        let reverseEndpoint = let x = backwardV `at` k in Endpoint x (x - k)
-        if odd delta && k `inInterval` (delta - pred d, delta + pred d) && overlaps graph forwardEndpoint reverseEndpoint then
-          return (Just (Snake (Endpoint (n - x reverseEndpoint) (m - y reverseEndpoint)) forwardEndpoint, EditDistance $ 2 * d - 1))
-        else
-          continue)
-      <*> for [negate d, negate d + 2 .. d] (\ k -> do
-        reverseEndpoint <- findDPath graph (EditDistance d) Reverse (Diagonal (k + delta))
-        forwardV <- gets forward
-        let forwardEndpoint = let x = forwardV `at` (k + delta) in Endpoint x (x - k)
-        if even delta && (k + delta) `inInterval` (negate d, d) && overlaps graph forwardEndpoint reverseEndpoint then
-          return (Just (Snake (Endpoint (n - x reverseEndpoint) (m - y reverseEndpoint)) forwardEndpoint, EditDistance $ 2 * d))
-        else
-          continue)
+      <$> for [negate d, negate d + 2 .. d] (searchAlongK graph (EditDistance d) Forward . Diagonal)
+      <*> for [negate d, negate d + 2 .. d] (searchAlongK graph (EditDistance d) Reverse . Diagonal)
+
+  SearchAlongK graph (EditDistance d) Forward (Diagonal k) -> do
+    forwardEndpoint <- findDPath graph (EditDistance d) Forward (Diagonal k)
+    backwardV <- gets backward
+    let reverseEndpoint = let x = backwardV `at` k in Endpoint x (x - k)
+    if odd delta && k `inInterval` (delta - pred d, delta + pred d) && overlaps graph forwardEndpoint reverseEndpoint then
+      return (Just (Snake (Endpoint (n - x reverseEndpoint) (m - y reverseEndpoint)) forwardEndpoint, EditDistance $ 2 * d - 1))
+    else
+      continue
+
+  SearchAlongK graph (EditDistance d) Reverse (Diagonal k) -> do
+    reverseEndpoint <- findDPath graph (EditDistance d) Reverse (Diagonal (k + delta))
+    forwardV <- gets forward
+    let forwardEndpoint = let x = forwardV `at` (k + delta) in Endpoint x (x - k)
+    if even delta && (k + delta) `inInterval` (negate d, d) && overlaps graph forwardEndpoint reverseEndpoint then
+      return (Just (Snake (Endpoint (n - x reverseEndpoint) (m - y reverseEndpoint)) forwardEndpoint, EditDistance $ 2 * d))
+    else
+      continue
 
   FindDPath _ (EditDistance d) Forward (Diagonal k) -> do
     v <- gets forward
@@ -184,6 +189,9 @@ middleSnake graph = M (MiddleSnake graph) `Then` return
 searchUpToD :: HasCallStack => EditGraph a -> EditDistance -> Myers a (Maybe (Snake, EditDistance))
 searchUpToD graph distance = M (SearchUpToD graph distance) `Then` return
 
+searchAlongK :: HasCallStack => EditGraph a -> EditDistance -> Direction -> Diagonal -> Myers a (Maybe (Snake, EditDistance))
+searchAlongK graph d direction k = M (SearchAlongK graph d direction k) `Then` return
+
 findDPath :: HasCallStack => EditGraph a -> EditDistance -> Direction -> Diagonal -> Myers a Endpoint
 findDPath graph d direction k = M (FindDPath graph d direction k) `Then` return
 
@@ -240,6 +248,7 @@ editGraph myers = case myers of
   LCS g -> g
   MiddleSnake g -> g
   SearchUpToD g _ -> g
+  SearchAlongK g _ _ _ -> g
   FindDPath g _ _ _ -> g
 
 
@@ -273,6 +282,7 @@ instance Show2 MyersF where
     LCS graph -> showsUnaryWith (liftShowsPrec sp1 sl1) "LCS" d graph
     MiddleSnake graph -> showsUnaryWith (liftShowsPrec sp1 sl1) "MiddleSnake" d graph
     SearchUpToD graph distance -> showsBinaryWith (liftShowsPrec sp1 sl1) showsPrec "SearchUpToD" d graph distance
+    SearchAlongK graph distance direction diagonal -> showsQuaternaryWith (liftShowsPrec sp1 sl1) showsPrec showsPrec showsPrec "SearchAlongK" d graph direction distance diagonal
     FindDPath graph distance direction diagonal -> showsQuaternaryWith (liftShowsPrec sp1 sl1) showsPrec showsPrec showsPrec "FindDPath" d graph direction distance diagonal
     where showsQuaternaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> (Int -> c -> ShowS) -> (Int -> d -> ShowS) -> String -> Int -> a -> b -> c -> d -> ShowS
           showsQuaternaryWith sp1 sp2 sp3 sp4 name d x y z w = showParen (d > 10) $

From cd051d85087a5c361ae7cae7d922336f59b5e72a Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 14:57:27 -0400
Subject: [PATCH 118/294] Reformat the decomposition of SearchUpToD.

---
 src/SES/Myers.hs | 5 ++---
 1 file changed, 2 insertions(+), 3 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 6216a64c1..406c5c718 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -110,9 +110,8 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
   MiddleSnake graph -> fmap (fromMaybe (error "bleah")) (for [0..maxD] (searchUpToD graph . EditDistance))
 
   SearchUpToD graph (EditDistance d) ->
-    (<|>)
-      <$> for [negate d, negate d + 2 .. d] (searchAlongK graph (EditDistance d) Forward . Diagonal)
-      <*> for [negate d, negate d + 2 .. d] (searchAlongK graph (EditDistance d) Reverse . Diagonal)
+    (<|>) <$> for [negate d, negate d + 2 .. d] (searchAlongK graph (EditDistance d) Forward . Diagonal)
+          <*> for [negate d, negate d + 2 .. d] (searchAlongK graph (EditDistance d) Reverse . Diagonal)
 
   SearchAlongK graph (EditDistance d) Forward (Diagonal k) -> do
     forwardEndpoint <- findDPath graph (EditDistance d) Forward (Diagonal k)

From 2d7bdeff56a34a40b7b2978173ddbba57d5d25d0 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 14:59:02 -0400
Subject: [PATCH 119/294] Produce a better error when MiddleSnake fails to find
 a value.

---
 src/SES/Myers.hs | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 406c5c718..6489d6f63 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -107,7 +107,11 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
       else
         return (zipWith These (toList as) (toList bs))
 
-  MiddleSnake graph -> fmap (fromMaybe (error "bleah")) (for [0..maxD] (searchUpToD graph . EditDistance))
+  MiddleSnake graph -> do
+    result <- for [0..maxD] (searchUpToD graph . EditDistance)
+    case result of
+      Just result -> return result
+      Nothing -> error "MiddleSnake must always find a value."
 
   SearchUpToD graph (EditDistance d) ->
     (<|>) <$> for [negate d, negate d + 2 .. d] (searchAlongK graph (EditDistance d) Forward . Diagonal)

From 7e02b60c3bef8d6feb2d849c1294120d33d3c8f1 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 15:13:31 -0400
Subject: [PATCH 120/294] Extract a common handler for producing a result from
 a search.

---
 src/SES/Myers.hs | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 6489d6f63..ed67b8e8d 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -122,7 +122,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     backwardV <- gets backward
     let reverseEndpoint = let x = backwardV `at` k in Endpoint x (x - k)
     if odd delta && k `inInterval` (delta - pred d, delta + pred d) && overlaps graph forwardEndpoint reverseEndpoint then
-      return (Just (Snake (Endpoint (n - x reverseEndpoint) (m - y reverseEndpoint)) forwardEndpoint, EditDistance $ 2 * d - 1))
+      return (done reverseEndpoint forwardEndpoint (2 * d - 1))
     else
       continue
 
@@ -131,7 +131,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     forwardV <- gets forward
     let forwardEndpoint = let x = forwardV `at` (k + delta) in Endpoint x (x - k)
     if even delta && (k + delta) `inInterval` (negate d, d) && overlaps graph forwardEndpoint reverseEndpoint then
-      return (Just (Snake (Endpoint (n - x reverseEndpoint) (m - y reverseEndpoint)) forwardEndpoint, EditDistance $ 2 * d))
+      return (done reverseEndpoint forwardEndpoint (2 * d))
     else
       continue
 
@@ -168,6 +168,8 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
 
         at v k = v ! maxD + k
 
+        done (Endpoint x y) uv d = Just (Snake (Endpoint (n - x) (m - y)) uv, EditDistance d)
+
         slide dir eq (Endpoint x y)
           | x >= 0, x < length as
           , y >= 0, y < length bs

From 08cf871da9f210efeabea7278b4971b42d8c7e5c Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 15:16:43 -0400
Subject: [PATCH 121/294] Extract a common constructor for the diagonal
 interval.

---
 src/SES/Myers.hs | 7 +++++--
 1 file changed, 5 insertions(+), 2 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index ed67b8e8d..1e5120619 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -121,7 +121,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     forwardEndpoint <- findDPath graph (EditDistance d) Forward (Diagonal k)
     backwardV <- gets backward
     let reverseEndpoint = let x = backwardV `at` k in Endpoint x (x - k)
-    if odd delta && k `inInterval` (delta - pred d, delta + pred d) && overlaps graph forwardEndpoint reverseEndpoint then
+    if odd delta && k `inInterval` diagonalInterval Forward d && overlaps graph forwardEndpoint reverseEndpoint then
       return (done reverseEndpoint forwardEndpoint (2 * d - 1))
     else
       continue
@@ -130,7 +130,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     reverseEndpoint <- findDPath graph (EditDistance d) Reverse (Diagonal (k + delta))
     forwardV <- gets forward
     let forwardEndpoint = let x = forwardV `at` (k + delta) in Endpoint x (x - k)
-    if even delta && (k + delta) `inInterval` (negate d, d) && overlaps graph forwardEndpoint reverseEndpoint then
+    if even delta && (k + delta) `inInterval` diagonalInterval Reverse d && overlaps graph forwardEndpoint reverseEndpoint then
       return (done reverseEndpoint forwardEndpoint (2 * d))
     else
       continue
@@ -168,6 +168,9 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
 
         at v k = v ! maxD + k
 
+        diagonalInterval Forward d = (delta - pred d, delta + pred d)
+        diagonalInterval Reverse d = (negate d, d)
+
         done (Endpoint x y) uv d = Just (Snake (Endpoint (n - x) (m - y)) uv, EditDistance d)
 
         slide dir eq (Endpoint x y)

From 241c5e2c4a03cb199488264152daff3a14439465 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 15:21:17 -0400
Subject: [PATCH 122/294] Bind and pass the direction.

---
 src/SES/Myers.hs | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 1e5120619..16d3958ad 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -117,20 +117,20 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     (<|>) <$> for [negate d, negate d + 2 .. d] (searchAlongK graph (EditDistance d) Forward . Diagonal)
           <*> for [negate d, negate d + 2 .. d] (searchAlongK graph (EditDistance d) Reverse . Diagonal)
 
-  SearchAlongK graph (EditDistance d) Forward (Diagonal k) -> do
-    forwardEndpoint <- findDPath graph (EditDistance d) Forward (Diagonal k)
+  SearchAlongK graph (EditDistance d) direction@Forward (Diagonal k) -> do
+    forwardEndpoint <- findDPath graph (EditDistance d) direction (Diagonal k)
     backwardV <- gets backward
     let reverseEndpoint = let x = backwardV `at` k in Endpoint x (x - k)
-    if odd delta && k `inInterval` diagonalInterval Forward d && overlaps graph forwardEndpoint reverseEndpoint then
+    if odd delta && k `inInterval` diagonalInterval direction d && overlaps graph forwardEndpoint reverseEndpoint then
       return (done reverseEndpoint forwardEndpoint (2 * d - 1))
     else
       continue
 
-  SearchAlongK graph (EditDistance d) Reverse (Diagonal k) -> do
-    reverseEndpoint <- findDPath graph (EditDistance d) Reverse (Diagonal (k + delta))
+  SearchAlongK graph (EditDistance d) direction@Reverse (Diagonal k) -> do
+    reverseEndpoint <- findDPath graph (EditDistance d) direction (Diagonal (k + delta))
     forwardV <- gets forward
     let forwardEndpoint = let x = forwardV `at` (k + delta) in Endpoint x (x - k)
-    if even delta && (k + delta) `inInterval` diagonalInterval Reverse d && overlaps graph forwardEndpoint reverseEndpoint then
+    if even delta && (k + delta) `inInterval` diagonalInterval direction d && overlaps graph forwardEndpoint reverseEndpoint then
       return (done reverseEndpoint forwardEndpoint (2 * d))
     else
       continue

From 93116b7f260bfb51381143de8b1442c3760d7277 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 15:24:00 -0400
Subject: [PATCH 123/294] Extract a common handler for the edit distance by
 direction.

---
 src/SES/Myers.hs | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 16d3958ad..62ddea77d 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -122,7 +122,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     backwardV <- gets backward
     let reverseEndpoint = let x = backwardV `at` k in Endpoint x (x - k)
     if odd delta && k `inInterval` diagonalInterval direction d && overlaps graph forwardEndpoint reverseEndpoint then
-      return (done reverseEndpoint forwardEndpoint (2 * d - 1))
+      return (done reverseEndpoint forwardEndpoint (editDistance direction d))
     else
       continue
 
@@ -131,7 +131,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     forwardV <- gets forward
     let forwardEndpoint = let x = forwardV `at` (k + delta) in Endpoint x (x - k)
     if even delta && (k + delta) `inInterval` diagonalInterval direction d && overlaps graph forwardEndpoint reverseEndpoint then
-      return (done reverseEndpoint forwardEndpoint (2 * d))
+      return (done reverseEndpoint forwardEndpoint (editDistance direction d))
     else
       continue
 
@@ -172,6 +172,8 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         diagonalInterval Reverse d = (negate d, d)
 
         done (Endpoint x y) uv d = Just (Snake (Endpoint (n - x) (m - y)) uv, EditDistance d)
+        editDistance Forward d = 2 * d - 1
+        editDistance Reverse d = 2 * d
 
         slide dir eq (Endpoint x y)
           | x >= 0, x < length as

From 99b07c3483c41d8a95fe7b4ad0a419105d01ef5e Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 15:25:59 -0400
Subject: [PATCH 124/294] Extract a common handler for the selection of the
 diagonal.

---
 src/SES/Myers.hs | 21 ++++++++++++---------
 1 file changed, 12 insertions(+), 9 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 62ddea77d..f53c4f886 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -118,18 +118,18 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
           <*> for [negate d, negate d + 2 .. d] (searchAlongK graph (EditDistance d) Reverse . Diagonal)
 
   SearchAlongK graph (EditDistance d) direction@Forward (Diagonal k) -> do
-    forwardEndpoint <- findDPath graph (EditDistance d) direction (Diagonal k)
+    forwardEndpoint <- findDPath graph (EditDistance d) direction (diagonalFor direction k)
     backwardV <- gets backward
-    let reverseEndpoint = let x = backwardV `at` k in Endpoint x (x - k)
+    let reverseEndpoint = let x = backwardV `at` diagonalFor direction k in Endpoint x (x - k)
     if odd delta && k `inInterval` diagonalInterval direction d && overlaps graph forwardEndpoint reverseEndpoint then
       return (done reverseEndpoint forwardEndpoint (editDistance direction d))
     else
       continue
 
   SearchAlongK graph (EditDistance d) direction@Reverse (Diagonal k) -> do
-    reverseEndpoint <- findDPath graph (EditDistance d) direction (Diagonal (k + delta))
+    reverseEndpoint <- findDPath graph (EditDistance d) direction (diagonalFor direction k)
     forwardV <- gets forward
-    let forwardEndpoint = let x = forwardV `at` (k + delta) in Endpoint x (x - k)
+    let forwardEndpoint = let x = forwardV `at` diagonalFor direction k in Endpoint x (x - k)
     if even delta && (k + delta) `inInterval` diagonalInterval direction d && overlaps graph forwardEndpoint reverseEndpoint then
       return (done reverseEndpoint forwardEndpoint (editDistance direction d))
     else
@@ -138,8 +138,8 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
   FindDPath _ (EditDistance d) Forward (Diagonal k) -> do
     v <- gets forward
     eq <- getEq
-    let prev = v `at` pred k
-    let next = v `at` succ k
+    let prev = v `at` Diagonal (pred k)
+    let next = v `at` Diagonal (succ k)
     let x = if k == negate d || k /= d && prev < next
           then next
           else succ prev
@@ -150,8 +150,8 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
   FindDPath _ (EditDistance d) Reverse (Diagonal k) -> do
     v <- gets backward
     eq <- getEq
-    let prev = v `at` pred k
-    let next = v `at` succ k
+    let prev = v `at` Diagonal (pred k)
+    let next = v `at` Diagonal (succ k)
     let x = if k == negate d || k /= d && prev < next
           then next
           else succ prev
@@ -166,11 +166,14 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         delta = n - m
         maxD = (m + n) `ceilDiv` 2
 
-        at v k = v ! maxD + k
+        at v (Diagonal k) = v ! maxD + k
 
         diagonalInterval Forward d = (delta - pred d, delta + pred d)
         diagonalInterval Reverse d = (negate d, d)
 
+        diagonalFor Forward k = Diagonal k
+        diagonalFor Reverse k = Diagonal (k + delta)
+
         done (Endpoint x y) uv d = Just (Snake (Endpoint (n - x) (m - y)) uv, EditDistance d)
         editDistance Forward d = 2 * d - 1
         editDistance Reverse d = 2 * d

From 8d820361b3e043c7358ed317c7d9dfc1100a88f8 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 15:33:08 -0400
Subject: [PATCH 125/294] Extract a common handler for the selection of the
 opposite vector.

---
 src/SES/Myers.hs | 7 +++++--
 1 file changed, 5 insertions(+), 2 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index f53c4f886..1fa91e3f9 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -119,7 +119,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
 
   SearchAlongK graph (EditDistance d) direction@Forward (Diagonal k) -> do
     forwardEndpoint <- findDPath graph (EditDistance d) direction (diagonalFor direction k)
-    backwardV <- gets backward
+    backwardV <- getOpposite direction
     let reverseEndpoint = let x = backwardV `at` diagonalFor direction k in Endpoint x (x - k)
     if odd delta && k `inInterval` diagonalInterval direction d && overlaps graph forwardEndpoint reverseEndpoint then
       return (done reverseEndpoint forwardEndpoint (editDistance direction d))
@@ -128,7 +128,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
 
   SearchAlongK graph (EditDistance d) direction@Reverse (Diagonal k) -> do
     reverseEndpoint <- findDPath graph (EditDistance d) direction (diagonalFor direction k)
-    forwardV <- gets forward
+    forwardV <- getOpposite direction
     let forwardEndpoint = let x = forwardV `at` diagonalFor direction k in Endpoint x (x - k)
     if even delta && (k + delta) `inInterval` diagonalInterval direction d && overlaps graph forwardEndpoint reverseEndpoint then
       return (done reverseEndpoint forwardEndpoint (editDistance direction d))
@@ -174,6 +174,9 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         diagonalFor Forward k = Diagonal k
         diagonalFor Reverse k = Diagonal (k + delta)
 
+        getOpposite Forward = gets backward
+        getOpposite Reverse = gets forward
+
         done (Endpoint x y) uv d = Just (Snake (Endpoint (n - x) (m - y)) uv, EditDistance d)
         editDistance Forward d = 2 * d - 1
         editDistance Reverse d = 2 * d

From c754ef0ae32bcc9b71bbdf84d72e05ba7f08eb1c Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 15:39:01 -0400
Subject: [PATCH 126/294] Consolidate the selection of the opposite endpoint.

---
 src/SES/Myers.hs | 11 +++++------
 1 file changed, 5 insertions(+), 6 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 1fa91e3f9..24aa9a72e 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -119,8 +119,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
 
   SearchAlongK graph (EditDistance d) direction@Forward (Diagonal k) -> do
     forwardEndpoint <- findDPath graph (EditDistance d) direction (diagonalFor direction k)
-    backwardV <- getOpposite direction
-    let reverseEndpoint = let x = backwardV `at` diagonalFor direction k in Endpoint x (x - k)
+    reverseEndpoint <- getOppositeEndpoint direction k
     if odd delta && k `inInterval` diagonalInterval direction d && overlaps graph forwardEndpoint reverseEndpoint then
       return (done reverseEndpoint forwardEndpoint (editDistance direction d))
     else
@@ -128,8 +127,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
 
   SearchAlongK graph (EditDistance d) direction@Reverse (Diagonal k) -> do
     reverseEndpoint <- findDPath graph (EditDistance d) direction (diagonalFor direction k)
-    forwardV <- getOpposite direction
-    let forwardEndpoint = let x = forwardV `at` diagonalFor direction k in Endpoint x (x - k)
+    forwardEndpoint <- getOppositeEndpoint direction k
     if even delta && (k + delta) `inInterval` diagonalInterval direction d && overlaps graph forwardEndpoint reverseEndpoint then
       return (done reverseEndpoint forwardEndpoint (editDistance direction d))
     else
@@ -174,8 +172,9 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         diagonalFor Forward k = Diagonal k
         diagonalFor Reverse k = Diagonal (k + delta)
 
-        getOpposite Forward = gets backward
-        getOpposite Reverse = gets forward
+        getOppositeEndpoint direction k = do
+          v <- gets (case direction of { Reverse -> backward ; Forward -> forward })
+          let x = v `at` diagonalFor direction k in return $ Endpoint x (x - k)
 
         done (Endpoint x y) uv d = Just (Snake (Endpoint (n - x) (m - y)) uv, EditDistance d)
         editDistance Forward d = 2 * d - 1

From a1acd3ea1c3812e7ce07d22a48bb9115c9a37987 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 16:15:31 -0400
Subject: [PATCH 127/294] =?UTF-8?q?Unpack=20edit=20distances=20only=20wher?=
 =?UTF-8?q?e=20they=E2=80=99re=20used.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/SES/Myers.hs | 18 +++++++++---------
 1 file changed, 9 insertions(+), 9 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 24aa9a72e..d7a1a9f22 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -117,16 +117,16 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     (<|>) <$> for [negate d, negate d + 2 .. d] (searchAlongK graph (EditDistance d) Forward . Diagonal)
           <*> for [negate d, negate d + 2 .. d] (searchAlongK graph (EditDistance d) Reverse . Diagonal)
 
-  SearchAlongK graph (EditDistance d) direction@Forward (Diagonal k) -> do
-    forwardEndpoint <- findDPath graph (EditDistance d) direction (diagonalFor direction k)
+  SearchAlongK graph d direction@Forward (Diagonal k) -> do
+    forwardEndpoint <- findDPath graph d direction (diagonalFor direction k)
     reverseEndpoint <- getOppositeEndpoint direction k
     if odd delta && k `inInterval` diagonalInterval direction d && overlaps graph forwardEndpoint reverseEndpoint then
       return (done reverseEndpoint forwardEndpoint (editDistance direction d))
     else
       continue
 
-  SearchAlongK graph (EditDistance d) direction@Reverse (Diagonal k) -> do
-    reverseEndpoint <- findDPath graph (EditDistance d) direction (diagonalFor direction k)
+  SearchAlongK graph d direction@Reverse (Diagonal k) -> do
+    reverseEndpoint <- findDPath graph d direction (diagonalFor direction k)
     forwardEndpoint <- getOppositeEndpoint direction k
     if even delta && (k + delta) `inInterval` diagonalInterval direction d && overlaps graph forwardEndpoint reverseEndpoint then
       return (done reverseEndpoint forwardEndpoint (editDistance direction d))
@@ -166,8 +166,8 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
 
         at v (Diagonal k) = v ! maxD + k
 
-        diagonalInterval Forward d = (delta - pred d, delta + pred d)
-        diagonalInterval Reverse d = (negate d, d)
+        diagonalInterval Forward (EditDistance d) = (delta - pred d, delta + pred d)
+        diagonalInterval Reverse (EditDistance d) = (negate d, d)
 
         diagonalFor Forward k = Diagonal k
         diagonalFor Reverse k = Diagonal (k + delta)
@@ -176,9 +176,9 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
           v <- gets (case direction of { Reverse -> backward ; Forward -> forward })
           let x = v `at` diagonalFor direction k in return $ Endpoint x (x - k)
 
-        done (Endpoint x y) uv d = Just (Snake (Endpoint (n - x) (m - y)) uv, EditDistance d)
-        editDistance Forward d = 2 * d - 1
-        editDistance Reverse d = 2 * d
+        done (Endpoint x y) uv d = Just (Snake (Endpoint (n - x) (m - y)) uv, d)
+        editDistance Forward (EditDistance d) = EditDistance (2 * d - 1)
+        editDistance Reverse (EditDistance d) = EditDistance (2 * d)
 
         slide dir eq (Endpoint x y)
           | x >= 0, x < length as

From 5b17eac69dd585d4723cfd4b9acafebf7cc7b41d Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 17:47:02 -0400
Subject: [PATCH 128/294] Offset the reverse array indices by -delta.

---
 src/SES/Myers.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index d7a1a9f22..0eb160de4 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -148,13 +148,13 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
   FindDPath _ (EditDistance d) Reverse (Diagonal k) -> do
     v <- gets backward
     eq <- getEq
-    let prev = v `at` Diagonal (pred k)
-    let next = v `at` Diagonal (succ k)
+    let prev = v ! maxD + (pred k - delta)
+    let next = v ! maxD + (succ k - delta)
     let x = if k == negate d || k /= d && prev < next
           then next
           else succ prev
     let Endpoint x' y' = slide Reverse eq (Endpoint x (x - k))
-    setBackward (v Vector.// [(maxD + k, x')])
+    setBackward (v Vector.// [(maxD + (k - delta), x')])
     return (Endpoint x' y')
 
   where (!) = (Vector.!)

From 22aa2e6abad0f31443ca63491a0ec43bb24cbd57 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 17:58:49 -0400
Subject: [PATCH 129/294] Over-allocate the state vectors by one place.

---
 src/SES/Myers.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 0eb160de4..bfbc4054a 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -226,7 +226,7 @@ emptyStateForStep step = case step of
         n = length as
         m = length bs
         maxD = (m + n) `ceilDiv` 2
-    in MyersState (Vector.replicate (maxD * 2) 0) (Vector.replicate (maxD * 2) 0)
+    in MyersState (Vector.replicate (succ (maxD * 2)) 0) (Vector.replicate (succ (maxD * 2)) 0)
   _ -> MyersState Vector.empty Vector.empty
 
 setForward :: Vector.Vector Int -> Myers a ()

From 3dc5bf754e125114546cf789eccecd6b5100ef08 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 18:07:52 -0400
Subject: [PATCH 130/294] Compute the lookup/set offset uniformly.

---
 src/SES/Myers.hs | 23 ++++++++++++-----------
 1 file changed, 12 insertions(+), 11 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index bfbc4054a..3439ccaae 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -133,28 +133,28 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     else
       continue
 
-  FindDPath _ (EditDistance d) Forward (Diagonal k) -> do
+  FindDPath _ (EditDistance d) direction@Forward (Diagonal k) -> do
     v <- gets forward
     eq <- getEq
-    let prev = v `at` Diagonal (pred k)
-    let next = v `at` Diagonal (succ k)
+    let prev = v ! offsetFor direction + pred k
+    let next = v ! offsetFor direction + succ k
     let x = if k == negate d || k /= d && prev < next
           then next
           else succ prev
     let Endpoint x' y' = slide Reverse eq (Endpoint x (x - k))
-    setForward (v Vector.// [(maxD + k, x')])
+    setForward (v Vector.// [(offsetFor direction + k, x')])
     return (Endpoint x' y')
 
-  FindDPath _ (EditDistance d) Reverse (Diagonal k) -> do
+  FindDPath _ (EditDistance d) direction@Reverse (Diagonal k) -> do
     v <- gets backward
     eq <- getEq
-    let prev = v ! maxD + (pred k - delta)
-    let next = v ! maxD + (succ k - delta)
+    let prev = v ! offsetFor direction + pred k
+    let next = v ! offsetFor direction + succ k
     let x = if k == negate d || k /= d && prev < next
           then next
           else succ prev
     let Endpoint x' y' = slide Reverse eq (Endpoint x (x - k))
-    setBackward (v Vector.// [(maxD + (k - delta), x')])
+    setBackward (v Vector.// [(offsetFor direction + k, x')])
     return (Endpoint x' y')
 
   where (!) = (Vector.!)
@@ -164,17 +164,18 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         delta = n - m
         maxD = (m + n) `ceilDiv` 2
 
-        at v (Diagonal k) = v ! maxD + k
-
         diagonalInterval Forward (EditDistance d) = (delta - pred d, delta + pred d)
         diagonalInterval Reverse (EditDistance d) = (negate d, d)
 
         diagonalFor Forward k = Diagonal k
         diagonalFor Reverse k = Diagonal (k + delta)
 
+        offsetFor Forward = maxD
+        offsetFor Reverse = maxD - delta
+
         getOppositeEndpoint direction k = do
           v <- gets (case direction of { Reverse -> backward ; Forward -> forward })
-          let x = v `at` diagonalFor direction k in return $ Endpoint x (x - k)
+          let x = v ! offsetFor direction + unDiagonal (diagonalFor direction k) in return $ Endpoint x (x - k)
 
         done (Endpoint x y) uv d = Just (Snake (Endpoint (n - x) (m - y)) uv, d)
         editDistance Forward (EditDistance d) = EditDistance (2 * d - 1)

From ffab3a378b6a179e6e1bc338662c3ec99a63215d Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 18:10:41 -0400
Subject: [PATCH 131/294] Consolidate FindDPath decomposition.

---
 src/SES/Myers.hs | 24 +++++++++---------------
 1 file changed, 9 insertions(+), 15 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 3439ccaae..5b7ca4a75 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -133,8 +133,8 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     else
       continue
 
-  FindDPath _ (EditDistance d) direction@Forward (Diagonal k) -> do
-    v <- gets forward
+  FindDPath _ (EditDistance d) direction (Diagonal k) -> do
+    v <- gets (stateFor direction)
     eq <- getEq
     let prev = v ! offsetFor direction + pred k
     let next = v ! offsetFor direction + succ k
@@ -142,19 +142,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
           then next
           else succ prev
     let Endpoint x' y' = slide Reverse eq (Endpoint x (x - k))
-    setForward (v Vector.// [(offsetFor direction + k, x')])
-    return (Endpoint x' y')
-
-  FindDPath _ (EditDistance d) direction@Reverse (Diagonal k) -> do
-    v <- gets backward
-    eq <- getEq
-    let prev = v ! offsetFor direction + pred k
-    let next = v ! offsetFor direction + succ k
-    let x = if k == negate d || k /= d && prev < next
-          then next
-          else succ prev
-    let Endpoint x' y' = slide Reverse eq (Endpoint x (x - k))
-    setBackward (v Vector.// [(offsetFor direction + k, x')])
+    setStateFor direction (v Vector.// [(offsetFor direction + k, x')])
     return (Endpoint x' y')
 
   where (!) = (Vector.!)
@@ -173,6 +161,12 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         offsetFor Forward = maxD
         offsetFor Reverse = maxD - delta
 
+        stateFor Forward = forward
+        stateFor Reverse = backward
+
+        setStateFor Forward = setForward
+        setStateFor Reverse = setBackward
+
         getOppositeEndpoint direction k = do
           v <- gets (case direction of { Reverse -> backward ; Forward -> forward })
           let x = v ! offsetFor direction + unDiagonal (diagonalFor direction k) in return $ Endpoint x (x - k)

From 60316fe28ee17d3b4c8f8a35ef2699b790124411 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 18:13:55 -0400
Subject: [PATCH 132/294] Consolidate endpoint computation in its entirety.

---
 src/SES/Myers.hs | 13 +++++++++----
 1 file changed, 9 insertions(+), 4 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 5b7ca4a75..85e80f9b7 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -118,16 +118,14 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
           <*> for [negate d, negate d + 2 .. d] (searchAlongK graph (EditDistance d) Reverse . Diagonal)
 
   SearchAlongK graph d direction@Forward (Diagonal k) -> do
-    forwardEndpoint <- findDPath graph d direction (diagonalFor direction k)
-    reverseEndpoint <- getOppositeEndpoint direction k
+    (forwardEndpoint, reverseEndpoint) <- endpointsFor graph d direction k
     if odd delta && k `inInterval` diagonalInterval direction d && overlaps graph forwardEndpoint reverseEndpoint then
       return (done reverseEndpoint forwardEndpoint (editDistance direction d))
     else
       continue
 
   SearchAlongK graph d direction@Reverse (Diagonal k) -> do
-    reverseEndpoint <- findDPath graph d direction (diagonalFor direction k)
-    forwardEndpoint <- getOppositeEndpoint direction k
+    (forwardEndpoint, reverseEndpoint) <- endpointsFor graph d direction k
     if even delta && (k + delta) `inInterval` diagonalInterval direction d && overlaps graph forwardEndpoint reverseEndpoint then
       return (done reverseEndpoint forwardEndpoint (editDistance direction d))
     else
@@ -167,6 +165,13 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         setStateFor Forward = setForward
         setStateFor Reverse = setBackward
 
+        endpointsFor graph d direction k = do
+          here <- findDPath graph d direction (diagonalFor direction k)
+          there <- getOppositeEndpoint direction k
+          case direction of
+            Forward -> return (here, there)
+            Reverse -> return (there, here)
+
         getOppositeEndpoint direction k = do
           v <- gets (case direction of { Reverse -> backward ; Forward -> forward })
           let x = v ! offsetFor direction + unDiagonal (diagonalFor direction k) in return $ Endpoint x (x - k)

From 52ea386c5bfbb00fd5e9c9b5830588204aa02b4e Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 18:15:09 -0400
Subject: [PATCH 133/294] Consolidate the diagonal to check the interval of.

---
 src/SES/Myers.hs | 9 ++++-----
 1 file changed, 4 insertions(+), 5 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 85e80f9b7..d026d8f2e 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -119,14 +119,14 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
 
   SearchAlongK graph d direction@Forward (Diagonal k) -> do
     (forwardEndpoint, reverseEndpoint) <- endpointsFor graph d direction k
-    if odd delta && k `inInterval` diagonalInterval direction d && overlaps graph forwardEndpoint reverseEndpoint then
+    if odd delta && diagonalFor direction k `inInterval` diagonalInterval direction d && overlaps graph forwardEndpoint reverseEndpoint then
       return (done reverseEndpoint forwardEndpoint (editDistance direction d))
     else
       continue
 
   SearchAlongK graph d direction@Reverse (Diagonal k) -> do
     (forwardEndpoint, reverseEndpoint) <- endpointsFor graph d direction k
-    if even delta && (k + delta) `inInterval` diagonalInterval direction d && overlaps graph forwardEndpoint reverseEndpoint then
+    if even delta && diagonalFor direction k `inInterval` diagonalInterval direction d && overlaps graph forwardEndpoint reverseEndpoint then
       return (done reverseEndpoint forwardEndpoint (editDistance direction d))
     else
       continue
@@ -150,6 +150,8 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         delta = n - m
         maxD = (m + n) `ceilDiv` 2
 
+        inInterval (Diagonal k) (lower, upper) = k >= lower && k <= upper
+
         diagonalInterval Forward (EditDistance d) = (delta - pred d, delta + pred d)
         diagonalInterval Reverse (EditDistance d) = (negate d, d)
 
@@ -238,9 +240,6 @@ setBackward v = modify (\ s -> s { backward = v })
 overlaps :: EditGraph a -> Endpoint -> Endpoint -> Bool
 overlaps (EditGraph as _) (Endpoint x y) (Endpoint u v) = x - y == u - v && x <= length as - u
 
-inInterval :: Ord a => a -> (a, a) -> Bool
-inInterval k (lower, upper) = k >= lower && k <= upper
-
 for :: [a] -> (a -> Myers c (Maybe b)) -> Myers c (Maybe b)
 for all run = foldr (\ a b -> (<|>) <$> run a <*> b) (return Nothing) all
 

From 24f0ddcb29e155b9e0951252b1eeaad4dd56dd0d Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 18:16:45 -0400
Subject: [PATCH 134/294] Consolidate how we decide whether to test for
 completion.

---
 src/SES/Myers.hs | 7 +++++--
 1 file changed, 5 insertions(+), 2 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index d026d8f2e..9e104e6d2 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -119,14 +119,14 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
 
   SearchAlongK graph d direction@Forward (Diagonal k) -> do
     (forwardEndpoint, reverseEndpoint) <- endpointsFor graph d direction k
-    if odd delta && diagonalFor direction k `inInterval` diagonalInterval direction d && overlaps graph forwardEndpoint reverseEndpoint then
+    if shouldTestOn direction && diagonalFor direction k `inInterval` diagonalInterval direction d && overlaps graph forwardEndpoint reverseEndpoint then
       return (done reverseEndpoint forwardEndpoint (editDistance direction d))
     else
       continue
 
   SearchAlongK graph d direction@Reverse (Diagonal k) -> do
     (forwardEndpoint, reverseEndpoint) <- endpointsFor graph d direction k
-    if even delta && diagonalFor direction k `inInterval` diagonalInterval direction d && overlaps graph forwardEndpoint reverseEndpoint then
+    if shouldTestOn direction && diagonalFor direction k `inInterval` diagonalInterval direction d && overlaps graph forwardEndpoint reverseEndpoint then
       return (done reverseEndpoint forwardEndpoint (editDistance direction d))
     else
       continue
@@ -158,6 +158,9 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         diagonalFor Forward k = Diagonal k
         diagonalFor Reverse k = Diagonal (k + delta)
 
+        shouldTestOn Forward = odd delta
+        shouldTestOn Reverse = even delta
+
         offsetFor Forward = maxD
         offsetFor Reverse = maxD - delta
 

From 06cea9d52808cfb3c618a1e693919438da0f045a Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 18:17:30 -0400
Subject: [PATCH 135/294] Consolidate the search along a diagonal.

---
 src/SES/Myers.hs | 9 +--------
 1 file changed, 1 insertion(+), 8 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 9e104e6d2..1f7644f83 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -117,14 +117,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     (<|>) <$> for [negate d, negate d + 2 .. d] (searchAlongK graph (EditDistance d) Forward . Diagonal)
           <*> for [negate d, negate d + 2 .. d] (searchAlongK graph (EditDistance d) Reverse . Diagonal)
 
-  SearchAlongK graph d direction@Forward (Diagonal k) -> do
-    (forwardEndpoint, reverseEndpoint) <- endpointsFor graph d direction k
-    if shouldTestOn direction && diagonalFor direction k `inInterval` diagonalInterval direction d && overlaps graph forwardEndpoint reverseEndpoint then
-      return (done reverseEndpoint forwardEndpoint (editDistance direction d))
-    else
-      continue
-
-  SearchAlongK graph d direction@Reverse (Diagonal k) -> do
+  SearchAlongK graph d direction (Diagonal k) -> do
     (forwardEndpoint, reverseEndpoint) <- endpointsFor graph d direction k
     if shouldTestOn direction && diagonalFor direction k `inInterval` diagonalInterval direction d && overlaps graph forwardEndpoint reverseEndpoint then
       return (done reverseEndpoint forwardEndpoint (editDistance direction d))

From 381e271924d9ce16a0ad2c7208f012fbf7b466b5 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 18:21:05 -0400
Subject: [PATCH 136/294] Rename EditDistance to Distance.

---
 src/SES/Myers.hs | 40 ++++++++++++++++++++--------------------
 1 file changed, 20 insertions(+), 20 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 1f7644f83..f6bb6e455 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -13,10 +13,10 @@ import Prologue hiding (for, State)
 data MyersF element result where
   SES :: EditGraph a -> MyersF a [These a a]
   LCS :: EditGraph a -> MyersF a [a]
-  MiddleSnake :: EditGraph a -> MyersF a (Snake, EditDistance)
-  SearchUpToD :: EditGraph a -> EditDistance -> MyersF a (Maybe (Snake, EditDistance))
-  SearchAlongK :: EditGraph a -> EditDistance -> Direction -> Diagonal -> MyersF a (Maybe (Snake, EditDistance))
-  FindDPath :: EditGraph a -> EditDistance -> Direction -> Diagonal -> MyersF a Endpoint
+  MiddleSnake :: EditGraph a -> MyersF a (Snake, Distance)
+  SearchUpToD :: EditGraph a -> Distance -> MyersF a (Maybe (Snake, Distance))
+  SearchAlongK :: EditGraph a -> Distance -> Direction -> Diagonal -> MyersF a (Maybe (Snake, Distance))
+  FindDPath :: EditGraph a -> Distance -> Direction -> Diagonal -> MyersF a Endpoint
 
 data State s a where
   Get :: State s s
@@ -35,7 +35,7 @@ data EditGraph a = EditGraph { as :: !(Vector.Vector a), bs :: !(Vector.Vector a
 data Snake = Snake { xy :: Endpoint, uv :: Endpoint }
   deriving (Eq, Show)
 
-newtype EditDistance = EditDistance { unEditDistance :: Int }
+newtype Distance = Distance { unDistance :: Int }
   deriving (Eq, Show)
 
 newtype Diagonal = Diagonal { unDiagonal :: Int }
@@ -79,7 +79,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
   LCS graph
     | null as || null bs -> return []
     | otherwise -> do
-      (Snake xy uv, EditDistance d) <- middleSnake graph
+      (Snake xy uv, Distance d) <- middleSnake graph
       if d > 1 then do
         let (before, _) = divideGraph graph xy
         let (start, after) = divideGraph graph uv
@@ -96,7 +96,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     | null bs -> return (This <$> toList as)
     | null as -> return (That <$> toList bs)
     | otherwise -> do
-      (Snake xy uv, EditDistance d) <- middleSnake graph
+      (Snake xy uv, Distance d) <- middleSnake graph
       if d > 1 then do
         let (before, _) = divideGraph graph xy
         let (start, after) = divideGraph graph uv
@@ -108,14 +108,14 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         return (zipWith These (toList as) (toList bs))
 
   MiddleSnake graph -> do
-    result <- for [0..maxD] (searchUpToD graph . EditDistance)
+    result <- for [0..maxD] (searchUpToD graph . Distance)
     case result of
       Just result -> return result
       Nothing -> error "MiddleSnake must always find a value."
 
-  SearchUpToD graph (EditDistance d) ->
-    (<|>) <$> for [negate d, negate d + 2 .. d] (searchAlongK graph (EditDistance d) Forward . Diagonal)
-          <*> for [negate d, negate d + 2 .. d] (searchAlongK graph (EditDistance d) Reverse . Diagonal)
+  SearchUpToD graph (Distance d) ->
+    (<|>) <$> for [negate d, negate d + 2 .. d] (searchAlongK graph (Distance d) Forward . Diagonal)
+          <*> for [negate d, negate d + 2 .. d] (searchAlongK graph (Distance d) Reverse . Diagonal)
 
   SearchAlongK graph d direction (Diagonal k) -> do
     (forwardEndpoint, reverseEndpoint) <- endpointsFor graph d direction k
@@ -124,7 +124,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     else
       continue
 
-  FindDPath _ (EditDistance d) direction (Diagonal k) -> do
+  FindDPath _ (Distance d) direction (Diagonal k) -> do
     v <- gets (stateFor direction)
     eq <- getEq
     let prev = v ! offsetFor direction + pred k
@@ -145,8 +145,8 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
 
         inInterval (Diagonal k) (lower, upper) = k >= lower && k <= upper
 
-        diagonalInterval Forward (EditDistance d) = (delta - pred d, delta + pred d)
-        diagonalInterval Reverse (EditDistance d) = (negate d, d)
+        diagonalInterval Forward (Distance d) = (delta - pred d, delta + pred d)
+        diagonalInterval Reverse (Distance d) = (negate d, d)
 
         diagonalFor Forward k = Diagonal k
         diagonalFor Reverse k = Diagonal (k + delta)
@@ -175,8 +175,8 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
           let x = v ! offsetFor direction + unDiagonal (diagonalFor direction k) in return $ Endpoint x (x - k)
 
         done (Endpoint x y) uv d = Just (Snake (Endpoint (n - x) (m - y)) uv, d)
-        editDistance Forward (EditDistance d) = EditDistance (2 * d - 1)
-        editDistance Reverse (EditDistance d) = EditDistance (2 * d)
+        editDistance Forward (Distance d) = Distance (2 * d - 1)
+        editDistance Reverse (Distance d) = Distance (2 * d)
 
         slide dir eq (Endpoint x y)
           | x >= 0, x < length as
@@ -196,16 +196,16 @@ ses graph = M (SES graph) `Then` return
 lcs :: HasCallStack => EditGraph a -> Myers a [a]
 lcs graph = M (LCS graph) `Then` return
 
-middleSnake :: HasCallStack => EditGraph a -> Myers a (Snake, EditDistance)
+middleSnake :: HasCallStack => EditGraph a -> Myers a (Snake, Distance)
 middleSnake graph = M (MiddleSnake graph) `Then` return
 
-searchUpToD :: HasCallStack => EditGraph a -> EditDistance -> Myers a (Maybe (Snake, EditDistance))
+searchUpToD :: HasCallStack => EditGraph a -> Distance -> Myers a (Maybe (Snake, Distance))
 searchUpToD graph distance = M (SearchUpToD graph distance) `Then` return
 
-searchAlongK :: HasCallStack => EditGraph a -> EditDistance -> Direction -> Diagonal -> Myers a (Maybe (Snake, EditDistance))
+searchAlongK :: HasCallStack => EditGraph a -> Distance -> Direction -> Diagonal -> Myers a (Maybe (Snake, Distance))
 searchAlongK graph d direction k = M (SearchAlongK graph d direction k) `Then` return
 
-findDPath :: HasCallStack => EditGraph a -> EditDistance -> Direction -> Diagonal -> Myers a Endpoint
+findDPath :: HasCallStack => EditGraph a -> Distance -> Direction -> Diagonal -> Myers a Endpoint
 findDPath graph d direction k = M (FindDPath graph d direction k) `Then` return
 
 getEq :: HasCallStack => Myers a (a -> a -> Bool)

From f63e810c31ccbf6539b3d16bacdfb9c2f0de1d9f Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 18:22:14 -0400
Subject: [PATCH 137/294] Define an operation to compute the edit distance.

---
 src/SES/Myers.hs | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index f6bb6e455..45a50d04d 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -13,6 +13,7 @@ import Prologue hiding (for, State)
 data MyersF element result where
   SES :: EditGraph a -> MyersF a [These a a]
   LCS :: EditGraph a -> MyersF a [a]
+  EditDistance :: EditGraph a -> MyersF a Int
   MiddleSnake :: EditGraph a -> MyersF a (Snake, Distance)
   SearchUpToD :: EditGraph a -> Distance -> MyersF a (Maybe (Snake, Distance))
   SearchAlongK :: EditGraph a -> Distance -> Direction -> Diagonal -> MyersF a (Maybe (Snake, Distance))
@@ -107,6 +108,8 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
       else
         return (zipWith These (toList as) (toList bs))
 
+  EditDistance graph -> unDistance . snd <$> middleSnake graph
+
   MiddleSnake graph -> do
     result <- for [0..maxD] (searchUpToD graph . Distance)
     case result of
@@ -256,6 +259,7 @@ editGraph :: MyersF a b -> EditGraph a
 editGraph myers = case myers of
   SES g -> g
   LCS g -> g
+  EditDistance g -> g
   MiddleSnake g -> g
   SearchUpToD g _ -> g
   SearchAlongK g _ _ _ -> g
@@ -290,6 +294,7 @@ instance Show2 MyersF where
   liftShowsPrec2 sp1 sl1 _ _ d m = case m of
     SES graph -> showsUnaryWith (liftShowsPrec sp1 sl1) "SES" d graph
     LCS graph -> showsUnaryWith (liftShowsPrec sp1 sl1) "LCS" d graph
+    EditDistance graph -> showsUnaryWith (liftShowsPrec sp1 sl1) "EditDistance" d graph
     MiddleSnake graph -> showsUnaryWith (liftShowsPrec sp1 sl1) "MiddleSnake" d graph
     SearchUpToD graph distance -> showsBinaryWith (liftShowsPrec sp1 sl1) showsPrec "SearchUpToD" d graph distance
     SearchAlongK graph distance direction diagonal -> showsQuaternaryWith (liftShowsPrec sp1 sl1) showsPrec showsPrec showsPrec "SearchAlongK" d graph direction distance diagonal

From 85a1dc0106c2ec4cd8fdf1db497a06a8eb7f6354 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Mar 2017 18:22:56 -0400
Subject: [PATCH 138/294] Define a smart constructor for the edit distance.

---
 src/SES/Myers.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 45a50d04d..d1af0c75e 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -199,6 +199,9 @@ ses graph = M (SES graph) `Then` return
 lcs :: HasCallStack => EditGraph a -> Myers a [a]
 lcs graph = M (LCS graph) `Then` return
 
+editDistance :: HasCallStack => EditGraph a -> Myers a Int
+editDistance graph = M (EditDistance graph) `Then` return
+
 middleSnake :: HasCallStack => EditGraph a -> Myers a (Snake, Distance)
 middleSnake graph = M (MiddleSnake graph) `Then` return
 

From 69ee63b692d0a258f7ad5edbdd070e8a2c35c992 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 14 Mar 2017 13:54:32 -0400
Subject: [PATCH 139/294] Add an operation for getting the endpoint along
 diagonal k.

---
 src/SES/Myers.hs | 24 +++++++++++++++++++-----
 1 file changed, 19 insertions(+), 5 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index d1af0c75e..efe2100e8 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -19,6 +19,8 @@ data MyersF element result where
   SearchAlongK :: EditGraph a -> Distance -> Direction -> Diagonal -> MyersF a (Maybe (Snake, Distance))
   FindDPath :: EditGraph a -> Distance -> Direction -> Diagonal -> MyersF a Endpoint
 
+  GetK :: EditGraph a -> Direction -> Diagonal -> MyersF a Int
+
 data State s a where
   Get :: State s s
   Put :: s -> State s ()
@@ -127,11 +129,11 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     else
       continue
 
-  FindDPath _ (Distance d) direction (Diagonal k) -> do
+  FindDPath graph (Distance d) direction (Diagonal k) -> do
     v <- gets (stateFor direction)
     eq <- getEq
-    let prev = v ! offsetFor direction + pred k
-    let next = v ! offsetFor direction + succ k
+    prev <- getK graph direction (Diagonal (pred k))
+    next <- getK graph direction (Diagonal (succ k))
     let x = if k == negate d || k /= d && prev < next
           then next
           else succ prev
@@ -139,6 +141,10 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     setStateFor direction (v Vector.// [(offsetFor direction + k, x')])
     return (Endpoint x' y')
 
+  GetK _ direction (Diagonal k) -> do
+    v <- gets (stateFor direction)
+    return (v ! offsetFor direction + k)
+
   where (!) = (Vector.!)
         EditGraph as bs = editGraph myers
         n = length as
@@ -214,6 +220,9 @@ searchAlongK graph d direction k = M (SearchAlongK graph d direction k) `Then` r
 findDPath :: HasCallStack => EditGraph a -> Distance -> Direction -> Diagonal -> Myers a Endpoint
 findDPath graph d direction k = M (FindDPath graph d direction k) `Then` return
 
+getK :: HasCallStack => EditGraph a -> Direction -> Diagonal -> Myers a Int
+getK graph direction diagonal = M (GetK graph direction diagonal) `Then` return
+
 getEq :: HasCallStack => Myers a (a -> a -> Bool)
 getEq = GetEq `Then` return
 
@@ -267,6 +276,7 @@ editGraph myers = case myers of
   SearchUpToD g _ -> g
   SearchAlongK g _ _ _ -> g
   FindDPath g _ _ _ -> g
+  GetK g _ _ -> g
 
 
 liftShowsVector :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Vector.Vector a -> ShowS
@@ -301,8 +311,12 @@ instance Show2 MyersF where
     MiddleSnake graph -> showsUnaryWith (liftShowsPrec sp1 sl1) "MiddleSnake" d graph
     SearchUpToD graph distance -> showsBinaryWith (liftShowsPrec sp1 sl1) showsPrec "SearchUpToD" d graph distance
     SearchAlongK graph distance direction diagonal -> showsQuaternaryWith (liftShowsPrec sp1 sl1) showsPrec showsPrec showsPrec "SearchAlongK" d graph direction distance diagonal
-    FindDPath graph distance direction diagonal -> showsQuaternaryWith (liftShowsPrec sp1 sl1) showsPrec showsPrec showsPrec "FindDPath" d graph direction distance diagonal
-    where showsQuaternaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> (Int -> c -> ShowS) -> (Int -> d -> ShowS) -> String -> Int -> a -> b -> c -> d -> ShowS
+    FindDPath graph distance direction diagonal -> showsQuaternaryWith (liftShowsPrec sp1 sl1) showsPrec showsPrec showsPrec "FindDPath" d graph distance direction diagonal
+    GetK graph direction diagonal -> showsTernaryWith (liftShowsPrec sp1 sl1) showsPrec showsPrec "GetK" d graph direction diagonal
+    where showsTernaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> (Int -> c -> ShowS) -> String -> Int -> a -> b -> c -> ShowS
+          showsTernaryWith sp1 sp2 sp3 name d x y z = showParen (d > 10) $
+            showString name . showChar ' ' . sp1 11 x . showChar ' ' . sp2 11 y . showChar ' ' . sp3 11 z
+          showsQuaternaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> (Int -> c -> ShowS) -> (Int -> d -> ShowS) -> String -> Int -> a -> b -> c -> d -> ShowS
           showsQuaternaryWith sp1 sp2 sp3 sp4 name d x y z w = showParen (d > 10) $
             showString name . showChar ' ' . sp1 11 x . showChar ' ' . sp2 11 y . showChar ' ' . sp3 11 z . showChar ' ' . sp4 11 w
 

From ca38c098f6d62e35b5593f809fedb09ec03455d0 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 14 Mar 2017 13:58:34 -0400
Subject: [PATCH 140/294] Use getK to simplify getOppositeEndpoint.

---
 src/SES/Myers.hs | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index efe2100e8..e316c2872 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -122,7 +122,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     (<|>) <$> for [negate d, negate d + 2 .. d] (searchAlongK graph (Distance d) Forward . Diagonal)
           <*> for [negate d, negate d + 2 .. d] (searchAlongK graph (Distance d) Reverse . Diagonal)
 
-  SearchAlongK graph d direction (Diagonal k) -> do
+  SearchAlongK graph d direction k -> do
     (forwardEndpoint, reverseEndpoint) <- endpointsFor graph d direction k
     if shouldTestOn direction && diagonalFor direction k `inInterval` diagonalInterval direction d && overlaps graph forwardEndpoint reverseEndpoint then
       return (done reverseEndpoint forwardEndpoint (editDistance direction d))
@@ -146,7 +146,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     return (v ! offsetFor direction + k)
 
   where (!) = (Vector.!)
-        EditGraph as bs = editGraph myers
+        graph@(EditGraph as bs) = editGraph myers
         n = length as
         m = length bs
         delta = n - m
@@ -157,8 +157,8 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         diagonalInterval Forward (Distance d) = (delta - pred d, delta + pred d)
         diagonalInterval Reverse (Distance d) = (negate d, d)
 
-        diagonalFor Forward k = Diagonal k
-        diagonalFor Reverse k = Diagonal (k + delta)
+        diagonalFor Forward k = k
+        diagonalFor Reverse k = Diagonal (unDiagonal k + delta)
 
         shouldTestOn Forward = odd delta
         shouldTestOn Reverse = even delta
@@ -180,8 +180,8 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
             Reverse -> return (there, here)
 
         getOppositeEndpoint direction k = do
-          v <- gets (case direction of { Reverse -> backward ; Forward -> forward })
-          let x = v ! offsetFor direction + unDiagonal (diagonalFor direction k) in return $ Endpoint x (x - k)
+          x <- getK graph direction k
+          return $ Endpoint x (x - unDiagonal k)
 
         done (Endpoint x y) uv d = Just (Snake (Endpoint (n - x) (m - y)) uv, d)
         editDistance Forward (Distance d) = Distance (2 * d - 1)

From 287fa3f7af0e3e81827ffa08ca074313891e6089 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 14 Mar 2017 14:07:31 -0400
Subject: [PATCH 141/294] Define a SetK operator.

---
 src/SES/Myers.hs | 43 ++++++++++++++++++++++---------------------
 1 file changed, 22 insertions(+), 21 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index e316c2872..390d22a38 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -20,6 +20,7 @@ data MyersF element result where
   FindDPath :: EditGraph a -> Distance -> Direction -> Diagonal -> MyersF a Endpoint
 
   GetK :: EditGraph a -> Direction -> Diagonal -> MyersF a Int
+  SetK :: EditGraph a -> Direction -> Diagonal -> Int -> MyersF a ()
 
 data State s a where
   Get :: State s s
@@ -129,22 +130,24 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     else
       continue
 
-  FindDPath graph (Distance d) direction (Diagonal k) -> do
-    v <- gets (stateFor direction)
+  FindDPath graph (Distance d) direction k -> do
     eq <- getEq
-    prev <- getK graph direction (Diagonal (pred k))
-    next <- getK graph direction (Diagonal (succ k))
-    let x = if k == negate d || k /= d && prev < next
+    prev <- getK graph direction (Diagonal (pred (unDiagonal k)))
+    next <- getK graph direction (Diagonal (succ (unDiagonal k)))
+    let x = if unDiagonal k == negate d || unDiagonal k /= d && prev < next
           then next
           else succ prev
-    let Endpoint x' y' = slide Reverse eq (Endpoint x (x - k))
-    setStateFor direction (v Vector.// [(offsetFor direction + k, x')])
+    let Endpoint x' y' = slide Reverse eq (Endpoint x (x - unDiagonal k))
+    setK graph direction k x'
     return (Endpoint x' y')
 
   GetK _ direction (Diagonal k) -> do
     v <- gets (stateFor direction)
     return (v ! offsetFor direction + k)
 
+  SetK _ direction (Diagonal k) x ->
+    setStateFor direction (Vector.// [(offsetFor direction + k, x)])
+
   where (!) = (Vector.!)
         graph@(EditGraph as bs) = editGraph myers
         n = length as
@@ -166,11 +169,11 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         offsetFor Forward = maxD
         offsetFor Reverse = maxD - delta
 
-        stateFor Forward = forward
-        stateFor Reverse = backward
+        stateFor Forward = fst
+        stateFor Reverse = snd
 
-        setStateFor Forward = setForward
-        setStateFor Reverse = setBackward
+        setStateFor Forward = modify . first
+        setStateFor Reverse = modify . second
 
         endpointsFor graph d direction k = do
           here <- findDPath graph d direction (diagonalFor direction k)
@@ -223,14 +226,16 @@ findDPath graph d direction k = M (FindDPath graph d direction k) `Then` return
 getK :: HasCallStack => EditGraph a -> Direction -> Diagonal -> Myers a Int
 getK graph direction diagonal = M (GetK graph direction diagonal) `Then` return
 
+setK :: HasCallStack => EditGraph a -> Direction -> Diagonal -> Int -> Myers a ()
+setK graph direction diagonal x = M (SetK graph direction diagonal x) `Then` return
+
 getEq :: HasCallStack => Myers a (a -> a -> Bool)
 getEq = GetEq `Then` return
 
 
 -- Implementation details
 
-data MyersState = MyersState { forward :: !(Vector.Vector Int), backward :: !(Vector.Vector Int) }
-  deriving (Eq, Show)
+type MyersState = (Vector.Vector Int, Vector.Vector Int)
 
 emptyStateForStep :: Myers a b -> MyersState
 emptyStateForStep step = case step of
@@ -239,14 +244,8 @@ emptyStateForStep step = case step of
         n = length as
         m = length bs
         maxD = (m + n) `ceilDiv` 2
-    in MyersState (Vector.replicate (succ (maxD * 2)) 0) (Vector.replicate (succ (maxD * 2)) 0)
-  _ -> MyersState Vector.empty Vector.empty
-
-setForward :: Vector.Vector Int -> Myers a ()
-setForward v = modify (\ s -> s { forward = v })
-
-setBackward :: Vector.Vector Int -> Myers a ()
-setBackward v = modify (\ s -> s { backward = v })
+    in (Vector.replicate (succ (maxD * 2)) 0, Vector.replicate (succ (maxD * 2)) 0)
+  _ -> (Vector.empty, Vector.empty)
 
 overlaps :: EditGraph a -> Endpoint -> Endpoint -> Bool
 overlaps (EditGraph as _) (Endpoint x y) (Endpoint u v) = x - y == u - v && x <= length as - u
@@ -277,6 +276,7 @@ editGraph myers = case myers of
   SearchAlongK g _ _ _ -> g
   FindDPath g _ _ _ -> g
   GetK g _ _ -> g
+  SetK g _ _ _ -> g
 
 
 liftShowsVector :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Vector.Vector a -> ShowS
@@ -313,6 +313,7 @@ instance Show2 MyersF where
     SearchAlongK graph distance direction diagonal -> showsQuaternaryWith (liftShowsPrec sp1 sl1) showsPrec showsPrec showsPrec "SearchAlongK" d graph direction distance diagonal
     FindDPath graph distance direction diagonal -> showsQuaternaryWith (liftShowsPrec sp1 sl1) showsPrec showsPrec showsPrec "FindDPath" d graph distance direction diagonal
     GetK graph direction diagonal -> showsTernaryWith (liftShowsPrec sp1 sl1) showsPrec showsPrec "GetK" d graph direction diagonal
+    SetK graph direction diagonal v -> showsQuaternaryWith (liftShowsPrec sp1 sl1) showsPrec showsPrec showsPrec "SetK" d graph direction diagonal v
     where showsTernaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> (Int -> c -> ShowS) -> String -> Int -> a -> b -> c -> ShowS
           showsTernaryWith sp1 sp2 sp3 name d x y z = showParen (d > 10) $
             showString name . showChar ' ' . sp1 11 x . showChar ' ' . sp2 11 y . showChar ' ' . sp3 11 z

From 2da73c083e6d5741832554165f2daa043acf0200 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 14 Mar 2017 14:10:46 -0400
Subject: [PATCH 142/294] Only show the steps in MyersF.

---
 src/SES/Myers.hs | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 390d22a38..19e1c4dba 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -62,9 +62,12 @@ runMyers eq step = runAll (emptyStateForStep step) step
 
 runMyersSteps :: HasCallStack => (a -> a -> Bool) -> Myers a b -> [(MyersState, Myers a b)]
 runMyersSteps eq step = go (emptyStateForStep step) step
-  where go state step = let ?callStack = popCallStack callStack in (state, step) : case runMyersStep eq state step of
+  where go state step = let ?callStack = popCallStack callStack in prefix state step $ case runMyersStep eq state step of
           Left result -> [ (state, return result) ]
           Right next -> uncurry go next
+        prefix state step = case step of
+          Then (M _) _ -> ((state, step) :)
+          _ -> identity
 
 runMyersStep :: HasCallStack => (a -> a -> Bool) -> MyersState -> Myers a b -> Either b (MyersState, Myers a b)
 runMyersStep eq state step = let ?callStack = popCallStack callStack in case step of

From 4cb9889dc9c9d0073201f1d93a3195810a1c1da1 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 14 Mar 2017 14:16:03 -0400
Subject: [PATCH 143/294] Simplify how the endpoint is selected.

---
 src/SES/Myers.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 19e1c4dba..b5bca1030 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -137,12 +137,12 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     eq <- getEq
     prev <- getK graph direction (Diagonal (pred (unDiagonal k)))
     next <- getK graph direction (Diagonal (succ (unDiagonal k)))
-    let x = if unDiagonal k == negate d || unDiagonal k /= d && prev < next
+    let fromX = if unDiagonal k == negate d || unDiagonal k /= d && prev < next
           then next
           else succ prev
-    let Endpoint x' y' = slide Reverse eq (Endpoint x (x - unDiagonal k))
-    setK graph direction k x'
-    return (Endpoint x' y')
+    let endpoint = slide Reverse eq (Endpoint fromX (fromX - unDiagonal k))
+    setK graph direction k (x endpoint)
+    return endpoint
 
   GetK _ direction (Diagonal k) -> do
     v <- gets (stateFor direction)

From bdcee42716e913caf1a2b68b6fe95ab9b8482fac Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 14 Mar 2017 14:16:50 -0400
Subject: [PATCH 144/294] Simplify the packing/unpacking of the diagonal.

---
 src/SES/Myers.hs | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index b5bca1030..e40febd37 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -133,15 +133,15 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     else
       continue
 
-  FindDPath graph (Distance d) direction k -> do
+  FindDPath graph (Distance d) direction (Diagonal k) -> do
     eq <- getEq
-    prev <- getK graph direction (Diagonal (pred (unDiagonal k)))
-    next <- getK graph direction (Diagonal (succ (unDiagonal k)))
-    let fromX = if unDiagonal k == negate d || unDiagonal k /= d && prev < next
+    prev <- getK graph direction (Diagonal (pred k))
+    next <- getK graph direction (Diagonal (succ k))
+    let fromX = if k == negate d || k /= d && prev < next
           then next
           else succ prev
-    let endpoint = slide Reverse eq (Endpoint fromX (fromX - unDiagonal k))
-    setK graph direction k (x endpoint)
+    let endpoint = slide Reverse eq (Endpoint fromX (fromX - k))
+    setK graph direction (Diagonal k) (x endpoint)
     return endpoint
 
   GetK _ direction (Diagonal k) -> do

From 5c878d0b631628a8167f8fb8a184c87e6e448578 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 14 Mar 2017 14:24:24 -0400
Subject: [PATCH 145/294] Consolidate showing the graph.

---
 src/SES/Myers.hs | 19 ++++++++++---------
 1 file changed, 10 insertions(+), 9 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index e40febd37..6b2d03d38 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -308,21 +308,22 @@ instance Show1 EditGraph where
 
 instance Show2 MyersF where
   liftShowsPrec2 sp1 sl1 _ _ d m = case m of
-    SES graph -> showsUnaryWith (liftShowsPrec sp1 sl1) "SES" d graph
-    LCS graph -> showsUnaryWith (liftShowsPrec sp1 sl1) "LCS" d graph
-    EditDistance graph -> showsUnaryWith (liftShowsPrec sp1 sl1) "EditDistance" d graph
-    MiddleSnake graph -> showsUnaryWith (liftShowsPrec sp1 sl1) "MiddleSnake" d graph
-    SearchUpToD graph distance -> showsBinaryWith (liftShowsPrec sp1 sl1) showsPrec "SearchUpToD" d graph distance
-    SearchAlongK graph distance direction diagonal -> showsQuaternaryWith (liftShowsPrec sp1 sl1) showsPrec showsPrec showsPrec "SearchAlongK" d graph direction distance diagonal
-    FindDPath graph distance direction diagonal -> showsQuaternaryWith (liftShowsPrec sp1 sl1) showsPrec showsPrec showsPrec "FindDPath" d graph distance direction diagonal
-    GetK graph direction diagonal -> showsTernaryWith (liftShowsPrec sp1 sl1) showsPrec showsPrec "GetK" d graph direction diagonal
-    SetK graph direction diagonal v -> showsQuaternaryWith (liftShowsPrec sp1 sl1) showsPrec showsPrec showsPrec "SetK" d graph direction diagonal v
+    SES graph -> showsUnaryWith showGraph "SES" d graph
+    LCS graph -> showsUnaryWith showGraph "LCS" d graph
+    EditDistance graph -> showsUnaryWith showGraph "EditDistance" d graph
+    MiddleSnake graph -> showsUnaryWith showGraph "MiddleSnake" d graph
+    SearchUpToD graph distance -> showsBinaryWith showGraph showsPrec "SearchUpToD" d graph distance
+    SearchAlongK graph distance direction diagonal -> showsQuaternaryWith showGraph showsPrec showsPrec showsPrec "SearchAlongK" d graph direction distance diagonal
+    FindDPath graph distance direction diagonal -> showsQuaternaryWith showGraph showsPrec showsPrec showsPrec "FindDPath" d graph distance direction diagonal
+    GetK graph direction diagonal -> showsTernaryWith showGraph showsPrec showsPrec "GetK" d graph direction diagonal
+    SetK graph direction diagonal v -> showsQuaternaryWith showGraph showsPrec showsPrec showsPrec "SetK" d graph direction diagonal v
     where showsTernaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> (Int -> c -> ShowS) -> String -> Int -> a -> b -> c -> ShowS
           showsTernaryWith sp1 sp2 sp3 name d x y z = showParen (d > 10) $
             showString name . showChar ' ' . sp1 11 x . showChar ' ' . sp2 11 y . showChar ' ' . sp3 11 z
           showsQuaternaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> (Int -> c -> ShowS) -> (Int -> d -> ShowS) -> String -> Int -> a -> b -> c -> d -> ShowS
           showsQuaternaryWith sp1 sp2 sp3 sp4 name d x y z w = showParen (d > 10) $
             showString name . showChar ' ' . sp1 11 x . showChar ' ' . sp2 11 y . showChar ' ' . sp3 11 z . showChar ' ' . sp4 11 w
+          showGraph = (liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> EditGraph a -> ShowS) sp1 sl1
 
 instance Show a => Show1 (MyersF a) where
   liftShowsPrec = liftShowsPrec2 showsPrec showList

From 6f5c52345bb5efd556b524a97ba5d999ea459d08 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 14 Mar 2017 14:30:45 -0400
Subject: [PATCH 146/294] Define a sliding operation.

---
 src/SES/Myers.hs | 25 +++++++++++++++++--------
 1 file changed, 17 insertions(+), 8 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 6b2d03d38..842d5d12e 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -22,6 +22,8 @@ data MyersF element result where
   GetK :: EditGraph a -> Direction -> Diagonal -> MyersF a Int
   SetK :: EditGraph a -> Direction -> Diagonal -> Int -> MyersF a ()
 
+  Slide :: EditGraph a -> Direction -> Endpoint -> MyersF a Endpoint
+
 data State s a where
   Get :: State s s
   Put :: s -> State s ()
@@ -134,13 +136,12 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
       continue
 
   FindDPath graph (Distance d) direction (Diagonal k) -> do
-    eq <- getEq
     prev <- getK graph direction (Diagonal (pred k))
     next <- getK graph direction (Diagonal (succ k))
     let fromX = if k == negate d || k /= d && prev < next
           then next
           else succ prev
-    let endpoint = slide Reverse eq (Endpoint fromX (fromX - k))
+    endpoint <- slide graph Reverse (Endpoint fromX (fromX - k))
     setK graph direction (Diagonal k) (x endpoint)
     return endpoint
 
@@ -151,6 +152,15 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
   SetK _ direction (Diagonal k) x ->
     setStateFor direction (Vector.// [(offsetFor direction + k, x)])
 
+  Slide graph direction (Endpoint x y)
+    | x >= 0, x < n
+    , y >= 0, y < m -> do
+      eq <- getEq
+      if nth direction as x `eq` nth direction bs y
+        then slide graph direction (Endpoint (succ x) (succ y))
+        else return (Endpoint x y)
+    | otherwise -> return (Endpoint x y)
+
   where (!) = (Vector.!)
         graph@(EditGraph as bs) = editGraph myers
         n = length as
@@ -193,12 +203,6 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         editDistance Forward (Distance d) = Distance (2 * d - 1)
         editDistance Reverse (Distance d) = Distance (2 * d)
 
-        slide dir eq (Endpoint x y)
-          | x >= 0, x < length as
-          , y >= 0, y < length bs
-          , nth dir as x `eq` nth dir bs y = slide dir eq (Endpoint (succ x) (succ y))
-          | otherwise = Endpoint x y
-
         nth Forward v i = v ! i
         nth Reverse v i = v ! (length v - 1 - i)
 
@@ -232,6 +236,9 @@ getK graph direction diagonal = M (GetK graph direction diagonal) `Then` return
 setK :: HasCallStack => EditGraph a -> Direction -> Diagonal -> Int -> Myers a ()
 setK graph direction diagonal x = M (SetK graph direction diagonal x) `Then` return
 
+slide :: HasCallStack => EditGraph a -> Direction -> Endpoint -> Myers a Endpoint
+slide graph direction from = M (Slide graph direction from) `Then` return
+
 getEq :: HasCallStack => Myers a (a -> a -> Bool)
 getEq = GetEq `Then` return
 
@@ -280,6 +287,7 @@ editGraph myers = case myers of
   FindDPath g _ _ _ -> g
   GetK g _ _ -> g
   SetK g _ _ _ -> g
+  Slide g _ _ -> g
 
 
 liftShowsVector :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Vector.Vector a -> ShowS
@@ -317,6 +325,7 @@ instance Show2 MyersF where
     FindDPath graph distance direction diagonal -> showsQuaternaryWith showGraph showsPrec showsPrec showsPrec "FindDPath" d graph distance direction diagonal
     GetK graph direction diagonal -> showsTernaryWith showGraph showsPrec showsPrec "GetK" d graph direction diagonal
     SetK graph direction diagonal v -> showsQuaternaryWith showGraph showsPrec showsPrec showsPrec "SetK" d graph direction diagonal v
+    Slide graph direction endpoint -> showsTernaryWith showGraph showsPrec showsPrec "Slide" d graph direction endpoint
     where showsTernaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> (Int -> c -> ShowS) -> String -> Int -> a -> b -> c -> ShowS
           showsTernaryWith sp1 sp2 sp3 name d x y z = showParen (d > 10) $
             showString name . showChar ' ' . sp1 11 x . showChar ' ' . sp2 11 y . showChar ' ' . sp3 11 z

From 270187c050702df3f9b563cd4935ad61181c0a2f Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 14 Mar 2017 14:37:15 -0400
Subject: [PATCH 147/294] =?UTF-8?q?Don=E2=80=99t=20hard-code=20the=20direc?=
 =?UTF-8?q?tion.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/SES/Myers.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 842d5d12e..c7dae5428 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -141,7 +141,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     let fromX = if k == negate d || k /= d && prev < next
           then next
           else succ prev
-    endpoint <- slide graph Reverse (Endpoint fromX (fromX - k))
+    endpoint <- slide graph direction (Endpoint fromX (fromX - k))
     setK graph direction (Diagonal k) (x endpoint)
     return endpoint
 

From 9e3b440a18d914caa8f3fa7713c1b3cbe3cd2228 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 14 Mar 2017 15:01:11 -0400
Subject: [PATCH 148/294] :fire: the local binding of !.

---
 src/SES/Myers.hs | 9 ++++-----
 1 file changed, 4 insertions(+), 5 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index c7dae5428..e2cef479e 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -147,7 +147,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
 
   GetK _ direction (Diagonal k) -> do
     v <- gets (stateFor direction)
-    return (v ! offsetFor direction + k)
+    return (v Vector.! offsetFor direction + k)
 
   SetK _ direction (Diagonal k) x ->
     setStateFor direction (Vector.// [(offsetFor direction + k, x)])
@@ -161,8 +161,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         else return (Endpoint x y)
     | otherwise -> return (Endpoint x y)
 
-  where (!) = (Vector.!)
-        graph@(EditGraph as bs) = editGraph myers
+  where graph@(EditGraph as bs) = editGraph myers
         n = length as
         m = length bs
         delta = n - m
@@ -203,8 +202,8 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         editDistance Forward (Distance d) = Distance (2 * d - 1)
         editDistance Reverse (Distance d) = Distance (2 * d)
 
-        nth Forward v i = v ! i
-        nth Reverse v i = v ! (length v - 1 - i)
+        nth Forward v i = v Vector.! i
+        nth Reverse v i = v Vector.! (length v - 1 - i)
 
 
 -- Smart constructors

From d33216f1b539ae250bc5619345ad0a8125a16be2 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 14 Mar 2017 15:01:21 -0400
Subject: [PATCH 149/294] Parenthesize for precedence.

---
 src/SES/Myers.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index e2cef479e..251e10f87 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -147,7 +147,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
 
   GetK _ direction (Diagonal k) -> do
     v <- gets (stateFor direction)
-    return (v Vector.! offsetFor direction + k)
+    return (v Vector.! (offsetFor direction + k))
 
   SetK _ direction (Diagonal k) x ->
     setStateFor direction (Vector.// [(offsetFor direction + k, x)])

From f8c8bf1d07c920321d51e842275f3b252a501adb Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 14 Mar 2017 15:23:10 -0400
Subject: [PATCH 150/294] Wrap indices around the state vector.

---
 src/SES/Myers.hs | 9 ++++-----
 1 file changed, 4 insertions(+), 5 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 251e10f87..680a5c533 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -147,10 +147,10 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
 
   GetK _ direction (Diagonal k) -> do
     v <- gets (stateFor direction)
-    return (v Vector.! (offsetFor direction + k))
+    return (v Vector.! index v k)
 
   SetK _ direction (Diagonal k) x ->
-    setStateFor direction (Vector.// [(offsetFor direction + k, x)])
+    setStateFor direction (\ v -> v Vector.// [(index v k, x)])
 
   Slide graph direction (Endpoint x y)
     | x >= 0, x < n
@@ -167,6 +167,8 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         delta = n - m
         maxD = (m + n) `ceilDiv` 2
 
+        index v k = if k >= 0 then k else length v + k
+
         inInterval (Diagonal k) (lower, upper) = k >= lower && k <= upper
 
         diagonalInterval Forward (Distance d) = (delta - pred d, delta + pred d)
@@ -178,9 +180,6 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         shouldTestOn Forward = odd delta
         shouldTestOn Reverse = even delta
 
-        offsetFor Forward = maxD
-        offsetFor Reverse = maxD - delta
-
         stateFor Forward = fst
         stateFor Reverse = snd
 

From 78a13970d2d2250b39261d454c6a1f4560794f1a Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 14 Mar 2017 15:28:37 -0400
Subject: [PATCH 151/294] Get the opposite endpoint correctly.

---
 src/SES/Myers.hs | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 680a5c533..a42aab8df 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -194,9 +194,12 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
             Reverse -> return (there, here)
 
         getOppositeEndpoint direction k = do
-          x <- getK graph direction k
+          x <- getK graph (invert direction) k
           return $ Endpoint x (x - unDiagonal k)
 
+        invert Forward = Reverse
+        invert Reverse = Forward
+
         done (Endpoint x y) uv d = Just (Snake (Endpoint (n - x) (m - y)) uv, d)
         editDistance Forward (Distance d) = Distance (2 * d - 1)
         editDistance Reverse (Distance d) = Distance (2 * d)

From 258f1de677e2c7f00dc06425a831cc99571fb8f7 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 14 Mar 2017 15:29:27 -0400
Subject: [PATCH 152/294] Check for overlap in the correct diagonal.

---
 src/SES/Myers.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index a42aab8df..78a43713e 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -188,7 +188,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
 
         endpointsFor graph d direction k = do
           here <- findDPath graph d direction (diagonalFor direction k)
-          there <- getOppositeEndpoint direction k
+          there <- getOppositeEndpoint direction (diagonalFor direction k)
           case direction of
             Forward -> return (here, there)
             Reverse -> return (there, here)

From 85cee25598ac3228fc8e1205c3c5a90575edaec1 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 14 Mar 2017 15:30:41 -0400
Subject: [PATCH 153/294] Be consistent in the use of k.

---
 src/SES/Myers.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 78a43713e..fcbcbf48b 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -129,7 +129,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
           <*> for [negate d, negate d + 2 .. d] (searchAlongK graph (Distance d) Reverse . Diagonal)
 
   SearchAlongK graph d direction k -> do
-    (forwardEndpoint, reverseEndpoint) <- endpointsFor graph d direction k
+    (forwardEndpoint, reverseEndpoint) <- endpointsFor graph d direction (diagonalFor direction k)
     if shouldTestOn direction && diagonalFor direction k `inInterval` diagonalInterval direction d && overlaps graph forwardEndpoint reverseEndpoint then
       return (done reverseEndpoint forwardEndpoint (editDistance direction d))
     else
@@ -187,8 +187,8 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         setStateFor Reverse = modify . second
 
         endpointsFor graph d direction k = do
-          here <- findDPath graph d direction (diagonalFor direction k)
-          there <- getOppositeEndpoint direction (diagonalFor direction k)
+          here <- findDPath graph d direction k
+          there <- getOppositeEndpoint direction k
           case direction of
             Forward -> return (here, there)
             Reverse -> return (there, here)

From 7db935496566376b29c100b6fb9e757dd531fa5b Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 14 Mar 2017 15:35:29 -0400
Subject: [PATCH 154/294] Unpack k on the left hand side.

---
 src/SES/Myers.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index fcbcbf48b..c47211683 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -175,7 +175,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         diagonalInterval Reverse (Distance d) = (negate d, d)
 
         diagonalFor Forward k = k
-        diagonalFor Reverse k = Diagonal (unDiagonal k + delta)
+        diagonalFor Reverse (Diagonal k) = Diagonal (k + delta)
 
         shouldTestOn Forward = odd delta
         shouldTestOn Reverse = even delta

From 72a836cd8e631821cb5ab8c5a8f0a377613f31a6 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 14 Mar 2017 15:40:02 -0400
Subject: [PATCH 155/294] Simplify the feasibility test.

---
 src/SES/Myers.hs | 9 ++++-----
 1 file changed, 4 insertions(+), 5 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index c47211683..f165a5ccc 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -130,7 +130,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
 
   SearchAlongK graph d direction k -> do
     (forwardEndpoint, reverseEndpoint) <- endpointsFor graph d direction (diagonalFor direction k)
-    if shouldTestOn direction && diagonalFor direction k `inInterval` diagonalInterval direction d && overlaps graph forwardEndpoint reverseEndpoint then
+    if shouldTestOn direction && inInterval d direction k && overlaps graph forwardEndpoint reverseEndpoint then
       return (done reverseEndpoint forwardEndpoint (editDistance direction d))
     else
       continue
@@ -169,10 +169,9 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
 
         index v k = if k >= 0 then k else length v + k
 
-        inInterval (Diagonal k) (lower, upper) = k >= lower && k <= upper
-
-        diagonalInterval Forward (Distance d) = (delta - pred d, delta + pred d)
-        diagonalInterval Reverse (Distance d) = (negate d, d)
+        inInterval (Distance d) direction (Diagonal k) = case direction of
+          Forward -> k >= (delta - pred d) && k <= (delta + pred d)
+          Reverse -> (k + delta) >= negate d && (k + delta) <= d
 
         diagonalFor Forward k = k
         diagonalFor Reverse (Diagonal k) = Diagonal (k + delta)

From 456b617807950dd3a89c84264d66167d130e025c Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 14 Mar 2017 15:42:02 -0400
Subject: [PATCH 156/294] Correct the overlaps test.

---
 src/SES/Myers.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index f165a5ccc..352494127 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -258,7 +258,7 @@ emptyStateForStep step = case step of
   _ -> (Vector.empty, Vector.empty)
 
 overlaps :: EditGraph a -> Endpoint -> Endpoint -> Bool
-overlaps (EditGraph as _) (Endpoint x y) (Endpoint u v) = x - y == u - v && x <= length as - u
+overlaps (EditGraph as _) (Endpoint x y) (Endpoint u v) = x - y == u - v && length as - u <= x
 
 for :: [a] -> (a -> Myers c (Maybe b)) -> Myers c (Maybe b)
 for all run = foldr (\ a b -> (<|>) <$> run a <*> b) (return Nothing) all

From ef3748d45fd2f45f69d06af414d295964beef19c Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 14 Mar 2017 15:53:30 -0400
Subject: [PATCH 157/294] =?UTF-8?q?:fire:=20done;=20we=20don=E2=80=99t=20n?=
 =?UTF-8?q?eed=20to=20invert=20the=20reverse=20endpoint=20apparently.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/SES/Myers.hs | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 352494127..d6b8a1053 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -131,7 +131,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
   SearchAlongK graph d direction k -> do
     (forwardEndpoint, reverseEndpoint) <- endpointsFor graph d direction (diagonalFor direction k)
     if shouldTestOn direction && inInterval d direction k && overlaps graph forwardEndpoint reverseEndpoint then
-      return (done reverseEndpoint forwardEndpoint (editDistance direction d))
+      return (Just (Snake reverseEndpoint forwardEndpoint, editDistance direction d))
     else
       continue
 
@@ -199,7 +199,6 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         invert Forward = Reverse
         invert Reverse = Forward
 
-        done (Endpoint x y) uv d = Just (Snake (Endpoint (n - x) (m - y)) uv, d)
         editDistance Forward (Distance d) = Distance (2 * d - 1)
         editDistance Reverse (Distance d) = Distance (2 * d)
 

From 70968be726f57804c80acd103fd5db9f483a4e20 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 14 Mar 2017 15:55:08 -0400
Subject: [PATCH 158/294] :fire: getOppositeEndpoint.

---
 src/SES/Myers.hs | 7 ++-----
 1 file changed, 2 insertions(+), 5 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index d6b8a1053..cbcff5fe5 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -187,15 +187,12 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
 
         endpointsFor graph d direction k = do
           here <- findDPath graph d direction k
-          there <- getOppositeEndpoint direction k
+          x <- getK graph (invert direction) k
+          let there = Endpoint x (x - unDiagonal k)
           case direction of
             Forward -> return (here, there)
             Reverse -> return (there, here)
 
-        getOppositeEndpoint direction k = do
-          x <- getK graph (invert direction) k
-          return $ Endpoint x (x - unDiagonal k)
-
         invert Forward = Reverse
         invert Reverse = Forward
 

From 2395c95ffd30398d8e851634b90b43efcb099ea2 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 14 Mar 2017 15:58:58 -0400
Subject: [PATCH 159/294] Simplify how we select the nth element from the edit
 graph.

---
 src/SES/Myers.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index cbcff5fe5..c18257465 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -200,7 +200,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         editDistance Reverse (Distance d) = Distance (2 * d)
 
         nth Forward v i = v Vector.! i
-        nth Reverse v i = v Vector.! (length v - 1 - i)
+        nth Reverse v i = v Vector.! (length v - succ i)
 
 
 -- Smart constructors

From aaf7f8ac35f7f1207bc136380a9dd634138d009c Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 14 Mar 2017 16:14:30 -0400
Subject: [PATCH 160/294] :fire: an unused binding.

---
 src/SES/Myers.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index c18257465..dafc9101b 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -161,7 +161,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         else return (Endpoint x y)
     | otherwise -> return (Endpoint x y)
 
-  where graph@(EditGraph as bs) = editGraph myers
+  where EditGraph as bs = editGraph myers
         n = length as
         m = length bs
         delta = n - m

From 0f897b791e08a6a1762c40e4516aed8db7698fc6 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 14 Mar 2017 16:24:04 -0400
Subject: [PATCH 161/294] :fire: nth.

---
 src/SES/Myers.hs | 6 ++----
 1 file changed, 2 insertions(+), 4 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index dafc9101b..60f97da50 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -156,10 +156,11 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     | x >= 0, x < n
     , y >= 0, y < m -> do
       eq <- getEq
-      if nth direction as x `eq` nth direction bs y
+      if (as `at` x) `eq` (bs `at` y)
         then slide graph direction (Endpoint (succ x) (succ y))
         else return (Endpoint x y)
     | otherwise -> return (Endpoint x y)
+    where v `at` i = v Vector.! case direction of { Forward -> i ; Reverse -> length v - succ i }
 
   where EditGraph as bs = editGraph myers
         n = length as
@@ -199,9 +200,6 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         editDistance Forward (Distance d) = Distance (2 * d - 1)
         editDistance Reverse (Distance d) = Distance (2 * d)
 
-        nth Forward v i = v Vector.! i
-        nth Reverse v i = v Vector.! (length v - succ i)
-
 
 -- Smart constructors
 

From 6bbbb962ea69fb45fd4231f8113ef080d812b482 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 14 Mar 2017 21:23:14 -0400
Subject: [PATCH 162/294] Invert the reverse endpoint.

---
 src/SES/Myers.hs | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 60f97da50..e4d056841 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -143,7 +143,9 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
           else succ prev
     endpoint <- slide graph direction (Endpoint fromX (fromX - k))
     setK graph direction (Diagonal k) (x endpoint)
-    return endpoint
+    return $ case direction of
+      Forward -> endpoint
+      Reverse -> Endpoint (n - x endpoint) (m - y endpoint)
 
   GetK _ direction (Diagonal k) -> do
     v <- gets (stateFor direction)

From 44c431263210560a32fdfeb1694d0bb12ea46339 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 14 Mar 2017 21:36:43 -0400
Subject: [PATCH 163/294] =?UTF-8?q?Don=E2=80=99t=20re-fetch=20the=20length?=
 =?UTF-8?q?s.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/SES/Myers.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index e4d056841..4d2d074d8 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -96,7 +96,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         before' <- lcs before
         after' <- lcs after
         return $! before' <> toList mid <> after'
-      else if length bs > length as then
+      else if m > n then
         return (toList as)
       else
         return (toList bs)

From 0f76dd289837f181146713519c76de4126396da4 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 14 Mar 2017 21:47:04 -0400
Subject: [PATCH 164/294] SES constructs individual deletions.

---
 src/SES/Myers.hs | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 4d2d074d8..b2426ce01 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -113,6 +113,8 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         before' <- ses before
         after' <- ses after
         return $! before' <> zipWith These (toList midAs) (toList midBs) <> after'
+      else if m > n then
+        return $! zipWith These (toList as) (toList bs) <> fmap That (toList (Vector.slice n 1 bs))
       else
         return (zipWith These (toList as) (toList bs))
 

From c2f76be95ff130e9b0e2b8252fae88aebf051054 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 14 Mar 2017 21:48:37 -0400
Subject: [PATCH 165/294] Index the vector instead of slicing.

---
 src/SES/Myers.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index b2426ce01..08cda8305 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -114,7 +114,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         after' <- ses after
         return $! before' <> zipWith These (toList midAs) (toList midBs) <> after'
       else if m > n then
-        return $! zipWith These (toList as) (toList bs) <> fmap That (toList (Vector.slice n 1 bs))
+        return $! zipWith These (toList as) (toList bs) <> [ That (bs Vector.! n) ]
       else
         return (zipWith These (toList as) (toList bs))
 

From f01cf5f84cbdbcde789252ac87197f58f354dbab Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 14 Mar 2017 21:49:30 -0400
Subject: [PATCH 166/294] SES constructs individual insertions.

---
 src/SES/Myers.hs | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 08cda8305..a5de12610 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -115,6 +115,8 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         return $! before' <> zipWith These (toList midAs) (toList midBs) <> after'
       else if m > n then
         return $! zipWith These (toList as) (toList bs) <> [ That (bs Vector.! n) ]
+      else if n > m then
+        return $! zipWith These (toList as) (toList bs) <> [ This (as Vector.! m) ]
       else
         return (zipWith These (toList as) (toList bs))
 

From 51cd572b3b4b715cd2c65ca2377d3f5ab7fb6c16 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 14 Mar 2017 21:53:06 -0400
Subject: [PATCH 167/294] Simplify the individual insertion/deletion code.

---
 src/SES/Myers.hs | 6 ++----
 1 file changed, 2 insertions(+), 4 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index a5de12610..04c30f496 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -113,10 +113,8 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         before' <- ses before
         after' <- ses after
         return $! before' <> zipWith These (toList midAs) (toList midBs) <> after'
-      else if m > n then
-        return $! zipWith These (toList as) (toList bs) <> [ That (bs Vector.! n) ]
-      else if n > m then
-        return $! zipWith These (toList as) (toList bs) <> [ This (as Vector.! m) ]
+      else if d == 1 then
+        return $! zipWith These (toList as) (toList bs) <> [ if m > n then That (bs Vector.! n) else This (as Vector.! m) ]
       else
         return (zipWith These (toList as) (toList bs))
 

From dceff54c31dcb15a7045431f0ffadbce70cce4e7 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 14 Mar 2017 22:02:21 -0400
Subject: [PATCH 168/294] EditGraph has two type parameters.

---
 src/SES/Myers.hs | 54 ++++++++++++++++++++++++------------------------
 1 file changed, 27 insertions(+), 27 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 04c30f496..9f0ba02de 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -11,18 +11,18 @@ import GHC.Stack
 import Prologue hiding (for, State)
 
 data MyersF element result where
-  SES :: EditGraph a -> MyersF a [These a a]
-  LCS :: EditGraph a -> MyersF a [a]
-  EditDistance :: EditGraph a -> MyersF a Int
-  MiddleSnake :: EditGraph a -> MyersF a (Snake, Distance)
-  SearchUpToD :: EditGraph a -> Distance -> MyersF a (Maybe (Snake, Distance))
-  SearchAlongK :: EditGraph a -> Distance -> Direction -> Diagonal -> MyersF a (Maybe (Snake, Distance))
-  FindDPath :: EditGraph a -> Distance -> Direction -> Diagonal -> MyersF a Endpoint
+  SES :: EditGraph a a -> MyersF a [These a a]
+  LCS :: EditGraph a a -> MyersF a [a]
+  EditDistance :: EditGraph a a -> MyersF a Int
+  MiddleSnake :: EditGraph a a -> MyersF a (Snake, Distance)
+  SearchUpToD :: EditGraph a a -> Distance -> MyersF a (Maybe (Snake, Distance))
+  SearchAlongK :: EditGraph a a -> Distance -> Direction -> Diagonal -> MyersF a (Maybe (Snake, Distance))
+  FindDPath :: EditGraph a a -> Distance -> Direction -> Diagonal -> MyersF a Endpoint
 
-  GetK :: EditGraph a -> Direction -> Diagonal -> MyersF a Int
-  SetK :: EditGraph a -> Direction -> Diagonal -> Int -> MyersF a ()
+  GetK :: EditGraph a a -> Direction -> Diagonal -> MyersF a Int
+  SetK :: EditGraph a a -> Direction -> Diagonal -> Int -> MyersF a ()
 
-  Slide :: EditGraph a -> Direction -> Endpoint -> MyersF a Endpoint
+  Slide :: EditGraph a a -> Direction -> Endpoint -> MyersF a Endpoint
 
 data State s a where
   Get :: State s s
@@ -35,7 +35,7 @@ data StepF element result where
 
 type Myers a = Freer (StepF a)
 
-data EditGraph a = EditGraph { as :: !(Vector.Vector a), bs :: !(Vector.Vector a) }
+data EditGraph a b = EditGraph { as :: !(Vector.Vector a), bs :: !(Vector.Vector b) }
   deriving (Eq, Show)
 
 data Snake = Snake { xy :: Endpoint, uv :: Endpoint }
@@ -207,34 +207,34 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
 
 -- Smart constructors
 
-ses :: HasCallStack => EditGraph a -> Myers a [These a a]
+ses :: HasCallStack => EditGraph a a -> Myers a [These a a]
 ses graph = M (SES graph) `Then` return
 
-lcs :: HasCallStack => EditGraph a -> Myers a [a]
+lcs :: HasCallStack => EditGraph a a -> Myers a [a]
 lcs graph = M (LCS graph) `Then` return
 
-editDistance :: HasCallStack => EditGraph a -> Myers a Int
+editDistance :: HasCallStack => EditGraph a a -> Myers a Int
 editDistance graph = M (EditDistance graph) `Then` return
 
-middleSnake :: HasCallStack => EditGraph a -> Myers a (Snake, Distance)
+middleSnake :: HasCallStack => EditGraph a a -> Myers a (Snake, Distance)
 middleSnake graph = M (MiddleSnake graph) `Then` return
 
-searchUpToD :: HasCallStack => EditGraph a -> Distance -> Myers a (Maybe (Snake, Distance))
+searchUpToD :: HasCallStack => EditGraph a a -> Distance -> Myers a (Maybe (Snake, Distance))
 searchUpToD graph distance = M (SearchUpToD graph distance) `Then` return
 
-searchAlongK :: HasCallStack => EditGraph a -> Distance -> Direction -> Diagonal -> Myers a (Maybe (Snake, Distance))
+searchAlongK :: HasCallStack => EditGraph a a -> Distance -> Direction -> Diagonal -> Myers a (Maybe (Snake, Distance))
 searchAlongK graph d direction k = M (SearchAlongK graph d direction k) `Then` return
 
-findDPath :: HasCallStack => EditGraph a -> Distance -> Direction -> Diagonal -> Myers a Endpoint
+findDPath :: HasCallStack => EditGraph a a -> Distance -> Direction -> Diagonal -> Myers a Endpoint
 findDPath graph d direction k = M (FindDPath graph d direction k) `Then` return
 
-getK :: HasCallStack => EditGraph a -> Direction -> Diagonal -> Myers a Int
+getK :: HasCallStack => EditGraph a a -> Direction -> Diagonal -> Myers a Int
 getK graph direction diagonal = M (GetK graph direction diagonal) `Then` return
 
-setK :: HasCallStack => EditGraph a -> Direction -> Diagonal -> Int -> Myers a ()
+setK :: HasCallStack => EditGraph a a -> Direction -> Diagonal -> Int -> Myers a ()
 setK graph direction diagonal x = M (SetK graph direction diagonal x) `Then` return
 
-slide :: HasCallStack => EditGraph a -> Direction -> Endpoint -> Myers a Endpoint
+slide :: HasCallStack => EditGraph a a -> Direction -> Endpoint -> Myers a Endpoint
 slide graph direction from = M (Slide graph direction from) `Then` return
 
 getEq :: HasCallStack => Myers a (a -> a -> Bool)
@@ -255,7 +255,7 @@ emptyStateForStep step = case step of
     in (Vector.replicate (succ (maxD * 2)) 0, Vector.replicate (succ (maxD * 2)) 0)
   _ -> (Vector.empty, Vector.empty)
 
-overlaps :: EditGraph a -> Endpoint -> Endpoint -> Bool
+overlaps :: EditGraph a b -> Endpoint -> Endpoint -> Bool
 overlaps (EditGraph as _) (Endpoint x y) (Endpoint u v) = x - y == u - v && length as - u <= x
 
 for :: [a] -> (a -> Myers c (Maybe b)) -> Myers c (Maybe b)
@@ -267,14 +267,14 @@ continue = return Nothing
 ceilDiv :: Integral a => a -> a -> a
 ceilDiv = (uncurry (+) .) . divMod
 
-divideGraph :: EditGraph a -> Endpoint -> (EditGraph a, EditGraph a)
+divideGraph :: EditGraph a b -> Endpoint -> (EditGraph a b, EditGraph a b)
 divideGraph (EditGraph as bs) (Endpoint x y) =
   ( EditGraph (slice 0  x              as) (slice 0  y              bs)
   , EditGraph (slice x (length as - x) as) (slice y (length bs - y) bs) )
   where slice from to v = Vector.slice (max 0 (min from (length v))) (max 0 (min to (length v))) v
 
 
-editGraph :: MyersF a b -> EditGraph a
+editGraph :: MyersF a b -> EditGraph a a
 editGraph myers = case myers of
   SES g -> g
   LCS g -> g
@@ -309,8 +309,8 @@ instance Show s => Show1 (State s) where
 instance Show s => Show (State s a) where
   showsPrec = liftShowsPrec (const (const identity)) (const identity)
 
-instance Show1 EditGraph where
-  liftShowsPrec sp sl d (EditGraph as bs) = showsBinaryWith (liftShowsVector sp sl) (liftShowsVector sp sl) "EditGraph" d as bs
+instance Show2 EditGraph where
+  liftShowsPrec2 sp1 sl1 sp2 sl2 d (EditGraph as bs) = showsBinaryWith (liftShowsVector sp1 sl1) (liftShowsVector sp2 sl2) "EditGraph" d as bs
 
 instance Show2 MyersF where
   liftShowsPrec2 sp1 sl1 _ _ d m = case m of
@@ -330,7 +330,7 @@ instance Show2 MyersF where
           showsQuaternaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> (Int -> c -> ShowS) -> (Int -> d -> ShowS) -> String -> Int -> a -> b -> c -> d -> ShowS
           showsQuaternaryWith sp1 sp2 sp3 sp4 name d x y z w = showParen (d > 10) $
             showString name . showChar ' ' . sp1 11 x . showChar ' ' . sp2 11 y . showChar ' ' . sp3 11 z . showChar ' ' . sp4 11 w
-          showGraph = (liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> EditGraph a -> ShowS) sp1 sl1
+          showGraph = (liftShowsPrec2 :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> (Int -> b -> ShowS) -> ([b] -> ShowS) -> Int -> EditGraph a b -> ShowS) sp1 sl1 sp1 sl1
 
 instance Show a => Show1 (MyersF a) where
   liftShowsPrec = liftShowsPrec2 showsPrec showList

From dfad93cfc1de4acdf2f7eb9c152de5732e3c5dd2 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 14 Mar 2017 22:18:02 -0400
Subject: [PATCH 169/294] Use multiple type parameters to help enforce
 correctness.

---
 src/SES/Myers.hs | 163 +++++++++++++++++++++++------------------------
 1 file changed, 81 insertions(+), 82 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 9f0ba02de..274d762d2 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -10,30 +10,30 @@ import GHC.Show
 import GHC.Stack
 import Prologue hiding (for, State)
 
-data MyersF element result where
-  SES :: EditGraph a a -> MyersF a [These a a]
-  LCS :: EditGraph a a -> MyersF a [a]
-  EditDistance :: EditGraph a a -> MyersF a Int
-  MiddleSnake :: EditGraph a a -> MyersF a (Snake, Distance)
-  SearchUpToD :: EditGraph a a -> Distance -> MyersF a (Maybe (Snake, Distance))
-  SearchAlongK :: EditGraph a a -> Distance -> Direction -> Diagonal -> MyersF a (Maybe (Snake, Distance))
-  FindDPath :: EditGraph a a -> Distance -> Direction -> Diagonal -> MyersF a Endpoint
+data MyersF a b result where
+  SES :: EditGraph a b -> MyersF a b [These a b]
+  LCS :: EditGraph a b -> MyersF a b [(a, b)]
+  EditDistance :: EditGraph a b -> MyersF a b Int
+  MiddleSnake :: EditGraph a b -> MyersF a b (Snake, Distance)
+  SearchUpToD :: EditGraph a b -> Distance -> MyersF a b (Maybe (Snake, Distance))
+  SearchAlongK :: EditGraph a b -> Distance -> Direction -> Diagonal -> MyersF a b (Maybe (Snake, Distance))
+  FindDPath :: EditGraph a b -> Distance -> Direction -> Diagonal -> MyersF a b Endpoint
 
-  GetK :: EditGraph a a -> Direction -> Diagonal -> MyersF a Int
-  SetK :: EditGraph a a -> Direction -> Diagonal -> Int -> MyersF a ()
+  GetK :: EditGraph a b -> Direction -> Diagonal -> MyersF a b Int
+  SetK :: EditGraph a b -> Direction -> Diagonal -> Int -> MyersF a b ()
 
-  Slide :: EditGraph a a -> Direction -> Endpoint -> MyersF a Endpoint
+  Slide :: EditGraph a b -> Direction -> Endpoint -> MyersF a b Endpoint
 
 data State s a where
   Get :: State s s
   Put :: s -> State s ()
 
-data StepF element result where
-  M :: MyersF a b -> StepF a b
-  S :: State MyersState b -> StepF a b
-  GetEq :: StepF a (a -> a -> Bool)
+data StepF a b result where
+  M :: MyersF a b c -> StepF a b c
+  S :: State MyersState c -> StepF a b c
+  GetEq :: StepF a b (a -> b -> Bool)
 
-type Myers a = Freer (StepF a)
+type Myers a b = Freer (StepF a b)
 
 data EditGraph a b = EditGraph { as :: !(Vector.Vector a), bs :: !(Vector.Vector b) }
   deriving (Eq, Show)
@@ -56,13 +56,13 @@ data Direction = Forward | Reverse
 
 -- Evaluation
 
-runMyers :: HasCallStack => (a -> a -> Bool) -> Myers a b -> b
+runMyers :: HasCallStack => (a -> b -> Bool) -> Myers a b c -> c
 runMyers eq step = runAll (emptyStateForStep step) step
   where runAll state step = case runMyersStep eq state step of
           Left a -> a
           Right next -> uncurry runAll next
 
-runMyersSteps :: HasCallStack => (a -> a -> Bool) -> Myers a b -> [(MyersState, Myers a b)]
+runMyersSteps :: HasCallStack => (a -> b -> Bool) -> Myers a b c -> [(MyersState, Myers a b c)]
 runMyersSteps eq step = go (emptyStateForStep step) step
   where go state step = let ?callStack = popCallStack callStack in prefix state step $ case runMyersStep eq state step of
           Left result -> [ (state, return result) ]
@@ -71,7 +71,7 @@ runMyersSteps eq step = go (emptyStateForStep step) step
           Then (M _) _ -> ((state, step) :)
           _ -> identity
 
-runMyersStep :: HasCallStack => (a -> a -> Bool) -> MyersState -> Myers a b -> Either b (MyersState, Myers a b)
+runMyersStep :: HasCallStack => (a -> b -> Bool) -> MyersState -> Myers a b c -> Either c (MyersState, Myers a b c)
 runMyersStep eq state step = let ?callStack = popCallStack callStack in case step of
   Return a -> Left a
   Then step cont -> case step of
@@ -83,7 +83,7 @@ runMyersStep eq state step = let ?callStack = popCallStack callStack in case ste
     GetEq -> Right (state, cont eq)
 
 
-decompose :: HasCallStack => MyersF a b -> Myers a b
+decompose :: HasCallStack => MyersF a b c -> Myers a b c
 decompose myers = let ?callStack = popCallStack callStack in case myers of
   LCS graph
     | null as || null bs -> return []
@@ -92,14 +92,12 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
       if d > 1 then do
         let (before, _) = divideGraph graph xy
         let (start, after) = divideGraph graph uv
-        let (EditGraph mid _, _) = divideGraph start xy
+        let (EditGraph midAs midBs, _) = divideGraph start xy
         before' <- lcs before
         after' <- lcs after
-        return $! before' <> toList mid <> after'
-      else if m > n then
-        return (toList as)
+        return $! before' <> zip (toList midAs) (toList midBs) <> after'
       else
-        return (toList bs)
+        return (zip (toList as) (toList bs))
 
   SES graph
     | null bs -> return (This <$> toList as)
@@ -164,7 +162,8 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         then slide graph direction (Endpoint (succ x) (succ y))
         else return (Endpoint x y)
     | otherwise -> return (Endpoint x y)
-    where v `at` i = v Vector.! case direction of { Forward -> i ; Reverse -> length v - succ i }
+    where at :: Vector.Vector a -> Int -> a
+          v `at` i = v Vector.! case direction of { Forward -> i ; Reverse -> length v - succ i }
 
   where EditGraph as bs = editGraph myers
         n = length as
@@ -207,37 +206,37 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
 
 -- Smart constructors
 
-ses :: HasCallStack => EditGraph a a -> Myers a [These a a]
+ses :: HasCallStack => EditGraph a b -> Myers a b [These a b]
 ses graph = M (SES graph) `Then` return
 
-lcs :: HasCallStack => EditGraph a a -> Myers a [a]
+lcs :: HasCallStack => EditGraph a b -> Myers a b [(a, b)]
 lcs graph = M (LCS graph) `Then` return
 
-editDistance :: HasCallStack => EditGraph a a -> Myers a Int
+editDistance :: HasCallStack => EditGraph a b -> Myers a b Int
 editDistance graph = M (EditDistance graph) `Then` return
 
-middleSnake :: HasCallStack => EditGraph a a -> Myers a (Snake, Distance)
+middleSnake :: HasCallStack => EditGraph a b -> Myers a b (Snake, Distance)
 middleSnake graph = M (MiddleSnake graph) `Then` return
 
-searchUpToD :: HasCallStack => EditGraph a a -> Distance -> Myers a (Maybe (Snake, Distance))
+searchUpToD :: HasCallStack => EditGraph a b -> Distance -> Myers a b (Maybe (Snake, Distance))
 searchUpToD graph distance = M (SearchUpToD graph distance) `Then` return
 
-searchAlongK :: HasCallStack => EditGraph a a -> Distance -> Direction -> Diagonal -> Myers a (Maybe (Snake, Distance))
+searchAlongK :: HasCallStack => EditGraph a b -> Distance -> Direction -> Diagonal -> Myers a b (Maybe (Snake, Distance))
 searchAlongK graph d direction k = M (SearchAlongK graph d direction k) `Then` return
 
-findDPath :: HasCallStack => EditGraph a a -> Distance -> Direction -> Diagonal -> Myers a Endpoint
+findDPath :: HasCallStack => EditGraph a b -> Distance -> Direction -> Diagonal -> Myers a b Endpoint
 findDPath graph d direction k = M (FindDPath graph d direction k) `Then` return
 
-getK :: HasCallStack => EditGraph a a -> Direction -> Diagonal -> Myers a Int
+getK :: HasCallStack => EditGraph a b -> Direction -> Diagonal -> Myers a b Int
 getK graph direction diagonal = M (GetK graph direction diagonal) `Then` return
 
-setK :: HasCallStack => EditGraph a a -> Direction -> Diagonal -> Int -> Myers a ()
+setK :: HasCallStack => EditGraph a b -> Direction -> Diagonal -> Int -> Myers a b ()
 setK graph direction diagonal x = M (SetK graph direction diagonal x) `Then` return
 
-slide :: HasCallStack => EditGraph a a -> Direction -> Endpoint -> Myers a Endpoint
+slide :: HasCallStack => EditGraph a b -> Direction -> Endpoint -> Myers a b Endpoint
 slide graph direction from = M (Slide graph direction from) `Then` return
 
-getEq :: HasCallStack => Myers a (a -> a -> Bool)
+getEq :: HasCallStack => Myers a b (a -> b -> Bool)
 getEq = GetEq `Then` return
 
 
@@ -245,7 +244,7 @@ getEq = GetEq `Then` return
 
 type MyersState = (Vector.Vector Int, Vector.Vector Int)
 
-emptyStateForStep :: Myers a b -> MyersState
+emptyStateForStep :: Myers a b c -> MyersState
 emptyStateForStep step = case step of
   Then (M myers) _ ->
     let EditGraph as bs = editGraph myers
@@ -258,10 +257,10 @@ emptyStateForStep step = case step of
 overlaps :: EditGraph a b -> Endpoint -> Endpoint -> Bool
 overlaps (EditGraph as _) (Endpoint x y) (Endpoint u v) = x - y == u - v && length as - u <= x
 
-for :: [a] -> (a -> Myers c (Maybe b)) -> Myers c (Maybe b)
+for :: [a] -> (a -> Myers c d (Maybe b)) -> Myers c d (Maybe b)
 for all run = foldr (\ a b -> (<|>) <$> run a <*> b) (return Nothing) all
 
-continue :: Myers b (Maybe a)
+continue :: Myers b c (Maybe a)
 continue = return Nothing
 
 ceilDiv :: Integral a => a -> a -> a
@@ -274,7 +273,7 @@ divideGraph (EditGraph as bs) (Endpoint x y) =
   where slice from to v = Vector.slice (max 0 (min from (length v))) (max 0 (min to (length v))) v
 
 
-editGraph :: MyersF a b -> EditGraph a a
+editGraph :: MyersF a b c -> EditGraph a b
 editGraph myers = case myers of
   SES g -> g
   LCS g -> g
@@ -291,20 +290,46 @@ editGraph myers = case myers of
 liftShowsVector :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Vector.Vector a -> ShowS
 liftShowsVector sp sl d = liftShowsPrec sp sl d . toList
 
+liftShowsMyersF :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> (Int -> b -> ShowS) -> ([b] -> ShowS) -> Int -> MyersF a b c -> ShowS
+liftShowsMyersF sp1 sl1 sp2 sl2 d m = case m of
+  SES graph -> showsUnaryWith showGraph "SES" d graph
+  LCS graph -> showsUnaryWith showGraph "LCS" d graph
+  EditDistance graph -> showsUnaryWith showGraph "EditDistance" d graph
+  MiddleSnake graph -> showsUnaryWith showGraph "MiddleSnake" d graph
+  SearchUpToD graph distance -> showsBinaryWith showGraph showsPrec "SearchUpToD" d graph distance
+  SearchAlongK graph distance direction diagonal -> showsQuaternaryWith showGraph showsPrec showsPrec showsPrec "SearchAlongK" d graph direction distance diagonal
+  FindDPath graph distance direction diagonal -> showsQuaternaryWith showGraph showsPrec showsPrec showsPrec "FindDPath" d graph distance direction diagonal
+  GetK graph direction diagonal -> showsTernaryWith showGraph showsPrec showsPrec "GetK" d graph direction diagonal
+  SetK graph direction diagonal v -> showsQuaternaryWith showGraph showsPrec showsPrec showsPrec "SetK" d graph direction diagonal v
+  Slide graph direction endpoint -> showsTernaryWith showGraph showsPrec showsPrec "Slide" d graph direction endpoint
+  where showsTernaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> (Int -> c -> ShowS) -> String -> Int -> a -> b -> c -> ShowS
+        showsTernaryWith sp1 sp2 sp3 name d x y z = showParen (d > 10) $
+          showString name . showChar ' ' . sp1 11 x . showChar ' ' . sp2 11 y . showChar ' ' . sp3 11 z
+        showsQuaternaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> (Int -> c -> ShowS) -> (Int -> d -> ShowS) -> String -> Int -> a -> b -> c -> d -> ShowS
+        showsQuaternaryWith sp1 sp2 sp3 sp4 name d x y z w = showParen (d > 10) $
+          showString name . showChar ' ' . sp1 11 x . showChar ' ' . sp2 11 y . showChar ' ' . sp3 11 z . showChar ' ' . sp4 11 w
+        showGraph = (liftShowsPrec2 :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> (Int -> b -> ShowS) -> ([b] -> ShowS) -> Int -> EditGraph a b -> ShowS) sp1 sl1 sp2 sl2
+
+liftShowsState :: (Int -> a -> ShowS) -> Int -> State a b -> ShowS
+liftShowsState sp d state = case state of
+  Get -> showString "Get"
+  Put s -> showsUnaryWith sp "Put" d s
+
+liftShowsStepF :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> (Int -> b -> ShowS) -> ([b] -> ShowS) -> Int -> StepF a b c -> ShowS
+liftShowsStepF sp1 sl1 sp2 sl2 d step = case step of
+  M m -> showsUnaryWith (liftShowsMyersF sp1 sl1 sp2 sl2) "M" d m
+  S s -> showsUnaryWith (liftShowsState showsPrec) "S" d s
+  GetEq -> showString "GetEq"
+
 
 -- Instances
 
-instance MonadState MyersState (Myers a) where
+instance MonadState MyersState (Myers a b) where
   get = S Get `Then` return
   put a = S (Put a) `Then` return
 
-instance Show2 State where
-  liftShowsPrec2 sp1 _ _ _ d state = case state of
-    Get -> showString "Get"
-    Put s -> showsUnaryWith sp1 "Put" d s
-
 instance Show s => Show1 (State s) where
-  liftShowsPrec = liftShowsPrec2 showsPrec showList
+  liftShowsPrec _ _ = liftShowsState showsPrec
 
 instance Show s => Show (State s a) where
   showsPrec = liftShowsPrec (const (const identity)) (const identity)
@@ -312,40 +337,14 @@ instance Show s => Show (State s a) where
 instance Show2 EditGraph where
   liftShowsPrec2 sp1 sl1 sp2 sl2 d (EditGraph as bs) = showsBinaryWith (liftShowsVector sp1 sl1) (liftShowsVector sp2 sl2) "EditGraph" d as bs
 
-instance Show2 MyersF where
-  liftShowsPrec2 sp1 sl1 _ _ d m = case m of
-    SES graph -> showsUnaryWith showGraph "SES" d graph
-    LCS graph -> showsUnaryWith showGraph "LCS" d graph
-    EditDistance graph -> showsUnaryWith showGraph "EditDistance" d graph
-    MiddleSnake graph -> showsUnaryWith showGraph "MiddleSnake" d graph
-    SearchUpToD graph distance -> showsBinaryWith showGraph showsPrec "SearchUpToD" d graph distance
-    SearchAlongK graph distance direction diagonal -> showsQuaternaryWith showGraph showsPrec showsPrec showsPrec "SearchAlongK" d graph direction distance diagonal
-    FindDPath graph distance direction diagonal -> showsQuaternaryWith showGraph showsPrec showsPrec showsPrec "FindDPath" d graph distance direction diagonal
-    GetK graph direction diagonal -> showsTernaryWith showGraph showsPrec showsPrec "GetK" d graph direction diagonal
-    SetK graph direction diagonal v -> showsQuaternaryWith showGraph showsPrec showsPrec showsPrec "SetK" d graph direction diagonal v
-    Slide graph direction endpoint -> showsTernaryWith showGraph showsPrec showsPrec "Slide" d graph direction endpoint
-    where showsTernaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> (Int -> c -> ShowS) -> String -> Int -> a -> b -> c -> ShowS
-          showsTernaryWith sp1 sp2 sp3 name d x y z = showParen (d > 10) $
-            showString name . showChar ' ' . sp1 11 x . showChar ' ' . sp2 11 y . showChar ' ' . sp3 11 z
-          showsQuaternaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> (Int -> c -> ShowS) -> (Int -> d -> ShowS) -> String -> Int -> a -> b -> c -> d -> ShowS
-          showsQuaternaryWith sp1 sp2 sp3 sp4 name d x y z w = showParen (d > 10) $
-            showString name . showChar ' ' . sp1 11 x . showChar ' ' . sp2 11 y . showChar ' ' . sp3 11 z . showChar ' ' . sp4 11 w
-          showGraph = (liftShowsPrec2 :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> (Int -> b -> ShowS) -> ([b] -> ShowS) -> Int -> EditGraph a b -> ShowS) sp1 sl1 sp1 sl1
+instance (Show a, Show b) => Show1 (MyersF a b) where
+  liftShowsPrec _ _ = liftShowsMyersF showsPrec showList showsPrec showList
 
-instance Show a => Show1 (MyersF a) where
-  liftShowsPrec = liftShowsPrec2 showsPrec showList
+instance (Show a, Show b) => Show (MyersF a b c) where
+  showsPrec = liftShowsMyersF showsPrec showList showsPrec showList
 
-instance Show a => Show (MyersF a b) where
-  showsPrec = liftShowsPrec (const (const identity)) (const identity)
+instance (Show a, Show b) => Show1 (StepF a b) where
+  liftShowsPrec _ _ = liftShowsStepF showsPrec showList showsPrec showList
 
-instance Show2 StepF where
-  liftShowsPrec2 sp1 sl1 sp2 sl2 d step = case step of
-    M m -> showsUnaryWith (liftShowsPrec2 sp1 sl1 sp2 sl2) "M" d m
-    S s -> showsUnaryWith (liftShowsPrec2 showsPrec showList sp2 sl2) "S" d s
-    GetEq -> showString "GetEq"
-
-instance Show a => Show1 (StepF a) where
-  liftShowsPrec = liftShowsPrec2 showsPrec showList
-
-instance Show a => Show (StepF a b) where
-  showsPrec = liftShowsPrec (const (const identity)) (const identity)
+instance (Show a, Show b) => Show (StepF a b c) where
+  showsPrec = liftShowsStepF showsPrec showList showsPrec showList

From a63ab09f0bcc89f6e28700eec6266d50677e155f Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 14 Mar 2017 22:24:32 -0400
Subject: [PATCH 170/294] Extract showsTernaryWith/showsQuaternaryWith to the
 top level.

---
 src/SES/Myers.hs | 16 +++++++++-------
 1 file changed, 9 insertions(+), 7 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 274d762d2..f118d242a 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -302,13 +302,15 @@ liftShowsMyersF sp1 sl1 sp2 sl2 d m = case m of
   GetK graph direction diagonal -> showsTernaryWith showGraph showsPrec showsPrec "GetK" d graph direction diagonal
   SetK graph direction diagonal v -> showsQuaternaryWith showGraph showsPrec showsPrec showsPrec "SetK" d graph direction diagonal v
   Slide graph direction endpoint -> showsTernaryWith showGraph showsPrec showsPrec "Slide" d graph direction endpoint
-  where showsTernaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> (Int -> c -> ShowS) -> String -> Int -> a -> b -> c -> ShowS
-        showsTernaryWith sp1 sp2 sp3 name d x y z = showParen (d > 10) $
-          showString name . showChar ' ' . sp1 11 x . showChar ' ' . sp2 11 y . showChar ' ' . sp3 11 z
-        showsQuaternaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> (Int -> c -> ShowS) -> (Int -> d -> ShowS) -> String -> Int -> a -> b -> c -> d -> ShowS
-        showsQuaternaryWith sp1 sp2 sp3 sp4 name d x y z w = showParen (d > 10) $
-          showString name . showChar ' ' . sp1 11 x . showChar ' ' . sp2 11 y . showChar ' ' . sp3 11 z . showChar ' ' . sp4 11 w
-        showGraph = (liftShowsPrec2 :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> (Int -> b -> ShowS) -> ([b] -> ShowS) -> Int -> EditGraph a b -> ShowS) sp1 sl1 sp2 sl2
+  where showGraph = (liftShowsPrec2 :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> (Int -> b -> ShowS) -> ([b] -> ShowS) -> Int -> EditGraph a b -> ShowS) sp1 sl1 sp2 sl2
+
+showsTernaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> (Int -> c -> ShowS) -> String -> Int -> a -> b -> c -> ShowS
+showsTernaryWith sp1 sp2 sp3 name d x y z = showParen (d > 10) $
+  showString name . showChar ' ' . sp1 11 x . showChar ' ' . sp2 11 y . showChar ' ' . sp3 11 z
+
+showsQuaternaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> (Int -> c -> ShowS) -> (Int -> d -> ShowS) -> String -> Int -> a -> b -> c -> d -> ShowS
+showsQuaternaryWith sp1 sp2 sp3 sp4 name d x y z w = showParen (d > 10) $
+  showString name . showChar ' ' . sp1 11 x . showChar ' ' . sp2 11 y . showChar ' ' . sp3 11 z . showChar ' ' . sp4 11 w
 
 liftShowsState :: (Int -> a -> ShowS) -> Int -> State a b -> ShowS
 liftShowsState sp d state = case state of

From de1c596d0fd8ad796674687d9aad46d5d0d202de Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 14 Mar 2017 22:27:41 -0400
Subject: [PATCH 171/294] Use an irrefutable pattern to eliminate the error
 call.

---
 src/SES/Myers.hs | 6 ++----
 1 file changed, 2 insertions(+), 4 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index f118d242a..b5a0a4095 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -119,10 +119,8 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
   EditDistance graph -> unDistance . snd <$> middleSnake graph
 
   MiddleSnake graph -> do
-    result <- for [0..maxD] (searchUpToD graph . Distance)
-    case result of
-      Just result -> return result
-      Nothing -> error "MiddleSnake must always find a value."
+    Just result <- for [0..maxD] (searchUpToD graph . Distance)
+    return result
 
   SearchUpToD graph (Distance d) ->
     (<|>) <$> for [negate d, negate d + 2 .. d] (searchAlongK graph (Distance d) Forward . Diagonal)

From 1c731b2e79709fd8010925a97e7e08b7f82e37f1 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 14 Mar 2017 22:36:15 -0400
Subject: [PATCH 172/294] Consolidate the division & conquest of LCS/SES.

---
 src/SES/Myers.hs | 45 +++++++++++++++++++++++----------------------
 1 file changed, 23 insertions(+), 22 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index b5a0a4095..070a39e61 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -88,33 +88,22 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
   LCS graph
     | null as || null bs -> return []
     | otherwise -> do
-      (Snake xy uv, Distance d) <- middleSnake graph
-      if d > 1 then do
-        let (before, _) = divideGraph graph xy
-        let (start, after) = divideGraph graph uv
-        let (EditGraph midAs midBs, _) = divideGraph start xy
-        before' <- lcs before
-        after' <- lcs after
-        return $! before' <> zip (toList midAs) (toList midBs) <> after'
-      else
-        return (zip (toList as) (toList bs))
+      result <- divideAndConquer graph lcs
+      return $! case result of
+        Left (a, EditGraph midAs midBs, c) -> a <> zip (toList midAs) (toList midBs) <> c
+        _ -> zip (toList as) (toList bs)
 
   SES graph
     | null bs -> return (This <$> toList as)
     | null as -> return (That <$> toList bs)
     | otherwise -> do
-      (Snake xy uv, Distance d) <- middleSnake graph
-      if d > 1 then do
-        let (before, _) = divideGraph graph xy
-        let (start, after) = divideGraph graph uv
-        let (EditGraph midAs midBs, _) = divideGraph start xy
-        before' <- ses before
-        after' <- ses after
-        return $! before' <> zipWith These (toList midAs) (toList midBs) <> after'
-      else if d == 1 then
-        return $! zipWith These (toList as) (toList bs) <> [ if m > n then That (bs Vector.! n) else This (as Vector.! m) ]
-      else
-        return (zipWith These (toList as) (toList bs))
+      result <- divideAndConquer graph ses
+      return $! case result of
+        Left (a, EditGraph midAs midBs, c) -> a <> zipWith These (toList midAs) (toList midBs) <> c
+        Right d -> if d == 1 then
+          zipWith These (toList as) (toList bs) <> [ if m > n then That (bs Vector.! n) else This (as Vector.! m) ]
+        else
+          zipWith These (toList as) (toList bs)
 
   EditDistance graph -> unDistance . snd <$> middleSnake graph
 
@@ -201,6 +190,18 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         editDistance Forward (Distance d) = Distance (2 * d - 1)
         editDistance Reverse (Distance d) = Distance (2 * d)
 
+        divideAndConquer graph with = do
+          (Snake xy uv, Distance d) <- middleSnake graph
+          if d > 1 then do
+            let (before, _) = divideGraph graph xy
+            let (start, after) = divideGraph graph uv
+            let (mid, _) = divideGraph start xy
+            before' <- with before
+            after' <- with after
+            return (Left (before', mid, after'))
+          else
+            return (Right d)
+
 
 -- Smart constructors
 

From 3cf5deb5f4cac78d84c3e881420f027836df5c0d Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 14 Mar 2017 22:38:34 -0400
Subject: [PATCH 173/294] Use a list comprehension to tighten up SES.

---
 src/SES/Myers.hs | 5 +----
 1 file changed, 1 insertion(+), 4 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 070a39e61..82651fd58 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -100,10 +100,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
       result <- divideAndConquer graph ses
       return $! case result of
         Left (a, EditGraph midAs midBs, c) -> a <> zipWith These (toList midAs) (toList midBs) <> c
-        Right d -> if d == 1 then
-          zipWith These (toList as) (toList bs) <> [ if m > n then That (bs Vector.! n) else This (as Vector.! m) ]
-        else
-          zipWith These (toList as) (toList bs)
+        Right d -> zipWith These (toList as) (toList bs) <> [ if m > n then That (bs Vector.! n) else This (as Vector.! m) | d == 1 ]
 
   EditDistance graph -> unDistance . snd <$> middleSnake graph
 

From 5399c9cfaea601ba235200cb93461b86b021d4c6 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 14 Mar 2017 22:43:35 -0400
Subject: [PATCH 174/294] Consolidate more of the derived state.

---
 src/SES/Myers.hs | 39 +++++++++++++++++----------------------
 1 file changed, 17 insertions(+), 22 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 82651fd58..2610668af 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -149,11 +149,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     where at :: Vector.Vector a -> Int -> a
           v `at` i = v Vector.! case direction of { Forward -> i ; Reverse -> length v - succ i }
 
-  where EditGraph as bs = editGraph myers
-        n = length as
-        m = length bs
-        delta = n - m
-        maxD = (m + n) `ceilDiv` 2
+  where (EditGraph as bs, n, m, maxD, delta) = editGraph myers
 
         index v k = if k >= 0 then k else length v + k
 
@@ -243,11 +239,8 @@ type MyersState = (Vector.Vector Int, Vector.Vector Int)
 emptyStateForStep :: Myers a b c -> MyersState
 emptyStateForStep step = case step of
   Then (M myers) _ ->
-    let EditGraph as bs = editGraph myers
-        n = length as
-        m = length bs
-        maxD = (m + n) `ceilDiv` 2
-    in (Vector.replicate (succ (maxD * 2)) 0, Vector.replicate (succ (maxD * 2)) 0)
+    let (_, _, _, maxD, _) = editGraph myers in
+    (Vector.replicate (succ (maxD * 2)) 0, Vector.replicate (succ (maxD * 2)) 0)
   _ -> (Vector.empty, Vector.empty)
 
 overlaps :: EditGraph a b -> Endpoint -> Endpoint -> Bool
@@ -269,18 +262,20 @@ divideGraph (EditGraph as bs) (Endpoint x y) =
   where slice from to v = Vector.slice (max 0 (min from (length v))) (max 0 (min to (length v))) v
 
 
-editGraph :: MyersF a b c -> EditGraph a b
-editGraph myers = case myers of
-  SES g -> g
-  LCS g -> g
-  EditDistance g -> g
-  MiddleSnake g -> g
-  SearchUpToD g _ -> g
-  SearchAlongK g _ _ _ -> g
-  FindDPath g _ _ _ -> g
-  GetK g _ _ -> g
-  SetK g _ _ _ -> g
-  Slide g _ _ -> g
+editGraph :: MyersF a b c -> (EditGraph a b, Int, Int, Int, Int)
+editGraph myers = (EditGraph as bs, n, m, (m + n) `ceilDiv` 2, n - m)
+  where EditGraph as bs = case myers of
+          SES g -> g
+          LCS g -> g
+          EditDistance g -> g
+          MiddleSnake g -> g
+          SearchUpToD g _ -> g
+          SearchAlongK g _ _ _ -> g
+          FindDPath g _ _ _ -> g
+          GetK g _ _ -> g
+          SetK g _ _ _ -> g
+          Slide g _ _ -> g
+        (n, m) = (length as, length bs)
 
 
 liftShowsVector :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Vector.Vector a -> ShowS

From 217b0821a77c19536947ed851c1ab12b7d10d519 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 14 Mar 2017 23:04:20 -0400
Subject: [PATCH 175/294] =?UTF-8?q?Run=20Myers=E2=80=99=20algorithm=20with?=
 =?UTF-8?q?out=20constructing=20the=20intermediate=20steps.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/SES/Myers.hs | 17 +++++++++++------
 1 file changed, 11 insertions(+), 6 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 2610668af..5fc8c364b 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE GADTs, ImplicitParams, MultiParamTypeClasses #-}
+{-# LANGUAGE GADTs, ImplicitParams, MultiParamTypeClasses, ScopedTypeVariables #-}
 module SES.Myers where
 
 import Control.Monad.Free.Freer
@@ -56,11 +56,16 @@ data Direction = Forward | Reverse
 
 -- Evaluation
 
-runMyers :: HasCallStack => (a -> b -> Bool) -> Myers a b c -> c
-runMyers eq step = runAll (emptyStateForStep step) step
-  where runAll state step = case runMyersStep eq state step of
-          Left a -> a
-          Right next -> uncurry runAll next
+runMyers :: forall a b c. HasCallStack => (a -> b -> Bool) -> Myers a b c -> c
+runMyers eq step = evalState (go step) (emptyStateForStep step)
+  where go :: forall c. Myers a b c -> StateT MyersState Identity c
+        go = iterFreerA algebra
+        algebra :: forall c x. StepF a b x -> (x -> StateT MyersState Identity c) -> StateT MyersState Identity c
+        algebra step cont = case step of
+          M m -> go (decompose m) >>= cont
+          S Get -> get >>= cont
+          S (Put s) -> put s >>= cont
+          GetEq -> cont eq
 
 runMyersSteps :: HasCallStack => (a -> b -> Bool) -> Myers a b c -> [(MyersState, Myers a b c)]
 runMyersSteps eq step = go (emptyStateForStep step) step

From 41427333d46289e03a1c2364bd6bdd7fbd4e68f8 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 14 Mar 2017 23:07:01 -0400
Subject: [PATCH 176/294] =?UTF-8?q?Run=20SES=20using=20Myers=E2=80=99=20al?=
 =?UTF-8?q?gorithm.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/SES.hs | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/src/SES.hs b/src/SES.hs
index 31050221e..9411a25fc 100644
--- a/src/SES.hs
+++ b/src/SES.hs
@@ -3,7 +3,9 @@ module SES where
 
 import qualified Data.Map as Map
 import Data.These
+import qualified Data.Vector as Vector
 import Prologue
+import qualified SES.Myers as Myers
 
 
 -- | Edit constructor for two terms, if comparable. Otherwise returns Nothing.
@@ -14,8 +16,7 @@ type Cost term = These term term -> Int
 
 -- | Find the shortest edit script (diff) between two terms given a function to compute the cost.
 ses :: Comparable term -> Cost term -> [term] -> [term] -> [These term term]
-ses canCompare cost as bs = fst <$> evalState diffState Map.empty where
-  diffState = diffAt canCompare cost (0, 0) as bs
+ses canCompare _ as bs = Myers.runMyers canCompare (Myers.ses (Myers.EditGraph (Vector.fromList as) (Vector.fromList bs)))
 
 -- | Find the shortest edit script between two terms at a given vertex in the edit graph.
 diffAt :: Comparable term -> Cost term -> (Int, Int) -> [term] -> [term] -> State (Map.Map (Int, Int) [(These term term, Int)]) [(These term term, Int)]

From b42c7e3d05f05c07f289bc38f280af470e8bad23 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 15 Mar 2017 10:33:27 -0400
Subject: [PATCH 177/294] Rename the Myers SES/LCS to indicate their linear
 space performance.

---
 src/SES.hs       |  2 +-
 src/SES/Myers.hs | 28 ++++++++++++++--------------
 2 files changed, 15 insertions(+), 15 deletions(-)

diff --git a/src/SES.hs b/src/SES.hs
index 9411a25fc..dae620c70 100644
--- a/src/SES.hs
+++ b/src/SES.hs
@@ -16,7 +16,7 @@ type Cost term = These term term -> Int
 
 -- | Find the shortest edit script (diff) between two terms given a function to compute the cost.
 ses :: Comparable term -> Cost term -> [term] -> [term] -> [These term term]
-ses canCompare _ as bs = Myers.runMyers canCompare (Myers.ses (Myers.EditGraph (Vector.fromList as) (Vector.fromList bs)))
+ses canCompare _ as bs = Myers.runMyers canCompare (Myers.sesNSpace (Myers.EditGraph (Vector.fromList as) (Vector.fromList bs)))
 
 -- | Find the shortest edit script between two terms at a given vertex in the edit graph.
 diffAt :: Comparable term -> Cost term -> (Int, Int) -> [term] -> [term] -> State (Map.Map (Int, Int) [(These term term, Int)]) [(These term term, Int)]
diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 5fc8c364b..67ec85620 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -11,8 +11,8 @@ import GHC.Stack
 import Prologue hiding (for, State)
 
 data MyersF a b result where
-  SES :: EditGraph a b -> MyersF a b [These a b]
-  LCS :: EditGraph a b -> MyersF a b [(a, b)]
+  SESNSpace :: EditGraph a b -> MyersF a b [These a b]
+  LCSNSpace :: EditGraph a b -> MyersF a b [(a, b)]
   EditDistance :: EditGraph a b -> MyersF a b Int
   MiddleSnake :: EditGraph a b -> MyersF a b (Snake, Distance)
   SearchUpToD :: EditGraph a b -> Distance -> MyersF a b (Maybe (Snake, Distance))
@@ -90,19 +90,19 @@ runMyersStep eq state step = let ?callStack = popCallStack callStack in case ste
 
 decompose :: HasCallStack => MyersF a b c -> Myers a b c
 decompose myers = let ?callStack = popCallStack callStack in case myers of
-  LCS graph
+  LCSNSpace graph
     | null as || null bs -> return []
     | otherwise -> do
-      result <- divideAndConquer graph lcs
+      result <- divideAndConquer graph lcsNSpace
       return $! case result of
         Left (a, EditGraph midAs midBs, c) -> a <> zip (toList midAs) (toList midBs) <> c
         _ -> zip (toList as) (toList bs)
 
-  SES graph
+  SESNSpace graph
     | null bs -> return (This <$> toList as)
     | null as -> return (That <$> toList bs)
     | otherwise -> do
-      result <- divideAndConquer graph ses
+      result <- divideAndConquer graph sesNSpace
       return $! case result of
         Left (a, EditGraph midAs midBs, c) -> a <> zipWith These (toList midAs) (toList midBs) <> c
         Right d -> zipWith These (toList as) (toList bs) <> [ if m > n then That (bs Vector.! n) else This (as Vector.! m) | d == 1 ]
@@ -203,11 +203,11 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
 
 -- Smart constructors
 
-ses :: HasCallStack => EditGraph a b -> Myers a b [These a b]
-ses graph = M (SES graph) `Then` return
+sesNSpace :: HasCallStack => EditGraph a b -> Myers a b [These a b]
+sesNSpace graph = M (SESNSpace graph) `Then` return
 
-lcs :: HasCallStack => EditGraph a b -> Myers a b [(a, b)]
-lcs graph = M (LCS graph) `Then` return
+lcsNSpace :: HasCallStack => EditGraph a b -> Myers a b [(a, b)]
+lcsNSpace graph = M (LCSNSpace graph) `Then` return
 
 editDistance :: HasCallStack => EditGraph a b -> Myers a b Int
 editDistance graph = M (EditDistance graph) `Then` return
@@ -270,8 +270,8 @@ divideGraph (EditGraph as bs) (Endpoint x y) =
 editGraph :: MyersF a b c -> (EditGraph a b, Int, Int, Int, Int)
 editGraph myers = (EditGraph as bs, n, m, (m + n) `ceilDiv` 2, n - m)
   where EditGraph as bs = case myers of
-          SES g -> g
-          LCS g -> g
+          SESNSpace g -> g
+          LCSNSpace g -> g
           EditDistance g -> g
           MiddleSnake g -> g
           SearchUpToD g _ -> g
@@ -288,8 +288,8 @@ liftShowsVector sp sl d = liftShowsPrec sp sl d . toList
 
 liftShowsMyersF :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> (Int -> b -> ShowS) -> ([b] -> ShowS) -> Int -> MyersF a b c -> ShowS
 liftShowsMyersF sp1 sl1 sp2 sl2 d m = case m of
-  SES graph -> showsUnaryWith showGraph "SES" d graph
-  LCS graph -> showsUnaryWith showGraph "LCS" d graph
+  SESNSpace graph -> showsUnaryWith showGraph "SES" d graph
+  LCSNSpace graph -> showsUnaryWith showGraph "LCS" d graph
   EditDistance graph -> showsUnaryWith showGraph "EditDistance" d graph
   MiddleSnake graph -> showsUnaryWith showGraph "MiddleSnake" d graph
   SearchUpToD graph distance -> showsBinaryWith showGraph showsPrec "SearchUpToD" d graph distance

From 9c8401037e81ccde20612d7d90f5bc7be43ecbdc Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 15 Mar 2017 11:17:52 -0400
Subject: [PATCH 178/294] Revert "Rename the Myers SES/LCS to indicate their
 linear space performance."

This reverts commit 77a1791a6831c788197a8c2e3993c51798754ed3.
---
 src/SES.hs       |  2 +-
 src/SES/Myers.hs | 28 ++++++++++++++--------------
 2 files changed, 15 insertions(+), 15 deletions(-)

diff --git a/src/SES.hs b/src/SES.hs
index dae620c70..9411a25fc 100644
--- a/src/SES.hs
+++ b/src/SES.hs
@@ -16,7 +16,7 @@ type Cost term = These term term -> Int
 
 -- | Find the shortest edit script (diff) between two terms given a function to compute the cost.
 ses :: Comparable term -> Cost term -> [term] -> [term] -> [These term term]
-ses canCompare _ as bs = Myers.runMyers canCompare (Myers.sesNSpace (Myers.EditGraph (Vector.fromList as) (Vector.fromList bs)))
+ses canCompare _ as bs = Myers.runMyers canCompare (Myers.ses (Myers.EditGraph (Vector.fromList as) (Vector.fromList bs)))
 
 -- | Find the shortest edit script between two terms at a given vertex in the edit graph.
 diffAt :: Comparable term -> Cost term -> (Int, Int) -> [term] -> [term] -> State (Map.Map (Int, Int) [(These term term, Int)]) [(These term term, Int)]
diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 67ec85620..5fc8c364b 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -11,8 +11,8 @@ import GHC.Stack
 import Prologue hiding (for, State)
 
 data MyersF a b result where
-  SESNSpace :: EditGraph a b -> MyersF a b [These a b]
-  LCSNSpace :: EditGraph a b -> MyersF a b [(a, b)]
+  SES :: EditGraph a b -> MyersF a b [These a b]
+  LCS :: EditGraph a b -> MyersF a b [(a, b)]
   EditDistance :: EditGraph a b -> MyersF a b Int
   MiddleSnake :: EditGraph a b -> MyersF a b (Snake, Distance)
   SearchUpToD :: EditGraph a b -> Distance -> MyersF a b (Maybe (Snake, Distance))
@@ -90,19 +90,19 @@ runMyersStep eq state step = let ?callStack = popCallStack callStack in case ste
 
 decompose :: HasCallStack => MyersF a b c -> Myers a b c
 decompose myers = let ?callStack = popCallStack callStack in case myers of
-  LCSNSpace graph
+  LCS graph
     | null as || null bs -> return []
     | otherwise -> do
-      result <- divideAndConquer graph lcsNSpace
+      result <- divideAndConquer graph lcs
       return $! case result of
         Left (a, EditGraph midAs midBs, c) -> a <> zip (toList midAs) (toList midBs) <> c
         _ -> zip (toList as) (toList bs)
 
-  SESNSpace graph
+  SES graph
     | null bs -> return (This <$> toList as)
     | null as -> return (That <$> toList bs)
     | otherwise -> do
-      result <- divideAndConquer graph sesNSpace
+      result <- divideAndConquer graph ses
       return $! case result of
         Left (a, EditGraph midAs midBs, c) -> a <> zipWith These (toList midAs) (toList midBs) <> c
         Right d -> zipWith These (toList as) (toList bs) <> [ if m > n then That (bs Vector.! n) else This (as Vector.! m) | d == 1 ]
@@ -203,11 +203,11 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
 
 -- Smart constructors
 
-sesNSpace :: HasCallStack => EditGraph a b -> Myers a b [These a b]
-sesNSpace graph = M (SESNSpace graph) `Then` return
+ses :: HasCallStack => EditGraph a b -> Myers a b [These a b]
+ses graph = M (SES graph) `Then` return
 
-lcsNSpace :: HasCallStack => EditGraph a b -> Myers a b [(a, b)]
-lcsNSpace graph = M (LCSNSpace graph) `Then` return
+lcs :: HasCallStack => EditGraph a b -> Myers a b [(a, b)]
+lcs graph = M (LCS graph) `Then` return
 
 editDistance :: HasCallStack => EditGraph a b -> Myers a b Int
 editDistance graph = M (EditDistance graph) `Then` return
@@ -270,8 +270,8 @@ divideGraph (EditGraph as bs) (Endpoint x y) =
 editGraph :: MyersF a b c -> (EditGraph a b, Int, Int, Int, Int)
 editGraph myers = (EditGraph as bs, n, m, (m + n) `ceilDiv` 2, n - m)
   where EditGraph as bs = case myers of
-          SESNSpace g -> g
-          LCSNSpace g -> g
+          SES g -> g
+          LCS g -> g
           EditDistance g -> g
           MiddleSnake g -> g
           SearchUpToD g _ -> g
@@ -288,8 +288,8 @@ liftShowsVector sp sl d = liftShowsPrec sp sl d . toList
 
 liftShowsMyersF :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> (Int -> b -> ShowS) -> ([b] -> ShowS) -> Int -> MyersF a b c -> ShowS
 liftShowsMyersF sp1 sl1 sp2 sl2 d m = case m of
-  SESNSpace graph -> showsUnaryWith showGraph "SES" d graph
-  LCSNSpace graph -> showsUnaryWith showGraph "LCS" d graph
+  SES graph -> showsUnaryWith showGraph "SES" d graph
+  LCS graph -> showsUnaryWith showGraph "LCS" d graph
   EditDistance graph -> showsUnaryWith showGraph "EditDistance" d graph
   MiddleSnake graph -> showsUnaryWith showGraph "MiddleSnake" d graph
   SearchUpToD graph distance -> showsBinaryWith showGraph showsPrec "SearchUpToD" d graph distance

From 3834903ebcfda03ed8374b03df989cd0067cb77f Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 15 Mar 2017 11:49:45 -0400
Subject: [PATCH 179/294] MyersState holds per-diagonal edit scripts.

---
 src/SES/Myers.hs | 47 ++++++++++++++++++++++++++++++-----------------
 1 file changed, 30 insertions(+), 17 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 5fc8c364b..1d2922c3f 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -9,6 +9,7 @@ import qualified Data.Vector as Vector
 import GHC.Show
 import GHC.Stack
 import Prologue hiding (for, State)
+import Text.Show
 
 data MyersF a b result where
   SES :: EditGraph a b -> MyersF a b [These a b]
@@ -30,7 +31,7 @@ data State s a where
 
 data StepF a b result where
   M :: MyersF a b c -> StepF a b c
-  S :: State MyersState c -> StepF a b c
+  S :: State (MyersState a b) c -> StepF a b c
   GetEq :: StepF a b (a -> b -> Bool)
 
 type Myers a b = Freer (StepF a b)
@@ -58,16 +59,16 @@ data Direction = Forward | Reverse
 
 runMyers :: forall a b c. HasCallStack => (a -> b -> Bool) -> Myers a b c -> c
 runMyers eq step = evalState (go step) (emptyStateForStep step)
-  where go :: forall c. Myers a b c -> StateT MyersState Identity c
+  where go :: forall c. Myers a b c -> StateT (MyersState a b) Identity c
         go = iterFreerA algebra
-        algebra :: forall c x. StepF a b x -> (x -> StateT MyersState Identity c) -> StateT MyersState Identity c
+        algebra :: forall c x. StepF a b x -> (x -> StateT (MyersState a b) Identity c) -> StateT (MyersState a b) Identity c
         algebra step cont = case step of
           M m -> go (decompose m) >>= cont
           S Get -> get >>= cont
           S (Put s) -> put s >>= cont
           GetEq -> cont eq
 
-runMyersSteps :: HasCallStack => (a -> b -> Bool) -> Myers a b c -> [(MyersState, Myers a b c)]
+runMyersSteps :: HasCallStack => (a -> b -> Bool) -> Myers a b c -> [(MyersState a b, Myers a b c)]
 runMyersSteps eq step = go (emptyStateForStep step) step
   where go state step = let ?callStack = popCallStack callStack in prefix state step $ case runMyersStep eq state step of
           Left result -> [ (state, return result) ]
@@ -76,7 +77,7 @@ runMyersSteps eq step = go (emptyStateForStep step) step
           Then (M _) _ -> ((state, step) :)
           _ -> identity
 
-runMyersStep :: HasCallStack => (a -> b -> Bool) -> MyersState -> Myers a b c -> Either c (MyersState, Myers a b c)
+runMyersStep :: HasCallStack => (a -> b -> Bool) -> MyersState a b -> Myers a b c -> Either c (MyersState a b, Myers a b c)
 runMyersStep eq state step = let ?callStack = popCallStack callStack in case step of
   Return a -> Left a
   Then step cont -> case step of
@@ -138,10 +139,10 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
 
   GetK _ direction (Diagonal k) -> do
     v <- gets (stateFor direction)
-    return (v Vector.! index v k)
+    return (fst (v Vector.! index v k))
 
   SetK _ direction (Diagonal k) x ->
-    setStateFor direction (\ v -> v Vector.// [(index v k, x)])
+    setStateFor direction (\ v -> v Vector.// [(index v k, (x, []))])
 
   Slide graph direction (Endpoint x y)
     | x >= 0, x < n
@@ -168,11 +169,11 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         shouldTestOn Forward = odd delta
         shouldTestOn Reverse = even delta
 
-        stateFor Forward = fst
-        stateFor Reverse = snd
+        stateFor Forward = fst . unMyersState
+        stateFor Reverse = snd . unMyersState
 
-        setStateFor Forward = modify . first
-        setStateFor Reverse = modify . second
+        setStateFor Forward f = modify (MyersState . first f . unMyersState)
+        setStateFor Reverse f = modify (MyersState . second f . unMyersState)
 
         endpointsFor graph d direction k = do
           here <- findDPath graph d direction k
@@ -239,14 +240,15 @@ getEq = GetEq `Then` return
 
 -- Implementation details
 
-type MyersState = (Vector.Vector Int, Vector.Vector Int)
+newtype MyersState a b = MyersState { unMyersState :: (Vector.Vector (Int, [These a b]), Vector.Vector (Int, [These a b])) }
+  deriving (Eq, Show)
 
-emptyStateForStep :: Myers a b c -> MyersState
+emptyStateForStep :: Myers a b c -> MyersState a b
 emptyStateForStep step = case step of
   Then (M myers) _ ->
     let (_, _, _, maxD, _) = editGraph myers in
-    (Vector.replicate (succ (maxD * 2)) 0, Vector.replicate (succ (maxD * 2)) 0)
-  _ -> (Vector.empty, Vector.empty)
+    MyersState (Vector.replicate (succ (maxD * 2)) (0, []), Vector.replicate (succ (maxD * 2)) (0, []))
+  _ -> MyersState (Vector.empty, Vector.empty)
 
 overlaps :: EditGraph a b -> Endpoint -> Endpoint -> Bool
 overlaps (EditGraph as _) (Endpoint x y) (Endpoint u v) = x - y == u - v && length as - u <= x
@@ -316,16 +318,27 @@ liftShowsState sp d state = case state of
 liftShowsStepF :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> (Int -> b -> ShowS) -> ([b] -> ShowS) -> Int -> StepF a b c -> ShowS
 liftShowsStepF sp1 sl1 sp2 sl2 d step = case step of
   M m -> showsUnaryWith (liftShowsMyersF sp1 sl1 sp2 sl2) "M" d m
-  S s -> showsUnaryWith (liftShowsState showsPrec) "S" d s
+  S s -> showsUnaryWith (liftShowsState (liftShowsPrec2 sp1 sl1 sp2 sl2)) "S" d s
   GetEq -> showString "GetEq"
 
+liftShowsThese :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> Int -> These a b -> ShowS
+liftShowsThese sa sb d t = case t of
+  This a -> showsUnaryWith sa "This" d a
+  That b -> showsUnaryWith sb "That" d b
+  These a b -> showsBinaryWith sa sb "These" d a b
+
 
 -- Instances
 
-instance MonadState MyersState (Myers a b) where
+instance MonadState (MyersState a b) (Myers a b) where
   get = S Get `Then` return
   put a = S (Put a) `Then` return
 
+instance Show2 MyersState where
+  liftShowsPrec2 sp1 _ sp2 _ d (MyersState (v1, v2)) = showsUnaryWith (showsWith (showsWith liftShowsPrec2 showsStateVector) showsStateVector) "MyersState" d (v1, v2)
+    where showsStateVector = showsWith liftShowsVector (showsWith liftShowsPrec (showsWith liftShowsPrec (liftShowsThese sp1 sp2)))
+          showsWith g f = g f (showListWith (f 0))
+
 instance Show s => Show1 (State s) where
   liftShowsPrec _ _ = liftShowsState showsPrec
 

From 7c7e559b4796d4ef070175bd495c9b2b238ab6f6 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 15 Mar 2017 11:52:41 -0400
Subject: [PATCH 180/294] Add a type synonym for edit scripts.

---
 src/SES/Myers.hs | 8 +++++---
 1 file changed, 5 insertions(+), 3 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 1d2922c3f..ec48edbab 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -12,7 +12,7 @@ import Prologue hiding (for, State)
 import Text.Show
 
 data MyersF a b result where
-  SES :: EditGraph a b -> MyersF a b [These a b]
+  SES :: EditGraph a b -> MyersF a b (EditScript a b)
   LCS :: EditGraph a b -> MyersF a b [(a, b)]
   EditDistance :: EditGraph a b -> MyersF a b Int
   MiddleSnake :: EditGraph a b -> MyersF a b (Snake, Distance)
@@ -25,6 +25,8 @@ data MyersF a b result where
 
   Slide :: EditGraph a b -> Direction -> Endpoint -> MyersF a b Endpoint
 
+type EditScript a b = [These a b]
+
 data State s a where
   Get :: State s s
   Put :: s -> State s ()
@@ -204,7 +206,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
 
 -- Smart constructors
 
-ses :: HasCallStack => EditGraph a b -> Myers a b [These a b]
+ses :: HasCallStack => EditGraph a b -> Myers a b (EditScript a b)
 ses graph = M (SES graph) `Then` return
 
 lcs :: HasCallStack => EditGraph a b -> Myers a b [(a, b)]
@@ -240,7 +242,7 @@ getEq = GetEq `Then` return
 
 -- Implementation details
 
-newtype MyersState a b = MyersState { unMyersState :: (Vector.Vector (Int, [These a b]), Vector.Vector (Int, [These a b])) }
+newtype MyersState a b = MyersState { unMyersState :: (Vector.Vector (Int, (EditScript a b)), Vector.Vector (Int, (EditScript a b))) }
   deriving (Eq, Show)
 
 emptyStateForStep :: Myers a b c -> MyersState a b

From 81762c9119c1b0efa74eccedee71a3d1506d6525 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 15 Mar 2017 11:54:44 -0400
Subject: [PATCH 181/294] getK returns the edit script thus far.

---
 src/SES/Myers.hs | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index ec48edbab..804f5ada4 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -20,7 +20,7 @@ data MyersF a b result where
   SearchAlongK :: EditGraph a b -> Distance -> Direction -> Diagonal -> MyersF a b (Maybe (Snake, Distance))
   FindDPath :: EditGraph a b -> Distance -> Direction -> Diagonal -> MyersF a b Endpoint
 
-  GetK :: EditGraph a b -> Direction -> Diagonal -> MyersF a b Int
+  GetK :: EditGraph a b -> Direction -> Diagonal -> MyersF a b (Int, EditScript a b)
   SetK :: EditGraph a b -> Direction -> Diagonal -> Int -> MyersF a b ()
 
   Slide :: EditGraph a b -> Direction -> Endpoint -> MyersF a b Endpoint
@@ -128,8 +128,8 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
       continue
 
   FindDPath graph (Distance d) direction (Diagonal k) -> do
-    prev <- getK graph direction (Diagonal (pred k))
-    next <- getK graph direction (Diagonal (succ k))
+    (prev, _) <- getK graph direction (Diagonal (pred k))
+    (next, _) <- getK graph direction (Diagonal (succ k))
     let fromX = if k == negate d || k /= d && prev < next
           then next
           else succ prev
@@ -141,7 +141,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
 
   GetK _ direction (Diagonal k) -> do
     v <- gets (stateFor direction)
-    return (fst (v Vector.! index v k))
+    return (v Vector.! index v k)
 
   SetK _ direction (Diagonal k) x ->
     setStateFor direction (\ v -> v Vector.// [(index v k, (x, []))])
@@ -179,7 +179,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
 
         endpointsFor graph d direction k = do
           here <- findDPath graph d direction k
-          x <- getK graph (invert direction) k
+          (x, _) <- getK graph (invert direction) k
           let there = Endpoint x (x - unDiagonal k)
           case direction of
             Forward -> return (here, there)
@@ -227,7 +227,7 @@ searchAlongK graph d direction k = M (SearchAlongK graph d direction k) `Then` r
 findDPath :: HasCallStack => EditGraph a b -> Distance -> Direction -> Diagonal -> Myers a b Endpoint
 findDPath graph d direction k = M (FindDPath graph d direction k) `Then` return
 
-getK :: HasCallStack => EditGraph a b -> Direction -> Diagonal -> Myers a b Int
+getK :: HasCallStack => EditGraph a b -> Direction -> Diagonal -> Myers a b (Int, EditScript a b)
 getK graph direction diagonal = M (GetK graph direction diagonal) `Then` return
 
 setK :: HasCallStack => EditGraph a b -> Direction -> Diagonal -> Int -> Myers a b ()

From d0c472a80337e958ff90ec56c0474371199fbf43 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 15 Mar 2017 11:58:30 -0400
Subject: [PATCH 182/294] Add a shows helper for quinary constructors.

---
 src/SES/Myers.hs | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 804f5ada4..7bbaf0d97 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -312,6 +312,10 @@ showsQuaternaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> (Int -> c -
 showsQuaternaryWith sp1 sp2 sp3 sp4 name d x y z w = showParen (d > 10) $
   showString name . showChar ' ' . sp1 11 x . showChar ' ' . sp2 11 y . showChar ' ' . sp3 11 z . showChar ' ' . sp4 11 w
 
+showsQuinaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> (Int -> c -> ShowS) -> (Int -> d -> ShowS) -> (Int -> e -> ShowS) -> String -> Int -> a -> b -> c -> d -> e -> ShowS
+showsQuinaryWith sp1 sp2 sp3 sp4 sp5 name d x y z w v = showParen (d > 10) $
+  showString name . showChar ' ' . sp1 11 x . showChar ' ' . sp2 11 y . showChar ' ' . sp3 11 z . showChar ' ' . sp4 11 w . showChar ' ' . sp5 11 v
+
 liftShowsState :: (Int -> a -> ShowS) -> Int -> State a b -> ShowS
 liftShowsState sp d state = case state of
   Get -> showString "Get"

From dc9381aa58a76bf4df3ebc23b3df57992f33eab7 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 15 Mar 2017 12:04:20 -0400
Subject: [PATCH 183/294] Extract a function to show an edit script.

---
 src/SES/Myers.hs | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 7bbaf0d97..2c3f1ae21 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -333,6 +333,9 @@ liftShowsThese sa sb d t = case t of
   That b -> showsUnaryWith sb "That" d b
   These a b -> showsBinaryWith sa sb "These" d a b
 
+liftShowsEditScript :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> Int -> EditScript a b -> ShowS
+liftShowsEditScript sa sb _ = showListWith (liftShowsThese sa sb 0)
+
 
 -- Instances
 
@@ -342,7 +345,7 @@ instance MonadState (MyersState a b) (Myers a b) where
 
 instance Show2 MyersState where
   liftShowsPrec2 sp1 _ sp2 _ d (MyersState (v1, v2)) = showsUnaryWith (showsWith (showsWith liftShowsPrec2 showsStateVector) showsStateVector) "MyersState" d (v1, v2)
-    where showsStateVector = showsWith liftShowsVector (showsWith liftShowsPrec (showsWith liftShowsPrec (liftShowsThese sp1 sp2)))
+    where showsStateVector = showsWith liftShowsVector (showsWith liftShowsPrec (liftShowsEditScript sp1 sp2))
           showsWith g f = g f (showListWith (f 0))
 
 instance Show s => Show1 (State s) where

From d2988e1daa28b7f2ce82967a7003b0bbeb378354 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 15 Mar 2017 12:04:34 -0400
Subject: [PATCH 184/294] SetK takes an edit script.

---
 src/SES/Myers.hs | 16 ++++++++--------
 1 file changed, 8 insertions(+), 8 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 2c3f1ae21..35a009972 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -21,7 +21,7 @@ data MyersF a b result where
   FindDPath :: EditGraph a b -> Distance -> Direction -> Diagonal -> MyersF a b Endpoint
 
   GetK :: EditGraph a b -> Direction -> Diagonal -> MyersF a b (Int, EditScript a b)
-  SetK :: EditGraph a b -> Direction -> Diagonal -> Int -> MyersF a b ()
+  SetK :: EditGraph a b -> Direction -> Diagonal -> Int -> EditScript a b -> MyersF a b ()
 
   Slide :: EditGraph a b -> Direction -> Endpoint -> MyersF a b Endpoint
 
@@ -134,7 +134,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
           then next
           else succ prev
     endpoint <- slide graph direction (Endpoint fromX (fromX - k))
-    setK graph direction (Diagonal k) (x endpoint)
+    setK graph direction (Diagonal k) (x endpoint) []
     return $ case direction of
       Forward -> endpoint
       Reverse -> Endpoint (n - x endpoint) (m - y endpoint)
@@ -143,8 +143,8 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     v <- gets (stateFor direction)
     return (v Vector.! index v k)
 
-  SetK _ direction (Diagonal k) x ->
-    setStateFor direction (\ v -> v Vector.// [(index v k, (x, []))])
+  SetK _ direction (Diagonal k) x script ->
+    setStateFor direction (\ v -> v Vector.// [(index v k, (x, script))])
 
   Slide graph direction (Endpoint x y)
     | x >= 0, x < n
@@ -230,8 +230,8 @@ findDPath graph d direction k = M (FindDPath graph d direction k) `Then` return
 getK :: HasCallStack => EditGraph a b -> Direction -> Diagonal -> Myers a b (Int, EditScript a b)
 getK graph direction diagonal = M (GetK graph direction diagonal) `Then` return
 
-setK :: HasCallStack => EditGraph a b -> Direction -> Diagonal -> Int -> Myers a b ()
-setK graph direction diagonal x = M (SetK graph direction diagonal x) `Then` return
+setK :: HasCallStack => EditGraph a b -> Direction -> Diagonal -> Int -> EditScript a b -> Myers a b ()
+setK graph direction diagonal x script = M (SetK graph direction diagonal x script) `Then` return
 
 slide :: HasCallStack => EditGraph a b -> Direction -> Endpoint -> Myers a b Endpoint
 slide graph direction from = M (Slide graph direction from) `Then` return
@@ -282,7 +282,7 @@ editGraph myers = (EditGraph as bs, n, m, (m + n) `ceilDiv` 2, n - m)
           SearchAlongK g _ _ _ -> g
           FindDPath g _ _ _ -> g
           GetK g _ _ -> g
-          SetK g _ _ _ -> g
+          SetK g _ _ _ _ -> g
           Slide g _ _ -> g
         (n, m) = (length as, length bs)
 
@@ -300,7 +300,7 @@ liftShowsMyersF sp1 sl1 sp2 sl2 d m = case m of
   SearchAlongK graph distance direction diagonal -> showsQuaternaryWith showGraph showsPrec showsPrec showsPrec "SearchAlongK" d graph direction distance diagonal
   FindDPath graph distance direction diagonal -> showsQuaternaryWith showGraph showsPrec showsPrec showsPrec "FindDPath" d graph distance direction diagonal
   GetK graph direction diagonal -> showsTernaryWith showGraph showsPrec showsPrec "GetK" d graph direction diagonal
-  SetK graph direction diagonal v -> showsQuaternaryWith showGraph showsPrec showsPrec showsPrec "SetK" d graph direction diagonal v
+  SetK graph direction diagonal v script -> showsQuinaryWith showGraph showsPrec showsPrec showsPrec (liftShowsEditScript sp1 sp2) "SetK" d graph direction diagonal v script
   Slide graph direction endpoint -> showsTernaryWith showGraph showsPrec showsPrec "Slide" d graph direction endpoint
   where showGraph = (liftShowsPrec2 :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> (Int -> b -> ShowS) -> ([b] -> ShowS) -> Int -> EditGraph a b -> ShowS) sp1 sl1 sp2 sl2
 

From d25421d69b9e8ba9148868f39f9e8c5ec9681121 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 15 Mar 2017 12:14:43 -0400
Subject: [PATCH 185/294] Sliding (nominally) produces the script of copied
 elements.

---
 src/SES/Myers.hs | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 35a009972..b066220de 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -23,7 +23,7 @@ data MyersF a b result where
   GetK :: EditGraph a b -> Direction -> Diagonal -> MyersF a b (Int, EditScript a b)
   SetK :: EditGraph a b -> Direction -> Diagonal -> Int -> EditScript a b -> MyersF a b ()
 
-  Slide :: EditGraph a b -> Direction -> Endpoint -> MyersF a b Endpoint
+  Slide :: EditGraph a b -> Direction -> Endpoint -> MyersF a b (Endpoint, EditScript a b)
 
 type EditScript a b = [These a b]
 
@@ -133,8 +133,8 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     let fromX = if k == negate d || k /= d && prev < next
           then next
           else succ prev
-    endpoint <- slide graph direction (Endpoint fromX (fromX - k))
-    setK graph direction (Diagonal k) (x endpoint) []
+    (endpoint, script) <- slide graph direction (Endpoint fromX (fromX - k))
+    setK graph direction (Diagonal k) (x endpoint) script
     return $ case direction of
       Forward -> endpoint
       Reverse -> Endpoint (n - x endpoint) (m - y endpoint)
@@ -152,8 +152,8 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
       eq <- getEq
       if (as `at` x) `eq` (bs `at` y)
         then slide graph direction (Endpoint (succ x) (succ y))
-        else return (Endpoint x y)
-    | otherwise -> return (Endpoint x y)
+        else return (Endpoint x y, [])
+    | otherwise -> return (Endpoint x y, [])
     where at :: Vector.Vector a -> Int -> a
           v `at` i = v Vector.! case direction of { Forward -> i ; Reverse -> length v - succ i }
 
@@ -233,7 +233,7 @@ getK graph direction diagonal = M (GetK graph direction diagonal) `Then` return
 setK :: HasCallStack => EditGraph a b -> Direction -> Diagonal -> Int -> EditScript a b -> Myers a b ()
 setK graph direction diagonal x script = M (SetK graph direction diagonal x script) `Then` return
 
-slide :: HasCallStack => EditGraph a b -> Direction -> Endpoint -> Myers a b Endpoint
+slide :: HasCallStack => EditGraph a b -> Direction -> Endpoint -> Myers a b (Endpoint, EditScript a b)
 slide graph direction from = M (Slide graph direction from) `Then` return
 
 getEq :: HasCallStack => Myers a b (a -> b -> Bool)

From 2c0089ed9052384d58450c3bcd719cae284b1dbe Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 15 Mar 2017 12:15:33 -0400
Subject: [PATCH 186/294] Constrain sliding to only produce copies.

---
 src/SES/Myers.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index b066220de..ba8d4aa3f 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -23,7 +23,7 @@ data MyersF a b result where
   GetK :: EditGraph a b -> Direction -> Diagonal -> MyersF a b (Int, EditScript a b)
   SetK :: EditGraph a b -> Direction -> Diagonal -> Int -> EditScript a b -> MyersF a b ()
 
-  Slide :: EditGraph a b -> Direction -> Endpoint -> MyersF a b (Endpoint, EditScript a b)
+  Slide :: EditGraph a b -> Direction -> Endpoint -> MyersF a b (Endpoint, [(a, b)])
 
 type EditScript a b = [These a b]
 
@@ -134,7 +134,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
           then next
           else succ prev
     (endpoint, script) <- slide graph direction (Endpoint fromX (fromX - k))
-    setK graph direction (Diagonal k) (x endpoint) script
+    setK graph direction (Diagonal k) (x endpoint) (uncurry These <$> script)
     return $ case direction of
       Forward -> endpoint
       Reverse -> Endpoint (n - x endpoint) (m - y endpoint)
@@ -233,7 +233,7 @@ getK graph direction diagonal = M (GetK graph direction diagonal) `Then` return
 setK :: HasCallStack => EditGraph a b -> Direction -> Diagonal -> Int -> EditScript a b -> Myers a b ()
 setK graph direction diagonal x script = M (SetK graph direction diagonal x script) `Then` return
 
-slide :: HasCallStack => EditGraph a b -> Direction -> Endpoint -> Myers a b (Endpoint, EditScript a b)
+slide :: HasCallStack => EditGraph a b -> Direction -> Endpoint -> Myers a b (Endpoint, [(a, b)])
 slide graph direction from = M (Slide graph direction from) `Then` return
 
 getEq :: HasCallStack => Myers a b (a -> b -> Bool)

From 646f7c9822bcb6b0e015bf3d3c8756df0d437455 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 15 Mar 2017 12:19:05 -0400
Subject: [PATCH 187/294] Prepend or append matched elements when sliding.

---
 src/SES/Myers.hs | 7 +++++--
 1 file changed, 5 insertions(+), 2 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index ba8d4aa3f..94c7544e6 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -150,12 +150,15 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     | x >= 0, x < n
     , y >= 0, y < m -> do
       eq <- getEq
-      if (as `at` x) `eq` (bs `at` y)
-        then slide graph direction (Endpoint (succ x) (succ y))
+      let a = as `at` x
+      let b = bs `at` y
+      if a `eq` b
+        then second (add (a, b)) <$> slide graph direction (Endpoint (succ x) (succ y))
         else return (Endpoint x y, [])
     | otherwise -> return (Endpoint x y, [])
     where at :: Vector.Vector a -> Int -> a
           v `at` i = v Vector.! case direction of { Forward -> i ; Reverse -> length v - succ i }
+          add pair = case direction of { Forward -> (++ [pair]) ; Reverse -> (pair :) }
 
   where (EditGraph as bs, n, m, maxD, delta) = editGraph myers
 

From 8f185d9310c7e1e1e1702e17df8b952e8e9c733c Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 15 Mar 2017 16:50:51 -0400
Subject: [PATCH 188/294] Carry computed paths along.

---
 src/SES/Myers.hs | 38 +++++++++++++++++++++-----------------
 1 file changed, 21 insertions(+), 17 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 94c7544e6..051878f8f 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -23,7 +23,7 @@ data MyersF a b result where
   GetK :: EditGraph a b -> Direction -> Diagonal -> MyersF a b (Int, EditScript a b)
   SetK :: EditGraph a b -> Direction -> Diagonal -> Int -> EditScript a b -> MyersF a b ()
 
-  Slide :: EditGraph a b -> Direction -> Endpoint -> MyersF a b (Endpoint, [(a, b)])
+  Slide :: EditGraph a b -> Direction -> Endpoint -> EditScript a b -> MyersF a b (Endpoint, EditScript a b)
 
 type EditScript a b = [These a b]
 
@@ -128,16 +128,18 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
       continue
 
   FindDPath graph (Distance d) direction (Diagonal k) -> do
-    (prev, _) <- getK graph direction (Diagonal (pred k))
-    (next, _) <- getK graph direction (Diagonal (succ k))
-    let fromX = if k == negate d || k /= d && prev < next
-          then next
-          else succ prev
-    (endpoint, script) <- slide graph direction (Endpoint fromX (fromX - k))
-    setK graph direction (Diagonal k) (x endpoint) (uncurry These <$> script)
+    (prev, prevScript) <- getK graph direction (Diagonal (pred k))
+    (next, nextScript) <- getK graph direction (Diagonal (succ k))
+    let (fromX, fromScript) = if k == negate d || k /= d && prev < next
+          then (next, nextScript)
+          else (succ prev, prevScript)
+    (endpoint, script) <- slide graph direction (Endpoint fromX (fromX - k)) fromScript
+    setK graph direction (Diagonal k) (x endpoint) script
     return $ case direction of
       Forward -> endpoint
       Reverse -> Endpoint (n - x endpoint) (m - y endpoint)
+    where at :: Vector.Vector a -> Int -> a
+          v `at` i = v Vector.! case direction of { Forward -> i ; Reverse -> length v - succ i }
 
   GetK _ direction (Diagonal k) -> do
     v <- gets (stateFor direction)
@@ -146,19 +148,18 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
   SetK _ direction (Diagonal k) x script ->
     setStateFor direction (\ v -> v Vector.// [(index v k, (x, script))])
 
-  Slide graph direction (Endpoint x y)
+  Slide graph direction (Endpoint x y) script
     | x >= 0, x < n
     , y >= 0, y < m -> do
       eq <- getEq
       let a = as `at` x
       let b = bs `at` y
       if a `eq` b
-        then second (add (a, b)) <$> slide graph direction (Endpoint (succ x) (succ y))
-        else return (Endpoint x y, [])
-    | otherwise -> return (Endpoint x y, [])
+        then slide graph direction (Endpoint (succ x) (succ y)) (addFor direction (These a b) script)
+        else return (Endpoint x y, script)
+    | otherwise -> return (Endpoint x y, script)
     where at :: Vector.Vector a -> Int -> a
           v `at` i = v Vector.! case direction of { Forward -> i ; Reverse -> length v - succ i }
-          add pair = case direction of { Forward -> (++ [pair]) ; Reverse -> (pair :) }
 
   where (EditGraph as bs, n, m, maxD, delta) = editGraph myers
 
@@ -180,6 +181,9 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         setStateFor Forward f = modify (MyersState . first f . unMyersState)
         setStateFor Reverse f = modify (MyersState . second f . unMyersState)
 
+        addFor :: Direction -> a -> [a] -> [a]
+        addFor dir a = case dir of { Forward -> (++ [a]) ; Reverse -> (a :) }
+
         endpointsFor graph d direction k = do
           here <- findDPath graph d direction k
           (x, _) <- getK graph (invert direction) k
@@ -236,8 +240,8 @@ getK graph direction diagonal = M (GetK graph direction diagonal) `Then` return
 setK :: HasCallStack => EditGraph a b -> Direction -> Diagonal -> Int -> EditScript a b -> Myers a b ()
 setK graph direction diagonal x script = M (SetK graph direction diagonal x script) `Then` return
 
-slide :: HasCallStack => EditGraph a b -> Direction -> Endpoint -> Myers a b (Endpoint, [(a, b)])
-slide graph direction from = M (Slide graph direction from) `Then` return
+slide :: HasCallStack => EditGraph a b -> Direction -> Endpoint -> EditScript a b -> Myers a b (Endpoint, EditScript a b)
+slide graph direction from script = M (Slide graph direction from script) `Then` return
 
 getEq :: HasCallStack => Myers a b (a -> b -> Bool)
 getEq = GetEq `Then` return
@@ -286,7 +290,7 @@ editGraph myers = (EditGraph as bs, n, m, (m + n) `ceilDiv` 2, n - m)
           FindDPath g _ _ _ -> g
           GetK g _ _ -> g
           SetK g _ _ _ _ -> g
-          Slide g _ _ -> g
+          Slide g _ _ _ -> g
         (n, m) = (length as, length bs)
 
 
@@ -304,7 +308,7 @@ liftShowsMyersF sp1 sl1 sp2 sl2 d m = case m of
   FindDPath graph distance direction diagonal -> showsQuaternaryWith showGraph showsPrec showsPrec showsPrec "FindDPath" d graph distance direction diagonal
   GetK graph direction diagonal -> showsTernaryWith showGraph showsPrec showsPrec "GetK" d graph direction diagonal
   SetK graph direction diagonal v script -> showsQuinaryWith showGraph showsPrec showsPrec showsPrec (liftShowsEditScript sp1 sp2) "SetK" d graph direction diagonal v script
-  Slide graph direction endpoint -> showsTernaryWith showGraph showsPrec showsPrec "Slide" d graph direction endpoint
+  Slide graph direction endpoint script -> showsQuaternaryWith showGraph showsPrec showsPrec (liftShowsEditScript sp1 sp2) "Slide" d graph direction endpoint script
   where showGraph = (liftShowsPrec2 :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> (Int -> b -> ShowS) -> ([b] -> ShowS) -> Int -> EditGraph a b -> ShowS) sp1 sl1 sp2 sl2
 
 showsTernaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> (Int -> c -> ShowS) -> String -> Int -> a -> b -> c -> ShowS

From 3b384ff77fd1553511a3ded6d33ea34869dd11d1 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 16 Mar 2017 11:10:25 -0400
Subject: [PATCH 189/294] Add in-bounds elements when constructing
 deletions/insertions.

---
 src/SES/Myers.hs | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 051878f8f..7edacc132 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -131,8 +131,8 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     (prev, prevScript) <- getK graph direction (Diagonal (pred k))
     (next, nextScript) <- getK graph direction (Diagonal (succ k))
     let (fromX, fromScript) = if k == negate d || k /= d && prev < next
-          then (next, nextScript)
-          else (succ prev, prevScript)
+          then (next, if d /= 0 && inBounds bs next then addFor direction (That (bs `at` next)) nextScript else nextScript) -- downward (insertion)
+          else (succ prev, if d /= 0 && inBounds as prev then addFor direction (This (as `at` prev)) prevScript else prevScript) -- rightward (deletion)
     (endpoint, script) <- slide graph direction (Endpoint fromX (fromX - k)) fromScript
     setK graph direction (Diagonal k) (x endpoint) script
     return $ case direction of
@@ -140,6 +140,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
       Reverse -> Endpoint (n - x endpoint) (m - y endpoint)
     where at :: Vector.Vector a -> Int -> a
           v `at` i = v Vector.! case direction of { Forward -> i ; Reverse -> length v - succ i }
+          inBounds v i = i >= 0 && i < length v
 
   GetK _ direction (Diagonal k) -> do
     v <- gets (stateFor direction)

From 215433e7a38b9b65518ad16b2c6202d88e823820 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 16 Mar 2017 11:14:33 -0400
Subject: [PATCH 190/294] Abstract the bounds-checked addition of edits.

---
 src/SES/Myers.hs | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 7edacc132..41a512ffe 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -131,8 +131,8 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     (prev, prevScript) <- getK graph direction (Diagonal (pred k))
     (next, nextScript) <- getK graph direction (Diagonal (succ k))
     let (fromX, fromScript) = if k == negate d || k /= d && prev < next
-          then (next, if d /= 0 && inBounds bs next then addFor direction (That (bs `at` next)) nextScript else nextScript) -- downward (insertion)
-          else (succ prev, if d /= 0 && inBounds as prev then addFor direction (This (as `at` prev)) prevScript else prevScript) -- rightward (deletion)
+          then (next,      addInBounds bs next That nextScript) -- downward (insertion)
+          else (succ prev, addInBounds as prev This prevScript) -- rightward (deletion)
     (endpoint, script) <- slide graph direction (Endpoint fromX (fromX - k)) fromScript
     setK graph direction (Diagonal k) (x endpoint) script
     return $ case direction of
@@ -140,7 +140,8 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
       Reverse -> Endpoint (n - x endpoint) (m - y endpoint)
     where at :: Vector.Vector a -> Int -> a
           v `at` i = v Vector.! case direction of { Forward -> i ; Reverse -> length v - succ i }
-          inBounds v i = i >= 0 && i < length v
+          addInBounds :: Vector.Vector a -> Int -> (a -> b) -> [b] -> [b]
+          addInBounds v i with to = if d /= 0 && i >= 0 && i < length v then addFor direction (with (v `at` i)) to else to
 
   GetK _ direction (Diagonal k) -> do
     v <- gets (stateFor direction)

From cb5e501027ecaad8e3bdebce8960bae9cd1c8bc8 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 16 Mar 2017 11:25:14 -0400
Subject: [PATCH 191/294] Use the semigroup append.

---
 src/SES/Myers.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 41a512ffe..d130a170d 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -184,7 +184,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         setStateFor Reverse f = modify (MyersState . second f . unMyersState)
 
         addFor :: Direction -> a -> [a] -> [a]
-        addFor dir a = case dir of { Forward -> (++ [a]) ; Reverse -> (a :) }
+        addFor dir a = case dir of { Forward -> (<> [a]) ; Reverse -> (a :) }
 
         endpointsFor graph d direction k = do
           here <- findDPath graph d direction k

From f10a2cd32f57bb929b5cf235758c99642ba556cd Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 16 Mar 2017 13:34:56 -0400
Subject: [PATCH 192/294] Allow the reverse path to add edits.

---
 src/SES/Myers.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index d130a170d..80d27f33b 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -141,7 +141,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     where at :: Vector.Vector a -> Int -> a
           v `at` i = v Vector.! case direction of { Forward -> i ; Reverse -> length v - succ i }
           addInBounds :: Vector.Vector a -> Int -> (a -> b) -> [b] -> [b]
-          addInBounds v i with to = if d /= 0 && i >= 0 && i < length v then addFor direction (with (v `at` i)) to else to
+          addInBounds v i with to = if (d /= 0 || direction == Reverse) && i >= 0 && i < length v then addFor direction (with (v `at` i)) to else to
 
   GetK _ direction (Diagonal k) -> do
     v <- gets (stateFor direction)

From aece49077a038214e922e6a4322d9a4e6864d2d7 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 16 Mar 2017 13:35:08 -0400
Subject: [PATCH 193/294] Look up the shortest edit script in the appropriate
 state vector.

---
 src/SES/Myers.hs | 7 +++----
 1 file changed, 3 insertions(+), 4 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 80d27f33b..855927960 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -105,10 +105,9 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     | null bs -> return (This <$> toList as)
     | null as -> return (That <$> toList bs)
     | otherwise -> do
-      result <- divideAndConquer graph ses
-      return $! case result of
-        Left (a, EditGraph midAs midBs, c) -> a <> zipWith These (toList midAs) (toList midBs) <> c
-        Right d -> zipWith These (toList as) (toList bs) <> [ if m > n then That (bs Vector.! n) else This (as Vector.! m) | d == 1 ]
+      Just (_, Distance d) <- for [0..maxD] (searchUpToD graph . Distance)
+      v <- gets ((if odd d then fst else snd) . unMyersState)
+      return (snd (v Vector.! if odd d then 0 else index v delta))
 
   EditDistance graph -> unDistance . snd <$> middleSnake graph
 

From 0528845c83aa520cc941659e59fc791a5d1d1c9f Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 16 Mar 2017 15:24:08 -0400
Subject: [PATCH 194/294] =?UTF-8?q?Use=20the=20endpoint=E2=80=99s=20y=20va?=
 =?UTF-8?q?lue=20as=20the=20index=20into=20bs.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/SES/Myers.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 855927960..7d97c50f5 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -130,8 +130,8 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     (prev, prevScript) <- getK graph direction (Diagonal (pred k))
     (next, nextScript) <- getK graph direction (Diagonal (succ k))
     let (fromX, fromScript) = if k == negate d || k /= d && prev < next
-          then (next,      addInBounds bs next That nextScript) -- downward (insertion)
-          else (succ prev, addInBounds as prev This prevScript) -- rightward (deletion)
+          then (next,      addInBounds bs (next - succ k) That nextScript) -- downward (insertion)
+          else (succ prev, addInBounds as  prev           This prevScript) -- rightward (deletion)
     (endpoint, script) <- slide graph direction (Endpoint fromX (fromX - k)) fromScript
     setK graph direction (Diagonal k) (x endpoint) script
     return $ case direction of

From ae4008f659dfba310201fdba11b33c8c2127c9ca Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 16 Mar 2017 15:27:20 -0400
Subject: [PATCH 195/294] Compute the LCS as the SES minus
 insertions/deletions.

---
 src/SES/Myers.hs | 6 ++----
 1 file changed, 2 insertions(+), 4 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 7d97c50f5..841e9a85e 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -96,10 +96,8 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
   LCS graph
     | null as || null bs -> return []
     | otherwise -> do
-      result <- divideAndConquer graph lcs
-      return $! case result of
-        Left (a, EditGraph midAs midBs, c) -> a <> zip (toList midAs) (toList midBs) <> c
-        _ -> zip (toList as) (toList bs)
+      result <- ses graph
+      return (catMaybes (these (const Nothing) (const Nothing) ((Just .) . (,)) <$> result))
 
   SES graph
     | null bs -> return (This <$> toList as)

From be58a09a02a970c368cdb5f5774806845f49a7ab Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 16 Mar 2017 15:27:34 -0400
Subject: [PATCH 196/294] :fire: divideAndConquer.

---
 src/SES/Myers.hs | 12 ------------
 1 file changed, 12 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 841e9a85e..caf7bd4df 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -197,18 +197,6 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         editDistance Forward (Distance d) = Distance (2 * d - 1)
         editDistance Reverse (Distance d) = Distance (2 * d)
 
-        divideAndConquer graph with = do
-          (Snake xy uv, Distance d) <- middleSnake graph
-          if d > 1 then do
-            let (before, _) = divideGraph graph xy
-            let (start, after) = divideGraph graph uv
-            let (mid, _) = divideGraph start xy
-            before' <- with before
-            after' <- with after
-            return (Left (before', mid, after'))
-          else
-            return (Right d)
-
 
 -- Smart constructors
 

From ede2ed9e9e237b85b7972e12a6d1bfc46c168fc1 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 16 Mar 2017 15:38:48 -0400
Subject: [PATCH 197/294] :fire: redundant parens.

---
 src/SES/Myers.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index caf7bd4df..b820fcf02 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -236,7 +236,7 @@ getEq = GetEq `Then` return
 
 -- Implementation details
 
-newtype MyersState a b = MyersState { unMyersState :: (Vector.Vector (Int, (EditScript a b)), Vector.Vector (Int, (EditScript a b))) }
+newtype MyersState a b = MyersState { unMyersState :: (Vector.Vector (Int, EditScript a b), Vector.Vector (Int, EditScript a b)) }
   deriving (Eq, Show)
 
 emptyStateForStep :: Myers a b c -> MyersState a b

From a8853d98073f27044e79aa42f8ac6b5dbe88c93d Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 17 Mar 2017 09:52:22 -0400
Subject: [PATCH 198/294] Bounds check getK and throw locally.

---
 src/SES/Myers.hs | 26 +++++++++++++++++++++-----
 1 file changed, 21 insertions(+), 5 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index b820fcf02..4690b797f 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE GADTs, ImplicitParams, MultiParamTypeClasses, ScopedTypeVariables #-}
 module SES.Myers where
 
+import Control.Exception
 import Control.Monad.Free.Freer
 import Data.Functor.Classes
 import Data.String
@@ -8,8 +9,8 @@ import Data.These
 import qualified Data.Vector as Vector
 import GHC.Show
 import GHC.Stack
-import Prologue hiding (for, State)
-import Text.Show
+import Prologue hiding (for, State, error)
+import Text.Show (showListWith)
 
 data MyersF a b result where
   SES :: EditGraph a b -> MyersF a b (EditScript a b)
@@ -32,7 +33,7 @@ data State s a where
   Put :: s -> State s ()
 
 data StepF a b result where
-  M :: MyersF a b c -> StepF a b c
+  M :: HasCallStack => MyersF a b c -> StepF a b c
   S :: State (MyersState a b) c -> StepF a b c
   GetEq :: StepF a b (a -> b -> Bool)
 
@@ -92,7 +93,7 @@ runMyersStep eq state step = let ?callStack = popCallStack callStack in case ste
 
 
 decompose :: HasCallStack => MyersF a b c -> Myers a b c
-decompose myers = let ?callStack = popCallStack callStack in case myers of
+decompose myers = let ?callStack = fromCallSiteList (filter ((/= "M") . fst) (getCallStack (popCallStack callStack))) in case myers of
   LCS graph
     | null as || null bs -> return []
     | otherwise -> do
@@ -142,7 +143,13 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
 
   GetK _ direction (Diagonal k) -> do
     v <- gets (stateFor direction)
-    return (v Vector.! index v k)
+    let i = index v k
+    if i < 0 then
+      throw (MyersException ("negative index " <> Prologue.show i) callStack)
+    else if i >= length v then
+      throw (MyersException ("index " <> Prologue.show i <> "past end of state vector " <> Prologue.show (length v)) callStack)
+    else
+      return (v Vector.! i)
 
   SetK _ direction (Diagonal k) x script ->
     setStateFor direction (\ v -> v Vector.// [(index v k, (x, script))])
@@ -183,6 +190,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         addFor :: Direction -> a -> [a] -> [a]
         addFor dir a = case dir of { Forward -> (<> [a]) ; Reverse -> (a :) }
 
+        endpointsFor :: HasCallStack => EditGraph a b -> Distance -> Direction -> Diagonal -> Myers a b (Endpoint, Endpoint)
         endpointsFor graph d direction k = do
           here <- findDPath graph d direction k
           (x, _) <- getK graph (invert direction) k
@@ -330,6 +338,9 @@ liftShowsThese sa sb d t = case t of
 liftShowsEditScript :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> Int -> EditScript a b -> ShowS
 liftShowsEditScript sa sb _ = showListWith (liftShowsThese sa sb 0)
 
+data MyersException = MyersException String CallStack
+  deriving (Typeable)
+
 
 -- Instances
 
@@ -362,3 +373,8 @@ instance (Show a, Show b) => Show1 (StepF a b) where
 
 instance (Show a, Show b) => Show (StepF a b c) where
   showsPrec = liftShowsStepF showsPrec showList showsPrec showList
+
+instance Exception MyersException
+
+instance Show MyersException where
+  showsPrec _ (MyersException s c) = showString "Exception: " . showString s . showChar '\n' . showString (prettyCallStack c)

From 64d8aced707b99cea1a85a9301c3fde7eab86a63 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 17 Mar 2017 09:54:49 -0400
Subject: [PATCH 199/294] Encapsulate throwing failures.

---
 src/SES/Myers.hs | 10 +++++++---
 1 file changed, 7 insertions(+), 3 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 4690b797f..5f20bcd08 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -93,7 +93,7 @@ runMyersStep eq state step = let ?callStack = popCallStack callStack in case ste
 
 
 decompose :: HasCallStack => MyersF a b c -> Myers a b c
-decompose myers = let ?callStack = fromCallSiteList (filter ((/= "M") . fst) (getCallStack (popCallStack callStack))) in case myers of
+decompose myers = let ?callStack = popCallStack callStack in case myers of
   LCS graph
     | null as || null bs -> return []
     | otherwise -> do
@@ -145,9 +145,9 @@ decompose myers = let ?callStack = fromCallSiteList (filter ((/= "M") . fst) (ge
     v <- gets (stateFor direction)
     let i = index v k
     if i < 0 then
-      throw (MyersException ("negative index " <> Prologue.show i) callStack)
+      fail ("negative index " <> Prologue.show i)
     else if i >= length v then
-      throw (MyersException ("index " <> Prologue.show i <> "past end of state vector " <> Prologue.show (length v)) callStack)
+      fail ("index " <> Prologue.show i <> "past end of state vector " <> Prologue.show (length v))
     else
       return (v Vector.! i)
 
@@ -199,6 +199,10 @@ decompose myers = let ?callStack = fromCallSiteList (filter ((/= "M") . fst) (ge
             Forward -> return (here, there)
             Reverse -> return (there, here)
 
+        fail :: (HasCallStack, Monad m) => String -> m a
+        fail s = let ?callStack = fromCallSiteList (filter ((/= "M") . fst) (getCallStack callStack)) in
+          throw (MyersException s callStack)
+
         invert Forward = Reverse
         invert Reverse = Forward
 

From adffda01dce46d5d40be1dea81f56659def8e5b5 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 17 Mar 2017 10:16:07 -0400
Subject: [PATCH 200/294] Add an eliminator for Direction.

---
 src/SES/Myers.hs | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 5f20bcd08..aa08ec6e8 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -57,6 +57,10 @@ data Endpoint = Endpoint { x :: !Int, y :: !Int }
 data Direction = Forward | Reverse
   deriving (Eq, Show)
 
+-- | Eliminate a Direction by selecting the first value for the Forward case and the second value for the Reverse case.
+direction :: Direction -> a -> a -> a
+direction d a b = case d of { Forward -> a ; Reverse -> b }
+
 
 -- Evaluation
 

From b53fa3a2835fc23c1683b8177f1b64daeed9c4dd Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 17 Mar 2017 10:21:38 -0400
Subject: [PATCH 201/294] Clean up FindDPath refinement using the direction
 eliminator.

---
 src/SES/Myers.hs | 18 ++++++++----------
 1 file changed, 8 insertions(+), 10 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index aa08ec6e8..a2544ec79 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -129,21 +129,19 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     else
       continue
 
-  FindDPath graph (Distance d) direction (Diagonal k) -> do
-    (prev, prevScript) <- getK graph direction (Diagonal (pred k))
-    (next, nextScript) <- getK graph direction (Diagonal (succ k))
+  FindDPath graph (Distance d) dir (Diagonal k) -> do
+    (prev, prevScript) <- getK graph dir (Diagonal (pred k))
+    (next, nextScript) <- getK graph dir (Diagonal (succ k))
     let (fromX, fromScript) = if k == negate d || k /= d && prev < next
           then (next,      addInBounds bs (next - succ k) That nextScript) -- downward (insertion)
           else (succ prev, addInBounds as  prev           This prevScript) -- rightward (deletion)
-    (endpoint, script) <- slide graph direction (Endpoint fromX (fromX - k)) fromScript
-    setK graph direction (Diagonal k) (x endpoint) script
-    return $ case direction of
-      Forward -> endpoint
-      Reverse -> Endpoint (n - x endpoint) (m - y endpoint)
+    (endpoint, script) <- slide graph dir (Endpoint fromX (fromX - k)) fromScript
+    setK graph dir (Diagonal k) (x endpoint) script
+    return (direction dir endpoint (Endpoint (n - x endpoint) (m - y endpoint)))
     where at :: Vector.Vector a -> Int -> a
-          v `at` i = v Vector.! case direction of { Forward -> i ; Reverse -> length v - succ i }
+          v `at` i = v Vector.! direction dir i (length v - succ i)
           addInBounds :: Vector.Vector a -> Int -> (a -> b) -> [b] -> [b]
-          addInBounds v i with to = if (d /= 0 || direction == Reverse) && i >= 0 && i < length v then addFor direction (with (v `at` i)) to else to
+          addInBounds v i with to = if (d /= 0 || dir == Reverse) && i >= 0 && i < length v then addFor dir (with (v `at` i)) to else to
 
   GetK _ direction (Diagonal k) -> do
     v <- gets (stateFor direction)

From dd4133d228e5f1b60a1cb07c210869a5ddd9ab1e Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 17 Mar 2017 10:21:47 -0400
Subject: [PATCH 202/294] Clarify the underflow/overflow exceptions.

---
 src/SES/Myers.hs | 11 ++++++-----
 1 file changed, 6 insertions(+), 5 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index a2544ec79..f59060c75 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -7,7 +7,7 @@ import Data.Functor.Classes
 import Data.String
 import Data.These
 import qualified Data.Vector as Vector
-import GHC.Show
+import GHC.Show hiding (show)
 import GHC.Stack
 import Prologue hiding (for, State, error)
 import Text.Show (showListWith)
@@ -143,13 +143,14 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
           addInBounds :: Vector.Vector a -> Int -> (a -> b) -> [b] -> [b]
           addInBounds v i with to = if (d /= 0 || dir == Reverse) && i >= 0 && i < length v then addFor dir (with (v `at` i)) to else to
 
-  GetK _ direction (Diagonal k) -> do
-    v <- gets (stateFor direction)
+  GetK _ dir (Diagonal k) -> do
+    v <- gets (stateFor dir)
     let i = index v k
+    let offset = direction dir 0 delta
     if i < 0 then
-      fail ("negative index " <> Prologue.show i)
+      fail ("diagonal " <> show k <> " (" <> show i <> ") underflows state indices " <> show (negate maxD + offset) <> ".." <> show (maxD + offset) <> " (0.." <> show (2 * maxD) <> ")")
     else if i >= length v then
-      fail ("index " <> Prologue.show i <> "past end of state vector " <> Prologue.show (length v))
+      fail ("diagonal " <> show k <> " (" <> show i <> ") overflows state indices " <> show (negate maxD + offset) <> ".." <> show (maxD + offset) <> " (0.." <> show (2 * maxD) <> ")")
     else
       return (v Vector.! i)
 

From 2a4c8676fa15f092cc65943f3ee3e05e964cf762 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 17 Mar 2017 10:25:15 -0400
Subject: [PATCH 203/294] Clean up the bounds checks with `when`.

---
 src/SES/Myers.hs | 7 +++----
 1 file changed, 3 insertions(+), 4 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index f59060c75..d2bbc8f62 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -147,12 +147,11 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     v <- gets (stateFor dir)
     let i = index v k
     let offset = direction dir 0 delta
-    if i < 0 then
+    when (i < 0) $
       fail ("diagonal " <> show k <> " (" <> show i <> ") underflows state indices " <> show (negate maxD + offset) <> ".." <> show (maxD + offset) <> " (0.." <> show (2 * maxD) <> ")")
-    else if i >= length v then
+    when (i >= length v) $
       fail ("diagonal " <> show k <> " (" <> show i <> ") overflows state indices " <> show (negate maxD + offset) <> ".." <> show (maxD + offset) <> " (0.." <> show (2 * maxD) <> ")")
-    else
-      return (v Vector.! i)
+    return (v Vector.! i)
 
   SetK _ direction (Diagonal k) x script ->
     setStateFor direction (\ v -> v Vector.// [(index v k, (x, script))])

From 562515e93cab6f3e59bc1db254af829bfcfb85e0 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 17 Mar 2017 10:28:31 -0400
Subject: [PATCH 204/294] Clean up Slide refinement using the direction
 eliminator.

---
 src/SES/Myers.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index d2bbc8f62..71842ecf5 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -156,18 +156,18 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
   SetK _ direction (Diagonal k) x script ->
     setStateFor direction (\ v -> v Vector.// [(index v k, (x, script))])
 
-  Slide graph direction (Endpoint x y) script
+  Slide graph dir (Endpoint x y) script
     | x >= 0, x < n
     , y >= 0, y < m -> do
       eq <- getEq
       let a = as `at` x
       let b = bs `at` y
       if a `eq` b
-        then slide graph direction (Endpoint (succ x) (succ y)) (addFor direction (These a b) script)
+        then slide graph dir (Endpoint (succ x) (succ y)) (addFor dir (These a b) script)
         else return (Endpoint x y, script)
     | otherwise -> return (Endpoint x y, script)
     where at :: Vector.Vector a -> Int -> a
-          v `at` i = v Vector.! case direction of { Forward -> i ; Reverse -> length v - succ i }
+          v `at` i = v Vector.! direction dir i (length v - succ i)
 
   where (EditGraph as bs, n, m, maxD, delta) = editGraph myers
 

From f9e00fc560bb0f63e8dc1840c111608264f76481 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 17 Mar 2017 10:29:41 -0400
Subject: [PATCH 205/294] Clean up SearchAlongK refinement with the direction
 eliminator.

---
 src/SES/Myers.hs | 11 ++++-------
 1 file changed, 4 insertions(+), 7 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 71842ecf5..9357f85df 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -122,10 +122,10 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     (<|>) <$> for [negate d, negate d + 2 .. d] (searchAlongK graph (Distance d) Forward . Diagonal)
           <*> for [negate d, negate d + 2 .. d] (searchAlongK graph (Distance d) Reverse . Diagonal)
 
-  SearchAlongK graph d direction k -> do
-    (forwardEndpoint, reverseEndpoint) <- endpointsFor graph d direction (diagonalFor direction k)
-    if shouldTestOn direction && inInterval d direction k && overlaps graph forwardEndpoint reverseEndpoint then
-      return (Just (Snake reverseEndpoint forwardEndpoint, editDistance direction d))
+  SearchAlongK graph d dir k -> do
+    (forwardEndpoint, reverseEndpoint) <- endpointsFor graph d dir (diagonalFor dir k)
+    if direction dir odd even delta && inInterval d dir k && overlaps graph forwardEndpoint reverseEndpoint then
+      return (Just (Snake reverseEndpoint forwardEndpoint, editDistance dir d))
     else
       continue
 
@@ -180,9 +180,6 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         diagonalFor Forward k = k
         diagonalFor Reverse (Diagonal k) = Diagonal (k + delta)
 
-        shouldTestOn Forward = odd delta
-        shouldTestOn Reverse = even delta
-
         stateFor Forward = fst . unMyersState
         stateFor Reverse = snd . unMyersState
 

From b180a448eddc30623105e3b3a58c662ce17c7823 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 17 Mar 2017 10:32:02 -0400
Subject: [PATCH 206/294] Clean up endpointsFor with the direction eliminator.

---
 src/SES/Myers.hs | 13 ++++---------
 1 file changed, 4 insertions(+), 9 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 9357f85df..e3c6ea54e 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -190,21 +190,16 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         addFor dir a = case dir of { Forward -> (<> [a]) ; Reverse -> (a :) }
 
         endpointsFor :: HasCallStack => EditGraph a b -> Distance -> Direction -> Diagonal -> Myers a b (Endpoint, Endpoint)
-        endpointsFor graph d direction k = do
-          here <- findDPath graph d direction k
-          (x, _) <- getK graph (invert direction) k
+        endpointsFor graph d dir k = do
+          here <- findDPath graph d dir k
+          (x, _) <- getK graph (direction dir Reverse Forward) k
           let there = Endpoint x (x - unDiagonal k)
-          case direction of
-            Forward -> return (here, there)
-            Reverse -> return (there, here)
+          return (direction dir (here, there) (there, here))
 
         fail :: (HasCallStack, Monad m) => String -> m a
         fail s = let ?callStack = fromCallSiteList (filter ((/= "M") . fst) (getCallStack callStack)) in
           throw (MyersException s callStack)
 
-        invert Forward = Reverse
-        invert Reverse = Forward
-
         editDistance Forward (Distance d) = Distance (2 * d - 1)
         editDistance Reverse (Distance d) = Distance (2 * d)
 

From 0ed77941183334c04fb510c613986723c74a4d24 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 17 Mar 2017 10:32:49 -0400
Subject: [PATCH 207/294] Clean up GetK a little further with the direction
 eliminator.

---
 src/SES/Myers.hs | 5 +----
 1 file changed, 1 insertion(+), 4 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index e3c6ea54e..b06c75a43 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -144,7 +144,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
           addInBounds v i with to = if (d /= 0 || dir == Reverse) && i >= 0 && i < length v then addFor dir (with (v `at` i)) to else to
 
   GetK _ dir (Diagonal k) -> do
-    v <- gets (stateFor dir)
+    v <- gets (direction dir fst snd . unMyersState)
     let i = index v k
     let offset = direction dir 0 delta
     when (i < 0) $
@@ -180,9 +180,6 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         diagonalFor Forward k = k
         diagonalFor Reverse (Diagonal k) = Diagonal (k + delta)
 
-        stateFor Forward = fst . unMyersState
-        stateFor Reverse = snd . unMyersState
-
         setStateFor Forward f = modify (MyersState . first f . unMyersState)
         setStateFor Reverse f = modify (MyersState . second f . unMyersState)
 

From 3044fa3a8f9f7b38b3ec25674f35fad31ffe7492 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 17 Mar 2017 10:34:37 -0400
Subject: [PATCH 208/294] Clean up SetK with the direction eliminator.

---
 src/SES/Myers.hs | 8 +++-----
 1 file changed, 3 insertions(+), 5 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index b06c75a43..405c10b9d 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -153,8 +153,9 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
       fail ("diagonal " <> show k <> " (" <> show i <> ") overflows state indices " <> show (negate maxD + offset) <> ".." <> show (maxD + offset) <> " (0.." <> show (2 * maxD) <> ")")
     return (v Vector.! i)
 
-  SetK _ direction (Diagonal k) x script ->
-    setStateFor direction (\ v -> v Vector.// [(index v k, (x, script))])
+  SetK _ dir (Diagonal k) x script ->
+    modify (MyersState . direction dir first second set . unMyersState)
+    where set v = v Vector.// [(index v k, (x, script))]
 
   Slide graph dir (Endpoint x y) script
     | x >= 0, x < n
@@ -180,9 +181,6 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         diagonalFor Forward k = k
         diagonalFor Reverse (Diagonal k) = Diagonal (k + delta)
 
-        setStateFor Forward f = modify (MyersState . first f . unMyersState)
-        setStateFor Reverse f = modify (MyersState . second f . unMyersState)
-
         addFor :: Direction -> a -> [a] -> [a]
         addFor dir a = case dir of { Forward -> (<> [a]) ; Reverse -> (a :) }
 

From e63935ae095ce4ebf103141840a464d901f95b91 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 17 Mar 2017 10:36:12 -0400
Subject: [PATCH 209/294] :fire: the edit distance for direction helper.

---
 src/SES/Myers.hs | 5 +----
 1 file changed, 1 insertion(+), 4 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 405c10b9d..ef58b9e3d 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -125,7 +125,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
   SearchAlongK graph d dir k -> do
     (forwardEndpoint, reverseEndpoint) <- endpointsFor graph d dir (diagonalFor dir k)
     if direction dir odd even delta && inInterval d dir k && overlaps graph forwardEndpoint reverseEndpoint then
-      return (Just (Snake reverseEndpoint forwardEndpoint, editDistance dir d))
+      return (Just (Snake reverseEndpoint forwardEndpoint, Distance (2 * unDistance d - direction dir 1 0)))
     else
       continue
 
@@ -195,9 +195,6 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         fail s = let ?callStack = fromCallSiteList (filter ((/= "M") . fst) (getCallStack callStack)) in
           throw (MyersException s callStack)
 
-        editDistance Forward (Distance d) = Distance (2 * d - 1)
-        editDistance Reverse (Distance d) = Distance (2 * d)
-
 
 -- Smart constructors
 

From 05d2ead9b115f81a90bd432a1de36d73e0e9db31 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 17 Mar 2017 10:37:00 -0400
Subject: [PATCH 210/294] :fire: the diagonalFor helper.

---
 src/SES/Myers.hs | 5 +----
 1 file changed, 1 insertion(+), 4 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index ef58b9e3d..9486903d7 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -123,7 +123,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
           <*> for [negate d, negate d + 2 .. d] (searchAlongK graph (Distance d) Reverse . Diagonal)
 
   SearchAlongK graph d dir k -> do
-    (forwardEndpoint, reverseEndpoint) <- endpointsFor graph d dir (diagonalFor dir k)
+    (forwardEndpoint, reverseEndpoint) <- endpointsFor graph d dir (direction dir k (Diagonal (unDiagonal k + delta)))
     if direction dir odd even delta && inInterval d dir k && overlaps graph forwardEndpoint reverseEndpoint then
       return (Just (Snake reverseEndpoint forwardEndpoint, Distance (2 * unDistance d - direction dir 1 0)))
     else
@@ -178,9 +178,6 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
           Forward -> k >= (delta - pred d) && k <= (delta + pred d)
           Reverse -> (k + delta) >= negate d && (k + delta) <= d
 
-        diagonalFor Forward k = k
-        diagonalFor Reverse (Diagonal k) = Diagonal (k + delta)
-
         addFor :: Direction -> a -> [a] -> [a]
         addFor dir a = case dir of { Forward -> (<> [a]) ; Reverse -> (a :) }
 

From c330c4a44b5bc15b28667ddc3474ca285e91f0ff Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 17 Mar 2017 10:37:56 -0400
Subject: [PATCH 211/294] Clean up addFor with the direction eliminator.

---
 src/SES/Myers.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 9486903d7..30bdb4b10 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -179,7 +179,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
           Reverse -> (k + delta) >= negate d && (k + delta) <= d
 
         addFor :: Direction -> a -> [a] -> [a]
-        addFor dir a = case dir of { Forward -> (<> [a]) ; Reverse -> (a :) }
+        addFor dir a = direction dir (<> [a]) (a :)
 
         endpointsFor :: HasCallStack => EditGraph a b -> Distance -> Direction -> Diagonal -> Myers a b (Endpoint, Endpoint)
         endpointsFor graph d dir k = do

From d82061ce7c38acf1abd6f1e0bd4308d3c29b949e Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 17 Mar 2017 10:47:56 -0400
Subject: [PATCH 212/294] Clean up inInterval with inRange.

---
 src/SES/Myers.hs | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 30bdb4b10..49e1aec5c 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -4,6 +4,7 @@ module SES.Myers where
 import Control.Exception
 import Control.Monad.Free.Freer
 import Data.Functor.Classes
+import Data.Ix (inRange)
 import Data.String
 import Data.These
 import qualified Data.Vector as Vector
@@ -175,8 +176,8 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         index v k = if k >= 0 then k else length v + k
 
         inInterval (Distance d) direction (Diagonal k) = case direction of
-          Forward -> k >= (delta - pred d) && k <= (delta + pred d)
-          Reverse -> (k + delta) >= negate d && (k + delta) <= d
+          Forward -> inRange (delta - pred d, delta + pred d) k
+          Reverse -> inRange (negate d, d) (k + delta)
 
         addFor :: Direction -> a -> [a] -> [a]
         addFor dir a = direction dir (<> [a]) (a :)

From 1b1ecc20a78137c23aa76045a3e4e197d993e2dd Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 20 Mar 2017 09:43:55 -0400
Subject: [PATCH 213/294] Add a convenience constructor for edit graphs.

---
 src/SES/Myers.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 49e1aec5c..7c0b9c5f1 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -43,6 +43,9 @@ type Myers a b = Freer (StepF a b)
 data EditGraph a b = EditGraph { as :: !(Vector.Vector a), bs :: !(Vector.Vector b) }
   deriving (Eq, Show)
 
+makeEditGraph :: (Foldable t, Foldable u) => t a -> u b -> EditGraph a b
+makeEditGraph as bs = EditGraph (Vector.fromList (toList as)) (Vector.fromList (toList bs))
+
 data Snake = Snake { xy :: Endpoint, uv :: Endpoint }
   deriving (Eq, Show)
 

From 26dc1c82a3dc4817b623bdfa558e6cf4ca562de9 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 20 Mar 2017 09:58:37 -0400
Subject: [PATCH 214/294] Use the makeEditGraph convenience in SES.

---
 src/SES.hs | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/src/SES.hs b/src/SES.hs
index 9411a25fc..9528c3e48 100644
--- a/src/SES.hs
+++ b/src/SES.hs
@@ -3,7 +3,6 @@ module SES where
 
 import qualified Data.Map as Map
 import Data.These
-import qualified Data.Vector as Vector
 import Prologue
 import qualified SES.Myers as Myers
 
@@ -16,7 +15,7 @@ type Cost term = These term term -> Int
 
 -- | Find the shortest edit script (diff) between two terms given a function to compute the cost.
 ses :: Comparable term -> Cost term -> [term] -> [term] -> [These term term]
-ses canCompare _ as bs = Myers.runMyers canCompare (Myers.ses (Myers.EditGraph (Vector.fromList as) (Vector.fromList bs)))
+ses canCompare _ as bs = Myers.runMyers canCompare (Myers.ses (Myers.makeEditGraph as bs))
 
 -- | Find the shortest edit script between two terms at a given vertex in the edit graph.
 diffAt :: Comparable term -> Cost term -> (Int, Int) -> [term] -> [term] -> State (Map.Map (Int, Int) [(These term term, Int)]) [(These term term, Int)]

From 4e42d96e0c42ede8fda1162a02cef5999585fd67 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 20 Mar 2017 10:10:09 -0400
Subject: [PATCH 215/294] Look up the result in the exiting diagonal.

---
 src/SES/Myers.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 7c0b9c5f1..5de890926 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -114,7 +114,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     | otherwise -> do
       Just (_, Distance d) <- for [0..maxD] (searchUpToD graph . Distance)
       v <- gets ((if odd d then fst else snd) . unMyersState)
-      return (snd (v Vector.! if odd d then 0 else index v delta))
+      return (snd (v Vector.! index v delta))
 
   EditDistance graph -> unDistance . snd <$> middleSnake graph
 

From d4b00fa24a11aaf7208bd20c273b33cedff6707f Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 20 Mar 2017 10:35:10 -0400
Subject: [PATCH 216/294] =?UTF-8?q?Bounds-check=20before=20getting=20the?=
 =?UTF-8?q?=20(k=20=C2=B1=201)th=20diagonal.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/SES/Myers.hs | 18 +++++++++++++-----
 1 file changed, 13 insertions(+), 5 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 5de890926..514a8d34d 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -134,11 +134,19 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
       continue
 
   FindDPath graph (Distance d) dir (Diagonal k) -> do
-    (prev, prevScript) <- getK graph dir (Diagonal (pred k))
-    (next, nextScript) <- getK graph dir (Diagonal (succ k))
-    let (fromX, fromScript) = if k == negate d || k /= d && prev < next
-          then (next,      addInBounds bs (next - succ k) That nextScript) -- downward (insertion)
-          else (succ prev, addInBounds as  prev           This prevScript) -- rightward (deletion)
+    (fromX, fromScript) <- if k == negate d then do
+      (next, nextScript) <- getK graph dir (Diagonal (succ k))
+      return (next,      addInBounds bs (next - succ k) That nextScript) -- downward (insertion)
+    else if k /= d then do
+      (prev, prevScript) <- getK graph dir (Diagonal (pred k))
+      (next, nextScript) <- getK graph dir (Diagonal (succ k))
+      return $ if prev < next then
+        (next,      addInBounds bs (next - succ k) That nextScript) -- downward (insertion)
+      else
+        (succ prev, addInBounds as  prev           This prevScript) -- rightward (deletion)
+    else do
+      (prev, prevScript) <- getK graph dir (Diagonal (pred k))
+      return (succ prev, addInBounds as  prev           This prevScript) -- rightward (deletion)
     (endpoint, script) <- slide graph dir (Endpoint fromX (fromX - k)) fromScript
     setK graph dir (Diagonal k) (x endpoint) script
     return (direction dir endpoint (Endpoint (n - x endpoint) (m - y endpoint)))

From e7c954bccc28760cbe4b09a23c815ee069a00a78 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 20 Mar 2017 11:19:18 -0400
Subject: [PATCH 217/294] getK returns an endpoint.

---
 src/SES/Myers.hs | 27 +++++++++++++--------------
 1 file changed, 13 insertions(+), 14 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 514a8d34d..5a05487fd 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -22,7 +22,7 @@ data MyersF a b result where
   SearchAlongK :: EditGraph a b -> Distance -> Direction -> Diagonal -> MyersF a b (Maybe (Snake, Distance))
   FindDPath :: EditGraph a b -> Distance -> Direction -> Diagonal -> MyersF a b Endpoint
 
-  GetK :: EditGraph a b -> Direction -> Diagonal -> MyersF a b (Int, EditScript a b)
+  GetK :: EditGraph a b -> Direction -> Diagonal -> MyersF a b (Endpoint, EditScript a b)
   SetK :: EditGraph a b -> Direction -> Diagonal -> Int -> EditScript a b -> MyersF a b ()
 
   Slide :: EditGraph a b -> Direction -> Endpoint -> EditScript a b -> MyersF a b (Endpoint, EditScript a b)
@@ -135,18 +135,18 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
 
   FindDPath graph (Distance d) dir (Diagonal k) -> do
     (fromX, fromScript) <- if k == negate d then do
-      (next, nextScript) <- getK graph dir (Diagonal (succ k))
-      return (next,      addInBounds bs (next - succ k) That nextScript) -- downward (insertion)
+      (Endpoint nextX nextY, nextScript) <- getK graph dir (Diagonal (succ k))
+      return (nextX,     addInBounds bs nextY That nextScript) -- downward (insertion)
     else if k /= d then do
-      (prev, prevScript) <- getK graph dir (Diagonal (pred k))
-      (next, nextScript) <- getK graph dir (Diagonal (succ k))
-      return $ if prev < next then
-        (next,      addInBounds bs (next - succ k) That nextScript) -- downward (insertion)
+      (Endpoint prevX _, prevScript) <- getK graph dir (Diagonal (pred k))
+      (Endpoint nextX nextY, nextScript) <- getK graph dir (Diagonal (succ k))
+      return $ if prevX < nextX then
+        (nextX,      addInBounds bs nextY That nextScript) -- downward (insertion)
       else
-        (succ prev, addInBounds as  prev           This prevScript) -- rightward (deletion)
+        (succ prevX, addInBounds as prevX This prevScript) -- rightward (deletion)
     else do
-      (prev, prevScript) <- getK graph dir (Diagonal (pred k))
-      return (succ prev, addInBounds as  prev           This prevScript) -- rightward (deletion)
+      (Endpoint prevX _, prevScript) <- getK graph dir (Diagonal (pred k))
+      return (succ prevX, addInBounds as prevX This prevScript) -- rightward (deletion)
     (endpoint, script) <- slide graph dir (Endpoint fromX (fromX - k)) fromScript
     setK graph dir (Diagonal k) (x endpoint) script
     return (direction dir endpoint (Endpoint (n - x endpoint) (m - y endpoint)))
@@ -163,7 +163,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
       fail ("diagonal " <> show k <> " (" <> show i <> ") underflows state indices " <> show (negate maxD + offset) <> ".." <> show (maxD + offset) <> " (0.." <> show (2 * maxD) <> ")")
     when (i >= length v) $
       fail ("diagonal " <> show k <> " (" <> show i <> ") overflows state indices " <> show (negate maxD + offset) <> ".." <> show (maxD + offset) <> " (0.." <> show (2 * maxD) <> ")")
-    return (v Vector.! i)
+    let (x, script) = v Vector.! i in return (Endpoint x (x - k), script)
 
   SetK _ dir (Diagonal k) x script ->
     modify (MyersState . direction dir first second set . unMyersState)
@@ -196,8 +196,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         endpointsFor :: HasCallStack => EditGraph a b -> Distance -> Direction -> Diagonal -> Myers a b (Endpoint, Endpoint)
         endpointsFor graph d dir k = do
           here <- findDPath graph d dir k
-          (x, _) <- getK graph (direction dir Reverse Forward) k
-          let there = Endpoint x (x - unDiagonal k)
+          (there, _) <- getK graph (direction dir Reverse Forward) k
           return (direction dir (here, there) (there, here))
 
         fail :: (HasCallStack, Monad m) => String -> m a
@@ -228,7 +227,7 @@ searchAlongK graph d direction k = M (SearchAlongK graph d direction k) `Then` r
 findDPath :: HasCallStack => EditGraph a b -> Distance -> Direction -> Diagonal -> Myers a b Endpoint
 findDPath graph d direction k = M (FindDPath graph d direction k) `Then` return
 
-getK :: HasCallStack => EditGraph a b -> Direction -> Diagonal -> Myers a b (Int, EditScript a b)
+getK :: HasCallStack => EditGraph a b -> Direction -> Diagonal -> Myers a b (Endpoint, EditScript a b)
 getK graph direction diagonal = M (GetK graph direction diagonal) `Then` return
 
 setK :: HasCallStack => EditGraph a b -> Direction -> Diagonal -> Int -> EditScript a b -> Myers a b ()

From 8d4e54a3fa6d8bcefc2d610e4589904eefe16136 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 20 Mar 2017 11:21:20 -0400
Subject: [PATCH 218/294] Avoid recomputing endpoints where feasible.

---
 src/SES/Myers.hs | 16 ++++++++--------
 1 file changed, 8 insertions(+), 8 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 5a05487fd..4cae48141 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -134,20 +134,20 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
       continue
 
   FindDPath graph (Distance d) dir (Diagonal k) -> do
-    (fromX, fromScript) <- if k == negate d then do
+    (from, fromScript) <- if k == negate d then do
       (Endpoint nextX nextY, nextScript) <- getK graph dir (Diagonal (succ k))
-      return (nextX,     addInBounds bs nextY That nextScript) -- downward (insertion)
+      return (Endpoint nextX (succ nextY),     addInBounds bs nextY That nextScript) -- downward (insertion)
     else if k /= d then do
-      (Endpoint prevX _, prevScript) <- getK graph dir (Diagonal (pred k))
+      (Endpoint prevX prevY, prevScript) <- getK graph dir (Diagonal (pred k))
       (Endpoint nextX nextY, nextScript) <- getK graph dir (Diagonal (succ k))
       return $ if prevX < nextX then
-        (nextX,      addInBounds bs nextY That nextScript) -- downward (insertion)
+        (Endpoint nextX (succ nextY), addInBounds bs nextY That nextScript) -- downward (insertion)
       else
-        (succ prevX, addInBounds as prevX This prevScript) -- rightward (deletion)
+        (Endpoint (succ prevX) prevY, addInBounds as prevX This prevScript) -- rightward (deletion)
     else do
-      (Endpoint prevX _, prevScript) <- getK graph dir (Diagonal (pred k))
-      return (succ prevX, addInBounds as prevX This prevScript) -- rightward (deletion)
-    (endpoint, script) <- slide graph dir (Endpoint fromX (fromX - k)) fromScript
+      (Endpoint prevX prevY, prevScript) <- getK graph dir (Diagonal (pred k))
+      return (Endpoint (succ prevX) prevY, addInBounds as prevX This prevScript) -- rightward (deletion)
+    (endpoint, script) <- slide graph dir from fromScript
     setK graph dir (Diagonal k) (x endpoint) script
     return (direction dir endpoint (Endpoint (n - x endpoint) (m - y endpoint)))
     where at :: Vector.Vector a -> Int -> a

From 093f3b95084c206deacbe834c08cefed1e23817d Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 20 Mar 2017 11:25:58 -0400
Subject: [PATCH 219/294] =?UTF-8?q?Stub=20in=20a=20spec=20for=20Myers?=
 =?UTF-8?q?=E2=80=99=20algorithm.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 semantic-diff.cabal    | 1 +
 test/SES/Myers/Spec.hs | 7 +++++++
 test/Spec.hs           | 2 ++
 3 files changed, 10 insertions(+)
 create mode 100644 test/SES/Myers/Spec.hs

diff --git a/semantic-diff.cabal b/semantic-diff.cabal
index 8534f6d59..f14298b65 100644
--- a/semantic-diff.cabal
+++ b/semantic-diff.cabal
@@ -148,6 +148,7 @@ test-suite test
                      , InterpreterSpec
                      , PatchOutputSpec
                      , RangeSpec
+                     , SES.Myers.Spec
                      , SourceSpec
                      , TermSpec
                      , TOCSpec
diff --git a/test/SES/Myers/Spec.hs b/test/SES/Myers/Spec.hs
new file mode 100644
index 000000000..faf8a1249
--- /dev/null
+++ b/test/SES/Myers/Spec.hs
@@ -0,0 +1,7 @@
+module SES.Myers.Spec where
+
+import Prologue
+import Test.Hspec
+
+spec :: Spec
+spec = return ()
diff --git a/test/Spec.hs b/test/Spec.hs
index 5a320a4c1..8f4237307 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -9,6 +9,7 @@ import qualified SummarySpec
 import qualified InterpreterSpec
 import qualified PatchOutputSpec
 import qualified RangeSpec
+import qualified SES.Myers.Spec
 import qualified SourceSpec
 import qualified TermSpec
 import qualified TOCSpec
@@ -27,6 +28,7 @@ main = hspec . parallel $ do
   describe "Interpreter" InterpreterSpec.spec
   describe "PatchOutput" PatchOutputSpec.spec
   describe "Range" RangeSpec.spec
+  describe "SES.Myers" SES.Myers.Spec.spec
   describe "Source" SourceSpec.spec
   describe "Term" TermSpec.spec
   describe "TOC" TOCSpec.spec

From 67ddbae36c751f6745797e96140e40d8613a4f65 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 20 Mar 2017 11:29:16 -0400
Subject: [PATCH 220/294] Test that equal lists are returned in These.

---
 test/SES/Myers/Spec.hs | 8 +++++++-
 1 file changed, 7 insertions(+), 1 deletion(-)

diff --git a/test/SES/Myers/Spec.hs b/test/SES/Myers/Spec.hs
index faf8a1249..bdde6beab 100644
--- a/test/SES/Myers/Spec.hs
+++ b/test/SES/Myers/Spec.hs
@@ -1,7 +1,13 @@
 module SES.Myers.Spec where
 
+import Data.These
 import Prologue
+import SES.Myers
 import Test.Hspec
+import Test.Hspec.LeanCheck
 
 spec :: Spec
-spec = return ()
+spec = do
+  describe "ses" $ do
+    prop "returns equal lists in These" $
+      \ as -> runMyers (==) (ses (makeEditGraph as as :: EditGraph Char Char)) `shouldBe` zipWith These as as

From 2f86a8d374541b128481527f3cf5d0944574cfe8 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 20 Mar 2017 11:31:06 -0400
Subject: [PATCH 221/294] Test that comparisons of a list against the empty
 list returns all values in This.

---
 test/SES/Myers/Spec.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/test/SES/Myers/Spec.hs b/test/SES/Myers/Spec.hs
index bdde6beab..c7e4756d5 100644
--- a/test/SES/Myers/Spec.hs
+++ b/test/SES/Myers/Spec.hs
@@ -11,3 +11,6 @@ spec = do
   describe "ses" $ do
     prop "returns equal lists in These" $
       \ as -> runMyers (==) (ses (makeEditGraph as as :: EditGraph Char Char)) `shouldBe` zipWith These as as
+
+    prop "returns deletions in This" $
+      \ as -> runMyers (==) (ses (makeEditGraph as [] :: EditGraph Char Char)) `shouldBe` fmap This as

From 2556e0f1e1f76dc5e8709c0bce2a28bb6fd4c6ab Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 20 Mar 2017 11:32:03 -0400
Subject: [PATCH 222/294] Test that comparisons of the empty list against a
 list returns all values in That.

---
 test/SES/Myers/Spec.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/test/SES/Myers/Spec.hs b/test/SES/Myers/Spec.hs
index c7e4756d5..465ef1f1b 100644
--- a/test/SES/Myers/Spec.hs
+++ b/test/SES/Myers/Spec.hs
@@ -14,3 +14,6 @@ spec = do
 
     prop "returns deletions in This" $
       \ as -> runMyers (==) (ses (makeEditGraph as [] :: EditGraph Char Char)) `shouldBe` fmap This as
+
+    prop "returns insertions in That" $
+      \ bs -> runMyers (==) (ses (makeEditGraph [] bs :: EditGraph Char Char)) `shouldBe` fmap That bs

From 54bd6a2a4ccae04ddab19a29f56cd26561dd9b5d Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 20 Mar 2017 11:45:07 -0400
Subject: [PATCH 223/294] The reverse edit graph is centred around k = 0.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

This means that we will need to translate between the different diagonal coordinates when looking for overlap, but we won‘t need to adjust the boundaries checked when finding the furthest endpoint along some diagonal k.
---
 src/SES/Myers.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 4cae48141..193fe4eac 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -127,7 +127,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
           <*> for [negate d, negate d + 2 .. d] (searchAlongK graph (Distance d) Reverse . Diagonal)
 
   SearchAlongK graph d dir k -> do
-    (forwardEndpoint, reverseEndpoint) <- endpointsFor graph d dir (direction dir k (Diagonal (unDiagonal k + delta)))
+    (forwardEndpoint, reverseEndpoint) <- endpointsFor graph d dir k
     if direction dir odd even delta && inInterval d dir k && overlaps graph forwardEndpoint reverseEndpoint then
       return (Just (Snake reverseEndpoint forwardEndpoint, Distance (2 * unDistance d - direction dir 1 0)))
     else

From 10ef21b7c89562db96ac02cc8edd783355e9fc93 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 20 Mar 2017 11:48:49 -0400
Subject: [PATCH 224/294] Select the correct diagonal in the opposing edit
 graph.

---
 src/SES/Myers.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 193fe4eac..d6790589d 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -196,7 +196,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         endpointsFor :: HasCallStack => EditGraph a b -> Distance -> Direction -> Diagonal -> Myers a b (Endpoint, Endpoint)
         endpointsFor graph d dir k = do
           here <- findDPath graph d dir k
-          (there, _) <- getK graph (direction dir Reverse Forward) k
+          (there, _) <- getK graph (direction dir Reverse Forward) (Diagonal (unDiagonal k + delta))
           return (direction dir (here, there) (there, here))
 
         fail :: (HasCallStack, Monad m) => String -> m a

From 6e0104dbd0ffc49701ff52da79c642365e92228e Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 20 Mar 2017 11:57:43 -0400
Subject: [PATCH 225/294] Throw an exception explicitly when failing to find
 the middle snake.

---
 src/SES/Myers.hs | 15 ++++++++++-----
 1 file changed, 10 insertions(+), 5 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index d6790589d..5a8946539 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -112,15 +112,20 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     | null bs -> return (This <$> toList as)
     | null as -> return (That <$> toList bs)
     | otherwise -> do
-      Just (_, Distance d) <- for [0..maxD] (searchUpToD graph . Distance)
-      v <- gets ((if odd d then fst else snd) . unMyersState)
-      return (snd (v Vector.! index v delta))
+      result <- for [0..maxD] (searchUpToD graph . Distance)
+      case result of
+        Just (_, Distance d) -> do
+          v <- gets ((if odd d then fst else snd) . unMyersState)
+          return (snd (v Vector.! index v delta))
+        _ -> fail "no middle snake found in edit graph."
 
   EditDistance graph -> unDistance . snd <$> middleSnake graph
 
   MiddleSnake graph -> do
-    Just result <- for [0..maxD] (searchUpToD graph . Distance)
-    return result
+    result <- for [0..maxD] (searchUpToD graph . Distance)
+    case result of
+      Just result -> return result
+      _ -> fail "no middle snake found in edit graph."
 
   SearchUpToD graph (Distance d) ->
     (<|>) <$> for [negate d, negate d + 2 .. d] (searchAlongK graph (Distance d) Forward . Diagonal)

From bbb95ff030ab36873c49fdc0e16e6fe57c86e511 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 20 Mar 2017 12:46:45 -0400
Subject: [PATCH 226/294] Add an explicit step for the overlaps check.

---
 src/SES/Myers.hs | 21 ++++++++++++++++-----
 1 file changed, 16 insertions(+), 5 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 5a8946539..c4531006e 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -27,6 +27,8 @@ data MyersF a b result where
 
   Slide :: EditGraph a b -> Direction -> Endpoint -> EditScript a b -> MyersF a b (Endpoint, EditScript a b)
 
+  Overlaps :: EditGraph a b -> Endpoint -> Endpoint -> MyersF a b Bool
+
 type EditScript a b = [These a b]
 
 data State s a where
@@ -133,8 +135,12 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
 
   SearchAlongK graph d dir k -> do
     (forwardEndpoint, reverseEndpoint) <- endpointsFor graph d dir k
-    if direction dir odd even delta && inInterval d dir k && overlaps graph forwardEndpoint reverseEndpoint then
-      return (Just (Snake reverseEndpoint forwardEndpoint, Distance (2 * unDistance d - direction dir 1 0)))
+    if direction dir odd even delta && inInterval d dir k then do
+      overlapping <- overlaps graph forwardEndpoint reverseEndpoint
+      if overlapping then
+        return (Just (Snake reverseEndpoint forwardEndpoint, Distance (2 * unDistance d - direction dir 1 0)))
+      else
+        continue
     else
       continue
 
@@ -187,6 +193,9 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     where at :: Vector.Vector a -> Int -> a
           v `at` i = v Vector.! direction dir i (length v - succ i)
 
+  Overlaps _ (Endpoint x y) (Endpoint u v) ->
+    return $ x - y == u - v && n - u <= x
+
   where (EditGraph as bs, n, m, maxD, delta) = editGraph myers
 
         index v k = if k >= 0 then k else length v + k
@@ -241,6 +250,9 @@ setK graph direction diagonal x script = M (SetK graph direction diagonal x scri
 slide :: HasCallStack => EditGraph a b -> Direction -> Endpoint -> EditScript a b -> Myers a b (Endpoint, EditScript a b)
 slide graph direction from script = M (Slide graph direction from script) `Then` return
 
+overlaps :: HasCallStack => EditGraph a b -> Endpoint -> Endpoint -> Myers a b Bool
+overlaps graph forward reverse = M (Overlaps graph forward reverse) `Then` return
+
 getEq :: HasCallStack => Myers a b (a -> b -> Bool)
 getEq = GetEq `Then` return
 
@@ -257,9 +269,6 @@ emptyStateForStep step = case step of
     MyersState (Vector.replicate (succ (maxD * 2)) (0, []), Vector.replicate (succ (maxD * 2)) (0, []))
   _ -> MyersState (Vector.empty, Vector.empty)
 
-overlaps :: EditGraph a b -> Endpoint -> Endpoint -> Bool
-overlaps (EditGraph as _) (Endpoint x y) (Endpoint u v) = x - y == u - v && length as - u <= x
-
 for :: [a] -> (a -> Myers c d (Maybe b)) -> Myers c d (Maybe b)
 for all run = foldr (\ a b -> (<|>) <$> run a <*> b) (return Nothing) all
 
@@ -289,6 +298,7 @@ editGraph myers = (EditGraph as bs, n, m, (m + n) `ceilDiv` 2, n - m)
           GetK g _ _ -> g
           SetK g _ _ _ _ -> g
           Slide g _ _ _ -> g
+          Overlaps g _ _ -> g
         (n, m) = (length as, length bs)
 
 
@@ -307,6 +317,7 @@ liftShowsMyersF sp1 sl1 sp2 sl2 d m = case m of
   GetK graph direction diagonal -> showsTernaryWith showGraph showsPrec showsPrec "GetK" d graph direction diagonal
   SetK graph direction diagonal v script -> showsQuinaryWith showGraph showsPrec showsPrec showsPrec (liftShowsEditScript sp1 sp2) "SetK" d graph direction diagonal v script
   Slide graph direction endpoint script -> showsQuaternaryWith showGraph showsPrec showsPrec (liftShowsEditScript sp1 sp2) "Slide" d graph direction endpoint script
+  Overlaps graph forward reverse -> showsTernaryWith showGraph showsPrec showsPrec "Overlaps" d graph forward reverse
   where showGraph = (liftShowsPrec2 :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> (Int -> b -> ShowS) -> ([b] -> ShowS) -> Int -> EditGraph a b -> ShowS) sp1 sl1 sp2 sl2
 
 showsTernaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> (Int -> c -> ShowS) -> String -> Int -> a -> b -> c -> ShowS

From d96931157f3187d03cf2dd8a272b0222d0dc2611 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 20 Mar 2017 13:04:06 -0400
Subject: [PATCH 227/294] Reformat an if statement.

---
 src/SES/Myers.hs | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index c4531006e..5a75a7527 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -186,9 +186,10 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
       eq <- getEq
       let a = as `at` x
       let b = bs `at` y
-      if a `eq` b
-        then slide graph dir (Endpoint (succ x) (succ y)) (addFor dir (These a b) script)
-        else return (Endpoint x y, script)
+      if a `eq` b then
+        slide graph dir (Endpoint (succ x) (succ y)) (addFor dir (These a b) script)
+      else
+        return (Endpoint x y, script)
     | otherwise -> return (Endpoint x y, script)
     where at :: Vector.Vector a -> Int -> a
           v `at` i = v Vector.! direction dir i (length v - succ i)

From 68a3d5fe1655457c0ad120c0b66ae53aabdb58d6 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 21 Mar 2017 12:02:53 -0400
Subject: [PATCH 228/294] Extract the index function to the top level.

---
 src/SES/Myers.hs | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 5a75a7527..d3accfc63 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -199,8 +199,6 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
 
   where (EditGraph as bs, n, m, maxD, delta) = editGraph myers
 
-        index v k = if k >= 0 then k else length v + k
-
         inInterval (Distance d) direction (Diagonal k) = case direction of
           Forward -> inRange (delta - pred d, delta + pred d) k
           Reverse -> inRange (negate d, d) (k + delta)
@@ -279,6 +277,9 @@ continue = return Nothing
 ceilDiv :: Integral a => a -> a -> a
 ceilDiv = (uncurry (+) .) . divMod
 
+index :: Vector.Vector a -> Int -> Int
+index v k = if k >= 0 then k else length v + k
+
 divideGraph :: EditGraph a b -> Endpoint -> (EditGraph a b, EditGraph a b)
 divideGraph (EditGraph as bs) (Endpoint x y) =
   ( EditGraph (slice 0  x              as) (slice 0  y              bs)

From fdc2f551c41bca1a3a05a55891614362b5383b1c Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 21 Mar 2017 15:18:01 -0400
Subject: [PATCH 229/294] Offset the y coordinates of reverse endpoints.

---
 src/SES/Myers.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index d3accfc63..b3869b6f7 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -174,7 +174,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
       fail ("diagonal " <> show k <> " (" <> show i <> ") underflows state indices " <> show (negate maxD + offset) <> ".." <> show (maxD + offset) <> " (0.." <> show (2 * maxD) <> ")")
     when (i >= length v) $
       fail ("diagonal " <> show k <> " (" <> show i <> ") overflows state indices " <> show (negate maxD + offset) <> ".." <> show (maxD + offset) <> " (0.." <> show (2 * maxD) <> ")")
-    let (x, script) = v Vector.! i in return (Endpoint x (x - k), script)
+    let (x, script) = v Vector.! i in return (Endpoint x (direction dir (x - k) (x - k + delta)), script)
 
   SetK _ dir (Diagonal k) x script ->
     modify (MyersState . direction dir first second set . unMyersState)

From 27b0b289549ad6f0e48d34ce369343dd3b9bd305 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 22 Mar 2017 15:25:50 -0400
Subject: [PATCH 230/294] :fire: the reverse path & control flow.

---
 src/SES/Myers.hs | 192 +++++++++++++++++------------------------------
 1 file changed, 68 insertions(+), 124 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index b3869b6f7..856f6e5a1 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -4,7 +4,6 @@ module SES.Myers where
 import Control.Exception
 import Control.Monad.Free.Freer
 import Data.Functor.Classes
-import Data.Ix (inRange)
 import Data.String
 import Data.These
 import qualified Data.Vector as Vector
@@ -17,17 +16,14 @@ data MyersF a b result where
   SES :: EditGraph a b -> MyersF a b (EditScript a b)
   LCS :: EditGraph a b -> MyersF a b [(a, b)]
   EditDistance :: EditGraph a b -> MyersF a b Int
-  MiddleSnake :: EditGraph a b -> MyersF a b (Snake, Distance)
-  SearchUpToD :: EditGraph a b -> Distance -> MyersF a b (Maybe (Snake, Distance))
-  SearchAlongK :: EditGraph a b -> Distance -> Direction -> Diagonal -> MyersF a b (Maybe (Snake, Distance))
-  FindDPath :: EditGraph a b -> Distance -> Direction -> Diagonal -> MyersF a b Endpoint
+  SearchUpToD :: EditGraph a b -> Distance -> MyersF a b (Maybe (EditScript a b, Distance))
+  SearchAlongK :: EditGraph a b -> Distance -> Diagonal -> MyersF a b (Maybe (EditScript a b, Distance))
+  FindDPath :: EditGraph a b -> Distance -> Diagonal -> MyersF a b Endpoint
 
-  GetK :: EditGraph a b -> Direction -> Diagonal -> MyersF a b (Endpoint, EditScript a b)
-  SetK :: EditGraph a b -> Direction -> Diagonal -> Int -> EditScript a b -> MyersF a b ()
+  GetK :: EditGraph a b -> Diagonal -> MyersF a b (Endpoint, EditScript a b)
+  SetK :: EditGraph a b -> Diagonal -> Int -> EditScript a b -> MyersF a b ()
 
-  Slide :: EditGraph a b -> Direction -> Endpoint -> EditScript a b -> MyersF a b (Endpoint, EditScript a b)
-
-  Overlaps :: EditGraph a b -> Endpoint -> Endpoint -> MyersF a b Bool
+  Slide :: EditGraph a b -> Endpoint -> EditScript a b -> MyersF a b (Endpoint, EditScript a b)
 
 type EditScript a b = [These a b]
 
@@ -48,9 +44,6 @@ data EditGraph a b = EditGraph { as :: !(Vector.Vector a), bs :: !(Vector.Vector
 makeEditGraph :: (Foldable t, Foldable u) => t a -> u b -> EditGraph a b
 makeEditGraph as bs = EditGraph (Vector.fromList (toList as)) (Vector.fromList (toList bs))
 
-data Snake = Snake { xy :: Endpoint, uv :: Endpoint }
-  deriving (Eq, Show)
-
 newtype Distance = Distance { unDistance :: Int }
   deriving (Eq, Show)
 
@@ -60,13 +53,6 @@ newtype Diagonal = Diagonal { unDiagonal :: Int }
 data Endpoint = Endpoint { x :: !Int, y :: !Int }
   deriving (Eq, Show)
 
-data Direction = Forward | Reverse
-  deriving (Eq, Show)
-
--- | Eliminate a Direction by selecting the first value for the Forward case and the second value for the Reverse case.
-direction :: Direction -> a -> a -> a
-direction d a b = case d of { Forward -> a ; Reverse -> b }
-
 
 -- Evaluation
 
@@ -116,101 +102,69 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     | otherwise -> do
       result <- for [0..maxD] (searchUpToD graph . Distance)
       case result of
-        Just (_, Distance d) -> do
-          v <- gets ((if odd d then fst else snd) . unMyersState)
-          return (snd (v Vector.! index v delta))
-        _ -> fail "no middle snake found in edit graph."
+        Just (script, _) -> return script
+        _ -> fail "no shortest edit script found in edit graph (this is a bug in SES.Myers)."
 
-  EditDistance graph -> unDistance . snd <$> middleSnake graph
+  EditDistance graph -> length . filter (these (const True) (const True) (const (const False))) <$> ses graph
 
-  MiddleSnake graph -> do
-    result <- for [0..maxD] (searchUpToD graph . Distance)
-    case result of
-      Just result -> return result
-      _ -> fail "no middle snake found in edit graph."
+  SearchUpToD graph (Distance d) -> for [negate d, negate d + 2 .. d] (searchAlongK graph (Distance d) . Diagonal)
 
-  SearchUpToD graph (Distance d) ->
-    (<|>) <$> for [negate d, negate d + 2 .. d] (searchAlongK graph (Distance d) Forward . Diagonal)
-          <*> for [negate d, negate d + 2 .. d] (searchAlongK graph (Distance d) Reverse . Diagonal)
-
-  SearchAlongK graph d dir k -> do
-    (forwardEndpoint, reverseEndpoint) <- endpointsFor graph d dir k
-    if direction dir odd even delta && inInterval d dir k then do
-      overlapping <- overlaps graph forwardEndpoint reverseEndpoint
-      if overlapping then
-        return (Just (Snake reverseEndpoint forwardEndpoint, Distance (2 * unDistance d - direction dir 1 0)))
-      else
-        continue
+  SearchAlongK graph d k -> do
+    Endpoint x y <- findDPath graph d k
+    if x >= n && y >= m then do
+      (_, script) <- getK graph k
+      return (Just (script, d))
     else
       continue
 
-  FindDPath graph (Distance d) dir (Diagonal k) -> do
-    (from, fromScript) <- if k == negate d then do
-      (Endpoint nextX nextY, nextScript) <- getK graph dir (Diagonal (succ k))
+  FindDPath graph (Distance d) (Diagonal k) -> do
+    (from, fromScript) <- if d == 0 then
+      return (Endpoint 0 0, [])
+    else if k == negate d then do
+      (Endpoint nextX nextY, nextScript) <- getK graph (Diagonal (succ k))
       return (Endpoint nextX (succ nextY),     addInBounds bs nextY That nextScript) -- downward (insertion)
     else if k /= d then do
-      (Endpoint prevX prevY, prevScript) <- getK graph dir (Diagonal (pred k))
-      (Endpoint nextX nextY, nextScript) <- getK graph dir (Diagonal (succ k))
+      (Endpoint prevX prevY, prevScript) <- getK graph (Diagonal (pred k))
+      (Endpoint nextX nextY, nextScript) <- getK graph (Diagonal (succ k))
       return $ if prevX < nextX then
         (Endpoint nextX (succ nextY), addInBounds bs nextY That nextScript) -- downward (insertion)
       else
         (Endpoint (succ prevX) prevY, addInBounds as prevX This prevScript) -- rightward (deletion)
     else do
-      (Endpoint prevX prevY, prevScript) <- getK graph dir (Diagonal (pred k))
+      (Endpoint prevX prevY, prevScript) <- getK graph (Diagonal (pred k))
       return (Endpoint (succ prevX) prevY, addInBounds as prevX This prevScript) -- rightward (deletion)
-    (endpoint, script) <- slide graph dir from fromScript
-    setK graph dir (Diagonal k) (x endpoint) script
-    return (direction dir endpoint (Endpoint (n - x endpoint) (m - y endpoint)))
-    where at :: Vector.Vector a -> Int -> a
-          v `at` i = v Vector.! direction dir i (length v - succ i)
-          addInBounds :: Vector.Vector a -> Int -> (a -> b) -> [b] -> [b]
-          addInBounds v i with to = if (d /= 0 || dir == Reverse) && i >= 0 && i < length v then addFor dir (with (v `at` i)) to else to
+    (endpoint, script) <- slide graph from fromScript
+    setK graph (Diagonal k) (x endpoint) script
+    return endpoint
+    where addInBounds :: Vector.Vector a -> Int -> (a -> b) -> [b] -> [b]
+          addInBounds v i with to = if i >= 0 && i < length v then with (v Vector.! i) : to else to
 
-  GetK _ dir (Diagonal k) -> do
-    v <- gets (direction dir fst snd . unMyersState)
+  GetK _ (Diagonal k) -> do
+    v <- gets unMyersState
     let i = index v k
-    let offset = direction dir 0 delta
     when (i < 0) $
-      fail ("diagonal " <> show k <> " (" <> show i <> ") underflows state indices " <> show (negate maxD + offset) <> ".." <> show (maxD + offset) <> " (0.." <> show (2 * maxD) <> ")")
+      fail ("diagonal " <> show k <> " (" <> show i <> ") underflows state indices " <> show (negate maxD) <> ".." <> show maxD <> " (0.." <> show (2 * maxD) <> ")")
     when (i >= length v) $
-      fail ("diagonal " <> show k <> " (" <> show i <> ") overflows state indices " <> show (negate maxD + offset) <> ".." <> show (maxD + offset) <> " (0.." <> show (2 * maxD) <> ")")
-    let (x, script) = v Vector.! i in return (Endpoint x (direction dir (x - k) (x - k + delta)), script)
+      fail ("diagonal " <> show k <> " (" <> show i <> ") overflows state indices " <> show (negate maxD) <> ".." <> show maxD <> " (0.." <> show (2 * maxD) <> ")")
+    let (x, script) = v Vector.! i in return (Endpoint x (x - k), script)
 
-  SetK _ dir (Diagonal k) x script ->
-    modify (MyersState . direction dir first second set . unMyersState)
+  SetK _ (Diagonal k) x script ->
+    modify (MyersState . set . unMyersState)
     where set v = v Vector.// [(index v k, (x, script))]
 
-  Slide graph dir (Endpoint x y) script
+  Slide graph (Endpoint x y) script
     | x >= 0, x < n
     , y >= 0, y < m -> do
       eq <- getEq
-      let a = as `at` x
-      let b = bs `at` y
+      let a = as Vector.! x
+      let b = bs Vector.! y
       if a `eq` b then
-        slide graph dir (Endpoint (succ x) (succ y)) (addFor dir (These a b) script)
+        slide graph (Endpoint (succ x) (succ y)) (These a b : script)
       else
         return (Endpoint x y, script)
     | otherwise -> return (Endpoint x y, script)
-    where at :: Vector.Vector a -> Int -> a
-          v `at` i = v Vector.! direction dir i (length v - succ i)
 
-  Overlaps _ (Endpoint x y) (Endpoint u v) ->
-    return $ x - y == u - v && n - u <= x
-
-  where (EditGraph as bs, n, m, maxD, delta) = editGraph myers
-
-        inInterval (Distance d) direction (Diagonal k) = case direction of
-          Forward -> inRange (delta - pred d, delta + pred d) k
-          Reverse -> inRange (negate d, d) (k + delta)
-
-        addFor :: Direction -> a -> [a] -> [a]
-        addFor dir a = direction dir (<> [a]) (a :)
-
-        endpointsFor :: HasCallStack => EditGraph a b -> Distance -> Direction -> Diagonal -> Myers a b (Endpoint, Endpoint)
-        endpointsFor graph d dir k = do
-          here <- findDPath graph d dir k
-          (there, _) <- getK graph (direction dir Reverse Forward) (Diagonal (unDiagonal k + delta))
-          return (direction dir (here, there) (there, here))
+  where (EditGraph as bs, n, m, maxD) = editGraph myers
 
         fail :: (HasCallStack, Monad m) => String -> m a
         fail s = let ?callStack = fromCallSiteList (filter ((/= "M") . fst) (getCallStack callStack)) in
@@ -228,29 +182,23 @@ lcs graph = M (LCS graph) `Then` return
 editDistance :: HasCallStack => EditGraph a b -> Myers a b Int
 editDistance graph = M (EditDistance graph) `Then` return
 
-middleSnake :: HasCallStack => EditGraph a b -> Myers a b (Snake, Distance)
-middleSnake graph = M (MiddleSnake graph) `Then` return
-
-searchUpToD :: HasCallStack => EditGraph a b -> Distance -> Myers a b (Maybe (Snake, Distance))
+searchUpToD :: HasCallStack => EditGraph a b -> Distance -> Myers a b (Maybe (EditScript a b, Distance))
 searchUpToD graph distance = M (SearchUpToD graph distance) `Then` return
 
-searchAlongK :: HasCallStack => EditGraph a b -> Distance -> Direction -> Diagonal -> Myers a b (Maybe (Snake, Distance))
-searchAlongK graph d direction k = M (SearchAlongK graph d direction k) `Then` return
+searchAlongK :: HasCallStack => EditGraph a b -> Distance -> Diagonal -> Myers a b (Maybe (EditScript a b, Distance))
+searchAlongK graph d k = M (SearchAlongK graph d k) `Then` return
 
-findDPath :: HasCallStack => EditGraph a b -> Distance -> Direction -> Diagonal -> Myers a b Endpoint
-findDPath graph d direction k = M (FindDPath graph d direction k) `Then` return
+findDPath :: HasCallStack => EditGraph a b -> Distance -> Diagonal -> Myers a b Endpoint
+findDPath graph d k = M (FindDPath graph d k) `Then` return
 
-getK :: HasCallStack => EditGraph a b -> Direction -> Diagonal -> Myers a b (Endpoint, EditScript a b)
-getK graph direction diagonal = M (GetK graph direction diagonal) `Then` return
+getK :: HasCallStack => EditGraph a b -> Diagonal -> Myers a b (Endpoint, EditScript a b)
+getK graph diagonal = M (GetK graph diagonal) `Then` return
 
-setK :: HasCallStack => EditGraph a b -> Direction -> Diagonal -> Int -> EditScript a b -> Myers a b ()
-setK graph direction diagonal x script = M (SetK graph direction diagonal x script) `Then` return
+setK :: HasCallStack => EditGraph a b -> Diagonal -> Int -> EditScript a b -> Myers a b ()
+setK graph diagonal x script = M (SetK graph diagonal x script) `Then` return
 
-slide :: HasCallStack => EditGraph a b -> Direction -> Endpoint -> EditScript a b -> Myers a b (Endpoint, EditScript a b)
-slide graph direction from script = M (Slide graph direction from script) `Then` return
-
-overlaps :: HasCallStack => EditGraph a b -> Endpoint -> Endpoint -> Myers a b Bool
-overlaps graph forward reverse = M (Overlaps graph forward reverse) `Then` return
+slide :: HasCallStack => EditGraph a b -> Endpoint -> EditScript a b -> Myers a b (Endpoint, EditScript a b)
+slide graph from script = M (Slide graph from script) `Then` return
 
 getEq :: HasCallStack => Myers a b (a -> b -> Bool)
 getEq = GetEq `Then` return
@@ -258,15 +206,15 @@ getEq = GetEq `Then` return
 
 -- Implementation details
 
-newtype MyersState a b = MyersState { unMyersState :: (Vector.Vector (Int, EditScript a b), Vector.Vector (Int, EditScript a b)) }
+newtype MyersState a b = MyersState { unMyersState :: Vector.Vector (Int, EditScript a b) }
   deriving (Eq, Show)
 
 emptyStateForStep :: Myers a b c -> MyersState a b
 emptyStateForStep step = case step of
   Then (M myers) _ ->
-    let (_, _, _, maxD, _) = editGraph myers in
-    MyersState (Vector.replicate (succ (maxD * 2)) (0, []), Vector.replicate (succ (maxD * 2)) (0, []))
-  _ -> MyersState (Vector.empty, Vector.empty)
+    let (_, _, _, maxD) = editGraph myers in
+    MyersState (Vector.replicate (succ (maxD * 2)) (0, []))
+  _ -> MyersState Vector.empty
 
 for :: [a] -> (a -> Myers c d (Maybe b)) -> Myers c d (Maybe b)
 for all run = foldr (\ a b -> (<|>) <$> run a <*> b) (return Nothing) all
@@ -287,20 +235,18 @@ divideGraph (EditGraph as bs) (Endpoint x y) =
   where slice from to v = Vector.slice (max 0 (min from (length v))) (max 0 (min to (length v))) v
 
 
-editGraph :: MyersF a b c -> (EditGraph a b, Int, Int, Int, Int)
-editGraph myers = (EditGraph as bs, n, m, (m + n) `ceilDiv` 2, n - m)
+editGraph :: MyersF a b c -> (EditGraph a b, Int, Int, Int)
+editGraph myers = (EditGraph as bs, n, m, (m + n) `ceilDiv` 2)
   where EditGraph as bs = case myers of
           SES g -> g
           LCS g -> g
           EditDistance g -> g
-          MiddleSnake g -> g
           SearchUpToD g _ -> g
-          SearchAlongK g _ _ _ -> g
-          FindDPath g _ _ _ -> g
-          GetK g _ _ -> g
-          SetK g _ _ _ _ -> g
-          Slide g _ _ _ -> g
-          Overlaps g _ _ -> g
+          SearchAlongK g _ _ -> g
+          FindDPath g _ _ -> g
+          GetK g _ -> g
+          SetK g _ _ _ -> g
+          Slide g _ _ -> g
         (n, m) = (length as, length bs)
 
 
@@ -312,14 +258,12 @@ liftShowsMyersF sp1 sl1 sp2 sl2 d m = case m of
   SES graph -> showsUnaryWith showGraph "SES" d graph
   LCS graph -> showsUnaryWith showGraph "LCS" d graph
   EditDistance graph -> showsUnaryWith showGraph "EditDistance" d graph
-  MiddleSnake graph -> showsUnaryWith showGraph "MiddleSnake" d graph
   SearchUpToD graph distance -> showsBinaryWith showGraph showsPrec "SearchUpToD" d graph distance
-  SearchAlongK graph distance direction diagonal -> showsQuaternaryWith showGraph showsPrec showsPrec showsPrec "SearchAlongK" d graph direction distance diagonal
-  FindDPath graph distance direction diagonal -> showsQuaternaryWith showGraph showsPrec showsPrec showsPrec "FindDPath" d graph distance direction diagonal
-  GetK graph direction diagonal -> showsTernaryWith showGraph showsPrec showsPrec "GetK" d graph direction diagonal
-  SetK graph direction diagonal v script -> showsQuinaryWith showGraph showsPrec showsPrec showsPrec (liftShowsEditScript sp1 sp2) "SetK" d graph direction diagonal v script
-  Slide graph direction endpoint script -> showsQuaternaryWith showGraph showsPrec showsPrec (liftShowsEditScript sp1 sp2) "Slide" d graph direction endpoint script
-  Overlaps graph forward reverse -> showsTernaryWith showGraph showsPrec showsPrec "Overlaps" d graph forward reverse
+  SearchAlongK graph distance diagonal -> showsTernaryWith showGraph showsPrec showsPrec "SearchAlongK" d graph distance diagonal
+  FindDPath graph distance diagonal -> showsTernaryWith showGraph showsPrec showsPrec "FindDPath" d graph distance diagonal
+  GetK graph diagonal -> showsBinaryWith showGraph showsPrec "GetK" d graph diagonal
+  SetK graph diagonal v script -> showsQuaternaryWith showGraph showsPrec showsPrec (liftShowsEditScript sp1 sp2) "SetK" d graph diagonal v script
+  Slide graph endpoint script -> showsTernaryWith showGraph showsPrec (liftShowsEditScript sp1 sp2) "Slide" d graph endpoint script
   where showGraph = (liftShowsPrec2 :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> (Int -> b -> ShowS) -> ([b] -> ShowS) -> Int -> EditGraph a b -> ShowS) sp1 sl1 sp2 sl2
 
 showsTernaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> (Int -> c -> ShowS) -> String -> Int -> a -> b -> c -> ShowS
@@ -365,7 +309,7 @@ instance MonadState (MyersState a b) (Myers a b) where
   put a = S (Put a) `Then` return
 
 instance Show2 MyersState where
-  liftShowsPrec2 sp1 _ sp2 _ d (MyersState (v1, v2)) = showsUnaryWith (showsWith (showsWith liftShowsPrec2 showsStateVector) showsStateVector) "MyersState" d (v1, v2)
+  liftShowsPrec2 sp1 _ sp2 _ d (MyersState v) = showsUnaryWith showsStateVector "MyersState" d v
     where showsStateVector = showsWith liftShowsVector (showsWith liftShowsPrec (liftShowsEditScript sp1 sp2))
           showsWith g f = g f (showListWith (f 0))
 

From de67e0491ea0c5ecef5f05c9dc04967d4c6ddf69 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 22 Mar 2017 15:27:18 -0400
Subject: [PATCH 231/294] Allocate exactly m + n + 1 state slots.

---
 src/SES/Myers.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 856f6e5a1..b1b507374 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -212,8 +212,8 @@ newtype MyersState a b = MyersState { unMyersState :: Vector.Vector (Int, EditSc
 emptyStateForStep :: Myers a b c -> MyersState a b
 emptyStateForStep step = case step of
   Then (M myers) _ ->
-    let (_, _, _, maxD) = editGraph myers in
-    MyersState (Vector.replicate (succ (maxD * 2)) (0, []))
+    let (_, n, m, _) = editGraph myers in
+    MyersState (Vector.replicate (succ (m + n)) (0, []))
   _ -> MyersState Vector.empty
 
 for :: [a] -> (a -> Myers c d (Maybe b)) -> Myers c d (Maybe b)

From d5bd9537dcce9a6314599725e88df976f07a7aa1 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 22 Mar 2017 15:31:17 -0400
Subject: [PATCH 232/294] Search up to m + n.

---
 src/SES/Myers.hs | 17 +++++++----------
 1 file changed, 7 insertions(+), 10 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index b1b507374..f805712c9 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -100,7 +100,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     | null bs -> return (This <$> toList as)
     | null as -> return (That <$> toList bs)
     | otherwise -> do
-      result <- for [0..maxD] (searchUpToD graph . Distance)
+      result <- for [0..(m + n)] (searchUpToD graph . Distance)
       case result of
         Just (script, _) -> return script
         _ -> fail "no shortest edit script found in edit graph (this is a bug in SES.Myers)."
@@ -143,9 +143,9 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     v <- gets unMyersState
     let i = index v k
     when (i < 0) $
-      fail ("diagonal " <> show k <> " (" <> show i <> ") underflows state indices " <> show (negate maxD) <> ".." <> show maxD <> " (0.." <> show (2 * maxD) <> ")")
+      fail ("diagonal " <> show k <> " (" <> show i <> ") underflows state indices " <> show (negate m) <> ".." <> show n <> " (0.." <> show (succ (m + n)) <> ")")
     when (i >= length v) $
-      fail ("diagonal " <> show k <> " (" <> show i <> ") overflows state indices " <> show (negate maxD) <> ".." <> show maxD <> " (0.." <> show (2 * maxD) <> ")")
+      fail ("diagonal " <> show k <> " (" <> show i <> ") overflows state indices " <> show (negate m) <> ".." <> show n <> " (0.." <> show (succ (m + n)) <> ")")
     let (x, script) = v Vector.! i in return (Endpoint x (x - k), script)
 
   SetK _ (Diagonal k) x script ->
@@ -164,7 +164,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         return (Endpoint x y, script)
     | otherwise -> return (Endpoint x y, script)
 
-  where (EditGraph as bs, n, m, maxD) = editGraph myers
+  where (EditGraph as bs, n, m) = editGraph myers
 
         fail :: (HasCallStack, Monad m) => String -> m a
         fail s = let ?callStack = fromCallSiteList (filter ((/= "M") . fst) (getCallStack callStack)) in
@@ -212,7 +212,7 @@ newtype MyersState a b = MyersState { unMyersState :: Vector.Vector (Int, EditSc
 emptyStateForStep :: Myers a b c -> MyersState a b
 emptyStateForStep step = case step of
   Then (M myers) _ ->
-    let (_, n, m, _) = editGraph myers in
+    let (_, n, m) = editGraph myers in
     MyersState (Vector.replicate (succ (m + n)) (0, []))
   _ -> MyersState Vector.empty
 
@@ -222,9 +222,6 @@ for all run = foldr (\ a b -> (<|>) <$> run a <*> b) (return Nothing) all
 continue :: Myers b c (Maybe a)
 continue = return Nothing
 
-ceilDiv :: Integral a => a -> a -> a
-ceilDiv = (uncurry (+) .) . divMod
-
 index :: Vector.Vector a -> Int -> Int
 index v k = if k >= 0 then k else length v + k
 
@@ -235,8 +232,8 @@ divideGraph (EditGraph as bs) (Endpoint x y) =
   where slice from to v = Vector.slice (max 0 (min from (length v))) (max 0 (min to (length v))) v
 
 
-editGraph :: MyersF a b c -> (EditGraph a b, Int, Int, Int)
-editGraph myers = (EditGraph as bs, n, m, (m + n) `ceilDiv` 2)
+editGraph :: MyersF a b c -> (EditGraph a b, Int, Int)
+editGraph myers = (EditGraph as bs, n, m)
   where EditGraph as bs = case myers of
           SES g -> g
           LCS g -> g

From 210ac2b0b0358996da11b1886eead52a278abad1 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 22 Mar 2017 15:38:57 -0400
Subject: [PATCH 233/294] Test that the edit distance is respected.

---
 test/SES/Myers/Spec.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/test/SES/Myers/Spec.hs b/test/SES/Myers/Spec.hs
index 465ef1f1b..30d49401d 100644
--- a/test/SES/Myers/Spec.hs
+++ b/test/SES/Myers/Spec.hs
@@ -17,3 +17,6 @@ spec = do
 
     prop "returns insertions in That" $
       \ bs -> runMyers (==) (ses (makeEditGraph [] bs :: EditGraph Char Char)) `shouldBe` fmap That bs
+
+    prop "returns all elements of disjoint inputs" $
+      \ as bs -> length (runMyers (==) (ses (makeEditGraph ((,) 0 <$> as :: [(Int, Char)]) ((,) 1 <$> bs :: [(Int, Char)])))) `shouldBe` length as + length bs

From a520062e37bdb4f640f0ce647b0c72a4546374b8 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 22 Mar 2017 15:40:52 -0400
Subject: [PATCH 234/294] We build up the edit script backwards, so reverse it.

---
 src/SES/Myers.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index f805712c9..23a81a591 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -102,7 +102,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     | otherwise -> do
       result <- for [0..(m + n)] (searchUpToD graph . Distance)
       case result of
-        Just (script, _) -> return script
+        Just (script, _) -> return (reverse script)
         _ -> fail "no shortest edit script found in edit graph (this is a bug in SES.Myers)."
 
   EditDistance graph -> length . filter (these (const True) (const True) (const (const False))) <$> ses graph

From bd766c70d679f9ecd01a287cb737ec76fbdf98dc Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 22 Mar 2017 15:55:22 -0400
Subject: [PATCH 235/294] Simplify how we insert/delete elements.

---
 src/SES/Myers.hs | 10 ++++------
 1 file changed, 4 insertions(+), 6 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 23a81a591..c0969c984 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -122,22 +122,20 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
       return (Endpoint 0 0, [])
     else if k == negate d then do
       (Endpoint nextX nextY, nextScript) <- getK graph (Diagonal (succ k))
-      return (Endpoint nextX (succ nextY),     addInBounds bs nextY That nextScript) -- downward (insertion)
+      return (Endpoint nextX (succ nextY),     That (bs Vector.! nextY) : nextScript) -- downward (insertion)
     else if k /= d then do
       (Endpoint prevX prevY, prevScript) <- getK graph (Diagonal (pred k))
       (Endpoint nextX nextY, nextScript) <- getK graph (Diagonal (succ k))
       return $ if prevX < nextX then
-        (Endpoint nextX (succ nextY), addInBounds bs nextY That nextScript) -- downward (insertion)
+        (Endpoint nextX (succ nextY), That (bs Vector.! nextY) : nextScript) -- downward (insertion)
       else
-        (Endpoint (succ prevX) prevY, addInBounds as prevX This prevScript) -- rightward (deletion)
+        (Endpoint (succ prevX) prevY, This (as Vector.! prevX) : prevScript) -- rightward (deletion)
     else do
       (Endpoint prevX prevY, prevScript) <- getK graph (Diagonal (pred k))
-      return (Endpoint (succ prevX) prevY, addInBounds as prevX This prevScript) -- rightward (deletion)
+      return (Endpoint (succ prevX) prevY, This (as Vector.! prevX) : prevScript) -- rightward (deletion)
     (endpoint, script) <- slide graph from fromScript
     setK graph (Diagonal k) (x endpoint) script
     return endpoint
-    where addInBounds :: Vector.Vector a -> Int -> (a -> b) -> [b] -> [b]
-          addInBounds v i with to = if i >= 0 && i < length v then with (v Vector.! i) : to else to
 
   GetK _ (Diagonal k) -> do
     v <- gets unMyersState

From aa4aa4438fa3d17bf2efcb86cbf079d2d1e47a9f Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 22 Mar 2017 16:18:49 -0400
Subject: [PATCH 236/294] Bounds-check insertions/deletions.

---
 src/SES/Myers.hs | 13 +++++++++----
 1 file changed, 9 insertions(+), 4 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index c0969c984..7bc96d852 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -122,17 +122,17 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
       return (Endpoint 0 0, [])
     else if k == negate d then do
       (Endpoint nextX nextY, nextScript) <- getK graph (Diagonal (succ k))
-      return (Endpoint nextX (succ nextY),     That (bs Vector.! nextY) : nextScript) -- downward (insertion)
+      return (Endpoint nextX (succ nextY), if nextY < m then That (bs ! nextY) : nextScript else nextScript) -- downward (insertion)
     else if k /= d then do
       (Endpoint prevX prevY, prevScript) <- getK graph (Diagonal (pred k))
       (Endpoint nextX nextY, nextScript) <- getK graph (Diagonal (succ k))
       return $ if prevX < nextX then
-        (Endpoint nextX (succ nextY), That (bs Vector.! nextY) : nextScript) -- downward (insertion)
+        (Endpoint nextX (succ nextY), if nextY < m then That (bs ! nextY) : nextScript else nextScript) -- downward (insertion)
       else
-        (Endpoint (succ prevX) prevY, This (as Vector.! prevX) : prevScript) -- rightward (deletion)
+        (Endpoint (succ prevX) prevY, if prevX < n then This (as ! prevX) : prevScript else prevScript) -- rightward (deletion)
     else do
       (Endpoint prevX prevY, prevScript) <- getK graph (Diagonal (pred k))
-      return (Endpoint (succ prevX) prevY, This (as Vector.! prevX) : prevScript) -- rightward (deletion)
+      return (Endpoint (succ prevX) prevY, if prevX < n then This (as ! prevX) : prevScript else prevScript) -- rightward (deletion)
     (endpoint, script) <- slide graph from fromScript
     setK graph (Diagonal k) (x endpoint) script
     return endpoint
@@ -164,6 +164,11 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
 
   where (EditGraph as bs, n, m) = editGraph myers
 
+        (!) :: HasCallStack => Vector.Vector a -> Int -> a
+        v ! i | i < length v = v Vector.! i
+              | otherwise = let ?callStack = fromCallSiteList (filter ((/= "M") . fst) (getCallStack callStack)) in
+                  throw (MyersException ("index " <> show i <> " out of bounds") callStack)
+
         fail :: (HasCallStack, Monad m) => String -> m a
         fail s = let ?callStack = fromCallSiteList (filter ((/= "M") . fst) (getCallStack callStack)) in
           throw (MyersException s callStack)

From 03f1854c7d74e8c0191457111faec7c10c1b2c68 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 22 Mar 2017 16:19:06 -0400
Subject: [PATCH 237/294] Skip diagonals > n.

---
 src/SES/Myers.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 7bc96d852..ad93b92b1 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -109,7 +109,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
 
   SearchUpToD graph (Distance d) -> for [negate d, negate d + 2 .. d] (searchAlongK graph (Distance d) . Diagonal)
 
-  SearchAlongK graph d k -> do
+  SearchAlongK graph d k -> if unDiagonal k > n then continue else do
     Endpoint x y <- findDPath graph d k
     if x >= n && y >= m then do
       (_, script) <- getK graph k

From 1b4e47ca2b5663094ff2d1a2aef1b931cd7e2c73 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 22 Mar 2017 16:21:36 -0400
Subject: [PATCH 238/294] Skip diagonals < -m.

---
 src/SES/Myers.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index ad93b92b1..60ca9f2d8 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -109,7 +109,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
 
   SearchUpToD graph (Distance d) -> for [negate d, negate d + 2 .. d] (searchAlongK graph (Distance d) . Diagonal)
 
-  SearchAlongK graph d k -> if unDiagonal k > n then continue else do
+  SearchAlongK graph d k -> if unDiagonal k >= negate m && unDiagonal k > n then continue else do
     Endpoint x y <- findDPath graph d k
     if x >= n && y >= m then do
       (_, script) <- getK graph k

From 6bcc0322f73b7cf86fdb5cf00bb5810c364af4cc Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 22 Mar 2017 16:40:13 -0400
Subject: [PATCH 239/294] Skip out-of-bounds values of k.

---
 src/SES/Myers.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 60ca9f2d8..c77f896fa 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -109,7 +109,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
 
   SearchUpToD graph (Distance d) -> for [negate d, negate d + 2 .. d] (searchAlongK graph (Distance d) . Diagonal)
 
-  SearchAlongK graph d k -> if unDiagonal k >= negate m && unDiagonal k > n then continue else do
+  SearchAlongK graph d k -> if negate m > unDiagonal k || unDiagonal k > n then continue else do
     Endpoint x y <- findDPath graph d k
     if x >= n && y >= m then do
       (_, script) <- getK graph k

From 35fb0f62ced969f823eb2f34a120f409b068998b Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 22 Mar 2017 16:47:58 -0400
Subject: [PATCH 240/294] Rename FindDPath to MoveFromAdjacent.

---
 src/SES/Myers.hs | 14 +++++++-------
 1 file changed, 7 insertions(+), 7 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index c77f896fa..f9e988c52 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -18,7 +18,7 @@ data MyersF a b result where
   EditDistance :: EditGraph a b -> MyersF a b Int
   SearchUpToD :: EditGraph a b -> Distance -> MyersF a b (Maybe (EditScript a b, Distance))
   SearchAlongK :: EditGraph a b -> Distance -> Diagonal -> MyersF a b (Maybe (EditScript a b, Distance))
-  FindDPath :: EditGraph a b -> Distance -> Diagonal -> MyersF a b Endpoint
+  MoveFromAdjacent :: EditGraph a b -> Distance -> Diagonal -> MyersF a b Endpoint
 
   GetK :: EditGraph a b -> Diagonal -> MyersF a b (Endpoint, EditScript a b)
   SetK :: EditGraph a b -> Diagonal -> Int -> EditScript a b -> MyersF a b ()
@@ -110,14 +110,14 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
   SearchUpToD graph (Distance d) -> for [negate d, negate d + 2 .. d] (searchAlongK graph (Distance d) . Diagonal)
 
   SearchAlongK graph d k -> if negate m > unDiagonal k || unDiagonal k > n then continue else do
-    Endpoint x y <- findDPath graph d k
+    Endpoint x y <- moveFromAdjacent graph d k
     if x >= n && y >= m then do
       (_, script) <- getK graph k
       return (Just (script, d))
     else
       continue
 
-  FindDPath graph (Distance d) (Diagonal k) -> do
+  MoveFromAdjacent graph (Distance d) (Diagonal k) -> do
     (from, fromScript) <- if d == 0 then
       return (Endpoint 0 0, [])
     else if k == negate d then do
@@ -191,8 +191,8 @@ searchUpToD graph distance = M (SearchUpToD graph distance) `Then` return
 searchAlongK :: HasCallStack => EditGraph a b -> Distance -> Diagonal -> Myers a b (Maybe (EditScript a b, Distance))
 searchAlongK graph d k = M (SearchAlongK graph d k) `Then` return
 
-findDPath :: HasCallStack => EditGraph a b -> Distance -> Diagonal -> Myers a b Endpoint
-findDPath graph d k = M (FindDPath graph d k) `Then` return
+moveFromAdjacent :: HasCallStack => EditGraph a b -> Distance -> Diagonal -> Myers a b Endpoint
+moveFromAdjacent graph d k = M (MoveFromAdjacent graph d k) `Then` return
 
 getK :: HasCallStack => EditGraph a b -> Diagonal -> Myers a b (Endpoint, EditScript a b)
 getK graph diagonal = M (GetK graph diagonal) `Then` return
@@ -243,7 +243,7 @@ editGraph myers = (EditGraph as bs, n, m)
           EditDistance g -> g
           SearchUpToD g _ -> g
           SearchAlongK g _ _ -> g
-          FindDPath g _ _ -> g
+          MoveFromAdjacent g _ _ -> g
           GetK g _ -> g
           SetK g _ _ _ -> g
           Slide g _ _ -> g
@@ -260,7 +260,7 @@ liftShowsMyersF sp1 sl1 sp2 sl2 d m = case m of
   EditDistance graph -> showsUnaryWith showGraph "EditDistance" d graph
   SearchUpToD graph distance -> showsBinaryWith showGraph showsPrec "SearchUpToD" d graph distance
   SearchAlongK graph distance diagonal -> showsTernaryWith showGraph showsPrec showsPrec "SearchAlongK" d graph distance diagonal
-  FindDPath graph distance diagonal -> showsTernaryWith showGraph showsPrec showsPrec "FindDPath" d graph distance diagonal
+  MoveFromAdjacent graph distance diagonal -> showsTernaryWith showGraph showsPrec showsPrec "MoveFromAdjacent" d graph distance diagonal
   GetK graph diagonal -> showsBinaryWith showGraph showsPrec "GetK" d graph diagonal
   SetK graph diagonal v script -> showsQuaternaryWith showGraph showsPrec showsPrec (liftShowsEditScript sp1 sp2) "SetK" d graph diagonal v script
   Slide graph endpoint script -> showsTernaryWith showGraph showsPrec (liftShowsEditScript sp1 sp2) "Slide" d graph endpoint script

From 1893d2da16a6bb953ab0f1a1b546496133b5ba32 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 22 Mar 2017 17:18:17 -0400
Subject: [PATCH 241/294] =?UTF-8?q?Don=E2=80=99t=20attempt=20moves=20from?=
 =?UTF-8?q?=20out-of-bounds=20diagonals.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/SES/Myers.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index f9e988c52..782159b7d 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -118,12 +118,12 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
       continue
 
   MoveFromAdjacent graph (Distance d) (Diagonal k) -> do
-    (from, fromScript) <- if d == 0 then
+    (from, fromScript) <- if d == 0 || k < negate m || k > n then
       return (Endpoint 0 0, [])
-    else if k == negate d then do
+    else if k == negate d || k == negate m then do
       (Endpoint nextX nextY, nextScript) <- getK graph (Diagonal (succ k))
       return (Endpoint nextX (succ nextY), if nextY < m then That (bs ! nextY) : nextScript else nextScript) -- downward (insertion)
-    else if k /= d then do
+    else if k /= d && k /= n then do
       (Endpoint prevX prevY, prevScript) <- getK graph (Diagonal (pred k))
       (Endpoint nextX nextY, nextScript) <- getK graph (Diagonal (succ k))
       return $ if prevX < nextX then

From ec2c0c703c6469494892f4d41833fbd1bcd438d0 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 22 Mar 2017 17:20:37 -0400
Subject: [PATCH 242/294] Renae the disjoint input test.

---
 test/SES/Myers/Spec.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/test/SES/Myers/Spec.hs b/test/SES/Myers/Spec.hs
index 30d49401d..bf4a5d3cc 100644
--- a/test/SES/Myers/Spec.hs
+++ b/test/SES/Myers/Spec.hs
@@ -18,5 +18,5 @@ spec = do
     prop "returns insertions in That" $
       \ bs -> runMyers (==) (ses (makeEditGraph [] bs :: EditGraph Char Char)) `shouldBe` fmap That bs
 
-    prop "returns all elements of disjoint inputs" $
+    prop "returns all elements individually for disjoint inputs" $
       \ as bs -> length (runMyers (==) (ses (makeEditGraph ((,) 0 <$> as :: [(Int, Char)]) ((,) 1 <$> bs :: [(Int, Char)])))) `shouldBe` length as + length bs

From ce5af997c98a2028f485a77a5e74cda0133b8799 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 22 Mar 2017 17:26:05 -0400
Subject: [PATCH 243/294] =?UTF-8?q?Test=20that=20our=20implementation=20of?=
 =?UTF-8?q?=20Myers=E2=80=99=20algorithm=20is=20lossless.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 test/SES/Myers/Spec.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/test/SES/Myers/Spec.hs b/test/SES/Myers/Spec.hs
index bf4a5d3cc..a021bfbfe 100644
--- a/test/SES/Myers/Spec.hs
+++ b/test/SES/Myers/Spec.hs
@@ -20,3 +20,6 @@ spec = do
 
     prop "returns all elements individually for disjoint inputs" $
       \ as bs -> length (runMyers (==) (ses (makeEditGraph ((,) 0 <$> as :: [(Int, Char)]) ((,) 1 <$> bs :: [(Int, Char)])))) `shouldBe` length as + length bs
+
+    prop "is lossless w.r.t. both input elements & ordering" $
+      \ as bs -> foldr (\ each (as, bs) -> these (flip (,) bs. (:as)) ((,) as . (:bs)) (\ a b -> (a:as, b:bs)) each) ([], []) (runMyers (==) (ses (makeEditGraph as bs :: EditGraph Char Char))) `shouldBe` (as, bs)

From f2f5af7d6a688ca7178a4c00cd0d107de5e04c37 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 23 Mar 2017 08:55:29 -0400
Subject: [PATCH 244/294] :fire: divideGraph.

---
 src/SES/Myers.hs | 6 ------
 1 file changed, 6 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 782159b7d..05b174e26 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -228,12 +228,6 @@ continue = return Nothing
 index :: Vector.Vector a -> Int -> Int
 index v k = if k >= 0 then k else length v + k
 
-divideGraph :: EditGraph a b -> Endpoint -> (EditGraph a b, EditGraph a b)
-divideGraph (EditGraph as bs) (Endpoint x y) =
-  ( EditGraph (slice 0  x              as) (slice 0  y              bs)
-  , EditGraph (slice x (length as - x) as) (slice y (length bs - y) bs) )
-  where slice from to v = Vector.slice (max 0 (min from (length v))) (max 0 (min to (length v))) v
-
 
 editGraph :: MyersF a b c -> (EditGraph a b, Int, Int)
 editGraph myers = (EditGraph as bs, n, m)

From b9e8fd3e7a4d5176de2a8c18d31ec672994283e2 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 23 Mar 2017 09:01:49 -0400
Subject: [PATCH 245/294] Store inputs & state in arrays instead of vectors.

---
 src/SES/Myers.hs | 28 ++++++++++++++--------------
 1 file changed, 14 insertions(+), 14 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 05b174e26..5fee4e65b 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -3,10 +3,10 @@ module SES.Myers where
 
 import Control.Exception
 import Control.Monad.Free.Freer
+import Data.Array hiding (index)
 import Data.Functor.Classes
 import Data.String
 import Data.These
-import qualified Data.Vector as Vector
 import GHC.Show hiding (show)
 import GHC.Stack
 import Prologue hiding (for, State, error)
@@ -38,11 +38,11 @@ data StepF a b result where
 
 type Myers a b = Freer (StepF a b)
 
-data EditGraph a b = EditGraph { as :: !(Vector.Vector a), bs :: !(Vector.Vector b) }
+data EditGraph a b = EditGraph { as :: !(Array Int a), bs :: !(Array Int b) }
   deriving (Eq, Show)
 
 makeEditGraph :: (Foldable t, Foldable u) => t a -> u b -> EditGraph a b
-makeEditGraph as bs = EditGraph (Vector.fromList (toList as)) (Vector.fromList (toList bs))
+makeEditGraph as bs = EditGraph (listArray (0, pred (length as)) (toList as)) (listArray (0, pred (length bs)) (toList bs))
 
 newtype Distance = Distance { unDistance :: Int }
   deriving (Eq, Show)
@@ -144,18 +144,18 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
       fail ("diagonal " <> show k <> " (" <> show i <> ") underflows state indices " <> show (negate m) <> ".." <> show n <> " (0.." <> show (succ (m + n)) <> ")")
     when (i >= length v) $
       fail ("diagonal " <> show k <> " (" <> show i <> ") overflows state indices " <> show (negate m) <> ".." <> show n <> " (0.." <> show (succ (m + n)) <> ")")
-    let (x, script) = v Vector.! i in return (Endpoint x (x - k), script)
+    let (x, script) = v ! i in return (Endpoint x (x - k), script)
 
   SetK _ (Diagonal k) x script ->
     modify (MyersState . set . unMyersState)
-    where set v = v Vector.// [(index v k, (x, script))]
+    where set v = v // [(index v k, (x, script))]
 
   Slide graph (Endpoint x y) script
     | x >= 0, x < n
     , y >= 0, y < m -> do
       eq <- getEq
-      let a = as Vector.! x
-      let b = bs Vector.! y
+      let a = as ! x
+      let b = bs ! y
       if a `eq` b then
         slide graph (Endpoint (succ x) (succ y)) (These a b : script)
       else
@@ -164,8 +164,8 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
 
   where (EditGraph as bs, n, m) = editGraph myers
 
-        (!) :: HasCallStack => Vector.Vector a -> Int -> a
-        v ! i | i < length v = v Vector.! i
+        (!) :: HasCallStack => Array Int a -> Int -> a
+        v ! i | i < length v = v Data.Array.! i
               | otherwise = let ?callStack = fromCallSiteList (filter ((/= "M") . fst) (getCallStack callStack)) in
                   throw (MyersException ("index " <> show i <> " out of bounds") callStack)
 
@@ -209,15 +209,15 @@ getEq = GetEq `Then` return
 
 -- Implementation details
 
-newtype MyersState a b = MyersState { unMyersState :: Vector.Vector (Int, EditScript a b) }
+newtype MyersState a b = MyersState { unMyersState :: Array Int (Int, EditScript a b) }
   deriving (Eq, Show)
 
 emptyStateForStep :: Myers a b c -> MyersState a b
 emptyStateForStep step = case step of
   Then (M myers) _ ->
     let (_, n, m) = editGraph myers in
-    MyersState (Vector.replicate (succ (m + n)) (0, []))
-  _ -> MyersState Vector.empty
+    MyersState (listArray (0, m + n) (repeat (0, [])))
+  _ -> MyersState (listArray (0, negate 1) [])
 
 for :: [a] -> (a -> Myers c d (Maybe b)) -> Myers c d (Maybe b)
 for all run = foldr (\ a b -> (<|>) <$> run a <*> b) (return Nothing) all
@@ -225,7 +225,7 @@ for all run = foldr (\ a b -> (<|>) <$> run a <*> b) (return Nothing) all
 continue :: Myers b c (Maybe a)
 continue = return Nothing
 
-index :: Vector.Vector a -> Int -> Int
+index :: Array Int a -> Int -> Int
 index v k = if k >= 0 then k else length v + k
 
 
@@ -244,7 +244,7 @@ editGraph myers = (EditGraph as bs, n, m)
         (n, m) = (length as, length bs)
 
 
-liftShowsVector :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Vector.Vector a -> ShowS
+liftShowsVector :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Array Int a -> ShowS
 liftShowsVector sp sl d = liftShowsPrec sp sl d . toList
 
 liftShowsMyersF :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> (Int -> b -> ShowS) -> ([b] -> ShowS) -> Int -> MyersF a b c -> ShowS

From 7fe2522e4d7c8b2f8782b7f1ab32bac82c8b336b Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 23 Mar 2017 09:55:56 -0400
Subject: [PATCH 246/294] :fire: the shared graph/n/m bindings.

---
 src/SES/Myers.hs | 46 +++++++++++++++++++++++-----------------------
 1 file changed, 23 insertions(+), 23 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 5fee4e65b..ff287df17 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -90,17 +90,17 @@ runMyersStep eq state step = let ?callStack = popCallStack callStack in case ste
 
 decompose :: HasCallStack => MyersF a b c -> Myers a b c
 decompose myers = let ?callStack = popCallStack callStack in case myers of
-  LCS graph
+  LCS (EditGraph as bs)
     | null as || null bs -> return []
     | otherwise -> do
-      result <- ses graph
+      result <- ses (EditGraph as bs)
       return (catMaybes (these (const Nothing) (const Nothing) ((Just .) . (,)) <$> result))
 
-  SES graph
+  SES (EditGraph as bs)
     | null bs -> return (This <$> toList as)
     | null as -> return (That <$> toList bs)
     | otherwise -> do
-      result <- for [0..(m + n)] (searchUpToD graph . Distance)
+      result <- for [0..(length as + length bs)] (searchUpToD (EditGraph as bs) . Distance)
       case result of
         Just (script, _) -> return (reverse script)
         _ -> fail "no shortest edit script found in edit graph (this is a bug in SES.Myers)."
@@ -109,37 +109,39 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
 
   SearchUpToD graph (Distance d) -> for [negate d, negate d + 2 .. d] (searchAlongK graph (Distance d) . Diagonal)
 
-  SearchAlongK graph d k -> if negate m > unDiagonal k || unDiagonal k > n then continue else do
-    Endpoint x y <- moveFromAdjacent graph d k
-    if x >= n && y >= m then do
-      (_, script) <- getK graph k
+  SearchAlongK (EditGraph as bs) d k -> if negate (length bs) > unDiagonal k || unDiagonal k > length as then continue else do
+    Endpoint x y <- moveFromAdjacent (EditGraph as bs) d k
+    if x >= length as && y >= length bs then do
+      (_, script) <- getK (EditGraph as bs) k
       return (Just (script, d))
     else
       continue
 
-  MoveFromAdjacent graph (Distance d) (Diagonal k) -> do
+  MoveFromAdjacent (EditGraph as bs) (Distance d) (Diagonal k) -> do
+    let (n, m) = (length as, length bs)
     (from, fromScript) <- if d == 0 || k < negate m || k > n then
       return (Endpoint 0 0, [])
     else if k == negate d || k == negate m then do
-      (Endpoint nextX nextY, nextScript) <- getK graph (Diagonal (succ k))
+      (Endpoint nextX nextY, nextScript) <- getK (EditGraph as bs) (Diagonal (succ k))
       return (Endpoint nextX (succ nextY), if nextY < m then That (bs ! nextY) : nextScript else nextScript) -- downward (insertion)
     else if k /= d && k /= n then do
-      (Endpoint prevX prevY, prevScript) <- getK graph (Diagonal (pred k))
-      (Endpoint nextX nextY, nextScript) <- getK graph (Diagonal (succ k))
+      (Endpoint prevX prevY, prevScript) <- getK (EditGraph as bs) (Diagonal (pred k))
+      (Endpoint nextX nextY, nextScript) <- getK (EditGraph as bs) (Diagonal (succ k))
       return $ if prevX < nextX then
         (Endpoint nextX (succ nextY), if nextY < m then That (bs ! nextY) : nextScript else nextScript) -- downward (insertion)
       else
         (Endpoint (succ prevX) prevY, if prevX < n then This (as ! prevX) : prevScript else prevScript) -- rightward (deletion)
     else do
-      (Endpoint prevX prevY, prevScript) <- getK graph (Diagonal (pred k))
+      (Endpoint prevX prevY, prevScript) <- getK (EditGraph as bs) (Diagonal (pred k))
       return (Endpoint (succ prevX) prevY, if prevX < n then This (as ! prevX) : prevScript else prevScript) -- rightward (deletion)
-    (endpoint, script) <- slide graph from fromScript
-    setK graph (Diagonal k) (x endpoint) script
+    (endpoint, script) <- slide (EditGraph as bs) from fromScript
+    setK (EditGraph as bs) (Diagonal k) (x endpoint) script
     return endpoint
 
-  GetK _ (Diagonal k) -> do
+  GetK (EditGraph as bs) (Diagonal k) -> do
     v <- gets unMyersState
     let i = index v k
+    let (n, m) = (length as, length bs)
     when (i < 0) $
       fail ("diagonal " <> show k <> " (" <> show i <> ") underflows state indices " <> show (negate m) <> ".." <> show n <> " (0.." <> show (succ (m + n)) <> ")")
     when (i >= length v) $
@@ -150,21 +152,19 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
     modify (MyersState . set . unMyersState)
     where set v = v // [(index v k, (x, script))]
 
-  Slide graph (Endpoint x y) script
-    | x >= 0, x < n
-    , y >= 0, y < m -> do
+  Slide (EditGraph as bs) (Endpoint x y) script
+    | x >= 0, x < length as
+    , y >= 0, y < length bs -> do
       eq <- getEq
       let a = as ! x
       let b = bs ! y
       if a `eq` b then
-        slide graph (Endpoint (succ x) (succ y)) (These a b : script)
+        slide (EditGraph as bs) (Endpoint (succ x) (succ y)) (These a b : script)
       else
         return (Endpoint x y, script)
     | otherwise -> return (Endpoint x y, script)
 
-  where (EditGraph as bs, n, m) = editGraph myers
-
-        (!) :: HasCallStack => Array Int a -> Int -> a
+  where (!) :: HasCallStack => Array Int a -> Int -> a
         v ! i | i < length v = v Data.Array.! i
               | otherwise = let ?callStack = fromCallSiteList (filter ((/= "M") . fst) (getCallStack callStack)) in
                   throw (MyersException ("index " <> show i <> " out of bounds") callStack)

From 97a6028318f45035009053967aeb41baf17be1a0 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 23 Mar 2017 10:00:11 -0400
Subject: [PATCH 247/294] Extract the runLCS evaluator.

---
 src/SES/Myers.hs | 13 ++++++++-----
 1 file changed, 8 insertions(+), 5 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index ff287df17..10dc2cad9 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -90,11 +90,7 @@ runMyersStep eq state step = let ?callStack = popCallStack callStack in case ste
 
 decompose :: HasCallStack => MyersF a b c -> Myers a b c
 decompose myers = let ?callStack = popCallStack callStack in case myers of
-  LCS (EditGraph as bs)
-    | null as || null bs -> return []
-    | otherwise -> do
-      result <- ses (EditGraph as bs)
-      return (catMaybes (these (const Nothing) (const Nothing) ((Just .) . (,)) <$> result))
+  LCS graph -> runLCS graph
 
   SES (EditGraph as bs)
     | null bs -> return (This <$> toList as)
@@ -173,6 +169,13 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         fail s = let ?callStack = fromCallSiteList (filter ((/= "M") . fst) (getCallStack callStack)) in
           throw (MyersException s callStack)
 
+runLCS :: HasCallStack => EditGraph a b -> Myers a b [(a, b)]
+runLCS (EditGraph as bs)
+  | null as || null bs = return []
+  | otherwise = let ?callStack = popCallStack callStack in do
+    result <- ses (EditGraph as bs)
+    return (catMaybes (these (const Nothing) (const Nothing) ((Just .) . (,)) <$> result))
+
 
 -- Smart constructors
 

From 2ef802e8d760582fa6636a14ce5012c31f72edc4 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 23 Mar 2017 10:02:06 -0400
Subject: [PATCH 248/294] Extract the failure function to the top level.

---
 src/SES/Myers.hs | 8 +++++---
 1 file changed, 5 insertions(+), 3 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 10dc2cad9..d7bfca2b5 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -165,9 +165,6 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
               | otherwise = let ?callStack = fromCallSiteList (filter ((/= "M") . fst) (getCallStack callStack)) in
                   throw (MyersException ("index " <> show i <> " out of bounds") callStack)
 
-        fail :: (HasCallStack, Monad m) => String -> m a
-        fail s = let ?callStack = fromCallSiteList (filter ((/= "M") . fst) (getCallStack callStack)) in
-          throw (MyersException s callStack)
 
 runLCS :: HasCallStack => EditGraph a b -> Myers a b [(a, b)]
 runLCS (EditGraph as bs)
@@ -247,6 +244,11 @@ editGraph myers = (EditGraph as bs, n, m)
         (n, m) = (length as, length bs)
 
 
+fail :: (HasCallStack, Monad m) => String -> m a
+fail s = let ?callStack = fromCallSiteList (filter ((/= "M") . fst) (getCallStack callStack)) in
+  throw (MyersException s callStack)
+
+
 liftShowsVector :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Array Int a -> ShowS
 liftShowsVector sp sl d = liftShowsPrec sp sl d . toList
 

From 5955e7665d33e59d382ba115f8e692c138e30836 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 23 Mar 2017 10:03:03 -0400
Subject: [PATCH 249/294] Extract the SES evaluator.

---
 src/SES/Myers.hs | 20 +++++++++++---------
 1 file changed, 11 insertions(+), 9 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index d7bfca2b5..0bc5f5cb5 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -90,17 +90,9 @@ runMyersStep eq state step = let ?callStack = popCallStack callStack in case ste
 
 decompose :: HasCallStack => MyersF a b c -> Myers a b c
 decompose myers = let ?callStack = popCallStack callStack in case myers of
+  SES graph -> runSES graph
   LCS graph -> runLCS graph
 
-  SES (EditGraph as bs)
-    | null bs -> return (This <$> toList as)
-    | null as -> return (That <$> toList bs)
-    | otherwise -> do
-      result <- for [0..(length as + length bs)] (searchUpToD (EditGraph as bs) . Distance)
-      case result of
-        Just (script, _) -> return (reverse script)
-        _ -> fail "no shortest edit script found in edit graph (this is a bug in SES.Myers)."
-
   EditDistance graph -> length . filter (these (const True) (const True) (const (const False))) <$> ses graph
 
   SearchUpToD graph (Distance d) -> for [negate d, negate d + 2 .. d] (searchAlongK graph (Distance d) . Diagonal)
@@ -166,6 +158,16 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
                   throw (MyersException ("index " <> show i <> " out of bounds") callStack)
 
 
+runSES :: HasCallStack => EditGraph a b -> Myers a b (EditScript a b)
+runSES (EditGraph as bs)
+  | null bs = return (This <$> toList as)
+  | null as = return (That <$> toList bs)
+  | otherwise = let ?callStack = popCallStack callStack in do
+    result <- for [0..(length as + length bs)] (searchUpToD (EditGraph as bs) . Distance)
+    case result of
+      Just (script, _) -> return (reverse script)
+      _ -> fail "no shortest edit script found in edit graph (this is a bug in SES.Myers)."
+
 runLCS :: HasCallStack => EditGraph a b -> Myers a b [(a, b)]
 runLCS (EditGraph as bs)
   | null as || null bs = return []

From 27a608ad7b4875833e2f46876661965e1db78cf0 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 23 Mar 2017 10:04:07 -0400
Subject: [PATCH 250/294] Extract the editDistance evaluator.

---
 src/SES/Myers.hs | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 0bc5f5cb5..ed2b4f6ed 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -92,8 +92,7 @@ decompose :: HasCallStack => MyersF a b c -> Myers a b c
 decompose myers = let ?callStack = popCallStack callStack in case myers of
   SES graph -> runSES graph
   LCS graph -> runLCS graph
-
-  EditDistance graph -> length . filter (these (const True) (const True) (const (const False))) <$> ses graph
+  EditDistance graph -> runEditDistance graph
 
   SearchUpToD graph (Distance d) -> for [negate d, negate d + 2 .. d] (searchAlongK graph (Distance d) . Diagonal)
 
@@ -175,6 +174,9 @@ runLCS (EditGraph as bs)
     result <- ses (EditGraph as bs)
     return (catMaybes (these (const Nothing) (const Nothing) ((Just .) . (,)) <$> result))
 
+runEditDistance :: HasCallStack => EditGraph a b -> Myers a b Int
+runEditDistance graph = length . filter (these (const True) (const True) (const (const False))) <$> ses graph
+
 
 -- Smart constructors
 

From f0e21a1cb43aac92e1f61270d9d2d52aec795d35 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 23 Mar 2017 10:05:07 -0400
Subject: [PATCH 251/294] Extract the searchUpToD evaluator.

---
 src/SES/Myers.hs | 7 +++++--
 1 file changed, 5 insertions(+), 2 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index ed2b4f6ed..1cc50de8e 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -93,8 +93,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
   SES graph -> runSES graph
   LCS graph -> runLCS graph
   EditDistance graph -> runEditDistance graph
-
-  SearchUpToD graph (Distance d) -> for [negate d, negate d + 2 .. d] (searchAlongK graph (Distance d) . Diagonal)
+  SearchUpToD graph d -> runSearchUpToD graph d
 
   SearchAlongK (EditGraph as bs) d k -> if negate (length bs) > unDiagonal k || unDiagonal k > length as then continue else do
     Endpoint x y <- moveFromAdjacent (EditGraph as bs) d k
@@ -178,6 +177,10 @@ runEditDistance :: HasCallStack => EditGraph a b -> Myers a b Int
 runEditDistance graph = length . filter (these (const True) (const True) (const (const False))) <$> ses graph
 
 
+runSearchUpToD :: HasCallStack => EditGraph a b -> Distance -> Myers a b (Maybe (EditScript a b, Distance))
+runSearchUpToD graph (Distance d) = for [negate d, negate d + 2 .. d] (searchAlongK graph (Distance d) . Diagonal)
+
+
 -- Smart constructors
 
 ses :: HasCallStack => EditGraph a b -> Myers a b (EditScript a b)

From 2b1bf43a1e0b735ce0d79e25d32fb3e7670f7be4 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 23 Mar 2017 10:05:27 -0400
Subject: [PATCH 252/294] Pop a couple of call stacks.

---
 src/SES/Myers.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 1cc50de8e..a0a26a0c4 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -174,11 +174,11 @@ runLCS (EditGraph as bs)
     return (catMaybes (these (const Nothing) (const Nothing) ((Just .) . (,)) <$> result))
 
 runEditDistance :: HasCallStack => EditGraph a b -> Myers a b Int
-runEditDistance graph = length . filter (these (const True) (const True) (const (const False))) <$> ses graph
+runEditDistance graph = let ?callStack = popCallStack callStack in length . filter (these (const True) (const True) (const (const False))) <$> ses graph
 
 
 runSearchUpToD :: HasCallStack => EditGraph a b -> Distance -> Myers a b (Maybe (EditScript a b, Distance))
-runSearchUpToD graph (Distance d) = for [negate d, negate d + 2 .. d] (searchAlongK graph (Distance d) . Diagonal)
+runSearchUpToD graph (Distance d) = let ?callStack = popCallStack callStack in for [negate d, negate d + 2 .. d] (searchAlongK graph (Distance d) . Diagonal)
 
 
 -- Smart constructors

From b477a93dbaeda2cb5adf8025835f8507e3362d69 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 23 Mar 2017 10:06:53 -0400
Subject: [PATCH 253/294] Extract the searchAlongK evaluator.

---
 src/SES/Myers.hs | 21 +++++++++++++--------
 1 file changed, 13 insertions(+), 8 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index a0a26a0c4..b808a39bd 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -94,14 +94,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
   LCS graph -> runLCS graph
   EditDistance graph -> runEditDistance graph
   SearchUpToD graph d -> runSearchUpToD graph d
-
-  SearchAlongK (EditGraph as bs) d k -> if negate (length bs) > unDiagonal k || unDiagonal k > length as then continue else do
-    Endpoint x y <- moveFromAdjacent (EditGraph as bs) d k
-    if x >= length as && y >= length bs then do
-      (_, script) <- getK (EditGraph as bs) k
-      return (Just (script, d))
-    else
-      continue
+  SearchAlongK graph d k -> runSearchAlongK graph d k
 
   MoveFromAdjacent (EditGraph as bs) (Distance d) (Diagonal k) -> do
     let (n, m) = (length as, length bs)
@@ -180,6 +173,18 @@ runEditDistance graph = let ?callStack = popCallStack callStack in length . filt
 runSearchUpToD :: HasCallStack => EditGraph a b -> Distance -> Myers a b (Maybe (EditScript a b, Distance))
 runSearchUpToD graph (Distance d) = let ?callStack = popCallStack callStack in for [negate d, negate d + 2 .. d] (searchAlongK graph (Distance d) . Diagonal)
 
+runSearchAlongK :: HasCallStack => EditGraph a b -> Distance -> Diagonal -> Myers a b (Maybe (EditScript a b, Distance))
+runSearchAlongK (EditGraph as bs) d k = let ?callStack = popCallStack callStack in
+  if negate (length bs) > unDiagonal k || unDiagonal k > length as then
+    continue
+  else do
+    Endpoint x y <- moveFromAdjacent (EditGraph as bs) d k
+    if x >= length as && y >= length bs then do
+      (_, script) <- getK (EditGraph as bs) k
+      return (Just (script, d))
+    else
+      continue
+
 
 -- Smart constructors
 

From 310689487691108d6501061bc3f5d71964a85801 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 23 Mar 2017 10:07:48 -0400
Subject: [PATCH 254/294] Extract the moveFromAdjacent evaluator.

---
 src/SES/Myers.hs | 44 +++++++++++++++++++++++---------------------
 1 file changed, 23 insertions(+), 21 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index b808a39bd..7989c8ccb 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -95,27 +95,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
   EditDistance graph -> runEditDistance graph
   SearchUpToD graph d -> runSearchUpToD graph d
   SearchAlongK graph d k -> runSearchAlongK graph d k
-
-  MoveFromAdjacent (EditGraph as bs) (Distance d) (Diagonal k) -> do
-    let (n, m) = (length as, length bs)
-    (from, fromScript) <- if d == 0 || k < negate m || k > n then
-      return (Endpoint 0 0, [])
-    else if k == negate d || k == negate m then do
-      (Endpoint nextX nextY, nextScript) <- getK (EditGraph as bs) (Diagonal (succ k))
-      return (Endpoint nextX (succ nextY), if nextY < m then That (bs ! nextY) : nextScript else nextScript) -- downward (insertion)
-    else if k /= d && k /= n then do
-      (Endpoint prevX prevY, prevScript) <- getK (EditGraph as bs) (Diagonal (pred k))
-      (Endpoint nextX nextY, nextScript) <- getK (EditGraph as bs) (Diagonal (succ k))
-      return $ if prevX < nextX then
-        (Endpoint nextX (succ nextY), if nextY < m then That (bs ! nextY) : nextScript else nextScript) -- downward (insertion)
-      else
-        (Endpoint (succ prevX) prevY, if prevX < n then This (as ! prevX) : prevScript else prevScript) -- rightward (deletion)
-    else do
-      (Endpoint prevX prevY, prevScript) <- getK (EditGraph as bs) (Diagonal (pred k))
-      return (Endpoint (succ prevX) prevY, if prevX < n then This (as ! prevX) : prevScript else prevScript) -- rightward (deletion)
-    (endpoint, script) <- slide (EditGraph as bs) from fromScript
-    setK (EditGraph as bs) (Diagonal k) (x endpoint) script
-    return endpoint
+  MoveFromAdjacent graph d k -> runMoveFromAdjacent graph d k
 
   GetK (EditGraph as bs) (Diagonal k) -> do
     v <- gets unMyersState
@@ -185,6 +165,28 @@ runSearchAlongK (EditGraph as bs) d k = let ?callStack = popCallStack callStack
     else
       continue
 
+runMoveFromAdjacent :: HasCallStack => EditGraph a b -> Distance -> Diagonal -> Myers a b Endpoint
+runMoveFromAdjacent (EditGraph as bs) (Distance d) (Diagonal k) = let ?callStack = popCallStack callStack in do
+  let (n, m) = (length as, length bs)
+  (from, fromScript) <- if d == 0 || k < negate m || k > n then
+    return (Endpoint 0 0, [])
+  else if k == negate d || k == negate m then do
+    (Endpoint nextX nextY, nextScript) <- getK (EditGraph as bs) (Diagonal (succ k))
+    return (Endpoint nextX (succ nextY), if nextY < m then That (bs ! nextY) : nextScript else nextScript) -- downward (insertion)
+  else if k /= d && k /= n then do
+    (Endpoint prevX prevY, prevScript) <- getK (EditGraph as bs) (Diagonal (pred k))
+    (Endpoint nextX nextY, nextScript) <- getK (EditGraph as bs) (Diagonal (succ k))
+    return $ if prevX < nextX then
+      (Endpoint nextX (succ nextY), if nextY < m then That (bs ! nextY) : nextScript else nextScript) -- downward (insertion)
+    else
+      (Endpoint (succ prevX) prevY, if prevX < n then This (as ! prevX) : prevScript else prevScript) -- rightward (deletion)
+  else do
+    (Endpoint prevX prevY, prevScript) <- getK (EditGraph as bs) (Diagonal (pred k))
+    return (Endpoint (succ prevX) prevY, if prevX < n then This (as ! prevX) : prevScript else prevScript) -- rightward (deletion)
+  (endpoint, script) <- slide (EditGraph as bs) from fromScript
+  setK (EditGraph as bs) (Diagonal k) (x endpoint) script
+  return endpoint
+
 
 -- Smart constructors
 

From 03808897cf1268d48c383d71b04258ebeed3c95d Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 23 Mar 2017 10:08:47 -0400
Subject: [PATCH 255/294] Extract the getK evaluator.

---
 src/SES/Myers.hs | 22 +++++++++++++---------
 1 file changed, 13 insertions(+), 9 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 7989c8ccb..da3bf5da2 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -97,15 +97,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
   SearchAlongK graph d k -> runSearchAlongK graph d k
   MoveFromAdjacent graph d k -> runMoveFromAdjacent graph d k
 
-  GetK (EditGraph as bs) (Diagonal k) -> do
-    v <- gets unMyersState
-    let i = index v k
-    let (n, m) = (length as, length bs)
-    when (i < 0) $
-      fail ("diagonal " <> show k <> " (" <> show i <> ") underflows state indices " <> show (negate m) <> ".." <> show n <> " (0.." <> show (succ (m + n)) <> ")")
-    when (i >= length v) $
-      fail ("diagonal " <> show k <> " (" <> show i <> ") overflows state indices " <> show (negate m) <> ".." <> show n <> " (0.." <> show (succ (m + n)) <> ")")
-    let (x, script) = v ! i in return (Endpoint x (x - k), script)
+  GetK graph k -> runGetK graph k
 
   SetK _ (Diagonal k) x script ->
     modify (MyersState . set . unMyersState)
@@ -188,6 +180,18 @@ runMoveFromAdjacent (EditGraph as bs) (Distance d) (Diagonal k) = let ?callStack
   return endpoint
 
 
+runGetK :: HasCallStack => EditGraph a b -> Diagonal -> Myers a b (Endpoint, EditScript a b)
+runGetK (EditGraph as bs) (Diagonal k) = let ?callStack = popCallStack callStack in do
+  v <- gets unMyersState
+  let i = index v k
+  let (n, m) = (length as, length bs)
+  when (i < 0) $
+    fail ("diagonal " <> show k <> " (" <> show i <> ") underflows state indices " <> show (negate m) <> ".." <> show n <> " (0.." <> show (succ (m + n)) <> ")")
+  when (i >= length v) $
+    fail ("diagonal " <> show k <> " (" <> show i <> ") overflows state indices " <> show (negate m) <> ".." <> show n <> " (0.." <> show (succ (m + n)) <> ")")
+  let (x, script) = v ! i in return (Endpoint x (x - k), script)
+
+
 -- Smart constructors
 
 ses :: HasCallStack => EditGraph a b -> Myers a b (EditScript a b)

From 83efbb56b69d68d00df41f468e03340c188d913f Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 23 Mar 2017 10:10:40 -0400
Subject: [PATCH 256/294] Extract the setK evaluator.

---
 src/SES/Myers.hs | 10 ++++++----
 1 file changed, 6 insertions(+), 4 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index da3bf5da2..d000447b9 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -98,10 +98,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
   MoveFromAdjacent graph d k -> runMoveFromAdjacent graph d k
 
   GetK graph k -> runGetK graph k
-
-  SetK _ (Diagonal k) x script ->
-    modify (MyersState . set . unMyersState)
-    where set v = v // [(index v k, (x, script))]
+  SetK graph k x script -> runSetK graph k x script
 
   Slide (EditGraph as bs) (Endpoint x y) script
     | x >= 0, x < length as
@@ -191,6 +188,11 @@ runGetK (EditGraph as bs) (Diagonal k) = let ?callStack = popCallStack callStack
     fail ("diagonal " <> show k <> " (" <> show i <> ") overflows state indices " <> show (negate m) <> ".." <> show n <> " (0.." <> show (succ (m + n)) <> ")")
   let (x, script) = v ! i in return (Endpoint x (x - k), script)
 
+runSetK :: HasCallStack => EditGraph a b -> Diagonal -> Int -> EditScript a b -> Myers a b ()
+runSetK graph (Diagonal k) x script = let ?callStack = popCallStack callStack in
+  modify (MyersState . set . unMyersState)
+  where set v = v // [(index v k, (x, script))]
+
 
 -- Smart constructors
 

From bdb1670f6795e63f62515e6aa24e4f8830a72c78 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 23 Mar 2017 10:13:40 -0400
Subject: [PATCH 257/294] Move the ! overload to the top level.

---
 src/SES/Myers.hs | 28 ++++++++++++++--------------
 1 file changed, 14 insertions(+), 14 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index d000447b9..d9274a095 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -3,7 +3,7 @@ module SES.Myers where
 
 import Control.Exception
 import Control.Monad.Free.Freer
-import Data.Array hiding (index)
+import qualified Data.Array as Array
 import Data.Functor.Classes
 import Data.String
 import Data.These
@@ -38,11 +38,11 @@ data StepF a b result where
 
 type Myers a b = Freer (StepF a b)
 
-data EditGraph a b = EditGraph { as :: !(Array Int a), bs :: !(Array Int b) }
+data EditGraph a b = EditGraph { as :: !(Array.Array Int a), bs :: !(Array.Array Int b) }
   deriving (Eq, Show)
 
 makeEditGraph :: (Foldable t, Foldable u) => t a -> u b -> EditGraph a b
-makeEditGraph as bs = EditGraph (listArray (0, pred (length as)) (toList as)) (listArray (0, pred (length bs)) (toList bs))
+makeEditGraph as bs = EditGraph (Array.listArray (0, pred (length as)) (toList as)) (Array.listArray (0, pred (length bs)) (toList bs))
 
 newtype Distance = Distance { unDistance :: Int }
   deriving (Eq, Show)
@@ -112,11 +112,6 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
         return (Endpoint x y, script)
     | otherwise -> return (Endpoint x y, script)
 
-  where (!) :: HasCallStack => Array Int a -> Int -> a
-        v ! i | i < length v = v Data.Array.! i
-              | otherwise = let ?callStack = fromCallSiteList (filter ((/= "M") . fst) (getCallStack callStack)) in
-                  throw (MyersException ("index " <> show i <> " out of bounds") callStack)
-
 
 runSES :: HasCallStack => EditGraph a b -> Myers a b (EditScript a b)
 runSES (EditGraph as bs)
@@ -191,7 +186,7 @@ runGetK (EditGraph as bs) (Diagonal k) = let ?callStack = popCallStack callStack
 runSetK :: HasCallStack => EditGraph a b -> Diagonal -> Int -> EditScript a b -> Myers a b ()
 runSetK graph (Diagonal k) x script = let ?callStack = popCallStack callStack in
   modify (MyersState . set . unMyersState)
-  where set v = v // [(index v k, (x, script))]
+  where set v = v Array.// [(index v k, (x, script))]
 
 
 -- Smart constructors
@@ -229,15 +224,15 @@ getEq = GetEq `Then` return
 
 -- Implementation details
 
-newtype MyersState a b = MyersState { unMyersState :: Array Int (Int, EditScript a b) }
+newtype MyersState a b = MyersState { unMyersState :: Array.Array Int (Int, EditScript a b) }
   deriving (Eq, Show)
 
 emptyStateForStep :: Myers a b c -> MyersState a b
 emptyStateForStep step = case step of
   Then (M myers) _ ->
     let (_, n, m) = editGraph myers in
-    MyersState (listArray (0, m + n) (repeat (0, [])))
-  _ -> MyersState (listArray (0, negate 1) [])
+    MyersState (Array.listArray (0, m + n) (repeat (0, [])))
+  _ -> MyersState (Array.listArray (0, negate 1) [])
 
 for :: [a] -> (a -> Myers c d (Maybe b)) -> Myers c d (Maybe b)
 for all run = foldr (\ a b -> (<|>) <$> run a <*> b) (return Nothing) all
@@ -245,7 +240,7 @@ for all run = foldr (\ a b -> (<|>) <$> run a <*> b) (return Nothing) all
 continue :: Myers b c (Maybe a)
 continue = return Nothing
 
-index :: Array Int a -> Int -> Int
+index :: Array.Array Int a -> Int -> Int
 index v k = if k >= 0 then k else length v + k
 
 
@@ -268,8 +263,13 @@ fail :: (HasCallStack, Monad m) => String -> m a
 fail s = let ?callStack = fromCallSiteList (filter ((/= "M") . fst) (getCallStack callStack)) in
   throw (MyersException s callStack)
 
+(!) :: HasCallStack => Array.Array Int a -> Int -> a
+v ! i | i < length v = v Array.! i
+      | otherwise = let ?callStack = fromCallSiteList (filter ((/= "M") . fst) (getCallStack callStack)) in
+          throw (MyersException ("index " <> show i <> " out of bounds") callStack)
 
-liftShowsVector :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Array Int a -> ShowS
+
+liftShowsVector :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Array.Array Int a -> ShowS
 liftShowsVector sp sl d = liftShowsPrec sp sl d . toList
 
 liftShowsMyersF :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> (Int -> b -> ShowS) -> ([b] -> ShowS) -> Int -> MyersF a b c -> ShowS

From 66d8e618b50aa2ab51f89c3f83c056a9db4d5fc0 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 23 Mar 2017 10:14:50 -0400
Subject: [PATCH 258/294] Extract the runSlide evaluator.

---
 src/SES/Myers.hs | 25 ++++++++++++++-----------
 1 file changed, 14 insertions(+), 11 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index d9274a095..89daeb74b 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -100,17 +100,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
   GetK graph k -> runGetK graph k
   SetK graph k x script -> runSetK graph k x script
 
-  Slide (EditGraph as bs) (Endpoint x y) script
-    | x >= 0, x < length as
-    , y >= 0, y < length bs -> do
-      eq <- getEq
-      let a = as ! x
-      let b = bs ! y
-      if a `eq` b then
-        slide (EditGraph as bs) (Endpoint (succ x) (succ y)) (These a b : script)
-      else
-        return (Endpoint x y, script)
-    | otherwise -> return (Endpoint x y, script)
+  Slide graph from script -> runSlide graph from script
 
 
 runSES :: HasCallStack => EditGraph a b -> Myers a b (EditScript a b)
@@ -188,6 +178,19 @@ runSetK graph (Diagonal k) x script = let ?callStack = popCallStack callStack in
   modify (MyersState . set . unMyersState)
   where set v = v Array.// [(index v k, (x, script))]
 
+runSlide :: HasCallStack => EditGraph a b -> Endpoint -> EditScript a b -> Myers a b (Endpoint, EditScript a b)
+runSlide (EditGraph as bs) (Endpoint x y) script
+  | x >= 0, x < length as
+  , y >= 0, y < length bs = let ?callStack = popCallStack callStack in do
+    eq <- getEq
+    let a = as ! x
+    let b = bs ! y
+    if a `eq` b then
+      slide (EditGraph as bs) (Endpoint (succ x) (succ y)) (These a b : script)
+    else
+      return (Endpoint x y, script)
+  | otherwise = return (Endpoint x y, script)
+
 
 -- Smart constructors
 

From 35688591473518861a8ec88ee0c26384bbca1881 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 23 Mar 2017 10:15:55 -0400
Subject: [PATCH 259/294] Bounds-check when setting k.

---
 src/SES/Myers.hs | 12 +++++++++---
 1 file changed, 9 insertions(+), 3 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 89daeb74b..9b50f0fac 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -174,9 +174,15 @@ runGetK (EditGraph as bs) (Diagonal k) = let ?callStack = popCallStack callStack
   let (x, script) = v ! i in return (Endpoint x (x - k), script)
 
 runSetK :: HasCallStack => EditGraph a b -> Diagonal -> Int -> EditScript a b -> Myers a b ()
-runSetK graph (Diagonal k) x script = let ?callStack = popCallStack callStack in
-  modify (MyersState . set . unMyersState)
-  where set v = v Array.// [(index v k, (x, script))]
+runSetK (EditGraph as bs) (Diagonal k) x script = let ?callStack = popCallStack callStack in do
+  v <- gets unMyersState
+  let i = index v k
+  let (n, m) = (length as, length bs)
+  when (i < 0) $
+    fail ("diagonal " <> show k <> " (" <> show i <> ") underflows state indices " <> show (negate m) <> ".." <> show n <> " (0.." <> show (succ (m + n)) <> ")")
+  when (i >= length v) $
+    fail ("diagonal " <> show k <> " (" <> show i <> ") overflows state indices " <> show (negate m) <> ".." <> show n <> " (0.." <> show (succ (m + n)) <> ")")
+  put (MyersState (v Array.// [(index v k, (x, script))]))
 
 runSlide :: HasCallStack => EditGraph a b -> Endpoint -> EditScript a b -> Myers a b (Endpoint, EditScript a b)
 runSlide (EditGraph as bs) (Endpoint x y) script

From 6a3ea32528266a3de75c80e83277b9fd3f37d4fe Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 23 Mar 2017 10:21:33 -0400
Subject: [PATCH 260/294] Extract bounds-checking for k.

---
 src/SES/Myers.hs | 35 +++++++++++++++++------------------
 1 file changed, 17 insertions(+), 18 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 9b50f0fac..8dc8d1bce 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -163,26 +163,14 @@ runMoveFromAdjacent (EditGraph as bs) (Distance d) (Diagonal k) = let ?callStack
 
 
 runGetK :: HasCallStack => EditGraph a b -> Diagonal -> Myers a b (Endpoint, EditScript a b)
-runGetK (EditGraph as bs) (Diagonal k) = let ?callStack = popCallStack callStack in do
-  v <- gets unMyersState
-  let i = index v k
-  let (n, m) = (length as, length bs)
-  when (i < 0) $
-    fail ("diagonal " <> show k <> " (" <> show i <> ") underflows state indices " <> show (negate m) <> ".." <> show n <> " (0.." <> show (succ (m + n)) <> ")")
-  when (i >= length v) $
-    fail ("diagonal " <> show k <> " (" <> show i <> ") overflows state indices " <> show (negate m) <> ".." <> show n <> " (0.." <> show (succ (m + n)) <> ")")
-  let (x, script) = v ! i in return (Endpoint x (x - k), script)
+runGetK graph k = let ?callStack = popCallStack callStack in do
+  (i, v) <- checkK graph k
+  let (x, script) = v ! i in return (Endpoint x (x - unDiagonal k), script)
 
 runSetK :: HasCallStack => EditGraph a b -> Diagonal -> Int -> EditScript a b -> Myers a b ()
-runSetK (EditGraph as bs) (Diagonal k) x script = let ?callStack = popCallStack callStack in do
-  v <- gets unMyersState
-  let i = index v k
-  let (n, m) = (length as, length bs)
-  when (i < 0) $
-    fail ("diagonal " <> show k <> " (" <> show i <> ") underflows state indices " <> show (negate m) <> ".." <> show n <> " (0.." <> show (succ (m + n)) <> ")")
-  when (i >= length v) $
-    fail ("diagonal " <> show k <> " (" <> show i <> ") overflows state indices " <> show (negate m) <> ".." <> show n <> " (0.." <> show (succ (m + n)) <> ")")
-  put (MyersState (v Array.// [(index v k, (x, script))]))
+runSetK graph k x script = let ?callStack = popCallStack callStack in do
+  (i, v) <- checkK graph k
+  put (MyersState (v Array.// [(i, (x, script))]))
 
 runSlide :: HasCallStack => EditGraph a b -> Endpoint -> EditScript a b -> Myers a b (Endpoint, EditScript a b)
 runSlide (EditGraph as bs) (Endpoint x y) script
@@ -277,6 +265,17 @@ v ! i | i < length v = v Array.! i
       | otherwise = let ?callStack = fromCallSiteList (filter ((/= "M") . fst) (getCallStack callStack)) in
           throw (MyersException ("index " <> show i <> " out of bounds") callStack)
 
+checkK :: HasCallStack => EditGraph a b -> Diagonal -> Myers a b (Int, Array.Array Int (Int, EditScript a b))
+checkK (EditGraph as bs) (Diagonal k) = let ?callStack = popCallStack callStack in do
+  v <- gets unMyersState
+  let i = index v k
+  let (n, m) = (length as, length bs)
+  when (i < 0) $
+    fail ("diagonal " <> show k <> " (" <> show i <> ") underflows state indices " <> show (negate m) <> ".." <> show n <> " (0.." <> show (succ (m + n)) <> ")")
+  when (i >= length v) $
+    fail ("diagonal " <> show k <> " (" <> show i <> ") overflows state indices " <> show (negate m) <> ".." <> show n <> " (0.." <> show (succ (m + n)) <> ")")
+  return (i, v)
+
 
 liftShowsVector :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Array.Array Int a -> ShowS
 liftShowsVector sp sl d = liftShowsPrec sp sl d . toList

From a873891ce7cf020fdf18f134e06f62d6fce2f8eb Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 23 Mar 2017 10:29:09 -0400
Subject: [PATCH 261/294] Inline decompose.

---
 src/SES/Myers.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 8dc8d1bce..032760e98 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -101,6 +101,7 @@ decompose myers = let ?callStack = popCallStack callStack in case myers of
   SetK graph k x script -> runSetK graph k x script
 
   Slide graph from script -> runSlide graph from script
+{-# INLINE decompose #-}
 
 
 runSES :: HasCallStack => EditGraph a b -> Myers a b (EditScript a b)

From 41928ba5946297358798b5fe60ace7ac855acda6 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 23 Mar 2017 10:44:24 -0400
Subject: [PATCH 262/294] Read the edit graph from the environment instead of
 passing it around.

---
 src/SES.hs             |   2 +-
 src/SES/Myers.hs       | 173 ++++++++++++++++++-----------------------
 test/SES/Myers/Spec.hs |  10 +--
 3 files changed, 83 insertions(+), 102 deletions(-)

diff --git a/src/SES.hs b/src/SES.hs
index 9528c3e48..4cdd864e5 100644
--- a/src/SES.hs
+++ b/src/SES.hs
@@ -15,7 +15,7 @@ type Cost term = These term term -> Int
 
 -- | Find the shortest edit script (diff) between two terms given a function to compute the cost.
 ses :: Comparable term -> Cost term -> [term] -> [term] -> [These term term]
-ses canCompare _ as bs = Myers.runMyers canCompare (Myers.ses (Myers.makeEditGraph as bs))
+ses canCompare _ as bs = Myers.runMyers canCompare (Myers.makeEditGraph as bs) (Myers.ses)
 
 -- | Find the shortest edit script between two terms at a given vertex in the edit graph.
 diffAt :: Comparable term -> Cost term -> (Int, Int) -> [term] -> [term] -> State (Map.Map (Int, Int) [(These term term, Int)]) [(These term term, Int)]
diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 032760e98..76750b78d 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -13,17 +13,17 @@ import Prologue hiding (for, State, error)
 import Text.Show (showListWith)
 
 data MyersF a b result where
-  SES :: EditGraph a b -> MyersF a b (EditScript a b)
-  LCS :: EditGraph a b -> MyersF a b [(a, b)]
-  EditDistance :: EditGraph a b -> MyersF a b Int
-  SearchUpToD :: EditGraph a b -> Distance -> MyersF a b (Maybe (EditScript a b, Distance))
-  SearchAlongK :: EditGraph a b -> Distance -> Diagonal -> MyersF a b (Maybe (EditScript a b, Distance))
-  MoveFromAdjacent :: EditGraph a b -> Distance -> Diagonal -> MyersF a b Endpoint
+  SES :: MyersF a b (EditScript a b)
+  LCS :: MyersF a b [(a, b)]
+  EditDistance :: MyersF a b Int
+  SearchUpToD :: Distance -> MyersF a b (Maybe (EditScript a b, Distance))
+  SearchAlongK :: Distance -> Diagonal -> MyersF a b (Maybe (EditScript a b, Distance))
+  MoveFromAdjacent :: Distance -> Diagonal -> MyersF a b Endpoint
 
-  GetK :: EditGraph a b -> Diagonal -> MyersF a b (Endpoint, EditScript a b)
-  SetK :: EditGraph a b -> Diagonal -> Int -> EditScript a b -> MyersF a b ()
+  GetK :: Diagonal -> MyersF a b (Endpoint, EditScript a b)
+  SetK :: Diagonal -> Int -> EditScript a b -> MyersF a b ()
 
-  Slide :: EditGraph a b -> Endpoint -> EditScript a b -> MyersF a b (Endpoint, EditScript a b)
+  Slide :: Endpoint -> EditScript a b -> MyersF a b (Endpoint, EditScript a b)
 
 type EditScript a b = [These a b]
 
@@ -56,31 +56,31 @@ data Endpoint = Endpoint { x :: !Int, y :: !Int }
 
 -- Evaluation
 
-runMyers :: forall a b c. HasCallStack => (a -> b -> Bool) -> Myers a b c -> c
-runMyers eq step = evalState (go step) (emptyStateForStep step)
+runMyers :: forall a b c. HasCallStack => (a -> b -> Bool) -> EditGraph a b ->Myers a b c -> c
+runMyers eq graph step = evalState (go step) (emptyStateForGraph graph)
   where go :: forall c. Myers a b c -> StateT (MyersState a b) Identity c
         go = iterFreerA algebra
         algebra :: forall c x. StepF a b x -> (x -> StateT (MyersState a b) Identity c) -> StateT (MyersState a b) Identity c
         algebra step cont = case step of
-          M m -> go (decompose m) >>= cont
+          M m -> go (decompose graph m) >>= cont
           S Get -> get >>= cont
           S (Put s) -> put s >>= cont
           GetEq -> cont eq
 
-runMyersSteps :: HasCallStack => (a -> b -> Bool) -> Myers a b c -> [(MyersState a b, Myers a b c)]
-runMyersSteps eq step = go (emptyStateForStep step) step
-  where go state step = let ?callStack = popCallStack callStack in prefix state step $ case runMyersStep eq state step of
+runMyersSteps :: HasCallStack => (a -> b -> Bool) -> EditGraph a b ->Myers a b c -> [(MyersState a b, Myers a b c)]
+runMyersSteps eq graph = go (emptyStateForGraph graph)
+  where go state step = let ?callStack = popCallStack callStack in prefix state step $ case runMyersStep eq graph state step of
           Left result -> [ (state, return result) ]
           Right next -> uncurry go next
         prefix state step = case step of
           Then (M _) _ -> ((state, step) :)
           _ -> identity
 
-runMyersStep :: HasCallStack => (a -> b -> Bool) -> MyersState a b -> Myers a b c -> Either c (MyersState a b, Myers a b c)
-runMyersStep eq state step = let ?callStack = popCallStack callStack in case step of
+runMyersStep :: HasCallStack => (a -> b -> Bool) -> EditGraph a b ->MyersState a b -> Myers a b c -> Either c (MyersState a b, Myers a b c)
+runMyersStep eq graph state step = let ?callStack = popCallStack callStack in case step of
   Return a -> Left a
   Then step cont -> case step of
-    M myers -> Right (state, decompose myers >>= cont)
+    M myers -> Right (state, decompose graph myers >>= cont)
 
     S Get -> Right (state, cont state)
     S (Put state') -> Right (state', cont ())
@@ -88,19 +88,19 @@ runMyersStep eq state step = let ?callStack = popCallStack callStack in case ste
     GetEq -> Right (state, cont eq)
 
 
-decompose :: HasCallStack => MyersF a b c -> Myers a b c
-decompose myers = let ?callStack = popCallStack callStack in case myers of
-  SES graph -> runSES graph
-  LCS graph -> runLCS graph
-  EditDistance graph -> runEditDistance graph
-  SearchUpToD graph d -> runSearchUpToD graph d
-  SearchAlongK graph d k -> runSearchAlongK graph d k
-  MoveFromAdjacent graph d k -> runMoveFromAdjacent graph d k
+decompose :: HasCallStack => EditGraph a b ->MyersF a b c -> Myers a b c
+decompose graph myers = let ?callStack = popCallStack callStack in case myers of
+  SES -> runSES graph
+  LCS -> runLCS graph
+  EditDistance -> runEditDistance graph
+  SearchUpToD d -> runSearchUpToD graph d
+  SearchAlongK d k -> runSearchAlongK graph d k
+  MoveFromAdjacent d k -> runMoveFromAdjacent graph d k
 
-  GetK graph k -> runGetK graph k
-  SetK graph k x script -> runSetK graph k x script
+  GetK k -> runGetK graph k
+  SetK k x script -> runSetK graph k x script
 
-  Slide graph from script -> runSlide graph from script
+  Slide from script -> runSlide graph from script
 {-# INLINE decompose #-}
 
 
@@ -109,7 +109,7 @@ runSES (EditGraph as bs)
   | null bs = return (This <$> toList as)
   | null as = return (That <$> toList bs)
   | otherwise = let ?callStack = popCallStack callStack in do
-    result <- for [0..(length as + length bs)] (searchUpToD (EditGraph as bs) . Distance)
+    result <- for [0..(length as + length bs)] (searchUpToD . Distance)
     case result of
       Just (script, _) -> return (reverse script)
       _ -> fail "no shortest edit script found in edit graph (this is a bug in SES.Myers)."
@@ -118,24 +118,24 @@ runLCS :: HasCallStack => EditGraph a b -> Myers a b [(a, b)]
 runLCS (EditGraph as bs)
   | null as || null bs = return []
   | otherwise = let ?callStack = popCallStack callStack in do
-    result <- ses (EditGraph as bs)
+    result <- ses
     return (catMaybes (these (const Nothing) (const Nothing) ((Just .) . (,)) <$> result))
 
 runEditDistance :: HasCallStack => EditGraph a b -> Myers a b Int
-runEditDistance graph = let ?callStack = popCallStack callStack in length . filter (these (const True) (const True) (const (const False))) <$> ses graph
+runEditDistance _ = let ?callStack = popCallStack callStack in length . filter (these (const True) (const True) (const (const False))) <$> ses
 
 
 runSearchUpToD :: HasCallStack => EditGraph a b -> Distance -> Myers a b (Maybe (EditScript a b, Distance))
-runSearchUpToD graph (Distance d) = let ?callStack = popCallStack callStack in for [negate d, negate d + 2 .. d] (searchAlongK graph (Distance d) . Diagonal)
+runSearchUpToD _ (Distance d) = let ?callStack = popCallStack callStack in for [negate d, negate d + 2 .. d] (searchAlongK (Distance d) . Diagonal)
 
 runSearchAlongK :: HasCallStack => EditGraph a b -> Distance -> Diagonal -> Myers a b (Maybe (EditScript a b, Distance))
 runSearchAlongK (EditGraph as bs) d k = let ?callStack = popCallStack callStack in
   if negate (length bs) > unDiagonal k || unDiagonal k > length as then
     continue
   else do
-    Endpoint x y <- moveFromAdjacent (EditGraph as bs) d k
+    Endpoint x y <- moveFromAdjacent d k
     if x >= length as && y >= length bs then do
-      (_, script) <- getK (EditGraph as bs) k
+      (_, script) <- getK k
       return (Just (script, d))
     else
       continue
@@ -146,20 +146,20 @@ runMoveFromAdjacent (EditGraph as bs) (Distance d) (Diagonal k) = let ?callStack
   (from, fromScript) <- if d == 0 || k < negate m || k > n then
     return (Endpoint 0 0, [])
   else if k == negate d || k == negate m then do
-    (Endpoint nextX nextY, nextScript) <- getK (EditGraph as bs) (Diagonal (succ k))
+    (Endpoint nextX nextY, nextScript) <- getK (Diagonal (succ k))
     return (Endpoint nextX (succ nextY), if nextY < m then That (bs ! nextY) : nextScript else nextScript) -- downward (insertion)
   else if k /= d && k /= n then do
-    (Endpoint prevX prevY, prevScript) <- getK (EditGraph as bs) (Diagonal (pred k))
-    (Endpoint nextX nextY, nextScript) <- getK (EditGraph as bs) (Diagonal (succ k))
+    (Endpoint prevX prevY, prevScript) <- getK (Diagonal (pred k))
+    (Endpoint nextX nextY, nextScript) <- getK (Diagonal (succ k))
     return $ if prevX < nextX then
       (Endpoint nextX (succ nextY), if nextY < m then That (bs ! nextY) : nextScript else nextScript) -- downward (insertion)
     else
       (Endpoint (succ prevX) prevY, if prevX < n then This (as ! prevX) : prevScript else prevScript) -- rightward (deletion)
   else do
-    (Endpoint prevX prevY, prevScript) <- getK (EditGraph as bs) (Diagonal (pred k))
+    (Endpoint prevX prevY, prevScript) <- getK (Diagonal (pred k))
     return (Endpoint (succ prevX) prevY, if prevX < n then This (as ! prevX) : prevScript else prevScript) -- rightward (deletion)
-  (endpoint, script) <- slide (EditGraph as bs) from fromScript
-  setK (EditGraph as bs) (Diagonal k) (x endpoint) script
+  (endpoint, script) <- slide from fromScript
+  setK (Diagonal k) (x endpoint) script
   return endpoint
 
 
@@ -181,7 +181,7 @@ runSlide (EditGraph as bs) (Endpoint x y) script
     let a = as ! x
     let b = bs ! y
     if a `eq` b then
-      slide (EditGraph as bs) (Endpoint (succ x) (succ y)) (These a b : script)
+      slide (Endpoint (succ x) (succ y)) (These a b : script)
     else
       return (Endpoint x y, script)
   | otherwise = return (Endpoint x y, script)
@@ -189,32 +189,32 @@ runSlide (EditGraph as bs) (Endpoint x y) script
 
 -- Smart constructors
 
-ses :: HasCallStack => EditGraph a b -> Myers a b (EditScript a b)
-ses graph = M (SES graph) `Then` return
+ses :: HasCallStack => Myers a b (EditScript a b)
+ses = M SES `Then` return
 
-lcs :: HasCallStack => EditGraph a b -> Myers a b [(a, b)]
-lcs graph = M (LCS graph) `Then` return
+lcs :: HasCallStack => Myers a b [(a, b)]
+lcs = M LCS `Then` return
 
-editDistance :: HasCallStack => EditGraph a b -> Myers a b Int
-editDistance graph = M (EditDistance graph) `Then` return
+editDistance :: HasCallStack => Myers a b Int
+editDistance = M EditDistance `Then` return
 
-searchUpToD :: HasCallStack => EditGraph a b -> Distance -> Myers a b (Maybe (EditScript a b, Distance))
-searchUpToD graph distance = M (SearchUpToD graph distance) `Then` return
+searchUpToD :: HasCallStack => Distance -> Myers a b (Maybe (EditScript a b, Distance))
+searchUpToD distance = M (SearchUpToD distance) `Then` return
 
-searchAlongK :: HasCallStack => EditGraph a b -> Distance -> Diagonal -> Myers a b (Maybe (EditScript a b, Distance))
-searchAlongK graph d k = M (SearchAlongK graph d k) `Then` return
+searchAlongK :: HasCallStack => Distance -> Diagonal -> Myers a b (Maybe (EditScript a b, Distance))
+searchAlongK d k = M (SearchAlongK d k) `Then` return
 
-moveFromAdjacent :: HasCallStack => EditGraph a b -> Distance -> Diagonal -> Myers a b Endpoint
-moveFromAdjacent graph d k = M (MoveFromAdjacent graph d k) `Then` return
+moveFromAdjacent :: HasCallStack => Distance -> Diagonal -> Myers a b Endpoint
+moveFromAdjacent d k = M (MoveFromAdjacent d k) `Then` return
 
-getK :: HasCallStack => EditGraph a b -> Diagonal -> Myers a b (Endpoint, EditScript a b)
-getK graph diagonal = M (GetK graph diagonal) `Then` return
+getK :: HasCallStack => Diagonal -> Myers a b (Endpoint, EditScript a b)
+getK diagonal = M (GetK diagonal) `Then` return
 
-setK :: HasCallStack => EditGraph a b -> Diagonal -> Int -> EditScript a b -> Myers a b ()
-setK graph diagonal x script = M (SetK graph diagonal x script) `Then` return
+setK :: HasCallStack => Diagonal -> Int -> EditScript a b -> Myers a b ()
+setK diagonal x script = M (SetK diagonal x script) `Then` return
 
-slide :: HasCallStack => EditGraph a b -> Endpoint -> EditScript a b -> Myers a b (Endpoint, EditScript a b)
-slide graph from script = M (Slide graph from script) `Then` return
+slide :: HasCallStack => Endpoint -> EditScript a b -> Myers a b (Endpoint, EditScript a b)
+slide from script = M (Slide from script) `Then` return
 
 getEq :: HasCallStack => Myers a b (a -> b -> Bool)
 getEq = GetEq `Then` return
@@ -225,12 +225,9 @@ getEq = GetEq `Then` return
 newtype MyersState a b = MyersState { unMyersState :: Array.Array Int (Int, EditScript a b) }
   deriving (Eq, Show)
 
-emptyStateForStep :: Myers a b c -> MyersState a b
-emptyStateForStep step = case step of
-  Then (M myers) _ ->
-    let (_, n, m) = editGraph myers in
-    MyersState (Array.listArray (0, m + n) (repeat (0, [])))
-  _ -> MyersState (Array.listArray (0, negate 1) [])
+emptyStateForGraph :: EditGraph a b -> MyersState a b
+emptyStateForGraph (EditGraph as bs) = let (n, m) = (length as, length bs) in
+  MyersState (Array.listArray (0, m + n) (repeat (0, [])))
 
 for :: [a] -> (a -> Myers c d (Maybe b)) -> Myers c d (Maybe b)
 for all run = foldr (\ a b -> (<|>) <$> run a <*> b) (return Nothing) all
@@ -242,21 +239,6 @@ index :: Array.Array Int a -> Int -> Int
 index v k = if k >= 0 then k else length v + k
 
 
-editGraph :: MyersF a b c -> (EditGraph a b, Int, Int)
-editGraph myers = (EditGraph as bs, n, m)
-  where EditGraph as bs = case myers of
-          SES g -> g
-          LCS g -> g
-          EditDistance g -> g
-          SearchUpToD g _ -> g
-          SearchAlongK g _ _ -> g
-          MoveFromAdjacent g _ _ -> g
-          GetK g _ -> g
-          SetK g _ _ _ -> g
-          Slide g _ _ -> g
-        (n, m) = (length as, length bs)
-
-
 fail :: (HasCallStack, Monad m) => String -> m a
 fail s = let ?callStack = fromCallSiteList (filter ((/= "M") . fst) (getCallStack callStack)) in
   throw (MyersException s callStack)
@@ -281,18 +263,17 @@ checkK (EditGraph as bs) (Diagonal k) = let ?callStack = popCallStack callStack
 liftShowsVector :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Array.Array Int a -> ShowS
 liftShowsVector sp sl d = liftShowsPrec sp sl d . toList
 
-liftShowsMyersF :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> (Int -> b -> ShowS) -> ([b] -> ShowS) -> Int -> MyersF a b c -> ShowS
-liftShowsMyersF sp1 sl1 sp2 sl2 d m = case m of
-  SES graph -> showsUnaryWith showGraph "SES" d graph
-  LCS graph -> showsUnaryWith showGraph "LCS" d graph
-  EditDistance graph -> showsUnaryWith showGraph "EditDistance" d graph
-  SearchUpToD graph distance -> showsBinaryWith showGraph showsPrec "SearchUpToD" d graph distance
-  SearchAlongK graph distance diagonal -> showsTernaryWith showGraph showsPrec showsPrec "SearchAlongK" d graph distance diagonal
-  MoveFromAdjacent graph distance diagonal -> showsTernaryWith showGraph showsPrec showsPrec "MoveFromAdjacent" d graph distance diagonal
-  GetK graph diagonal -> showsBinaryWith showGraph showsPrec "GetK" d graph diagonal
-  SetK graph diagonal v script -> showsQuaternaryWith showGraph showsPrec showsPrec (liftShowsEditScript sp1 sp2) "SetK" d graph diagonal v script
-  Slide graph endpoint script -> showsTernaryWith showGraph showsPrec (liftShowsEditScript sp1 sp2) "Slide" d graph endpoint script
-  where showGraph = (liftShowsPrec2 :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> (Int -> b -> ShowS) -> ([b] -> ShowS) -> Int -> EditGraph a b -> ShowS) sp1 sl1 sp2 sl2
+liftShowsMyersF :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> Int -> MyersF a b c -> ShowS
+liftShowsMyersF sp1 sp2 d m = case m of
+  SES -> showString "SES"
+  LCS -> showString "LCS"
+  EditDistance -> showString "EditDistance"
+  SearchUpToD distance -> showsUnaryWith showsPrec "SearchUpToD" d distance
+  SearchAlongK distance diagonal -> showsBinaryWith showsPrec showsPrec "SearchAlongK" d distance diagonal
+  MoveFromAdjacent distance diagonal -> showsBinaryWith showsPrec showsPrec "MoveFromAdjacent" d distance diagonal
+  GetK diagonal -> showsUnaryWith showsPrec "GetK" d diagonal
+  SetK diagonal v script -> showsTernaryWith showsPrec showsPrec (liftShowsEditScript sp1 sp2) "SetK" d diagonal v script
+  Slide endpoint script -> showsBinaryWith showsPrec (liftShowsEditScript sp1 sp2) "Slide" d endpoint script
 
 showsTernaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> (Int -> c -> ShowS) -> String -> Int -> a -> b -> c -> ShowS
 showsTernaryWith sp1 sp2 sp3 name d x y z = showParen (d > 10) $
@@ -313,7 +294,7 @@ liftShowsState sp d state = case state of
 
 liftShowsStepF :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> (Int -> b -> ShowS) -> ([b] -> ShowS) -> Int -> StepF a b c -> ShowS
 liftShowsStepF sp1 sl1 sp2 sl2 d step = case step of
-  M m -> showsUnaryWith (liftShowsMyersF sp1 sl1 sp2 sl2) "M" d m
+  M m -> showsUnaryWith (liftShowsMyersF sp1 sp2) "M" d m
   S s -> showsUnaryWith (liftShowsState (liftShowsPrec2 sp1 sl1 sp2 sl2)) "S" d s
   GetEq -> showString "GetEq"
 
@@ -351,10 +332,10 @@ instance Show2 EditGraph where
   liftShowsPrec2 sp1 sl1 sp2 sl2 d (EditGraph as bs) = showsBinaryWith (liftShowsVector sp1 sl1) (liftShowsVector sp2 sl2) "EditGraph" d as bs
 
 instance (Show a, Show b) => Show1 (MyersF a b) where
-  liftShowsPrec _ _ = liftShowsMyersF showsPrec showList showsPrec showList
+  liftShowsPrec _ _ = liftShowsMyersF showsPrec showsPrec
 
 instance (Show a, Show b) => Show (MyersF a b c) where
-  showsPrec = liftShowsMyersF showsPrec showList showsPrec showList
+  showsPrec = liftShowsMyersF showsPrec showsPrec
 
 instance (Show a, Show b) => Show1 (StepF a b) where
   liftShowsPrec _ _ = liftShowsStepF showsPrec showList showsPrec showList
diff --git a/test/SES/Myers/Spec.hs b/test/SES/Myers/Spec.hs
index a021bfbfe..096d6b1a1 100644
--- a/test/SES/Myers/Spec.hs
+++ b/test/SES/Myers/Spec.hs
@@ -10,16 +10,16 @@ spec :: Spec
 spec = do
   describe "ses" $ do
     prop "returns equal lists in These" $
-      \ as -> runMyers (==) (ses (makeEditGraph as as :: EditGraph Char Char)) `shouldBe` zipWith These as as
+      \ as -> runMyers (==) (makeEditGraph as as :: EditGraph Char Char) ses `shouldBe` zipWith These as as
 
     prop "returns deletions in This" $
-      \ as -> runMyers (==) (ses (makeEditGraph as [] :: EditGraph Char Char)) `shouldBe` fmap This as
+      \ as -> runMyers (==) (makeEditGraph as [] :: EditGraph Char Char) ses `shouldBe` fmap This as
 
     prop "returns insertions in That" $
-      \ bs -> runMyers (==) (ses (makeEditGraph [] bs :: EditGraph Char Char)) `shouldBe` fmap That bs
+      \ bs -> runMyers (==) (makeEditGraph [] bs :: EditGraph Char Char) ses `shouldBe` fmap That bs
 
     prop "returns all elements individually for disjoint inputs" $
-      \ as bs -> length (runMyers (==) (ses (makeEditGraph ((,) 0 <$> as :: [(Int, Char)]) ((,) 1 <$> bs :: [(Int, Char)])))) `shouldBe` length as + length bs
+      \ as bs -> length (runMyers (==) (makeEditGraph ((,) 0 <$> as :: [(Int, Char)]) ((,) 1 <$> bs :: [(Int, Char)])) ses) `shouldBe` length as + length bs
 
     prop "is lossless w.r.t. both input elements & ordering" $
-      \ as bs -> foldr (\ each (as, bs) -> these (flip (,) bs. (:as)) ((,) as . (:bs)) (\ a b -> (a:as, b:bs)) each) ([], []) (runMyers (==) (ses (makeEditGraph as bs :: EditGraph Char Char))) `shouldBe` (as, bs)
+      \ as bs -> foldr (\ each (as, bs) -> these (flip (,) bs. (:as)) ((,) as . (:bs)) (\ a b -> (a:as, b:bs)) each) ([], []) (runMyers (==) (makeEditGraph as bs :: EditGraph Char Char) ses) `shouldBe` (as, bs)

From ee0554c22b32e626cca8e5d76c57841b45a2f8df Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 23 Mar 2017 10:46:03 -0400
Subject: [PATCH 263/294] Read the comparator from the environment.

---
 src/SES/Myers.hs | 15 +++++++--------
 1 file changed, 7 insertions(+), 8 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 76750b78d..ea88d9135 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -62,7 +62,7 @@ runMyers eq graph step = evalState (go step) (emptyStateForGraph graph)
         go = iterFreerA algebra
         algebra :: forall c x. StepF a b x -> (x -> StateT (MyersState a b) Identity c) -> StateT (MyersState a b) Identity c
         algebra step cont = case step of
-          M m -> go (decompose graph m) >>= cont
+          M m -> go (decompose eq graph m) >>= cont
           S Get -> get >>= cont
           S (Put s) -> put s >>= cont
           GetEq -> cont eq
@@ -80,7 +80,7 @@ runMyersStep :: HasCallStack => (a -> b -> Bool) -> EditGraph a b ->MyersState a
 runMyersStep eq graph state step = let ?callStack = popCallStack callStack in case step of
   Return a -> Left a
   Then step cont -> case step of
-    M myers -> Right (state, decompose graph myers >>= cont)
+    M myers -> Right (state, decompose eq graph myers >>= cont)
 
     S Get -> Right (state, cont state)
     S (Put state') -> Right (state', cont ())
@@ -88,8 +88,8 @@ runMyersStep eq graph state step = let ?callStack = popCallStack callStack in ca
     GetEq -> Right (state, cont eq)
 
 
-decompose :: HasCallStack => EditGraph a b ->MyersF a b c -> Myers a b c
-decompose graph myers = let ?callStack = popCallStack callStack in case myers of
+decompose :: HasCallStack => (a -> b -> Bool) -> EditGraph a b ->MyersF a b c -> Myers a b c
+decompose eq graph myers = let ?callStack = popCallStack callStack in case myers of
   SES -> runSES graph
   LCS -> runLCS graph
   EditDistance -> runEditDistance graph
@@ -100,7 +100,7 @@ decompose graph myers = let ?callStack = popCallStack callStack in case myers of
   GetK k -> runGetK graph k
   SetK k x script -> runSetK graph k x script
 
-  Slide from script -> runSlide graph from script
+  Slide from script -> runSlide eq graph from script
 {-# INLINE decompose #-}
 
 
@@ -173,11 +173,10 @@ runSetK graph k x script = let ?callStack = popCallStack callStack in do
   (i, v) <- checkK graph k
   put (MyersState (v Array.// [(i, (x, script))]))
 
-runSlide :: HasCallStack => EditGraph a b -> Endpoint -> EditScript a b -> Myers a b (Endpoint, EditScript a b)
-runSlide (EditGraph as bs) (Endpoint x y) script
+runSlide :: HasCallStack => (a -> b -> Bool) -> EditGraph a b -> Endpoint -> EditScript a b -> Myers a b (Endpoint, EditScript a b)
+runSlide eq (EditGraph as bs) (Endpoint x y) script
   | x >= 0, x < length as
   , y >= 0, y < length bs = let ?callStack = popCallStack callStack in do
-    eq <- getEq
     let a = as ! x
     let b = bs ! y
     if a `eq` b then

From 88b4e5fe066bc1c9db4cb0e1ef78c9088e0d6a7e Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 23 Mar 2017 10:46:30 -0400
Subject: [PATCH 264/294] :fire: getEq.

---
 src/SES/Myers.hs | 8 --------
 1 file changed, 8 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index ea88d9135..4f4623c04 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -34,7 +34,6 @@ data State s a where
 data StepF a b result where
   M :: HasCallStack => MyersF a b c -> StepF a b c
   S :: State (MyersState a b) c -> StepF a b c
-  GetEq :: StepF a b (a -> b -> Bool)
 
 type Myers a b = Freer (StepF a b)
 
@@ -65,7 +64,6 @@ runMyers eq graph step = evalState (go step) (emptyStateForGraph graph)
           M m -> go (decompose eq graph m) >>= cont
           S Get -> get >>= cont
           S (Put s) -> put s >>= cont
-          GetEq -> cont eq
 
 runMyersSteps :: HasCallStack => (a -> b -> Bool) -> EditGraph a b ->Myers a b c -> [(MyersState a b, Myers a b c)]
 runMyersSteps eq graph = go (emptyStateForGraph graph)
@@ -85,8 +83,6 @@ runMyersStep eq graph state step = let ?callStack = popCallStack callStack in ca
     S Get -> Right (state, cont state)
     S (Put state') -> Right (state', cont ())
 
-    GetEq -> Right (state, cont eq)
-
 
 decompose :: HasCallStack => (a -> b -> Bool) -> EditGraph a b ->MyersF a b c -> Myers a b c
 decompose eq graph myers = let ?callStack = popCallStack callStack in case myers of
@@ -215,9 +211,6 @@ setK diagonal x script = M (SetK diagonal x script) `Then` return
 slide :: HasCallStack => Endpoint -> EditScript a b -> Myers a b (Endpoint, EditScript a b)
 slide from script = M (Slide from script) `Then` return
 
-getEq :: HasCallStack => Myers a b (a -> b -> Bool)
-getEq = GetEq `Then` return
-
 
 -- Implementation details
 
@@ -295,7 +288,6 @@ liftShowsStepF :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> (Int -> b -> ShowS) -
 liftShowsStepF sp1 sl1 sp2 sl2 d step = case step of
   M m -> showsUnaryWith (liftShowsMyersF sp1 sp2) "M" d m
   S s -> showsUnaryWith (liftShowsState (liftShowsPrec2 sp1 sl1 sp2 sl2)) "S" d s
-  GetEq -> showString "GetEq"
 
 liftShowsThese :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> Int -> These a b -> ShowS
 liftShowsThese sa sb d t = case t of

From 17fad7ce14693f3b33364fefd0a34788c77c100c Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 23 Mar 2017 10:48:51 -0400
Subject: [PATCH 265/294] Tidy up slide evaluation.

---
 src/SES/Myers.hs | 13 +++++--------
 1 file changed, 5 insertions(+), 8 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 4f4623c04..ceb94205b 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -172,14 +172,11 @@ runSetK graph k x script = let ?callStack = popCallStack callStack in do
 runSlide :: HasCallStack => (a -> b -> Bool) -> EditGraph a b -> Endpoint -> EditScript a b -> Myers a b (Endpoint, EditScript a b)
 runSlide eq (EditGraph as bs) (Endpoint x y) script
   | x >= 0, x < length as
-  , y >= 0, y < length bs = let ?callStack = popCallStack callStack in do
-    let a = as ! x
-    let b = bs ! y
-    if a `eq` b then
-      slide (Endpoint (succ x) (succ y)) (These a b : script)
-    else
-      return (Endpoint x y, script)
-  | otherwise = return (Endpoint x y, script)
+  , y >= 0, y < length bs
+  , a <- as ! x
+  , b <- bs ! y
+  , a `eq` b  = slide  (Endpoint (succ x) (succ y)) (These a b : script)
+  | otherwise = return (Endpoint       x        y,   script)
 
 
 -- Smart constructors

From 3130ae48e94408c55123123e19b3e2e1d0846652 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 23 Mar 2017 13:24:27 -0400
Subject: [PATCH 266/294] Bounds-check k in searchUpToD.

---
 src/SES/Myers.hs | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index ceb94205b..37d8d573e 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -4,6 +4,7 @@ module SES.Myers where
 import Control.Exception
 import Control.Monad.Free.Freer
 import qualified Data.Array as Array
+import Data.Ix (inRange)
 import Data.Functor.Classes
 import Data.String
 import Data.These
@@ -122,7 +123,9 @@ runEditDistance _ = let ?callStack = popCallStack callStack in length . filter (
 
 
 runSearchUpToD :: HasCallStack => EditGraph a b -> Distance -> Myers a b (Maybe (EditScript a b, Distance))
-runSearchUpToD _ (Distance d) = let ?callStack = popCallStack callStack in for [negate d, negate d + 2 .. d] (searchAlongK (Distance d) . Diagonal)
+runSearchUpToD (EditGraph as bs) (Distance d) = let ?callStack = popCallStack callStack in
+  for [ k | k <- [negate d, negate d + 2 .. d], inRange (negate m, n) k ] (searchAlongK (Distance d) . Diagonal)
+  where (n, m) = (length as, length bs)
 
 runSearchAlongK :: HasCallStack => EditGraph a b -> Distance -> Diagonal -> Myers a b (Maybe (EditScript a b, Distance))
 runSearchAlongK (EditGraph as bs) d k = let ?callStack = popCallStack callStack in

From 7a0efc33912a7e86f1ee8bbb2f4599ada5ee0091 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 23 Mar 2017 13:24:38 -0400
Subject: [PATCH 267/294] :fire: the bounds check in runSearchAlongK.

---
 src/SES/Myers.hs | 15 ++++++---------
 1 file changed, 6 insertions(+), 9 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 37d8d573e..5534cfd7e 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -128,16 +128,13 @@ runSearchUpToD (EditGraph as bs) (Distance d) = let ?callStack = popCallStack ca
   where (n, m) = (length as, length bs)
 
 runSearchAlongK :: HasCallStack => EditGraph a b -> Distance -> Diagonal -> Myers a b (Maybe (EditScript a b, Distance))
-runSearchAlongK (EditGraph as bs) d k = let ?callStack = popCallStack callStack in
-  if negate (length bs) > unDiagonal k || unDiagonal k > length as then
+runSearchAlongK (EditGraph as bs) d k = let ?callStack = popCallStack callStack in do
+  Endpoint x y <- moveFromAdjacent d k
+  if x >= length as && y >= length bs then do
+    (_, script) <- getK k
+    return (Just (script, d))
+  else
     continue
-  else do
-    Endpoint x y <- moveFromAdjacent d k
-    if x >= length as && y >= length bs then do
-      (_, script) <- getK k
-      return (Just (script, d))
-    else
-      continue
 
 runMoveFromAdjacent :: HasCallStack => EditGraph a b -> Distance -> Diagonal -> Myers a b Endpoint
 runMoveFromAdjacent (EditGraph as bs) (Distance d) (Diagonal k) = let ?callStack = popCallStack callStack in do

From 759b5515f9f962f382be68f16e582558bf1f380b Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 23 Mar 2017 13:28:40 -0400
Subject: [PATCH 268/294] ses is the main entry point.

---
 src/SES.hs             |  2 +-
 src/SES/Myers.hs       |  6 +++---
 test/SES/Myers/Spec.hs | 10 +++++-----
 3 files changed, 9 insertions(+), 9 deletions(-)

diff --git a/src/SES.hs b/src/SES.hs
index d21e6627e..96225c873 100644
--- a/src/SES.hs
+++ b/src/SES.hs
@@ -16,7 +16,7 @@ type Cost term = These term term -> Int
 
 -- | Find the shortest edit script (diff) between two terms given a function to compute the cost.
 ses :: Comparable term -> Cost term -> [term] -> [term] -> [These term term]
-ses canCompare _ as bs = Myers.runMyers canCompare (Myers.makeEditGraph as bs) Myers.ses
+ses canCompare _ as bs = Myers.ses canCompare as bs
 
 
 -- | Find the shortest edit script between two terms at a given vertex in the edit graph.
diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 5534cfd7e..40420eb80 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -56,6 +56,9 @@ data Endpoint = Endpoint { x :: !Int, y :: !Int }
 
 -- Evaluation
 
+ses :: (HasCallStack, Foldable t, Foldable u) => (a -> b -> Bool) -> t a -> u b -> EditScript a b
+ses eq as bs = runMyers eq (makeEditGraph as bs) (M SES `Then` return)
+
 runMyers :: forall a b c. HasCallStack => (a -> b -> Bool) -> EditGraph a b ->Myers a b c -> c
 runMyers eq graph step = evalState (go step) (emptyStateForGraph graph)
   where go :: forall c. Myers a b c -> StateT (MyersState a b) Identity c
@@ -181,9 +184,6 @@ runSlide eq (EditGraph as bs) (Endpoint x y) script
 
 -- Smart constructors
 
-ses :: HasCallStack => Myers a b (EditScript a b)
-ses = M SES `Then` return
-
 lcs :: HasCallStack => Myers a b [(a, b)]
 lcs = M LCS `Then` return
 
diff --git a/test/SES/Myers/Spec.hs b/test/SES/Myers/Spec.hs
index 096d6b1a1..2afd7e040 100644
--- a/test/SES/Myers/Spec.hs
+++ b/test/SES/Myers/Spec.hs
@@ -10,16 +10,16 @@ spec :: Spec
 spec = do
   describe "ses" $ do
     prop "returns equal lists in These" $
-      \ as -> runMyers (==) (makeEditGraph as as :: EditGraph Char Char) ses `shouldBe` zipWith These as as
+      \ as -> (ses (==) as as :: EditGraph Char Char) `shouldBe` zipWith These as as
 
     prop "returns deletions in This" $
-      \ as -> runMyers (==) (makeEditGraph as [] :: EditGraph Char Char) ses `shouldBe` fmap This as
+      \ as -> (ses (==) as [] :: EditGraph Char Char) ses `shouldBe` fmap This as
 
     prop "returns insertions in That" $
-      \ bs -> runMyers (==) (makeEditGraph [] bs :: EditGraph Char Char) ses `shouldBe` fmap That bs
+      \ bs -> (ses (==) [] bs :: EditGraph Char Char) ses `shouldBe` fmap That bs
 
     prop "returns all elements individually for disjoint inputs" $
-      \ as bs -> length (runMyers (==) (makeEditGraph ((,) 0 <$> as :: [(Int, Char)]) ((,) 1 <$> bs :: [(Int, Char)])) ses) `shouldBe` length as + length bs
+      \ as bs -> length (ses (==) ((,) 0 <$> as :: [(Int, Char)]) ((,) 1 <$> bs :: [(Int, Char)])) `shouldBe` length as + length bs
 
     prop "is lossless w.r.t. both input elements & ordering" $
-      \ as bs -> foldr (\ each (as, bs) -> these (flip (,) bs. (:as)) ((,) as . (:bs)) (\ a b -> (a:as, b:bs)) each) ([], []) (runMyers (==) (makeEditGraph as bs :: EditGraph Char Char) ses) `shouldBe` (as, bs)
+      \ as bs -> foldr (\ each (as, bs) -> these (flip (,) bs. (:as)) ((,) as . (:bs)) (\ a b -> (a:as, b:bs)) each) ([], []) (ses (==) as bs :: EditGraph Char Char) `shouldBe` (as, bs)

From 452842b197e52dbb9e9cb2f68ab0c7c4b70b2fe2 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 23 Mar 2017 14:08:52 -0400
Subject: [PATCH 269/294] Correct the calls into SES from lcs & editDistance.

---
 src/SES/Myers.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 40420eb80..096dafa5c 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -118,11 +118,11 @@ runLCS :: HasCallStack => EditGraph a b -> Myers a b [(a, b)]
 runLCS (EditGraph as bs)
   | null as || null bs = return []
   | otherwise = let ?callStack = popCallStack callStack in do
-    result <- ses
+    result <- M SES `Then` return
     return (catMaybes (these (const Nothing) (const Nothing) ((Just .) . (,)) <$> result))
 
 runEditDistance :: HasCallStack => EditGraph a b -> Myers a b Int
-runEditDistance _ = let ?callStack = popCallStack callStack in length . filter (these (const True) (const True) (const (const False))) <$> ses
+runEditDistance _ = let ?callStack = popCallStack callStack in length . filter (these (const True) (const True) (const (const False))) <$> (M SES `Then` return)
 
 
 runSearchUpToD :: HasCallStack => EditGraph a b -> Distance -> Myers a b (Maybe (EditScript a b, Distance))

From a13c7f009fce7b40a7e3acc2a4b18531c9609154 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 23 Mar 2017 14:14:03 -0400
Subject: [PATCH 270/294] Correct the type annotations in the tests.

---
 test/SES/Myers/Spec.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/test/SES/Myers/Spec.hs b/test/SES/Myers/Spec.hs
index 2afd7e040..7be0f4948 100644
--- a/test/SES/Myers/Spec.hs
+++ b/test/SES/Myers/Spec.hs
@@ -10,16 +10,16 @@ spec :: Spec
 spec = do
   describe "ses" $ do
     prop "returns equal lists in These" $
-      \ as -> (ses (==) as as :: EditGraph Char Char) `shouldBe` zipWith These as as
+      \ as -> (ses (==) as as :: EditScript Char Char) `shouldBe` zipWith These as as
 
     prop "returns deletions in This" $
-      \ as -> (ses (==) as [] :: EditGraph Char Char) ses `shouldBe` fmap This as
+      \ as -> (ses (==) as [] :: EditScript Char Char) `shouldBe` fmap This as
 
     prop "returns insertions in That" $
-      \ bs -> (ses (==) [] bs :: EditGraph Char Char) ses `shouldBe` fmap That bs
+      \ bs -> (ses (==) [] bs :: EditScript Char Char) `shouldBe` fmap That bs
 
     prop "returns all elements individually for disjoint inputs" $
       \ as bs -> length (ses (==) ((,) 0 <$> as :: [(Int, Char)]) ((,) 1 <$> bs :: [(Int, Char)])) `shouldBe` length as + length bs
 
     prop "is lossless w.r.t. both input elements & ordering" $
-      \ as bs -> foldr (\ each (as, bs) -> these (flip (,) bs. (:as)) ((,) as . (:bs)) (\ a b -> (a:as, b:bs)) each) ([], []) (ses (==) as bs :: EditGraph Char Char) `shouldBe` (as, bs)
+      \ as bs -> foldr (\ each (as, bs) -> these (flip (,) bs. (:as)) ((,) as . (:bs)) (\ a b -> (a:as, b:bs)) each) ([], []) (ses (==) as bs :: EditScript Char Char) `shouldBe` (as, bs)

From 1ab51de582258bce97e0bca4d43565f6efcbaa82 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 23 Mar 2017 14:21:09 -0400
Subject: [PATCH 271/294] =?UTF-8?q?Update=20the=20failing=20test=E2=80=99s?=
 =?UTF-8?q?=20fixture.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

I’m pretty sure this is due to us producing a different shortest edit script than the old implementation (but still a correct one, and a shortest one—just a different correct/shortest one), and that in turn causing RWS to make different choices.
---
 test/fixtures/ruby/math-assignment.diffB-A.txt | 10 ++++++----
 1 file changed, 6 insertions(+), 4 deletions(-)

diff --git a/test/fixtures/ruby/math-assignment.diffB-A.txt b/test/fixtures/ruby/math-assignment.diffB-A.txt
index c362a3ed0..27b93c445 100644
--- a/test/fixtures/ruby/math-assignment.diffB-A.txt
+++ b/test/fixtures/ruby/math-assignment.diffB-A.txt
@@ -1,8 +1,7 @@
 (Program
-  (OperatorAssignment
+  {-(OperatorAssignment
     (Identifier)
-  { (IntegerLiteral)
-  ->(IntegerLiteral) })
+    (IntegerLiteral))-}
   (OperatorAssignment
     (Identifier)
     (IntegerLiteral))
@@ -14,4 +13,7 @@
     (IntegerLiteral))
   (OperatorAssignment
     (Identifier)
-    (IntegerLiteral)))
+    (IntegerLiteral))
+  {+(OperatorAssignment
+    (Identifier)
+    (IntegerLiteral))+})

From 347e96f31ab78b12b65d1e5de0c02da0c7aec3b7 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 23 Mar 2017 14:22:56 -0400
Subject: [PATCH 272/294] Add phantom type parameters to Endpoint.

---
 src/SES/Myers.hs | 20 ++++++++++----------
 1 file changed, 10 insertions(+), 10 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 096dafa5c..5280555d8 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -19,12 +19,12 @@ data MyersF a b result where
   EditDistance :: MyersF a b Int
   SearchUpToD :: Distance -> MyersF a b (Maybe (EditScript a b, Distance))
   SearchAlongK :: Distance -> Diagonal -> MyersF a b (Maybe (EditScript a b, Distance))
-  MoveFromAdjacent :: Distance -> Diagonal -> MyersF a b Endpoint
+  MoveFromAdjacent :: Distance -> Diagonal -> MyersF a b (Endpoint a b)
 
-  GetK :: Diagonal -> MyersF a b (Endpoint, EditScript a b)
+  GetK :: Diagonal -> MyersF a b (Endpoint a b, EditScript a b)
   SetK :: Diagonal -> Int -> EditScript a b -> MyersF a b ()
 
-  Slide :: Endpoint -> EditScript a b -> MyersF a b (Endpoint, EditScript a b)
+  Slide :: Endpoint a b -> EditScript a b -> MyersF a b (Endpoint a b, EditScript a b)
 
 type EditScript a b = [These a b]
 
@@ -50,7 +50,7 @@ newtype Distance = Distance { unDistance :: Int }
 newtype Diagonal = Diagonal { unDiagonal :: Int }
   deriving (Eq, Show)
 
-data Endpoint = Endpoint { x :: !Int, y :: !Int }
+data Endpoint a b = Endpoint { x :: !Int, y :: !Int }
   deriving (Eq, Show)
 
 
@@ -139,7 +139,7 @@ runSearchAlongK (EditGraph as bs) d k = let ?callStack = popCallStack callStack
   else
     continue
 
-runMoveFromAdjacent :: HasCallStack => EditGraph a b -> Distance -> Diagonal -> Myers a b Endpoint
+runMoveFromAdjacent :: HasCallStack => EditGraph a b -> Distance -> Diagonal -> Myers a b (Endpoint a b)
 runMoveFromAdjacent (EditGraph as bs) (Distance d) (Diagonal k) = let ?callStack = popCallStack callStack in do
   let (n, m) = (length as, length bs)
   (from, fromScript) <- if d == 0 || k < negate m || k > n then
@@ -162,7 +162,7 @@ runMoveFromAdjacent (EditGraph as bs) (Distance d) (Diagonal k) = let ?callStack
   return endpoint
 
 
-runGetK :: HasCallStack => EditGraph a b -> Diagonal -> Myers a b (Endpoint, EditScript a b)
+runGetK :: HasCallStack => EditGraph a b -> Diagonal -> Myers a b (Endpoint a b, EditScript a b)
 runGetK graph k = let ?callStack = popCallStack callStack in do
   (i, v) <- checkK graph k
   let (x, script) = v ! i in return (Endpoint x (x - unDiagonal k), script)
@@ -172,7 +172,7 @@ runSetK graph k x script = let ?callStack = popCallStack callStack in do
   (i, v) <- checkK graph k
   put (MyersState (v Array.// [(i, (x, script))]))
 
-runSlide :: HasCallStack => (a -> b -> Bool) -> EditGraph a b -> Endpoint -> EditScript a b -> Myers a b (Endpoint, EditScript a b)
+runSlide :: HasCallStack => (a -> b -> Bool) -> EditGraph a b -> Endpoint a b -> EditScript a b -> Myers a b (Endpoint a b, EditScript a b)
 runSlide eq (EditGraph as bs) (Endpoint x y) script
   | x >= 0, x < length as
   , y >= 0, y < length bs
@@ -196,16 +196,16 @@ searchUpToD distance = M (SearchUpToD distance) `Then` return
 searchAlongK :: HasCallStack => Distance -> Diagonal -> Myers a b (Maybe (EditScript a b, Distance))
 searchAlongK d k = M (SearchAlongK d k) `Then` return
 
-moveFromAdjacent :: HasCallStack => Distance -> Diagonal -> Myers a b Endpoint
+moveFromAdjacent :: HasCallStack => Distance -> Diagonal -> Myers a b (Endpoint a b)
 moveFromAdjacent d k = M (MoveFromAdjacent d k) `Then` return
 
-getK :: HasCallStack => Diagonal -> Myers a b (Endpoint, EditScript a b)
+getK :: HasCallStack => Diagonal -> Myers a b (Endpoint a b, EditScript a b)
 getK diagonal = M (GetK diagonal) `Then` return
 
 setK :: HasCallStack => Diagonal -> Int -> EditScript a b -> Myers a b ()
 setK diagonal x script = M (SetK diagonal x script) `Then` return
 
-slide :: HasCallStack => Endpoint -> EditScript a b -> Myers a b (Endpoint, EditScript a b)
+slide :: HasCallStack => Endpoint a b -> EditScript a b -> Myers a b (Endpoint a b, EditScript a b)
 slide from script = M (Slide from script) `Then` return
 
 

From 19c559ab749d635f144d1a43d72c38731d2618b7 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 23 Mar 2017 14:31:50 -0400
Subject: [PATCH 273/294] Endpoints carry edit scripts.

---
 src/SES/Myers.hs | 63 ++++++++++++++++++++++++++----------------------
 1 file changed, 34 insertions(+), 29 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 5280555d8..0e5a84324 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -21,10 +21,10 @@ data MyersF a b result where
   SearchAlongK :: Distance -> Diagonal -> MyersF a b (Maybe (EditScript a b, Distance))
   MoveFromAdjacent :: Distance -> Diagonal -> MyersF a b (Endpoint a b)
 
-  GetK :: Diagonal -> MyersF a b (Endpoint a b, EditScript a b)
+  GetK :: Diagonal -> MyersF a b (Endpoint a b)
   SetK :: Diagonal -> Int -> EditScript a b -> MyersF a b ()
 
-  Slide :: Endpoint a b -> EditScript a b -> MyersF a b (Endpoint a b, EditScript a b)
+  Slide :: Endpoint a b -> MyersF a b (Endpoint a b)
 
 type EditScript a b = [These a b]
 
@@ -50,7 +50,7 @@ newtype Distance = Distance { unDistance :: Int }
 newtype Diagonal = Diagonal { unDiagonal :: Int }
   deriving (Eq, Show)
 
-data Endpoint a b = Endpoint { x :: !Int, y :: !Int }
+data Endpoint a b = Endpoint { x :: !Int, y :: !Int, script :: !(EditScript a b) }
   deriving (Eq, Show)
 
 
@@ -100,7 +100,7 @@ decompose eq graph myers = let ?callStack = popCallStack callStack in case myers
   GetK k -> runGetK graph k
   SetK k x script -> runSetK graph k x script
 
-  Slide from script -> runSlide eq graph from script
+  Slide from -> runSlide eq graph from
 {-# INLINE decompose #-}
 
 
@@ -132,9 +132,8 @@ runSearchUpToD (EditGraph as bs) (Distance d) = let ?callStack = popCallStack ca
 
 runSearchAlongK :: HasCallStack => EditGraph a b -> Distance -> Diagonal -> Myers a b (Maybe (EditScript a b, Distance))
 runSearchAlongK (EditGraph as bs) d k = let ?callStack = popCallStack callStack in do
-  Endpoint x y <- moveFromAdjacent d k
-  if x >= length as && y >= length bs then do
-    (_, script) <- getK k
+  Endpoint x y script <- moveFromAdjacent d k
+  if x >= length as && y >= length bs then
     return (Just (script, d))
   else
     continue
@@ -142,44 +141,44 @@ runSearchAlongK (EditGraph as bs) d k = let ?callStack = popCallStack callStack
 runMoveFromAdjacent :: HasCallStack => EditGraph a b -> Distance -> Diagonal -> Myers a b (Endpoint a b)
 runMoveFromAdjacent (EditGraph as bs) (Distance d) (Diagonal k) = let ?callStack = popCallStack callStack in do
   let (n, m) = (length as, length bs)
-  (from, fromScript) <- if d == 0 || k < negate m || k > n then
-    return (Endpoint 0 0, [])
+  from <- if d == 0 || k < negate m || k > n then
+    return (Endpoint 0 0 [])
   else if k == negate d || k == negate m then do
-    (Endpoint nextX nextY, nextScript) <- getK (Diagonal (succ k))
-    return (Endpoint nextX (succ nextY), if nextY < m then That (bs ! nextY) : nextScript else nextScript) -- downward (insertion)
+    (Endpoint nextX nextY nextScript) <- getK (Diagonal (succ k))
+    return (Endpoint nextX (succ nextY) (if nextY < m then That (bs ! nextY) : nextScript else nextScript)) -- downward (insertion)
   else if k /= d && k /= n then do
-    (Endpoint prevX prevY, prevScript) <- getK (Diagonal (pred k))
-    (Endpoint nextX nextY, nextScript) <- getK (Diagonal (succ k))
+    (Endpoint prevX prevY prevScript) <- getK (Diagonal (pred k))
+    (Endpoint nextX nextY nextScript) <- getK (Diagonal (succ k))
     return $ if prevX < nextX then
-      (Endpoint nextX (succ nextY), if nextY < m then That (bs ! nextY) : nextScript else nextScript) -- downward (insertion)
+      (Endpoint nextX (succ nextY) (if nextY < m then That (bs ! nextY) : nextScript else nextScript)) -- downward (insertion)
     else
-      (Endpoint (succ prevX) prevY, if prevX < n then This (as ! prevX) : prevScript else prevScript) -- rightward (deletion)
+      (Endpoint (succ prevX) prevY (if prevX < n then This (as ! prevX) : prevScript else prevScript)) -- rightward (deletion)
   else do
-    (Endpoint prevX prevY, prevScript) <- getK (Diagonal (pred k))
-    return (Endpoint (succ prevX) prevY, if prevX < n then This (as ! prevX) : prevScript else prevScript) -- rightward (deletion)
-  (endpoint, script) <- slide from fromScript
-  setK (Diagonal k) (x endpoint) script
+    (Endpoint prevX prevY prevScript) <- getK (Diagonal (pred k))
+    return (Endpoint (succ prevX) prevY (if prevX < n then This (as ! prevX) : prevScript else prevScript)) -- rightward (deletion)
+  endpoint <- slide from
+  setK (Diagonal k) (x endpoint) (script endpoint)
   return endpoint
 
 
-runGetK :: HasCallStack => EditGraph a b -> Diagonal -> Myers a b (Endpoint a b, EditScript a b)
+runGetK :: HasCallStack => EditGraph a b -> Diagonal -> Myers a b (Endpoint a b)
 runGetK graph k = let ?callStack = popCallStack callStack in do
   (i, v) <- checkK graph k
-  let (x, script) = v ! i in return (Endpoint x (x - unDiagonal k), script)
+  let (x, script) = v ! i in return (Endpoint x (x - unDiagonal k) script)
 
 runSetK :: HasCallStack => EditGraph a b -> Diagonal -> Int -> EditScript a b -> Myers a b ()
 runSetK graph k x script = let ?callStack = popCallStack callStack in do
   (i, v) <- checkK graph k
   put (MyersState (v Array.// [(i, (x, script))]))
 
-runSlide :: HasCallStack => (a -> b -> Bool) -> EditGraph a b -> Endpoint a b -> EditScript a b -> Myers a b (Endpoint a b, EditScript a b)
-runSlide eq (EditGraph as bs) (Endpoint x y) script
+runSlide :: HasCallStack => (a -> b -> Bool) -> EditGraph a b -> Endpoint a b -> Myers a b (Endpoint a b)
+runSlide eq (EditGraph as bs) (Endpoint x y script)
   | x >= 0, x < length as
   , y >= 0, y < length bs
   , a <- as ! x
   , b <- bs ! y
-  , a `eq` b  = slide  (Endpoint (succ x) (succ y)) (These a b : script)
-  | otherwise = return (Endpoint       x        y,   script)
+  , a `eq` b  = slide  (Endpoint (succ x) (succ y) (These a b : script))
+  | otherwise = return (Endpoint       x        y               script)
 
 
 -- Smart constructors
@@ -199,14 +198,14 @@ searchAlongK d k = M (SearchAlongK d k) `Then` return
 moveFromAdjacent :: HasCallStack => Distance -> Diagonal -> Myers a b (Endpoint a b)
 moveFromAdjacent d k = M (MoveFromAdjacent d k) `Then` return
 
-getK :: HasCallStack => Diagonal -> Myers a b (Endpoint a b, EditScript a b)
+getK :: HasCallStack => Diagonal -> Myers a b (Endpoint a b)
 getK diagonal = M (GetK diagonal) `Then` return
 
 setK :: HasCallStack => Diagonal -> Int -> EditScript a b -> Myers a b ()
 setK diagonal x script = M (SetK diagonal x script) `Then` return
 
-slide :: HasCallStack => Endpoint a b -> EditScript a b -> Myers a b (Endpoint a b, EditScript a b)
-slide from script = M (Slide from script) `Then` return
+slide :: HasCallStack => Endpoint a b -> Myers a b (Endpoint a b)
+slide from = M (Slide from) `Then` return
 
 
 -- Implementation details
@@ -262,7 +261,7 @@ liftShowsMyersF sp1 sp2 d m = case m of
   MoveFromAdjacent distance diagonal -> showsBinaryWith showsPrec showsPrec "MoveFromAdjacent" d distance diagonal
   GetK diagonal -> showsUnaryWith showsPrec "GetK" d diagonal
   SetK diagonal v script -> showsTernaryWith showsPrec showsPrec (liftShowsEditScript sp1 sp2) "SetK" d diagonal v script
-  Slide endpoint script -> showsBinaryWith showsPrec (liftShowsEditScript sp1 sp2) "Slide" d endpoint script
+  Slide endpoint -> showsUnaryWith (liftShowsEndpoint sp1 sp2) "Slide" d endpoint
 
 showsTernaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> (Int -> c -> ShowS) -> String -> Int -> a -> b -> c -> ShowS
 showsTernaryWith sp1 sp2 sp3 name d x y z = showParen (d > 10) $
@@ -295,6 +294,9 @@ liftShowsThese sa sb d t = case t of
 liftShowsEditScript :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> Int -> EditScript a b -> ShowS
 liftShowsEditScript sa sb _ = showListWith (liftShowsThese sa sb 0)
 
+liftShowsEndpoint :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> Int -> Endpoint a b -> ShowS
+liftShowsEndpoint sp1 sp2 d (Endpoint x y script) = showsTernaryWith showsPrec showsPrec (liftShowsEditScript sp1 sp2) "Endpoint" d x y script
+
 data MyersException = MyersException String CallStack
   deriving (Typeable)
 
@@ -319,6 +321,9 @@ instance Show s => Show (State s a) where
 instance Show2 EditGraph where
   liftShowsPrec2 sp1 sl1 sp2 sl2 d (EditGraph as bs) = showsBinaryWith (liftShowsVector sp1 sl1) (liftShowsVector sp2 sl2) "EditGraph" d as bs
 
+instance Show2 Endpoint where
+  liftShowsPrec2 sp1 _ sp2 _ = liftShowsEndpoint sp1 sp2
+
 instance (Show a, Show b) => Show1 (MyersF a b) where
   liftShowsPrec _ _ = liftShowsMyersF showsPrec showsPrec
 

From 2567d185c8e5e56c8b828f28d3821426067c4e90 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 23 Mar 2017 14:34:04 -0400
Subject: [PATCH 274/294] Placate hlint.

---
 src/SES/Myers.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 0e5a84324..4b273883d 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -150,9 +150,9 @@ runMoveFromAdjacent (EditGraph as bs) (Distance d) (Diagonal k) = let ?callStack
     (Endpoint prevX prevY prevScript) <- getK (Diagonal (pred k))
     (Endpoint nextX nextY nextScript) <- getK (Diagonal (succ k))
     return $ if prevX < nextX then
-      (Endpoint nextX (succ nextY) (if nextY < m then That (bs ! nextY) : nextScript else nextScript)) -- downward (insertion)
+      Endpoint nextX (succ nextY) (if nextY < m then That (bs ! nextY) : nextScript else nextScript) -- downward (insertion)
     else
-      (Endpoint (succ prevX) prevY (if prevX < n then This (as ! prevX) : prevScript else prevScript)) -- rightward (deletion)
+      Endpoint (succ prevX) prevY (if prevX < n then This (as ! prevX) : prevScript else prevScript) -- rightward (deletion)
   else do
     (Endpoint prevX prevY prevScript) <- getK (Diagonal (pred k))
     return (Endpoint (succ prevX) prevY (if prevX < n then This (as ! prevX) : prevScript else prevScript)) -- rightward (deletion)

From 2118ea17d10a6e35f55590c3ddadc33eb406e42d Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 23 Mar 2017 14:34:32 -0400
Subject: [PATCH 275/294] SetK takes an endpoint.

---
 src/SES/Myers.hs | 16 ++++++++--------
 1 file changed, 8 insertions(+), 8 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 4b273883d..c57206e36 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -22,7 +22,7 @@ data MyersF a b result where
   MoveFromAdjacent :: Distance -> Diagonal -> MyersF a b (Endpoint a b)
 
   GetK :: Diagonal -> MyersF a b (Endpoint a b)
-  SetK :: Diagonal -> Int -> EditScript a b -> MyersF a b ()
+  SetK :: Diagonal -> Endpoint a b -> MyersF a b ()
 
   Slide :: Endpoint a b -> MyersF a b (Endpoint a b)
 
@@ -98,7 +98,7 @@ decompose eq graph myers = let ?callStack = popCallStack callStack in case myers
   MoveFromAdjacent d k -> runMoveFromAdjacent graph d k
 
   GetK k -> runGetK graph k
-  SetK k x script -> runSetK graph k x script
+  SetK k x -> runSetK graph k x
 
   Slide from -> runSlide eq graph from
 {-# INLINE decompose #-}
@@ -157,7 +157,7 @@ runMoveFromAdjacent (EditGraph as bs) (Distance d) (Diagonal k) = let ?callStack
     (Endpoint prevX prevY prevScript) <- getK (Diagonal (pred k))
     return (Endpoint (succ prevX) prevY (if prevX < n then This (as ! prevX) : prevScript else prevScript)) -- rightward (deletion)
   endpoint <- slide from
-  setK (Diagonal k) (x endpoint) (script endpoint)
+  setK (Diagonal k) endpoint
   return endpoint
 
 
@@ -166,8 +166,8 @@ runGetK graph k = let ?callStack = popCallStack callStack in do
   (i, v) <- checkK graph k
   let (x, script) = v ! i in return (Endpoint x (x - unDiagonal k) script)
 
-runSetK :: HasCallStack => EditGraph a b -> Diagonal -> Int -> EditScript a b -> Myers a b ()
-runSetK graph k x script = let ?callStack = popCallStack callStack in do
+runSetK :: HasCallStack => EditGraph a b -> Diagonal -> Endpoint a b -> Myers a b ()
+runSetK graph k (Endpoint x _ script) = let ?callStack = popCallStack callStack in do
   (i, v) <- checkK graph k
   put (MyersState (v Array.// [(i, (x, script))]))
 
@@ -201,8 +201,8 @@ moveFromAdjacent d k = M (MoveFromAdjacent d k) `Then` return
 getK :: HasCallStack => Diagonal -> Myers a b (Endpoint a b)
 getK diagonal = M (GetK diagonal) `Then` return
 
-setK :: HasCallStack => Diagonal -> Int -> EditScript a b -> Myers a b ()
-setK diagonal x script = M (SetK diagonal x script) `Then` return
+setK :: HasCallStack => Diagonal -> Endpoint a b -> Myers a b ()
+setK diagonal x = M (SetK diagonal x) `Then` return
 
 slide :: HasCallStack => Endpoint a b -> Myers a b (Endpoint a b)
 slide from = M (Slide from) `Then` return
@@ -260,7 +260,7 @@ liftShowsMyersF sp1 sp2 d m = case m of
   SearchAlongK distance diagonal -> showsBinaryWith showsPrec showsPrec "SearchAlongK" d distance diagonal
   MoveFromAdjacent distance diagonal -> showsBinaryWith showsPrec showsPrec "MoveFromAdjacent" d distance diagonal
   GetK diagonal -> showsUnaryWith showsPrec "GetK" d diagonal
-  SetK diagonal v script -> showsTernaryWith showsPrec showsPrec (liftShowsEditScript sp1 sp2) "SetK" d diagonal v script
+  SetK diagonal v -> showsBinaryWith showsPrec (liftShowsEndpoint sp1 sp2) "SetK" d diagonal v
   Slide endpoint -> showsUnaryWith (liftShowsEndpoint sp1 sp2) "Slide" d endpoint
 
 showsTernaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> (Int -> c -> ShowS) -> String -> Int -> a -> b -> c -> ShowS

From 8a5d2f1fa70132ce12ee64ba07e1aef51632a349 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 23 Mar 2017 14:51:45 -0400
Subject: [PATCH 276/294] Represent downward/rightward moves explicitly in the
 DSL.

---
 src/SES/Myers.hs | 37 ++++++++++++++++++++++++++-----------
 1 file changed, 26 insertions(+), 11 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index c57206e36..17842ade2 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -20,6 +20,8 @@ data MyersF a b result where
   SearchUpToD :: Distance -> MyersF a b (Maybe (EditScript a b, Distance))
   SearchAlongK :: Distance -> Diagonal -> MyersF a b (Maybe (EditScript a b, Distance))
   MoveFromAdjacent :: Distance -> Diagonal -> MyersF a b (Endpoint a b)
+  MoveDownFrom :: Endpoint a b -> MyersF a b (Endpoint a b)
+  MoveRightFrom :: Endpoint a b -> MyersF a b (Endpoint a b)
 
   GetK :: Diagonal -> MyersF a b (Endpoint a b)
   SetK :: Diagonal -> Endpoint a b -> MyersF a b ()
@@ -96,6 +98,8 @@ decompose eq graph myers = let ?callStack = popCallStack callStack in case myers
   SearchUpToD d -> runSearchUpToD graph d
   SearchAlongK d k -> runSearchAlongK graph d k
   MoveFromAdjacent d k -> runMoveFromAdjacent graph d k
+  MoveDownFrom e -> runMoveDownFrom graph e
+  MoveRightFrom e -> runMoveRightFrom graph e
 
   GetK k -> runGetK graph k
   SetK k x -> runSetK graph k x
@@ -143,23 +147,26 @@ runMoveFromAdjacent (EditGraph as bs) (Distance d) (Diagonal k) = let ?callStack
   let (n, m) = (length as, length bs)
   from <- if d == 0 || k < negate m || k > n then
     return (Endpoint 0 0 [])
-  else if k == negate d || k == negate m then do
-    (Endpoint nextX nextY nextScript) <- getK (Diagonal (succ k))
-    return (Endpoint nextX (succ nextY) (if nextY < m then That (bs ! nextY) : nextScript else nextScript)) -- downward (insertion)
+  else if k == negate d || k == negate m then
+    getK (Diagonal (succ k)) >>= moveDownFrom
   else if k /= d && k /= n then do
-    (Endpoint prevX prevY prevScript) <- getK (Diagonal (pred k))
-    (Endpoint nextX nextY nextScript) <- getK (Diagonal (succ k))
-    return $ if prevX < nextX then
-      Endpoint nextX (succ nextY) (if nextY < m then That (bs ! nextY) : nextScript else nextScript) -- downward (insertion)
+    prev <- getK (Diagonal (pred k))
+    next <- getK (Diagonal (succ k))
+    if x prev < x next then
+      moveDownFrom next
     else
-      Endpoint (succ prevX) prevY (if prevX < n then This (as ! prevX) : prevScript else prevScript) -- rightward (deletion)
-  else do
-    (Endpoint prevX prevY prevScript) <- getK (Diagonal (pred k))
-    return (Endpoint (succ prevX) prevY (if prevX < n then This (as ! prevX) : prevScript else prevScript)) -- rightward (deletion)
+      moveRightFrom prev
+  else
+    getK (Diagonal (pred k)) >>= moveRightFrom
   endpoint <- slide from
   setK (Diagonal k) endpoint
   return endpoint
 
+runMoveDownFrom :: HasCallStack => EditGraph a b -> Endpoint a b -> Myers a b (Endpoint a b)
+runMoveDownFrom (EditGraph _ bs) (Endpoint x y script) = return (Endpoint x (succ y) (if y < length bs then That (bs ! y) : script else script))
+
+runMoveRightFrom :: HasCallStack => EditGraph a b -> Endpoint a b -> Myers a b (Endpoint a b)
+runMoveRightFrom (EditGraph as _) (Endpoint x y script) = return (Endpoint (succ x) y (if x < length as then This (as ! x) : script else script))
 
 runGetK :: HasCallStack => EditGraph a b -> Diagonal -> Myers a b (Endpoint a b)
 runGetK graph k = let ?callStack = popCallStack callStack in do
@@ -198,6 +205,12 @@ searchAlongK d k = M (SearchAlongK d k) `Then` return
 moveFromAdjacent :: HasCallStack => Distance -> Diagonal -> Myers a b (Endpoint a b)
 moveFromAdjacent d k = M (MoveFromAdjacent d k) `Then` return
 
+moveDownFrom :: HasCallStack => Endpoint a b -> Myers a b (Endpoint a b)
+moveDownFrom e = M (MoveDownFrom e) `Then` return
+
+moveRightFrom :: HasCallStack => Endpoint a b -> Myers a b (Endpoint a b)
+moveRightFrom e = M (MoveRightFrom e) `Then` return
+
 getK :: HasCallStack => Diagonal -> Myers a b (Endpoint a b)
 getK diagonal = M (GetK diagonal) `Then` return
 
@@ -259,6 +272,8 @@ liftShowsMyersF sp1 sp2 d m = case m of
   SearchUpToD distance -> showsUnaryWith showsPrec "SearchUpToD" d distance
   SearchAlongK distance diagonal -> showsBinaryWith showsPrec showsPrec "SearchAlongK" d distance diagonal
   MoveFromAdjacent distance diagonal -> showsBinaryWith showsPrec showsPrec "MoveFromAdjacent" d distance diagonal
+  MoveDownFrom endpoint -> showsUnaryWith (liftShowsEndpoint sp1 sp2) "MoveDownFrom" d endpoint
+  MoveRightFrom endpoint -> showsUnaryWith (liftShowsEndpoint sp1 sp2) "MoveRightFrom" d endpoint
   GetK diagonal -> showsUnaryWith showsPrec "GetK" d diagonal
   SetK diagonal v -> showsBinaryWith showsPrec (liftShowsEndpoint sp1 sp2) "SetK" d diagonal v
   Slide endpoint -> showsUnaryWith (liftShowsEndpoint sp1 sp2) "Slide" d endpoint

From af04668fc504722cf926e6319dfff6ebfce418a5 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 23 Mar 2017 14:54:18 -0400
Subject: [PATCH 277/294] Move ses into its own section.

---
 src/SES/Myers.hs | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 17842ade2..c013abb0d 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -56,11 +56,14 @@ data Endpoint a b = Endpoint { x :: !Int, y :: !Int, script :: !(EditScript a b)
   deriving (Eq, Show)
 
 
--- Evaluation
+-- API
 
 ses :: (HasCallStack, Foldable t, Foldable u) => (a -> b -> Bool) -> t a -> u b -> EditScript a b
 ses eq as bs = runMyers eq (makeEditGraph as bs) (M SES `Then` return)
 
+
+-- Evaluation
+
 runMyers :: forall a b c. HasCallStack => (a -> b -> Bool) -> EditGraph a b ->Myers a b c -> c
 runMyers eq graph step = evalState (go step) (emptyStateForGraph graph)
   where go :: forall c. Myers a b c -> StateT (MyersState a b) Identity c

From 70b825ecbb09fb3054f96f43ecaac5c17113ed51 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 23 Mar 2017 14:55:12 -0400
Subject: [PATCH 278/294] Move State into the implementation details section.

---
 src/SES/Myers.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index c013abb0d..74560747b 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -30,10 +30,6 @@ data MyersF a b result where
 
 type EditScript a b = [These a b]
 
-data State s a where
-  Get :: State s s
-  Put :: s -> State s ()
-
 data StepF a b result where
   M :: HasCallStack => MyersF a b c -> StepF a b c
   S :: State (MyersState a b) c -> StepF a b c
@@ -229,6 +225,10 @@ slide from = M (Slide from) `Then` return
 newtype MyersState a b = MyersState { unMyersState :: Array.Array Int (Int, EditScript a b) }
   deriving (Eq, Show)
 
+data State s a where
+  Get :: State s s
+  Put :: s -> State s ()
+
 emptyStateForGraph :: EditGraph a b -> MyersState a b
 emptyStateForGraph (EditGraph as bs) = let (n, m) = (length as, length bs) in
   MyersState (Array.listArray (0, m + n) (repeat (0, [])))

From 7f13ef23a2b079f4d4add3af1d2af51de297d91e Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 23 Mar 2017 15:34:52 -0400
Subject: [PATCH 279/294] :memo: all the things.

---
 src/SES/Myers.hs | 68 +++++++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 64 insertions(+), 4 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 74560747b..31ee314ef 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -13,6 +13,7 @@ import GHC.Stack
 import Prologue hiding (for, State, error)
 import Text.Show (showListWith)
 
+-- | Operations in Myers’ algorithm.
 data MyersF a b result where
   SES :: MyersF a b (EditScript a b)
   LCS :: MyersF a b [(a, b)]
@@ -28,39 +29,48 @@ data MyersF a b result where
 
   Slide :: Endpoint a b -> MyersF a b (Endpoint a b)
 
+-- | An edit script, i.e. a sequence of changes/copies of elements.
 type EditScript a b = [These a b]
 
+-- | Steps in the execution of Myers’ algorithm, i.e. the sum of MyersF and State.
 data StepF a b result where
   M :: HasCallStack => MyersF a b c -> StepF a b c
   S :: State (MyersState a b) c -> StepF a b c
 
 type Myers a b = Freer (StepF a b)
 
+-- | Notionally the cartesian product of two sequences, represented as a simple wrapper around those arrays holding those sequences’ elements for O(1) lookups.
 data EditGraph a b = EditGraph { as :: !(Array.Array Int a), bs :: !(Array.Array Int b) }
   deriving (Eq, Show)
 
+-- | Construct an edit graph from Foldable sequences.
 makeEditGraph :: (Foldable t, Foldable u) => t a -> u b -> EditGraph a b
 makeEditGraph as bs = EditGraph (Array.listArray (0, pred (length as)) (toList as)) (Array.listArray (0, pred (length bs)) (toList bs))
 
+-- | An edit distance, i.e. a cardinal number of changes.
 newtype Distance = Distance { unDistance :: Int }
   deriving (Eq, Show)
 
+-- | A diagonal in the edit graph of lists of lengths n and m, numbered from -m to n.
 newtype Diagonal = Diagonal { unDiagonal :: Int }
   deriving (Eq, Show)
 
+-- | The endpoint of a path through the edit graph, represented as the x/y indices and the script of edits made to get to that point.
 data Endpoint a b = Endpoint { x :: !Int, y :: !Int, script :: !(EditScript a b) }
   deriving (Eq, Show)
 
 
 -- API
 
+-- | Compute the shortest edit script using Myers’ algorithm.
 ses :: (HasCallStack, Foldable t, Foldable u) => (a -> b -> Bool) -> t a -> u b -> EditScript a b
 ses eq as bs = runMyers eq (makeEditGraph as bs) (M SES `Then` return)
 
 
 -- Evaluation
 
-runMyers :: forall a b c. HasCallStack => (a -> b -> Bool) -> EditGraph a b ->Myers a b c -> c
+-- | Fully evaluate an operation in Myers’ algorithm given a comparator function and an edit graph.
+runMyers :: forall a b c. HasCallStack => (a -> b -> Bool) -> EditGraph a b -> Myers a b c -> c
 runMyers eq graph step = evalState (go step) (emptyStateForGraph graph)
   where go :: forall c. Myers a b c -> StateT (MyersState a b) Identity c
         go = iterFreerA algebra
@@ -70,7 +80,8 @@ runMyers eq graph step = evalState (go step) (emptyStateForGraph graph)
           S Get -> get >>= cont
           S (Put s) -> put s >>= cont
 
-runMyersSteps :: HasCallStack => (a -> b -> Bool) -> EditGraph a b ->Myers a b c -> [(MyersState a b, Myers a b c)]
+-- | Fully evaluate an operation in Myers’ algorithm given a comparator function and an edit graph, returning a list of states and next steps.
+runMyersSteps :: HasCallStack => (a -> b -> Bool) -> EditGraph a b -> Myers a b c -> [(MyersState a b, Myers a b c)]
 runMyersSteps eq graph = go (emptyStateForGraph graph)
   where go state step = let ?callStack = popCallStack callStack in prefix state step $ case runMyersStep eq graph state step of
           Left result -> [ (state, return result) ]
@@ -79,7 +90,8 @@ runMyersSteps eq graph = go (emptyStateForGraph graph)
           Then (M _) _ -> ((state, step) :)
           _ -> identity
 
-runMyersStep :: HasCallStack => (a -> b -> Bool) -> EditGraph a b ->MyersState a b -> Myers a b c -> Either c (MyersState a b, Myers a b c)
+-- | Evaluate one step in Myers’ algorithm given a comparator function and an edit graph, returning Either the final result, or the next state and step.
+runMyersStep :: HasCallStack => (a -> b -> Bool) -> EditGraph a b -> MyersState a b -> Myers a b c -> Either c (MyersState a b, Myers a b c)
 runMyersStep eq graph state step = let ?callStack = popCallStack callStack in case step of
   Return a -> Left a
   Then step cont -> case step of
@@ -89,7 +101,10 @@ runMyersStep eq graph state step = let ?callStack = popCallStack callStack in ca
     S (Put state') -> Right (state', cont ())
 
 
-decompose :: HasCallStack => (a -> b -> Bool) -> EditGraph a b ->MyersF a b c -> Myers a b c
+-- | Decompose an operation in Myers’ algorithm into its continuation.
+--
+--   Dispatches to the per-operation run… functions which implement the meat of the algorithm.
+decompose :: HasCallStack => (a -> b -> Bool) -> EditGraph a b -> MyersF a b c -> Myers a b c
 decompose eq graph myers = let ?callStack = popCallStack callStack in case myers of
   SES -> runSES graph
   LCS -> runLCS graph
@@ -107,6 +122,7 @@ decompose eq graph myers = let ?callStack = popCallStack callStack in case myers
 {-# INLINE decompose #-}
 
 
+-- | Compute the shortest edit script (diff) of an edit graph.
 runSES :: HasCallStack => EditGraph a b -> Myers a b (EditScript a b)
 runSES (EditGraph as bs)
   | null bs = return (This <$> toList as)
@@ -117,6 +133,7 @@ runSES (EditGraph as bs)
       Just (script, _) -> return (reverse script)
       _ -> fail "no shortest edit script found in edit graph (this is a bug in SES.Myers)."
 
+-- | Compute the longest common subsequence of an edit graph.
 runLCS :: HasCallStack => EditGraph a b -> Myers a b [(a, b)]
 runLCS (EditGraph as bs)
   | null as || null bs = return []
@@ -124,15 +141,18 @@ runLCS (EditGraph as bs)
     result <- M SES `Then` return
     return (catMaybes (these (const Nothing) (const Nothing) ((Just .) . (,)) <$> result))
 
+-- | Compute the edit distance of an edit graph.
 runEditDistance :: HasCallStack => EditGraph a b -> Myers a b Int
 runEditDistance _ = let ?callStack = popCallStack callStack in length . filter (these (const True) (const True) (const (const False))) <$> (M SES `Then` return)
 
 
+-- | Search an edit graph for the shortest edit script up to a given proposed edit distance, building on the results of previous searches.
 runSearchUpToD :: HasCallStack => EditGraph a b -> Distance -> Myers a b (Maybe (EditScript a b, Distance))
 runSearchUpToD (EditGraph as bs) (Distance d) = let ?callStack = popCallStack callStack in
   for [ k | k <- [negate d, negate d + 2 .. d], inRange (negate m, n) k ] (searchAlongK (Distance d) . Diagonal)
   where (n, m) = (length as, length bs)
 
+-- | Search an edit graph for the shortest edit script along a specific diagonal.
 runSearchAlongK :: HasCallStack => EditGraph a b -> Distance -> Diagonal -> Myers a b (Maybe (EditScript a b, Distance))
 runSearchAlongK (EditGraph as bs) d k = let ?callStack = popCallStack callStack in do
   Endpoint x y script <- moveFromAdjacent d k
@@ -141,14 +161,18 @@ runSearchAlongK (EditGraph as bs) d k = let ?callStack = popCallStack callStack
   else
     continue
 
+-- | Move onto a given diagonal from one of its in-bounds adjacent diagonals (if any), and slide down any diagonal edges eagerly.
 runMoveFromAdjacent :: HasCallStack => EditGraph a b -> Distance -> Diagonal -> Myers a b (Endpoint a b)
 runMoveFromAdjacent (EditGraph as bs) (Distance d) (Diagonal k) = let ?callStack = popCallStack callStack in do
   let (n, m) = (length as, length bs)
   from <- if d == 0 || k < negate m || k > n then
+    -- The top-left corner, or otherwise out-of-bounds.
     return (Endpoint 0 0 [])
   else if k == negate d || k == negate m then
+    -- The lower/left extent of the search region or edit graph, whichever is smaller.
     getK (Diagonal (succ k)) >>= moveDownFrom
   else if k /= d && k /= n then do
+    -- Somewhere in the interior of the search region and edit graph.
     prev <- getK (Diagonal (pred k))
     next <- getK (Diagonal (succ k))
     if x prev < x next then
@@ -156,27 +180,33 @@ runMoveFromAdjacent (EditGraph as bs) (Distance d) (Diagonal k) = let ?callStack
     else
       moveRightFrom prev
   else
+    -- The upper/right extent of the search region or edit graph, whichever is smaller.
     getK (Diagonal (pred k)) >>= moveRightFrom
   endpoint <- slide from
   setK (Diagonal k) endpoint
   return endpoint
 
+-- | Move downward from a given vertex, inserting the element for the corresponding row.
 runMoveDownFrom :: HasCallStack => EditGraph a b -> Endpoint a b -> Myers a b (Endpoint a b)
 runMoveDownFrom (EditGraph _ bs) (Endpoint x y script) = return (Endpoint x (succ y) (if y < length bs then That (bs ! y) : script else script))
 
+-- | Move rightward from a given vertex, deleting the element for the corresponding column.
 runMoveRightFrom :: HasCallStack => EditGraph a b -> Endpoint a b -> Myers a b (Endpoint a b)
 runMoveRightFrom (EditGraph as _) (Endpoint x y script) = return (Endpoint (succ x) y (if x < length as then This (as ! x) : script else script))
 
+-- | Return the maximum extent reached and path taken along a given diagonal.
 runGetK :: HasCallStack => EditGraph a b -> Diagonal -> Myers a b (Endpoint a b)
 runGetK graph k = let ?callStack = popCallStack callStack in do
   (i, v) <- checkK graph k
   let (x, script) = v ! i in return (Endpoint x (x - unDiagonal k) script)
 
+-- | Update the maximum extent reached and path taken along a given diagonal.
 runSetK :: HasCallStack => EditGraph a b -> Diagonal -> Endpoint a b -> Myers a b ()
 runSetK graph k (Endpoint x _ script) = let ?callStack = popCallStack callStack in do
   (i, v) <- checkK graph k
   put (MyersState (v Array.// [(i, (x, script))]))
 
+-- | Slide down any diagonal edges from a given vertex.
 runSlide :: HasCallStack => (a -> b -> Bool) -> EditGraph a b -> Endpoint a b -> Myers a b (Endpoint a b)
 runSlide eq (EditGraph as bs) (Endpoint x y script)
   | x >= 0, x < length as
@@ -189,69 +219,88 @@ runSlide eq (EditGraph as bs) (Endpoint x y script)
 
 -- Smart constructors
 
+-- | Compute the longest common subsequence.
 lcs :: HasCallStack => Myers a b [(a, b)]
 lcs = M LCS `Then` return
 
+-- | Compute the edit distance.
 editDistance :: HasCallStack => Myers a b Int
 editDistance = M EditDistance `Then` return
 
+-- | Search an edit graph for the shortest edit script up to a given proposed edit distance, building on the results of previous searches.
 searchUpToD :: HasCallStack => Distance -> Myers a b (Maybe (EditScript a b, Distance))
 searchUpToD distance = M (SearchUpToD distance) `Then` return
 
+-- | Search an edit graph for the shortest edit script along a specific diagonal.
 searchAlongK :: HasCallStack => Distance -> Diagonal -> Myers a b (Maybe (EditScript a b, Distance))
 searchAlongK d k = M (SearchAlongK d k) `Then` return
 
+-- | Move onto a given diagonal from one of its in-bounds adjacent diagonals (if any), and slide down any diagonal edges eagerly.
 moveFromAdjacent :: HasCallStack => Distance -> Diagonal -> Myers a b (Endpoint a b)
 moveFromAdjacent d k = M (MoveFromAdjacent d k) `Then` return
 
+-- | Move downward from a given vertex, inserting the element for the corresponding row.
 moveDownFrom :: HasCallStack => Endpoint a b -> Myers a b (Endpoint a b)
 moveDownFrom e = M (MoveDownFrom e) `Then` return
 
+-- | Move rightward from a given vertex, deleting the element for the corresponding column.
 moveRightFrom :: HasCallStack => Endpoint a b -> Myers a b (Endpoint a b)
 moveRightFrom e = M (MoveRightFrom e) `Then` return
 
+-- | Return the maximum extent reached and path taken along a given diagonal.
 getK :: HasCallStack => Diagonal -> Myers a b (Endpoint a b)
 getK diagonal = M (GetK diagonal) `Then` return
 
+-- | Update the maximum extent reached and path taken along a given diagonal.
 setK :: HasCallStack => Diagonal -> Endpoint a b -> Myers a b ()
 setK diagonal x = M (SetK diagonal x) `Then` return
 
+-- | Slide down any diagonal edges from a given vertex.
 slide :: HasCallStack => Endpoint a b -> Myers a b (Endpoint a b)
 slide from = M (Slide from) `Then` return
 
 
 -- Implementation details
 
+-- | The state stored by Myers’ algorithm; an array of m + n + 1 values indicating the maximum x-index reached and path taken along each diagonal.
 newtype MyersState a b = MyersState { unMyersState :: Array.Array Int (Int, EditScript a b) }
   deriving (Eq, Show)
 
+-- | State effect used in Myers.
 data State s a where
   Get :: State s s
   Put :: s -> State s ()
 
+-- | Compute the empty state of length m + n + 1 for a given edit graph.
 emptyStateForGraph :: EditGraph a b -> MyersState a b
 emptyStateForGraph (EditGraph as bs) = let (n, m) = (length as, length bs) in
   MyersState (Array.listArray (0, m + n) (repeat (0, [])))
 
+-- | Evaluate some function for each value in a list until one returns a value or the list is exhausted.
 for :: [a] -> (a -> Myers c d (Maybe b)) -> Myers c d (Maybe b)
 for all run = foldr (\ a b -> (<|>) <$> run a <*> b) (return Nothing) all
 
+-- | Continue evaluation of a for loop without returning a value. To exit the loop without continuing, return a value in 'Just' instead.
 continue :: Myers b c (Maybe a)
 continue = return Nothing
 
+-- | Compute the actual index into the state array from a (possibly negative) diagonal number.
 index :: Array.Array Int a -> Int -> Int
 index v k = if k >= 0 then k else length v + k
 
 
+-- | Throw a failure. Used to indicate an error in the implementation of Myers’ algorithm.
 fail :: (HasCallStack, Monad m) => String -> m a
 fail s = let ?callStack = fromCallSiteList (filter ((/= "M") . fst) (getCallStack callStack)) in
   throw (MyersException s callStack)
 
+-- | Bounds-checked indexing of arrays, preserving the call stack.
 (!) :: HasCallStack => Array.Array Int a -> Int -> a
 v ! i | i < length v = v Array.! i
       | otherwise = let ?callStack = fromCallSiteList (filter ((/= "M") . fst) (getCallStack callStack)) in
           throw (MyersException ("index " <> show i <> " out of bounds") callStack)
 
+-- | Check that a given diagonal is in-bounds for the edit graph, returning the actual index to use and the state array.
 checkK :: HasCallStack => EditGraph a b -> Diagonal -> Myers a b (Int, Array.Array Int (Int, EditScript a b))
 checkK (EditGraph as bs) (Diagonal k) = let ?callStack = popCallStack callStack in do
   v <- gets unMyersState
@@ -264,9 +313,11 @@ checkK (EditGraph as bs) (Diagonal k) = let ?callStack = popCallStack callStack
   return (i, v)
 
 
+-- | Lifted showing of arrays.
 liftShowsVector :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Array.Array Int a -> ShowS
 liftShowsVector sp sl d = liftShowsPrec sp sl d . toList
 
+-- | Lifted showing of operations in Myers’ algorithm.
 liftShowsMyersF :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> Int -> MyersF a b c -> ShowS
 liftShowsMyersF sp1 sp2 d m = case m of
   SES -> showString "SES"
@@ -281,40 +332,49 @@ liftShowsMyersF sp1 sp2 d m = case m of
   SetK diagonal v -> showsBinaryWith showsPrec (liftShowsEndpoint sp1 sp2) "SetK" d diagonal v
   Slide endpoint -> showsUnaryWith (liftShowsEndpoint sp1 sp2) "Slide" d endpoint
 
+-- | Lifted showing of ternary constructors.
 showsTernaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> (Int -> c -> ShowS) -> String -> Int -> a -> b -> c -> ShowS
 showsTernaryWith sp1 sp2 sp3 name d x y z = showParen (d > 10) $
   showString name . showChar ' ' . sp1 11 x . showChar ' ' . sp2 11 y . showChar ' ' . sp3 11 z
 
+-- | Lifted showing of quaternary constructors.
 showsQuaternaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> (Int -> c -> ShowS) -> (Int -> d -> ShowS) -> String -> Int -> a -> b -> c -> d -> ShowS
 showsQuaternaryWith sp1 sp2 sp3 sp4 name d x y z w = showParen (d > 10) $
   showString name . showChar ' ' . sp1 11 x . showChar ' ' . sp2 11 y . showChar ' ' . sp3 11 z . showChar ' ' . sp4 11 w
 
+-- | Lifted showing of quinary constructors.
 showsQuinaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> (Int -> c -> ShowS) -> (Int -> d -> ShowS) -> (Int -> e -> ShowS) -> String -> Int -> a -> b -> c -> d -> e -> ShowS
 showsQuinaryWith sp1 sp2 sp3 sp4 sp5 name d x y z w v = showParen (d > 10) $
   showString name . showChar ' ' . sp1 11 x . showChar ' ' . sp2 11 y . showChar ' ' . sp3 11 z . showChar ' ' . sp4 11 w . showChar ' ' . sp5 11 v
 
+-- | Lifted showing of State.
 liftShowsState :: (Int -> a -> ShowS) -> Int -> State a b -> ShowS
 liftShowsState sp d state = case state of
   Get -> showString "Get"
   Put s -> showsUnaryWith sp "Put" d s
 
+-- | Lift value/list showing functions into a showing function for steps in Myers’ algorithm.
 liftShowsStepF :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> (Int -> b -> ShowS) -> ([b] -> ShowS) -> Int -> StepF a b c -> ShowS
 liftShowsStepF sp1 sl1 sp2 sl2 d step = case step of
   M m -> showsUnaryWith (liftShowsMyersF sp1 sp2) "M" d m
   S s -> showsUnaryWith (liftShowsState (liftShowsPrec2 sp1 sl1 sp2 sl2)) "S" d s
 
+-- | Lifted showing of These.
 liftShowsThese :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> Int -> These a b -> ShowS
 liftShowsThese sa sb d t = case t of
   This a -> showsUnaryWith sa "This" d a
   That b -> showsUnaryWith sb "That" d b
   These a b -> showsBinaryWith sa sb "These" d a b
 
+-- | Lifted showing of edit scripts.
 liftShowsEditScript :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> Int -> EditScript a b -> ShowS
 liftShowsEditScript sa sb _ = showListWith (liftShowsThese sa sb 0)
 
+-- | Lifted showing of edit graph endpoints.
 liftShowsEndpoint :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> Int -> Endpoint a b -> ShowS
 liftShowsEndpoint sp1 sp2 d (Endpoint x y script) = showsTernaryWith showsPrec showsPrec (liftShowsEditScript sp1 sp2) "Endpoint" d x y script
 
+-- | Exceptions in Myers’ algorithm, along with a description and call stack.
 data MyersException = MyersException String CallStack
   deriving (Typeable)
 

From 5f9899f6fc705eec07a4f0d9deafd4837b293731 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 23 Mar 2017 15:35:11 -0400
Subject: [PATCH 280/294] :fire: liftShowsQuaternary & liftShowsQuinary.

---
 src/SES/Myers.hs | 10 ----------
 1 file changed, 10 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 31ee314ef..c9b5f2828 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -337,16 +337,6 @@ showsTernaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> (Int -> c -> S
 showsTernaryWith sp1 sp2 sp3 name d x y z = showParen (d > 10) $
   showString name . showChar ' ' . sp1 11 x . showChar ' ' . sp2 11 y . showChar ' ' . sp3 11 z
 
--- | Lifted showing of quaternary constructors.
-showsQuaternaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> (Int -> c -> ShowS) -> (Int -> d -> ShowS) -> String -> Int -> a -> b -> c -> d -> ShowS
-showsQuaternaryWith sp1 sp2 sp3 sp4 name d x y z w = showParen (d > 10) $
-  showString name . showChar ' ' . sp1 11 x . showChar ' ' . sp2 11 y . showChar ' ' . sp3 11 z . showChar ' ' . sp4 11 w
-
--- | Lifted showing of quinary constructors.
-showsQuinaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> (Int -> c -> ShowS) -> (Int -> d -> ShowS) -> (Int -> e -> ShowS) -> String -> Int -> a -> b -> c -> d -> e -> ShowS
-showsQuinaryWith sp1 sp2 sp3 sp4 sp5 name d x y z w v = showParen (d > 10) $
-  showString name . showChar ' ' . sp1 11 x . showChar ' ' . sp2 11 y . showChar ' ' . sp3 11 z . showChar ' ' . sp4 11 w . showChar ' ' . sp5 11 v
-
 -- | Lifted showing of State.
 liftShowsState :: (Int -> a -> ShowS) -> Int -> State a b -> ShowS
 liftShowsState sp d state = case state of

From 2b01729a6f9b47b69e122870661fae7aba15293e Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 23 Mar 2017 15:38:10 -0400
Subject: [PATCH 281/294] Rename StepF to Step.

---
 src/SES/Myers.hs | 22 +++++++++++-----------
 1 file changed, 11 insertions(+), 11 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index c9b5f2828..eb8911719 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -33,11 +33,11 @@ data MyersF a b result where
 type EditScript a b = [These a b]
 
 -- | Steps in the execution of Myers’ algorithm, i.e. the sum of MyersF and State.
-data StepF a b result where
-  M :: HasCallStack => MyersF a b c -> StepF a b c
-  S :: State (MyersState a b) c -> StepF a b c
+data Step a b result where
+  M :: HasCallStack => MyersF a b c -> Step a b c
+  S :: State (MyersState a b) c -> Step a b c
 
-type Myers a b = Freer (StepF a b)
+type Myers a b = Freer (Step a b)
 
 -- | Notionally the cartesian product of two sequences, represented as a simple wrapper around those arrays holding those sequences’ elements for O(1) lookups.
 data EditGraph a b = EditGraph { as :: !(Array.Array Int a), bs :: !(Array.Array Int b) }
@@ -74,7 +74,7 @@ runMyers :: forall a b c. HasCallStack => (a -> b -> Bool) -> EditGraph a b -> M
 runMyers eq graph step = evalState (go step) (emptyStateForGraph graph)
   where go :: forall c. Myers a b c -> StateT (MyersState a b) Identity c
         go = iterFreerA algebra
-        algebra :: forall c x. StepF a b x -> (x -> StateT (MyersState a b) Identity c) -> StateT (MyersState a b) Identity c
+        algebra :: forall c x. Step a b x -> (x -> StateT (MyersState a b) Identity c) -> StateT (MyersState a b) Identity c
         algebra step cont = case step of
           M m -> go (decompose eq graph m) >>= cont
           S Get -> get >>= cont
@@ -344,8 +344,8 @@ liftShowsState sp d state = case state of
   Put s -> showsUnaryWith sp "Put" d s
 
 -- | Lift value/list showing functions into a showing function for steps in Myers’ algorithm.
-liftShowsStepF :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> (Int -> b -> ShowS) -> ([b] -> ShowS) -> Int -> StepF a b c -> ShowS
-liftShowsStepF sp1 sl1 sp2 sl2 d step = case step of
+liftShowsStep :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> (Int -> b -> ShowS) -> ([b] -> ShowS) -> Int -> Step a b c -> ShowS
+liftShowsStep sp1 sl1 sp2 sl2 d step = case step of
   M m -> showsUnaryWith (liftShowsMyersF sp1 sp2) "M" d m
   S s -> showsUnaryWith (liftShowsState (liftShowsPrec2 sp1 sl1 sp2 sl2)) "S" d s
 
@@ -398,11 +398,11 @@ instance (Show a, Show b) => Show1 (MyersF a b) where
 instance (Show a, Show b) => Show (MyersF a b c) where
   showsPrec = liftShowsMyersF showsPrec showsPrec
 
-instance (Show a, Show b) => Show1 (StepF a b) where
-  liftShowsPrec _ _ = liftShowsStepF showsPrec showList showsPrec showList
+instance (Show a, Show b) => Show1 (Step a b) where
+  liftShowsPrec _ _ = liftShowsStep showsPrec showList showsPrec showList
 
-instance (Show a, Show b) => Show (StepF a b c) where
-  showsPrec = liftShowsStepF showsPrec showList showsPrec showList
+instance (Show a, Show b) => Show (Step a b c) where
+  showsPrec = liftShowsStep showsPrec showList showsPrec showList
 
 instance Exception MyersException
 

From a5f33b1bc66e2596a63d28636f48158dbac88416 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 23 Mar 2017 15:40:17 -0400
Subject: [PATCH 282/294] Explicitly enumerate the exports from SES.Myers.

---
 src/SES/Myers.hs | 14 +++++++++++++-
 1 file changed, 13 insertions(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index eb8911719..23dc17534 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -1,5 +1,17 @@
 {-# LANGUAGE GADTs, ImplicitParams, MultiParamTypeClasses, ScopedTypeVariables #-}
-module SES.Myers where
+module SES.Myers
+( MyersF(..)
+, EditScript
+, Step(..)
+, Myers
+, EditGraph(..)
+, Distance(..)
+, Diagonal(..)
+, Endpoint(..)
+, ses
+, MyersState(..)
+, index
+) where
 
 import Control.Exception
 import Control.Monad.Free.Freer

From 95d38df8c408f39454d35dddd9941be2bb370d13 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 23 Mar 2017 15:41:56 -0400
Subject: [PATCH 283/294] Add a few more exports.

---
 src/SES/Myers.hs | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 23dc17534..bc2c537a1 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -9,6 +9,10 @@ module SES.Myers
 , Diagonal(..)
 , Endpoint(..)
 , ses
+, runMyers
+, runMyersSteps
+, lcs
+, editDistance
 , MyersState(..)
 , index
 ) where

From ade6a50b301b8d9a5f1434eec41b1444540ae8a4 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 23 Mar 2017 15:48:29 -0400
Subject: [PATCH 284/294] =?UTF-8?q?Use=20the=20state=20array=E2=80=99s=20b?=
 =?UTF-8?q?ounds=20to=20obviate=20the=20need=20for=20index=20transformatio?=
 =?UTF-8?q?ns.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/SES/Myers.hs | 30 ++++++++++--------------------
 1 file changed, 10 insertions(+), 20 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index bc2c537a1..f4b0e6444 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -14,7 +14,6 @@ module SES.Myers
 , lcs
 , editDistance
 , MyersState(..)
-, index
 ) where
 
 import Control.Exception
@@ -213,14 +212,14 @@ runMoveRightFrom (EditGraph as _) (Endpoint x y script) = return (Endpoint (succ
 -- | Return the maximum extent reached and path taken along a given diagonal.
 runGetK :: HasCallStack => EditGraph a b -> Diagonal -> Myers a b (Endpoint a b)
 runGetK graph k = let ?callStack = popCallStack callStack in do
-  (i, v) <- checkK graph k
-  let (x, script) = v ! i in return (Endpoint x (x - unDiagonal k) script)
+  v <- checkK graph k
+  let (x, script) = v ! unDiagonal k in return (Endpoint x (x - unDiagonal k) script)
 
 -- | Update the maximum extent reached and path taken along a given diagonal.
 runSetK :: HasCallStack => EditGraph a b -> Diagonal -> Endpoint a b -> Myers a b ()
 runSetK graph k (Endpoint x _ script) = let ?callStack = popCallStack callStack in do
-  (i, v) <- checkK graph k
-  put (MyersState (v Array.// [(i, (x, script))]))
+  v <- checkK graph k
+  put (MyersState (v Array.// [(unDiagonal k, (x, script))]))
 
 -- | Slide down any diagonal edges from a given vertex.
 runSlide :: HasCallStack => (a -> b -> Bool) -> EditGraph a b -> Endpoint a b -> Myers a b (Endpoint a b)
@@ -290,7 +289,7 @@ data State s a where
 -- | Compute the empty state of length m + n + 1 for a given edit graph.
 emptyStateForGraph :: EditGraph a b -> MyersState a b
 emptyStateForGraph (EditGraph as bs) = let (n, m) = (length as, length bs) in
-  MyersState (Array.listArray (0, m + n) (repeat (0, [])))
+  MyersState (Array.listArray (negate m, n) (repeat (0, [])))
 
 -- | Evaluate some function for each value in a list until one returns a value or the list is exhausted.
 for :: [a] -> (a -> Myers c d (Maybe b)) -> Myers c d (Maybe b)
@@ -300,10 +299,6 @@ for all run = foldr (\ a b -> (<|>) <$> run a <*> b) (return Nothing) all
 continue :: Myers b c (Maybe a)
 continue = return Nothing
 
--- | Compute the actual index into the state array from a (possibly negative) diagonal number.
-index :: Array.Array Int a -> Int -> Int
-index v k = if k >= 0 then k else length v + k
-
 
 -- | Throw a failure. Used to indicate an error in the implementation of Myers’ algorithm.
 fail :: (HasCallStack, Monad m) => String -> m a
@@ -312,21 +307,16 @@ fail s = let ?callStack = fromCallSiteList (filter ((/= "M") . fst) (getCallStac
 
 -- | Bounds-checked indexing of arrays, preserving the call stack.
 (!) :: HasCallStack => Array.Array Int a -> Int -> a
-v ! i | i < length v = v Array.! i
+v ! i | inRange (Array.bounds v) i = v Array.! i
       | otherwise = let ?callStack = fromCallSiteList (filter ((/= "M") . fst) (getCallStack callStack)) in
           throw (MyersException ("index " <> show i <> " out of bounds") callStack)
 
 -- | Check that a given diagonal is in-bounds for the edit graph, returning the actual index to use and the state array.
-checkK :: HasCallStack => EditGraph a b -> Diagonal -> Myers a b (Int, Array.Array Int (Int, EditScript a b))
-checkK (EditGraph as bs) (Diagonal k) = let ?callStack = popCallStack callStack in do
+checkK :: HasCallStack => EditGraph a b -> Diagonal -> Myers a b (Array.Array Int (Int, EditScript a b))
+checkK _ (Diagonal k) = let ?callStack = popCallStack callStack in do
   v <- gets unMyersState
-  let i = index v k
-  let (n, m) = (length as, length bs)
-  when (i < 0) $
-    fail ("diagonal " <> show k <> " (" <> show i <> ") underflows state indices " <> show (negate m) <> ".." <> show n <> " (0.." <> show (succ (m + n)) <> ")")
-  when (i >= length v) $
-    fail ("diagonal " <> show k <> " (" <> show i <> ") overflows state indices " <> show (negate m) <> ".." <> show n <> " (0.." <> show (succ (m + n)) <> ")")
-  return (i, v)
+  unless (inRange (Array.bounds v) k) $ fail ("diagonal " <> show k <> " outside state bounds " <> show (Array.bounds v))
+  return v
 
 
 -- | Lifted showing of arrays.

From ce0b93dd30e40141d13ed5710dbf0b2707ce501d Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 23 Mar 2017 15:50:16 -0400
Subject: [PATCH 285/294] Rename slide -> slideFrom.

---
 src/SES/Myers.hs | 18 +++++++++---------
 1 file changed, 9 insertions(+), 9 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index f4b0e6444..af241f86f 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -38,11 +38,11 @@ data MyersF a b result where
   MoveFromAdjacent :: Distance -> Diagonal -> MyersF a b (Endpoint a b)
   MoveDownFrom :: Endpoint a b -> MyersF a b (Endpoint a b)
   MoveRightFrom :: Endpoint a b -> MyersF a b (Endpoint a b)
+  SlideFrom :: Endpoint a b -> MyersF a b (Endpoint a b)
 
   GetK :: Diagonal -> MyersF a b (Endpoint a b)
   SetK :: Diagonal -> Endpoint a b -> MyersF a b ()
 
-  Slide :: Endpoint a b -> MyersF a b (Endpoint a b)
 
 -- | An edit script, i.e. a sequence of changes/copies of elements.
 type EditScript a b = [These a b]
@@ -133,7 +133,7 @@ decompose eq graph myers = let ?callStack = popCallStack callStack in case myers
   GetK k -> runGetK graph k
   SetK k x -> runSetK graph k x
 
-  Slide from -> runSlide eq graph from
+  SlideFrom from -> runSlideFrom eq graph from
 {-# INLINE decompose #-}
 
 
@@ -197,7 +197,7 @@ runMoveFromAdjacent (EditGraph as bs) (Distance d) (Diagonal k) = let ?callStack
   else
     -- The upper/right extent of the search region or edit graph, whichever is smaller.
     getK (Diagonal (pred k)) >>= moveRightFrom
-  endpoint <- slide from
+  endpoint <- slideFrom from
   setK (Diagonal k) endpoint
   return endpoint
 
@@ -222,13 +222,13 @@ runSetK graph k (Endpoint x _ script) = let ?callStack = popCallStack callStack
   put (MyersState (v Array.// [(unDiagonal k, (x, script))]))
 
 -- | Slide down any diagonal edges from a given vertex.
-runSlide :: HasCallStack => (a -> b -> Bool) -> EditGraph a b -> Endpoint a b -> Myers a b (Endpoint a b)
-runSlide eq (EditGraph as bs) (Endpoint x y script)
+runSlideFrom :: HasCallStack => (a -> b -> Bool) -> EditGraph a b -> Endpoint a b -> Myers a b (Endpoint a b)
+runSlideFrom eq (EditGraph as bs) (Endpoint x y script)
   | x >= 0, x < length as
   , y >= 0, y < length bs
   , a <- as ! x
   , b <- bs ! y
-  , a `eq` b  = slide  (Endpoint (succ x) (succ y) (These a b : script))
+  , a `eq` b  = slideFrom  (Endpoint (succ x) (succ y) (These a b : script))
   | otherwise = return (Endpoint       x        y               script)
 
 
@@ -271,8 +271,8 @@ setK :: HasCallStack => Diagonal -> Endpoint a b -> Myers a b ()
 setK diagonal x = M (SetK diagonal x) `Then` return
 
 -- | Slide down any diagonal edges from a given vertex.
-slide :: HasCallStack => Endpoint a b -> Myers a b (Endpoint a b)
-slide from = M (Slide from) `Then` return
+slideFrom :: HasCallStack => Endpoint a b -> Myers a b (Endpoint a b)
+slideFrom from = M (SlideFrom from) `Then` return
 
 
 -- Implementation details
@@ -336,7 +336,7 @@ liftShowsMyersF sp1 sp2 d m = case m of
   MoveRightFrom endpoint -> showsUnaryWith (liftShowsEndpoint sp1 sp2) "MoveRightFrom" d endpoint
   GetK diagonal -> showsUnaryWith showsPrec "GetK" d diagonal
   SetK diagonal v -> showsBinaryWith showsPrec (liftShowsEndpoint sp1 sp2) "SetK" d diagonal v
-  Slide endpoint -> showsUnaryWith (liftShowsEndpoint sp1 sp2) "Slide" d endpoint
+  SlideFrom endpoint -> showsUnaryWith (liftShowsEndpoint sp1 sp2) "SlideFrom" d endpoint
 
 -- | Lifted showing of ternary constructors.
 showsTernaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> (Int -> c -> ShowS) -> String -> Int -> a -> b -> c -> ShowS

From 6ca3d56269afe2dddd216bb19c3ee3b281acdf5f Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 23 Mar 2017 15:52:13 -0400
Subject: [PATCH 286/294] Derive an Ord instance for Diagonal.

---
 src/SES/Myers.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index af241f86f..0520dcd6e 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -68,7 +68,7 @@ newtype Distance = Distance { unDistance :: Int }
 
 -- | A diagonal in the edit graph of lists of lengths n and m, numbered from -m to n.
 newtype Diagonal = Diagonal { unDiagonal :: Int }
-  deriving (Eq, Show)
+  deriving (Eq, Ord, Show)
 
 -- | The endpoint of a path through the edit graph, represented as the x/y indices and the script of edits made to get to that point.
 data Endpoint a b = Endpoint { x :: !Int, y :: !Int, script :: !(EditScript a b) }

From 973d873297ab11ac13da27cb786ba37b9fec4a81 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 23 Mar 2017 15:54:46 -0400
Subject: [PATCH 287/294] Derive an instance of Ix for Diagonal.

---
 src/SES/Myers.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 0520dcd6e..e0d950320 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -19,7 +19,7 @@ module SES.Myers
 import Control.Exception
 import Control.Monad.Free.Freer
 import qualified Data.Array as Array
-import Data.Ix (inRange)
+import Data.Ix
 import Data.Functor.Classes
 import Data.String
 import Data.These
@@ -68,7 +68,7 @@ newtype Distance = Distance { unDistance :: Int }
 
 -- | A diagonal in the edit graph of lists of lengths n and m, numbered from -m to n.
 newtype Diagonal = Diagonal { unDiagonal :: Int }
-  deriving (Eq, Ord, Show)
+  deriving (Eq, Ix, Ord, Show)
 
 -- | The endpoint of a path through the edit graph, represented as the x/y indices and the script of edits made to get to that point.
 data Endpoint a b = Endpoint { x :: !Int, y :: !Int, script :: !(EditScript a b) }

From f8b3d1490b7722ae936b34dfaaefb23ddef3a97e Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 23 Mar 2017 15:57:13 -0400
Subject: [PATCH 288/294] Index the state array by Diagonal.

---
 src/SES/Myers.hs | 16 ++++++++--------
 1 file changed, 8 insertions(+), 8 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index e0d950320..d7f7b11a9 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -213,13 +213,13 @@ runMoveRightFrom (EditGraph as _) (Endpoint x y script) = return (Endpoint (succ
 runGetK :: HasCallStack => EditGraph a b -> Diagonal -> Myers a b (Endpoint a b)
 runGetK graph k = let ?callStack = popCallStack callStack in do
   v <- checkK graph k
-  let (x, script) = v ! unDiagonal k in return (Endpoint x (x - unDiagonal k) script)
+  let (x, script) = v ! k in return (Endpoint x (x - unDiagonal k) script)
 
 -- | Update the maximum extent reached and path taken along a given diagonal.
 runSetK :: HasCallStack => EditGraph a b -> Diagonal -> Endpoint a b -> Myers a b ()
 runSetK graph k (Endpoint x _ script) = let ?callStack = popCallStack callStack in do
   v <- checkK graph k
-  put (MyersState (v Array.// [(unDiagonal k, (x, script))]))
+  put (MyersState (v Array.// [(k, (x, script))]))
 
 -- | Slide down any diagonal edges from a given vertex.
 runSlideFrom :: HasCallStack => (a -> b -> Bool) -> EditGraph a b -> Endpoint a b -> Myers a b (Endpoint a b)
@@ -278,7 +278,7 @@ slideFrom from = M (SlideFrom from) `Then` return
 -- Implementation details
 
 -- | The state stored by Myers’ algorithm; an array of m + n + 1 values indicating the maximum x-index reached and path taken along each diagonal.
-newtype MyersState a b = MyersState { unMyersState :: Array.Array Int (Int, EditScript a b) }
+newtype MyersState a b = MyersState { unMyersState :: Array.Array Diagonal (Int, EditScript a b) }
   deriving (Eq, Show)
 
 -- | State effect used in Myers.
@@ -289,7 +289,7 @@ data State s a where
 -- | Compute the empty state of length m + n + 1 for a given edit graph.
 emptyStateForGraph :: EditGraph a b -> MyersState a b
 emptyStateForGraph (EditGraph as bs) = let (n, m) = (length as, length bs) in
-  MyersState (Array.listArray (negate m, n) (repeat (0, [])))
+  MyersState (Array.listArray (Diagonal (negate m), Diagonal n) (repeat (0, [])))
 
 -- | Evaluate some function for each value in a list until one returns a value or the list is exhausted.
 for :: [a] -> (a -> Myers c d (Maybe b)) -> Myers c d (Maybe b)
@@ -306,21 +306,21 @@ fail s = let ?callStack = fromCallSiteList (filter ((/= "M") . fst) (getCallStac
   throw (MyersException s callStack)
 
 -- | Bounds-checked indexing of arrays, preserving the call stack.
-(!) :: HasCallStack => Array.Array Int a -> Int -> a
+(!) :: (HasCallStack, Ix i, Show i) => Array.Array i a -> i -> a
 v ! i | inRange (Array.bounds v) i = v Array.! i
       | otherwise = let ?callStack = fromCallSiteList (filter ((/= "M") . fst) (getCallStack callStack)) in
           throw (MyersException ("index " <> show i <> " out of bounds") callStack)
 
 -- | Check that a given diagonal is in-bounds for the edit graph, returning the actual index to use and the state array.
-checkK :: HasCallStack => EditGraph a b -> Diagonal -> Myers a b (Array.Array Int (Int, EditScript a b))
-checkK _ (Diagonal k) = let ?callStack = popCallStack callStack in do
+checkK :: HasCallStack => EditGraph a b -> Diagonal -> Myers a b (Array.Array Diagonal (Int, EditScript a b))
+checkK _ k = let ?callStack = popCallStack callStack in do
   v <- gets unMyersState
   unless (inRange (Array.bounds v) k) $ fail ("diagonal " <> show k <> " outside state bounds " <> show (Array.bounds v))
   return v
 
 
 -- | Lifted showing of arrays.
-liftShowsVector :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Array.Array Int a -> ShowS
+liftShowsVector :: Show i => (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Array.Array i a -> ShowS
 liftShowsVector sp sl d = liftShowsPrec sp sl d . toList
 
 -- | Lifted showing of operations in Myers’ algorithm.

From 2a1fb5ad368e239b0aa8977bd94aec575d89f91f Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 23 Mar 2017 16:39:57 -0400
Subject: [PATCH 289/294] Partially apply decompose.

---
 src/SES/Myers.hs | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index d7f7b11a9..fcdc8075f 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -91,9 +91,11 @@ runMyers eq graph step = evalState (go step) (emptyStateForGraph graph)
         go = iterFreerA algebra
         algebra :: forall c x. Step a b x -> (x -> StateT (MyersState a b) Identity c) -> StateT (MyersState a b) Identity c
         algebra step cont = case step of
-          M m -> go (decompose eq graph m) >>= cont
+          M m -> go (decompose' m) >>= cont
           S Get -> get >>= cont
           S (Put s) -> put s >>= cont
+        decompose' :: forall c. MyersF a b c -> Myers a b c
+        decompose' = decompose eq graph
 
 -- | Fully evaluate an operation in Myers’ algorithm given a comparator function and an edit graph, returning a list of states and next steps.
 runMyersSteps :: HasCallStack => (a -> b -> Bool) -> EditGraph a b -> Myers a b c -> [(MyersState a b, Myers a b c)]

From c66631cfa6189ee3926d1b3d0426fa52554dba41 Mon Sep 17 00:00:00 2001
From: Timothy Clem <timothy.clem@gmail.com>
Date: Fri, 24 Mar 2017 10:43:23 -0700
Subject: [PATCH 290/294] Add custom-setup stanza to fix build warnings

---
 semantic-diff.cabal | 6 ++++++
 1 file changed, 6 insertions(+)

diff --git a/semantic-diff.cabal b/semantic-diff.cabal
index 46026583a..a0dffe1ea 100644
--- a/semantic-diff.cabal
+++ b/semantic-diff.cabal
@@ -180,6 +180,12 @@ test-suite test
   default-language:    Haskell2010
   default-extensions:  DeriveFunctor, DeriveGeneric, FlexibleContexts, FlexibleInstances, OverloadedStrings, NoImplicitPrelude, RecordWildCards
 
+custom-setup
+  setup-depends:  base >= 4.8 && < 5
+                , Cabal
+                , directory
+                , process
+
 source-repository head
   type:     git
   location: https://github.com/github/semantic-diff

From c807c8271bf8f23f1d44a93f27fa7785157d9540 Mon Sep 17 00:00:00 2001
From: Timothy Clem <timothy.clem@gmail.com>
Date: Fri, 24 Mar 2017 10:43:43 -0700
Subject: [PATCH 291/294] ++haskell-tree-sitter to have custom setup stanza

---
 vendor/haskell-tree-sitter | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/vendor/haskell-tree-sitter b/vendor/haskell-tree-sitter
index 825bdfaf9..c70bc6daf 160000
--- a/vendor/haskell-tree-sitter
+++ b/vendor/haskell-tree-sitter
@@ -1 +1 @@
-Subproject commit 825bdfaf9488a1be49f8f5d3921cdcd22b7a46cb
+Subproject commit c70bc6dafcbdc572082c46345e6425508ceaf43f

From fedacdc7d5401b69a4ffd9b4f3693c9d7d5238d1 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 24 Mar 2017 14:06:57 -0400
Subject: [PATCH 292/294] :fire: continue.

---
 src/SES/Myers.hs | 6 +-----
 1 file changed, 1 insertion(+), 5 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index fcdc8075f..318efb456 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -176,7 +176,7 @@ runSearchAlongK (EditGraph as bs) d k = let ?callStack = popCallStack callStack
   if x >= length as && y >= length bs then
     return (Just (script, d))
   else
-    continue
+    return Nothing
 
 -- | Move onto a given diagonal from one of its in-bounds adjacent diagonals (if any), and slide down any diagonal edges eagerly.
 runMoveFromAdjacent :: HasCallStack => EditGraph a b -> Distance -> Diagonal -> Myers a b (Endpoint a b)
@@ -297,10 +297,6 @@ emptyStateForGraph (EditGraph as bs) = let (n, m) = (length as, length bs) in
 for :: [a] -> (a -> Myers c d (Maybe b)) -> Myers c d (Maybe b)
 for all run = foldr (\ a b -> (<|>) <$> run a <*> b) (return Nothing) all
 
--- | Continue evaluation of a for loop without returning a value. To exit the loop without continuing, return a value in 'Just' instead.
-continue :: Myers b c (Maybe a)
-continue = return Nothing
-
 
 -- | Throw a failure. Used to indicate an error in the implementation of Myers’ algorithm.
 fail :: (HasCallStack, Monad m) => String -> m a

From 66706c31de99882683f2424660118f2f9a91038c Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 24 Mar 2017 14:12:14 -0400
Subject: [PATCH 293/294] :fire: diffAt, Cost, &c.

---
 src/Data/RandomWalkSimilarity.hs |  8 ++----
 src/SES.hs                       | 49 +++-----------------------------
 2 files changed, 7 insertions(+), 50 deletions(-)

diff --git a/src/Data/RandomWalkSimilarity.hs b/src/Data/RandomWalkSimilarity.hs
index 2706c16ae..e92e2bcbc 100644
--- a/src/Data/RandomWalkSimilarity.hs
+++ b/src/Data/RandomWalkSimilarity.hs
@@ -33,7 +33,7 @@ import Diff
 import Info
 import Patch
 import Prologue as P
-import qualified SES
+import SES
 import System.Random.Mersenne.Pure64
 import Term (Term, TermF)
 
@@ -47,7 +47,7 @@ type Label f fields label = forall b. TermF f (Record fields) b -> label
 -- This implementation is based on the paper [_RWS-Diff—Flexible and Efficient Change Detection in Hierarchical Data_](https://github.com/github/semantic-diff/files/325837/RWS-Diff.Flexible.and.Efficient.Change.Detection.in.Hierarchical.Data.pdf).
 rws :: forall f fields.
        (GAlign f, Traversable f, Eq1 f, HasField fields Category, HasField fields (Maybe FeatureVector))
-    => SES.Cost (Term f (Record fields)) -- ^ A function computes a constant-time approximation to the edit distance between two terms.
+    => (These (Term f (Record fields)) (Term f (Record fields)) -> Int) -- ^ A function computes a constant-time approximation to the edit distance between two terms.
     -> (Term f (Record fields) -> Term f (Record fields) -> Bool) -- ^ A relation determining whether two terms can be compared.
     -> [Term f (Record fields)] -- ^ The list of old terms.
     -> [Term f (Record fields)] -- ^ The list of new terms.
@@ -69,7 +69,7 @@ rws editDistance canCompare as bs
 
   where
     minimumTermIndex = pred . maybe 0 getMin . getOption . foldMap (Option . Just . Min . termIndex)
-    sesDiffs = SES.ses (gliftEq (==) `on` fmap category) cost as bs
+    sesDiffs = ses (gliftEq (==) `on` fmap category) as bs
 
     (featurizedAs, featurizedBs, _, _, countersAndDiffs, allDiffs) =
       foldl' (\(as, bs, counterA, counterB, diffs, allDiffs) diff -> case diff of
@@ -151,8 +151,6 @@ rws editDistance canCompare as bs
       diffs
       ((termIndex &&& This . term) <$> unmappedA)
 
-    cost = these (const 1) (const 1) (const (const 0))
-
     kdas = KdTree.build (elems . feature) featurizedAs
     kdbs = KdTree.build (elems . feature) featurizedBs
 
diff --git a/src/SES.hs b/src/SES.hs
index 96225c873..e01e2062e 100644
--- a/src/SES.hs
+++ b/src/SES.hs
@@ -1,52 +1,11 @@
 {-# LANGUAGE Strict #-}
-module SES where
+module SES
+( Comparable
+, Myers.ses
+) where
 
-import Data.Array.MArray
-import Data.Array.ST
-import Data.These
 import Prologue
 import qualified SES.Myers as Myers
 
-
 -- | Edit constructor for two terms, if comparable. Otherwise returns Nothing.
 type Comparable term = term -> term -> Bool
-
--- | A function that computes the cost of an edit.
-type Cost term = These term term -> Int
-
--- | Find the shortest edit script (diff) between two terms given a function to compute the cost.
-ses :: Comparable term -> Cost term -> [term] -> [term] -> [These term term]
-ses canCompare _ as bs = Myers.ses canCompare as bs
-
-
--- | Find the shortest edit script between two terms at a given vertex in the edit graph.
-diffAt :: STArray s (Int, Int) (Maybe [(These term term, Int)]) -> Comparable term -> Cost term -> (Int, Int) -> [term] -> [term] -> ST s [(These term term, Int)]
-diffAt array canCompare cost (i, j) as bs
-  | (a : as') <- as, (b : bs') <- bs = do
-  maybeDiff <- readArray array (i, j)
-  case maybeDiff of
-    Just diffs -> pure diffs
-    Nothing -> do
-      down <- recur (i, succ j) as' bs
-      right <- recur (succ i, j) as bs'
-      nomination <- best <$> if canCompare a b
-        then do
-          diagonal <- recur (succ i, succ j) as' bs'
-          pure [ delete a down, insert b right, consWithCost cost (These a b) diagonal ]
-        else pure [ delete a down, insert b right ]
-      writeArray array (i, j) (Just nomination)
-      pure nomination
-  | null as = pure $ foldr insert [] bs
-  | null bs = pure $ foldr delete [] as
-  | otherwise = pure []
-  where
-    delete = consWithCost cost . This
-    insert = consWithCost cost . That
-    costOf [] = 0
-    costOf ((_, c) : _) = c
-    best = minimumBy (comparing costOf)
-    recur = diffAt array canCompare cost
-
--- | Prepend an edit script and the cumulative cost onto the edit script.
-consWithCost :: Cost term -> These term term -> [(These term term, Int)] -> [(These term term, Int)]
-consWithCost cost edit rest = (edit, cost edit + maybe 0 snd (fst <$> uncons rest)) : rest

From e5f018c619b659d7cb55f0f53dbf1198f752aa72 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 24 Mar 2017 14:13:41 -0400
Subject: [PATCH 294/294] Just say State.

---
 src/SES/Myers.hs | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
index 318efb456..51465e7a1 100644
--- a/src/SES/Myers.hs
+++ b/src/SES/Myers.hs
@@ -26,6 +26,7 @@ import Data.These
 import GHC.Show hiding (show)
 import GHC.Stack
 import Prologue hiding (for, State, error)
+import qualified Prologue
 import Text.Show (showListWith)
 
 -- | Operations in Myers’ algorithm.
@@ -87,9 +88,9 @@ ses eq as bs = runMyers eq (makeEditGraph as bs) (M SES `Then` return)
 -- | Fully evaluate an operation in Myers’ algorithm given a comparator function and an edit graph.
 runMyers :: forall a b c. HasCallStack => (a -> b -> Bool) -> EditGraph a b -> Myers a b c -> c
 runMyers eq graph step = evalState (go step) (emptyStateForGraph graph)
-  where go :: forall c. Myers a b c -> StateT (MyersState a b) Identity c
+  where go :: forall c. Myers a b c -> Prologue.State (MyersState a b) c
         go = iterFreerA algebra
-        algebra :: forall c x. Step a b x -> (x -> StateT (MyersState a b) Identity c) -> StateT (MyersState a b) Identity c
+        algebra :: forall c x. Step a b x -> (x -> Prologue.State (MyersState a b) c) -> Prologue.State (MyersState a b) c
         algebra step cont = case step of
           M m -> go (decompose' m) >>= cont
           S Get -> get >>= cont