-- Copyright (C) 2002 David Roundy
-- Copyright (C) 2005 Benedikt Schmidt
--
-- This program is free software; you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation; either version 2, or (at your option)
-- any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program; see the file COPYING.  If not, write to
-- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-- Boston, MA 02110-1301, USA.

-- |
-- Module      : Darcs.Util.Diff.Myers
-- Copyright   : 2003 David Roundy
--               2005 Benedikt Schmidt
-- License     : GPL
-- Maintainer  : darcs-devel@darcs.net
-- Stability   : experimental
-- Portability : portable
--
-- LCS stands for Longest Common Subsequence, and it is a relatively
-- challenging problem to find an LCS efficiently.  This module implements
-- the algorithm described in:
--
--   "An O(ND) Difference Algorithm and its Variations", Eugene Myers,
--   Algorithmica Vol. 1 No. 2, 1986, pp. 251-266;
--   especially the variation described in section 4.2 and most refinements
--   implemented in GNU diff (D is the edit-distance).
--
-- There is currently no heuristic to reduce the running time and produce
-- suboptimal output for large inputs with many differences. It behaves like
-- GNU diff with the -d option in this regard.
--
-- In the first step, a hash value for every line is calculated and collisions
-- are marked with a special value. This reduces a string comparison to an
-- int comparison for line tuples where at least one of the hash values is
-- not equal to the special value. After that, lines which only exists in one
-- of the files are removed and marked as changed which reduces the running
-- time of the following difference algorithm. GNU diff additionally removes
-- lines that appear very often in the other file in some cases.
-- The last step tries to create longer changed regions and line up deletions
-- in the first file to insertions in the second by shifting changed lines
-- forward and backward.

module Darcs.Util.Diff.Myers
    ( getChanges
    , shiftBoundaries
    , initP
    , aLen
    , PArray
    , getSlice
    ) where

import Darcs.Prelude

import Control.Monad
import Data.Int
import Control.Monad.ST
import Data.Maybe
import Darcs.Util.ByteString (hashPS)
import qualified Data.ByteString as B (empty, ByteString)
import Data.Array.Base
import Data.Array.Unboxed
import qualified Data.Map as Map ( lookup, empty, insertWith )

-- | create a list of changes between a and b, each change has the form
--   (starta, lima, startb, limb) which means that a[starta, lima)
--   has to be replaced by b[startb, limb)
getChanges ::  [B.ByteString] -> [B.ByteString]
           -> [(Int,[B.ByteString],[B.ByteString])]
getChanges :: [ByteString] -> [ByteString] -> [(Int, [ByteString], [ByteString])]
getChanges [ByteString]
a [ByteString]
b = PArray -> PArray -> Int -> [(Int, [ByteString], [ByteString])]
dropStart ([ByteString] -> PArray
initP [ByteString]
a) ([ByteString] -> PArray
initP [ByteString]
b) Int
1

dropStart ::  PArray -> PArray -> Int
           -> [(Int,[B.ByteString],[B.ByteString])]
dropStart :: PArray -> PArray -> Int -> [(Int, [ByteString], [ByteString])]
dropStart PArray
a PArray
b Int
off
  | Int
off forall a. Ord a => a -> a -> Bool
> forall (a :: * -> * -> *) e. IArray a e => a Int e -> Int
aLen PArray
a = [(Int
off forall a. Num a => a -> a -> a
- Int
1, [], PArray -> Int -> Int -> [ByteString]
getSlice PArray
b Int
off (forall (a :: * -> * -> *) e. IArray a e => a Int e -> Int
aLen PArray
b))]
  | Int
off forall a. Ord a => a -> a -> Bool
> forall (a :: * -> * -> *) e. IArray a e => a Int e -> Int
aLen PArray
b = [(Int
off forall a. Num a => a -> a -> a
- Int
1, PArray -> Int -> Int -> [ByteString]
getSlice PArray
a Int
off (forall (a :: * -> * -> *) e. IArray a e => a Int e -> Int
aLen PArray
a), [])]
  | PArray
aforall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
off forall a. Eq a => a -> a -> Bool
== PArray
bforall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
off = PArray -> PArray -> Int -> [(Int, [ByteString], [ByteString])]
dropStart PArray
a PArray
b (Int
off forall a. Num a => a -> a -> a
+ Int
1)
  | Bool
otherwise      = PArray
-> PArray -> Int -> Int -> [(Int, [ByteString], [ByteString])]
dropEnd PArray
a PArray
b Int
off Int
0

dropEnd ::  PArray -> PArray -> Int -> Int
        -> [(Int,[B.ByteString],[B.ByteString])]
dropEnd :: PArray
-> PArray -> Int -> Int -> [(Int, [ByteString], [ByteString])]
dropEnd PArray
a PArray
b Int
off Int
end
    | Int
off forall a. Ord a => a -> a -> Bool
> Int
alast        = [(Int
off forall a. Num a => a -> a -> a
- Int
1, [], PArray -> Int -> Int -> [ByteString]
getSlice PArray
b Int
off Int
blast)]
    | Int
off forall a. Ord a => a -> a -> Bool
> Int
blast        = [(Int
off forall a. Num a => a -> a -> a
- Int
1, PArray -> Int -> Int -> [ByteString]
getSlice PArray
a Int
off Int
alast, [])]
    | PArray
aforall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
alast forall a. Eq a => a -> a -> Bool
== PArray
bforall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
blast = PArray
-> PArray -> Int -> Int -> [(Int, [ByteString], [ByteString])]
dropEnd PArray
a PArray
b Int
off (Int
end forall a. Num a => a -> a -> a
+ Int
1)
    | Bool
otherwise          = (PArray, (Int, Int))
-> (PArray, (Int, Int)) -> [(Int, [ByteString], [ByteString])]
getChanges' (PArray
a, (Int
off, Int
alast)) (PArray
b, (Int
off, Int
blast))
  where alast :: Int
alast = forall (a :: * -> * -> *) e. IArray a e => a Int e -> Int
aLen PArray
a forall a. Num a => a -> a -> a
- Int
end
        blast :: Int
blast = forall (a :: * -> * -> *) e. IArray a e => a Int e -> Int
aLen PArray
b forall a. Num a => a -> a -> a
- Int
end

getSlice :: PArray -> Int -> Int -> [B.ByteString]
getSlice :: PArray -> Int -> Int -> [ByteString]
getSlice PArray
a Int
from Int
to
  | Int
from forall a. Ord a => a -> a -> Bool
> Int
to = []
  | Bool
otherwise = (PArray
a forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Int
from) forall a. a -> [a] -> [a]
: PArray -> Int -> Int -> [ByteString]
getSlice PArray
a (Int
from forall a. Num a => a -> a -> a
+ Int
1) Int
to

getChanges' :: (PArray, (Int, Int)) -> (PArray, (Int, Int))
            -> [(Int,[B.ByteString],[B.ByteString])]
getChanges' :: (PArray, (Int, Int))
-> (PArray, (Int, Int)) -> [(Int, [ByteString], [ByteString])]
getChanges' (PArray
a, (Int, Int)
abounds) (PArray
b, (Int, Int)
bbounds) =
    forall a b. (a -> b) -> [a] -> [b]
map (Int
-> PArray
-> PArray
-> (Int, Int, Int, Int)
-> (Int, [ByteString], [ByteString])
convertPatch Int
0 PArray
a PArray
b) forall a b. (a -> b) -> a -> b
$ BArray -> BArray -> [(Int, Int, Int, Int)]
createPatch BArray
c_a BArray
c_b
  where
        -- If the last few characters of two lines are the same, the lines are
        -- probably the same. The choice of 20 is plucked out of the air.
        toHash :: a i ByteString -> (i, i) -> a i Int32
toHash a i ByteString
x (i, i)
bnds = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (i, i)
bnds [ ByteString -> Int32
hashPS forall a b. (a -> b) -> a -> b
$ a i ByteString
xforall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!i
i | i
i <- forall a. Ix a => (a, a) -> [a]
range (i, i)
bnds]
        ah :: HArray
ah = forall {i} {a :: * -> * -> *} {a :: * -> * -> *}.
(Ix i, IArray a Int32, IArray a ByteString) =>
a i ByteString -> (i, i) -> a i Int32
toHash PArray
a (Int, Int)
abounds :: HArray
        mkAMap :: Map Int32 (Bool, Bool, Bool, ByteString)
-> [Int] -> Map Int32 (Bool, Bool, Bool, ByteString)
mkAMap Map Int32 (Bool, Bool, Bool, ByteString)
m (Int
i:[Int]
is) =
            let ins :: (a, b, c, d) -> (Bool, b, c, d) -> (Bool, Bool, Bool, d)
ins (a
_,b
_,c
_,d
new) (Bool
collision,b
_,c
_,d
old) =
                    (Bool
collision Bool -> Bool -> Bool
|| (d
new forall a. Eq a => a -> a -> Bool
/= d
old), Bool
True, Bool
False, d
old)
                m' :: Map Int32 (Bool, Bool, Bool, ByteString)
m' = forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith forall {d} {a} {b} {c} {b} {c}.
Eq d =>
(a, b, c, d) -> (Bool, b, c, d) -> (Bool, Bool, Bool, d)
ins (HArray
ahforall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
i) (Bool
False, Bool
True, Bool
False, PArray
aforall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
i) Map Int32 (Bool, Bool, Bool, ByteString)
m
            in Map Int32 (Bool, Bool, Bool, ByteString)
-> [Int] -> Map Int32 (Bool, Bool, Bool, ByteString)
mkAMap Map Int32 (Bool, Bool, Bool, ByteString)
m' [Int]
is
        mkAMap Map Int32 (Bool, Bool, Bool, ByteString)
m [Int]
_ = Map Int32 (Bool, Bool, Bool, ByteString)
m
        hm_a :: Map Int32 (Bool, Bool, Bool, ByteString)
hm_a = Map Int32 (Bool, Bool, Bool, ByteString)
-> [Int] -> Map Int32 (Bool, Bool, Bool, ByteString)
mkAMap forall k a. Map k a
Map.empty (forall a. Ix a => (a, a) -> [a]
range (Int, Int)
abounds)
        --
        bh :: HArray
bh = forall {i} {a :: * -> * -> *} {a :: * -> * -> *}.
(Ix i, IArray a Int32, IArray a ByteString) =>
a i ByteString -> (i, i) -> a i Int32
toHash PArray
b (Int, Int)
bbounds :: HArray
        mkBMap :: Map Int32 (Bool, Bool, Bool, ByteString)
-> [Int] -> Map Int32 (Bool, Bool, Bool, ByteString)
mkBMap Map Int32 (Bool, Bool, Bool, ByteString)
m (Int
i:[Int]
is) =
            let ins :: (a, b, c, d) -> (Bool, b, c, d) -> (Bool, b, Bool, d)
ins (a
_,b
_,c
_,d
new) (Bool
collision,b
in_a,c
_,d
old) =
                    (Bool
collision Bool -> Bool -> Bool
|| (d
new forall a. Eq a => a -> a -> Bool
/= d
old), b
in_a, Bool
True, d
old)
                m' :: Map Int32 (Bool, Bool, Bool, ByteString)
m' = forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith forall {d} {a} {b} {c} {b} {c}.
Eq d =>
(a, b, c, d) -> (Bool, b, c, d) -> (Bool, b, Bool, d)
ins (HArray
bhforall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
i) (Bool
False, Bool
False, Bool
True, PArray
bforall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
i) Map Int32 (Bool, Bool, Bool, ByteString)
m
            in Map Int32 (Bool, Bool, Bool, ByteString)
-> [Int] -> Map Int32 (Bool, Bool, Bool, ByteString)
mkBMap Map Int32 (Bool, Bool, Bool, ByteString)
m' [Int]
is
        mkBMap Map Int32 (Bool, Bool, Bool, ByteString)
m [Int]
_ = Map Int32 (Bool, Bool, Bool, ByteString)
m
        hm :: Map Int32 (Bool, Bool, Bool, ByteString)
hm = Map Int32 (Bool, Bool, Bool, ByteString)
-> [Int] -> Map Int32 (Bool, Bool, Bool, ByteString)
mkBMap Map Int32 (Bool, Bool, Bool, ByteString)
hm_a (forall a. Ix a => (a, a) -> [a]
range (Int, Int)
bbounds)
        -- take care of collisions, if there are different lines with the
        -- same hash in both files, then set the hash to markColl,
        -- PackedStrings are compared for two lines with the hash markColl
        get :: (a, Int32) -> Maybe (a, Int32)
get (a
i, Int32
h) = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int32
h Map Int32 (Bool, Bool, Bool, ByteString)
hm of
                      Just (Bool
_,Bool
False,Bool
_,ByteString
_) -> forall a. Maybe a
Nothing
                      Just (Bool
_,Bool
_,Bool
False,ByteString
_) -> forall a. Maybe a
Nothing
                      Just (Bool
False,Bool
True,Bool
True,ByteString
_) -> forall a. a -> Maybe a
Just (a
i, Int32
h)
                      Just (Bool
True,Bool
True,Bool
True,ByteString
_) -> forall a. a -> Maybe a
Just (a
i, Int32
markColl)
                      Maybe (Bool, Bool, Bool, ByteString)
Nothing -> forall a. HasCallStack => [Char] -> a
error [Char]
"impossible case"

        a' :: [(Int, Int32)]
a' = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {a}. (a, Int32) -> Maybe (a, Int32)
get [(Int
i, HArray
ahforall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
i) | Int
i <- forall a. Ix a => (a, a) -> [a]
range (forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds HArray
ah)]
        b' :: [(Int, Int32)]
b' = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {a}. (a, Int32) -> Maybe (a, Int32)
get [(Int
i, HArray
bhforall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
i) | Int
i <- forall a. Ix a => (a, a) -> [a]
range (forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds HArray
bh)]

        (BArray
c_a, BArray
c_b) = [(Int, Int32)]
-> [(Int, Int32)]
-> (PArray, (Int, Int))
-> (PArray, (Int, Int))
-> (BArray, BArray)
diffArr [(Int, Int32)]
a' [(Int, Int32)]
b' (PArray
a, (Int, Int)
abounds) (PArray
b, (Int, Int)
bbounds)

-- | mark hash value where collision occured
markColl :: Int32
markColl :: Int32
markColl = Int32
2345677

-- | return arrays with changes in a and b (1 indexed), offsets start with 0
diffArr :: [(Int,Int32)] -> [(Int,Int32)]
        -> (PArray, (Int, Int)) -> (PArray, (Int, Int))
        -> (BArray, BArray)
diffArr :: [(Int, Int32)]
-> [(Int, Int32)]
-> (PArray, (Int, Int))
-> (PArray, (Int, Int))
-> (BArray, BArray)
diffArr [(Int, Int32)]
a [(Int, Int32)]
b (PArray
p_a, (Int
off_a, Int
l_a)) (PArray
p_b, (Int
off_b, Int
l_b)) = forall a. (forall s. ST s a) -> a
runST (
  do let h_a :: HArray
h_a = [Int32] -> HArray
initH (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Int, Int32)]
a)
         h_b :: HArray
h_b = [Int32] -> HArray
initH (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Int, Int32)]
b)
         m_a :: MapArray
m_a = [Int] -> MapArray
initM (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Int, Int32)]
a)
         m_b :: MapArray
m_b = [Int] -> MapArray
initM (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Int, Int32)]
b)
         end_a :: Int
end_a = forall (a :: * -> * -> *) e. IArray a e => a Int e -> Int
aLen PArray
p_a
         end_b :: Int
end_b = forall (a :: * -> * -> *) e. IArray a e => a Int e -> Int
aLen PArray
p_b
     BSTArray s
c_a <- forall s. Int -> ST s (BSTArray s)
initVChanged Int
end_a
     BSTArray s
c_b <- forall s. Int -> ST s (BSTArray s)
initVChanged Int
end_b
     forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ (Int
l,Int32
_) -> forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray BSTArray s
c_a Int
l Bool
False) [(Int, Int32)]
a
     forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ (Int
l,Int32
_) -> forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray BSTArray s
c_b Int
l Bool
False) [(Int, Int32)]
b
     Int
_ <- forall s.
HArray
-> HArray
-> PArray
-> PArray
-> MapArray
-> MapArray
-> BSTArray s
-> BSTArray s
-> Int
-> Int
-> Int
-> Int
-> ST s Int
cmpseq HArray
h_a HArray
h_b PArray
p_a PArray
p_b MapArray
m_a MapArray
m_b BSTArray s
c_a BSTArray s
c_b Int
0 Int
0 (forall (a :: * -> * -> *) e. IArray a e => a Int e -> Int
aLen HArray
h_a) (forall (a :: * -> * -> *) e. IArray a e => a Int e -> Int
aLen HArray
h_b)
     let unchanged :: a i Bool -> m Int
unchanged a i Bool
ar = do {[Bool]
xs <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> m [e]
getElems a i Bool
ar; forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. (a -> Bool) -> [a] -> [a]
filter Bool -> Bool
not [Bool]
xs) forall a. Num a => a -> a -> a
-Int
1}
     Bool
err <- forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 forall a. Eq a => a -> a -> Bool
(/=) (forall {m :: * -> *} {a :: * -> * -> *} {i}.
(MArray a Bool m, Ix i) =>
a i Bool -> m Int
unchanged BSTArray s
c_a) (forall {m :: * -> *} {a :: * -> * -> *} {i}.
(MArray a Bool m, Ix i) =>
a i Bool -> m Int
unchanged BSTArray s
c_b)
     forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
err forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => [Char] -> a
error [Char]
"impossible case"
     -- Mark common lines at beginning and end
     forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ Int
i -> forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray BSTArray s
c_a Int
i Bool
False ) [Int
1..(Int
off_a forall a. Num a => a -> a -> a
- Int
1)]
     forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ Int
i -> forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray BSTArray s
c_b Int
i Bool
False ) [Int
1..(Int
off_b forall a. Num a => a -> a -> a
- Int
1)]
     forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ Int
i -> forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray BSTArray s
c_a Int
i Bool
False ) [(Int
l_a forall a. Num a => a -> a -> a
+ Int
1) .. Int
end_a]
     forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ Int
i -> forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray BSTArray s
c_b Int
i Bool
False ) [(Int
l_b forall a. Num a => a -> a -> a
+ Int
1) .. Int
end_b]
     forall s.
BSTArray s -> BSTArray s -> PArray -> Int -> Int -> ST s ()
shiftBoundaries BSTArray s
c_a BSTArray s
c_b PArray
p_a Int
1 Int
1
     forall s.
BSTArray s -> BSTArray s -> PArray -> Int -> Int -> ST s ()
shiftBoundaries BSTArray s
c_b BSTArray s
c_a PArray
p_b Int
1 Int
1
     Bool
err1 <- forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 forall a. Eq a => a -> a -> Bool
(/=) (forall {m :: * -> *} {a :: * -> * -> *} {i}.
(MArray a Bool m, Ix i) =>
a i Bool -> m Int
unchanged BSTArray s
c_a) (forall {m :: * -> *} {a :: * -> * -> *} {i}.
(MArray a Bool m, Ix i) =>
a i Bool -> m Int
unchanged BSTArray s
c_b)
     forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
err1 forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => [Char] -> a
error [Char]
"impossible case"
     BArray
c_a' <- forall i (a :: * -> * -> *) e (m :: * -> *) (b :: * -> * -> *).
(Ix i, MArray a e m, IArray b e) =>
a i e -> m (b i e)
unsafeFreeze BSTArray s
c_a
     BArray
c_b' <- forall i (a :: * -> * -> *) e (m :: * -> *) (b :: * -> * -> *).
(Ix i, MArray a e m, IArray b e) =>
a i e -> m (b i e)
unsafeFreeze BSTArray s
c_b
     forall (m :: * -> *) a. Monad m => a -> m a
return (BArray
c_a', BArray
c_b'))

-- | set changes array for a and b and return number of changed lines
cmpseq :: HArray -> HArray -> PArray -> PArray -> MapArray -> MapArray
       -> BSTArray s -> BSTArray s -> Int -> Int -> Int -> Int -> ST s Int
cmpseq :: forall s.
HArray
-> HArray
-> PArray
-> PArray
-> MapArray
-> MapArray
-> BSTArray s
-> BSTArray s
-> Int
-> Int
-> Int
-> Int
-> ST s Int
cmpseq HArray
_ HArray
_ PArray
_ PArray
_ MapArray
_ MapArray
_ BSTArray s
_ BSTArray s
_ Int
_ Int
_ Int
0 Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
cmpseq HArray
h_a HArray
h_b PArray
p_a PArray
p_b MapArray
m_a MapArray
m_b BSTArray s
c_a BSTArray s
c_b Int
off_a Int
off_b Int
l_a Int
l_b = do
  let lim_a :: Int
lim_a = Int
off_aforall a. Num a => a -> a -> a
+Int
l_a
      lim_b :: Int
lim_b = Int
off_bforall a. Num a => a -> a -> a
+Int
l_b
      off_a' :: Int
off_a' = HArray
-> HArray
-> PArray
-> PArray
-> MapArray
-> MapArray
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
findSnake HArray
h_a HArray
h_b PArray
p_a PArray
p_b MapArray
m_a MapArray
m_b Int
off_a Int
off_b Int
l_a Int
l_b Int
off_a Int
off_b
      off_b' :: Int
off_b' = Int
off_bforall a. Num a => a -> a -> a
+Int
off_a'forall a. Num a => a -> a -> a
-Int
off_a
      lim_a' :: Int
lim_a' = HArray
-> HArray
-> PArray
-> PArray
-> MapArray
-> MapArray
-> Int
-> Int
-> Int
-> Int
-> Int
findSnakeRev HArray
h_a HArray
h_b PArray
p_a PArray
p_b MapArray
m_a MapArray
m_b Int
lim_a Int
lim_b Int
off_a' Int
off_b'
      lim_b' :: Int
lim_b' = Int
lim_bforall a. Num a => a -> a -> a
+Int
lim_a'forall a. Num a => a -> a -> a
-Int
lim_a
      l_a' :: Int
l_a' = Int
lim_a'forall a. Num a => a -> a -> a
-Int
off_a'
      l_b' :: Int
l_b' = Int
lim_b'forall a. Num a => a -> a -> a
-Int
off_b'
  if Int
l_a' forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
l_b' forall a. Eq a => a -> a -> Bool
== Int
0
     then if Int
l_a' forall a. Eq a => a -> a -> Bool
== Int
0
             then do forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
l_b' forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$
                          forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Int
i -> forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray BSTArray s
c_b (MapArray
m_bforall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
i) Bool
True)
                                [(Int
off_b' forall a. Num a => a -> a -> a
+ Int
1) .. Int
lim_b']
                     forall (m :: * -> *) a. Monad m => a -> m a
return Int
l_b'
             else do forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
l_a' forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$
                          forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Int
i -> forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray BSTArray s
c_a (MapArray
m_aforall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
i) Bool
True)
                                [(Int
off_a' forall a. Num a => a -> a -> a
+ Int
1) .. Int
lim_a']
                     forall (m :: * -> *) a. Monad m => a -> m a
return Int
l_a'
     else do let m :: Int
m = Int
l_a' forall a. Num a => a -> a -> a
+ Int
l_b'
                 del :: Int
del = Int
l_a' forall a. Num a => a -> a -> a
- Int
l_b'
                 dodd :: Bool
dodd = forall a. Integral a => a -> Bool
odd Int
del
             VSTArray s
v <- forall s. Int -> ST s (VSTArray s)
initV Int
m
             VSTArray s
vrev <- forall s. Int -> Int -> ST s (VSTArray s)
initVRev Int
m Int
l_a'
             forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray VSTArray s
vrev Int
0 Int
l_a'
             forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray VSTArray s
v Int
0 Int
0
             (Int
xmid, Int
ymid, Int
_) <- forall s.
Int
-> HArray
-> HArray
-> PArray
-> PArray
-> MapArray
-> MapArray
-> VSTArray s
-> VSTArray s
-> Int
-> Int
-> Int
-> Int
-> Int
-> Bool
-> ST s (Int, Int, Int)
findDiag Int
1 HArray
h_a HArray
h_b PArray
p_a PArray
p_b MapArray
m_a MapArray
m_b VSTArray s
v VSTArray s
vrev
                                Int
off_a' Int
off_b' Int
l_a' Int
l_b' Int
del Bool
dodd
             forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Int
xmid forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
ymid forall a. Eq a => a -> a -> Bool
== Int
0) Bool -> Bool -> Bool
|| (Int
xmid forall a. Eq a => a -> a -> Bool
== Int
l_a' Bool -> Bool -> Bool
&& Int
ymid forall a. Eq a => a -> a -> Bool
== Int
l_b')
                   Bool -> Bool -> Bool
|| (Int
xmid forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
ymid forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
xmid forall a. Ord a => a -> a -> Bool
> Int
l_a' Bool -> Bool -> Bool
|| Int
ymid forall a. Ord a => a -> a -> Bool
> Int
l_b'))
                     forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => [Char] -> a
error [Char]
"impossible case"
             Int
c1 <- forall s.
HArray
-> HArray
-> PArray
-> PArray
-> MapArray
-> MapArray
-> BSTArray s
-> BSTArray s
-> Int
-> Int
-> Int
-> Int
-> ST s Int
cmpseq HArray
h_a HArray
h_b PArray
p_a PArray
p_b MapArray
m_a MapArray
m_b BSTArray s
c_a BSTArray s
c_b
                          Int
off_a' Int
off_b' Int
xmid Int
ymid
             Int
c2 <- forall s.
HArray
-> HArray
-> PArray
-> PArray
-> MapArray
-> MapArray
-> BSTArray s
-> BSTArray s
-> Int
-> Int
-> Int
-> Int
-> ST s Int
cmpseq HArray
h_a HArray
h_b PArray
p_a PArray
p_b MapArray
m_a MapArray
m_b BSTArray s
c_a BSTArray s
c_b
                          (Int
off_a' forall a. Num a => a -> a -> a
+ Int
xmid) (Int
off_b' forall a. Num a => a -> a -> a
+ Int
ymid)
                          (Int
l_a' forall a. Num a => a -> a -> a
- Int
xmid) (Int
l_b' forall a. Num a => a -> a -> a
- Int
ymid)
             forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int
c1 forall a. Num a => a -> a -> a
+ Int
c2

-- | return (xmid, ymid, cost) for the two substrings
--   a[off_a+1..off_a+1+l_a] and b
findDiag :: Int -> HArray -> HArray -> PArray -> PArray -> MapArray -> MapArray
         -> VSTArray s -> VSTArray s -> Int -> Int -> Int -> Int -> Int -> Bool
         -> ST s (Int, Int, Int)
findDiag :: forall s.
Int
-> HArray
-> HArray
-> PArray
-> PArray
-> MapArray
-> MapArray
-> VSTArray s
-> VSTArray s
-> Int
-> Int
-> Int
-> Int
-> Int
-> Bool
-> ST s (Int, Int, Int)
findDiag Int
c HArray
h_a HArray
h_b PArray
p_a PArray
p_b MapArray
m_a MapArray
m_b VSTArray s
v VSTArray s
vrev Int
off_a Int
off_b Int
l_a Int
l_b Int
del Bool
dodd = do
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
c forall a. Ord a => a -> a -> Bool
> Int
l_a forall a. Num a => a -> a -> a
+ Int
l_b) forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => [Char] -> a
error [Char]
"findDiag failed"
  Maybe (Int, Int)
r <- ST s (Maybe (Int, Int))
findF
  case Maybe (Int, Int)
r of
    Just (Int
xmid, Int
ymid) -> forall (m :: * -> *) a. Monad m => a -> m a
return (Int
xmid, Int
ymid, Int
cforall a. Num a => a -> a -> a
*Int
2 forall a. Num a => a -> a -> a
- Int
1)
    Maybe (Int, Int)
Nothing ->
      do Maybe (Int, Int)
r' <- ST s (Maybe (Int, Int))
findR
         case Maybe (Int, Int)
r' of
           Just (Int
xmid, Int
ymid) -> forall (m :: * -> *) a. Monad m => a -> m a
return (Int
xmid, Int
ymid, Int
cforall a. Num a => a -> a -> a
*Int
2)
           Maybe (Int, Int)
Nothing -> forall s.
Int
-> HArray
-> HArray
-> PArray
-> PArray
-> MapArray
-> MapArray
-> VSTArray s
-> VSTArray s
-> Int
-> Int
-> Int
-> Int
-> Int
-> Bool
-> ST s (Int, Int, Int)
findDiag (Int
c forall a. Num a => a -> a -> a
+ Int
1) HArray
h_a HArray
h_b PArray
p_a PArray
p_b MapArray
m_a MapArray
m_b VSTArray s
v VSTArray s
vrev
                      Int
off_a Int
off_b Int
l_a Int
l_b Int
del Bool
dodd
 where fdmax :: Int
fdmax = if Int
c forall a. Ord a => a -> a -> Bool
<= Int
l_a then Int
c else Int
l_a forall a. Num a => a -> a -> a
- ((Int
l_a forall a. Num a => a -> a -> a
+ Int
c) forall a. Integral a => a -> a -> a
`mod` Int
2)
       rdmax :: Int
rdmax = if Int
c forall a. Ord a => a -> a -> Bool
<= Int
l_b then Int
c else Int
l_b forall a. Num a => a -> a -> a
- ((Int
l_b forall a. Num a => a -> a -> a
+ Int
c) forall a. Integral a => a -> a -> a
`mod` Int
2)
       lastrdmax :: Int
lastrdmax = if (Int
cforall a. Num a => a -> a -> a
-Int
1) forall a. Ord a => a -> a -> Bool
<= Int
l_b then Int
cforall a. Num a => a -> a -> a
-Int
1 else Int
l_bforall a. Num a => a -> a -> a
-(Int
l_b forall a. Num a => a -> a -> a
+ (Int
cforall a. Num a => a -> a -> a
-Int
1) forall a. Integral a => a -> a -> a
`mod` Int
2)
       lastrdmin :: Int
lastrdmin = -(if (Int
cforall a. Num a => a -> a -> a
-Int
1) forall a. Ord a => a -> a -> Bool
<= Int
l_a then Int
cforall a. Num a => a -> a -> a
-Int
1 else Int
l_aforall a. Num a => a -> a -> a
-((Int
l_a forall a. Num a => a -> a -> a
+ (Int
cforall a. Num a => a -> a -> a
-Int
1)) forall a. Integral a => a -> a -> a
`mod` Int
2))
       fdmin :: Int
fdmin = -Int
rdmax
       rdmin :: Int
rdmin = -Int
fdmax
       findF :: ST s (Maybe (Int, Int))
findF = Int -> ST s (Maybe (Int, Int))
findF' Int
fdmax
       findR :: ST s (Maybe (Int, Int))
findR = Int -> ST s (Maybe (Int, Int))
findR' Int
rdmax
       findF' :: Int -> ST s (Maybe (Int, Int))
findF' Int
d = do Int
x <- forall s.
HArray
-> HArray
-> PArray
-> PArray
-> MapArray
-> MapArray
-> VSTArray s
-> Int
-> Int
-> Int
-> Int
-> Int
-> ST s Int
findOne HArray
h_a HArray
h_b PArray
p_a PArray
p_b MapArray
m_a MapArray
m_b VSTArray s
v Int
d Int
off_a Int
off_b Int
l_a Int
l_b
                     if Bool
dodd Bool -> Bool -> Bool
&& Int
d forall a. Num a => a -> a -> a
- Int
del forall a. Ord a => a -> a -> Bool
>= Int
lastrdmin Bool -> Bool -> Bool
&& Int
d forall a. Num a => a -> a -> a
- Int
del forall a. Ord a => a -> a -> Bool
<= Int
lastrdmax
                        then do Int
xr <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray VSTArray s
vrev (Int
d forall a. Num a => a -> a -> a
- Int
del)
                                if Int
xr forall a. Ord a => a -> a -> Bool
<= Int
x then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Int
x, Int
x forall a. Num a => a -> a -> a
- Int
d)
                                           else if Int
d forall a. Ord a => a -> a -> Bool
<= Int
fdmin then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
                                                              else Int -> ST s (Maybe (Int, Int))
findF' (Int
dforall a. Num a => a -> a -> a
-Int
2)
                        else if Int
d forall a. Ord a => a -> a -> Bool
<= Int
fdmin then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing else Int -> ST s (Maybe (Int, Int))
findF' (Int
dforall a. Num a => a -> a -> a
-Int
2)
       findR' :: Int -> ST s (Maybe (Int, Int))
findR' Int
d = do Int
x <- forall s.
HArray
-> HArray
-> PArray
-> PArray
-> MapArray
-> MapArray
-> VSTArray s
-> Int
-> Int
-> Int
-> Int
-> ST s Int
findOneRev HArray
h_a HArray
h_b PArray
p_a PArray
p_b MapArray
m_a MapArray
m_b VSTArray s
vrev Int
d Int
del Int
off_a Int
off_b
                     if Bool -> Bool
not Bool
dodd Bool -> Bool -> Bool
&& (Int
d forall a. Num a => a -> a -> a
+ Int
del forall a. Ord a => a -> a -> Bool
>= Int
fdmin) Bool -> Bool -> Bool
&& (Int
d forall a. Num a => a -> a -> a
+ Int
del forall a. Ord a => a -> a -> Bool
<= Int
fdmax)
                        then do Int
xf <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray VSTArray s
v (Int
d forall a. Num a => a -> a -> a
+ Int
del)
                                if Int
x forall a. Ord a => a -> a -> Bool
<= Int
xf then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Int
x,Int
xforall a. Num a => a -> a -> a
-Int
delforall a. Num a => a -> a -> a
-Int
d)
                                           else if Int
d forall a. Ord a => a -> a -> Bool
<= Int
rdmin then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
                                                              else Int -> ST s (Maybe (Int, Int))
findR' (Int
dforall a. Num a => a -> a -> a
-Int
2)
                        else if Int
d forall a. Ord a => a -> a -> Bool
<= Int
rdmin then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing else Int -> ST s (Maybe (Int, Int))
findR' (Int
dforall a. Num a => a -> a -> a
-Int
2)

-- | find position on diag d with one more insert/delete going forward
findOne  :: HArray -> HArray -> PArray -> PArray -> MapArray -> MapArray
         -> VSTArray s -> Int -> Int -> Int -> Int -> Int -> ST s Int
findOne :: forall s.
HArray
-> HArray
-> PArray
-> PArray
-> MapArray
-> MapArray
-> VSTArray s
-> Int
-> Int
-> Int
-> Int
-> Int
-> ST s Int
findOne HArray
h_a HArray
h_b PArray
p_a PArray
p_b MapArray
m_a MapArray
m_b VSTArray s
v Int
d Int
off_a Int
off_b Int
l_a Int
l_b = do
  Int
x0 <- do Int
xbelow <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray VSTArray s
v (Int
d forall a. Num a => a -> a -> a
- Int
1)
           Int
xover <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray VSTArray s
v (Int
d forall a. Num a => a -> a -> a
+ Int
1)
           forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Int
xover forall a. Ord a => a -> a -> Bool
> Int
xbelow then Int
xover else Int
xbelow forall a. Num a => a -> a -> a
+ Int
1
  let y0 :: Int
y0 = Int
x0 forall a. Num a => a -> a -> a
- Int
d
      x :: Int
x = HArray
-> HArray
-> PArray
-> PArray
-> MapArray
-> MapArray
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
findSnake HArray
h_a HArray
h_b PArray
p_a PArray
p_b  MapArray
m_a MapArray
m_b (Int
x0forall a. Num a => a -> a -> a
+Int
off_a) (Int
y0forall a. Num a => a -> a -> a
+Int
off_b)
            Int
l_a Int
l_b Int
off_a Int
off_b
  forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray VSTArray s
v Int
d (Int
x forall a. Num a => a -> a -> a
- Int
off_a)
  forall (m :: * -> *) a. Monad m => a -> m a
return (Int
xforall a. Num a => a -> a -> a
-Int
off_a)

-- | follow snake from northwest to southeast, x and y are absolute positions
findSnake :: HArray -> HArray -> PArray -> PArray -> MapArray -> MapArray
          -> Int -> Int -> Int -> Int -> Int -> Int -> Int
findSnake :: HArray
-> HArray
-> PArray
-> PArray
-> MapArray
-> MapArray
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
findSnake HArray
h_a HArray
h_b PArray
p_a PArray
p_b  MapArray
m_a MapArray
m_b Int
x Int
y Int
l_a Int
l_b Int
off_a Int
off_b =
  if Int
x forall a. Ord a => a -> a -> Bool
< Int
l_a forall a. Num a => a -> a -> a
+ Int
off_a Bool -> Bool -> Bool
&& Int
y forall a. Ord a => a -> a -> Bool
< Int
l_b forall a. Num a => a -> a -> a
+ Int
off_b Bool -> Bool -> Bool
&& HArray
h_aforall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!(Int
xforall a. Num a => a -> a -> a
+Int
1) forall a. Eq a => a -> a -> Bool
== HArray
h_bforall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!(Int
yforall a. Num a => a -> a -> a
+Int
1)
       Bool -> Bool -> Bool
&& (HArray
h_aforall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!(Int
xforall a. Num a => a -> a -> a
+Int
1) forall a. Eq a => a -> a -> Bool
/= Int32
markColl Bool -> Bool -> Bool
|| PArray
p_aforall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!(MapArray
m_aforall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!(Int
xforall a. Num a => a -> a -> a
+Int
1)) forall a. Eq a => a -> a -> Bool
== PArray
p_bforall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!(MapArray
m_bforall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!(Int
yforall a. Num a => a -> a -> a
+Int
1)))
     then HArray
-> HArray
-> PArray
-> PArray
-> MapArray
-> MapArray
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
findSnake HArray
h_a HArray
h_b PArray
p_a PArray
p_b MapArray
m_a MapArray
m_b (Int
x forall a. Num a => a -> a -> a
+ Int
1) (Int
y forall a. Num a => a -> a -> a
+ Int
1) Int
l_a Int
l_b Int
off_a Int
off_b
     else Int
x

-- | find position on diag d with one more insert/delete going backward
findOneRev :: HArray -> HArray -> PArray -> PArray -> MapArray -> MapArray
           -> VSTArray s -> Int -> Int -> Int -> Int -> ST s Int
findOneRev :: forall s.
HArray
-> HArray
-> PArray
-> PArray
-> MapArray
-> MapArray
-> VSTArray s
-> Int
-> Int
-> Int
-> Int
-> ST s Int
findOneRev HArray
h_a HArray
h_b PArray
p_a PArray
p_b MapArray
m_a MapArray
m_b VSTArray s
v Int
d Int
del Int
off_a Int
off_b = do
  Int
x0 <- do Int
xbelow <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray VSTArray s
v (Int
d forall a. Num a => a -> a -> a
- Int
1)
           Int
xover <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray VSTArray s
v (Int
d forall a. Num a => a -> a -> a
+ Int
1)
           forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Int
xbelow forall a. Ord a => a -> a -> Bool
< Int
xover then Int
xbelow else Int
xoverforall a. Num a => a -> a -> a
-Int
1
  let y0 :: Int
y0 = Int
x0 forall a. Num a => a -> a -> a
- Int
del forall a. Num a => a -> a -> a
- Int
d
      x :: Int
x = HArray
-> HArray
-> PArray
-> PArray
-> MapArray
-> MapArray
-> Int
-> Int
-> Int
-> Int
-> Int
findSnakeRev HArray
h_a HArray
h_b PArray
p_a PArray
p_b MapArray
m_a MapArray
m_b (Int
x0forall a. Num a => a -> a -> a
+Int
off_a) (Int
y0forall a. Num a => a -> a -> a
+Int
off_b)
            Int
off_a Int
off_b
  forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray VSTArray s
v Int
d (Int
xforall a. Num a => a -> a -> a
-Int
off_a)
  forall (m :: * -> *) a. Monad m => a -> m a
return (Int
xforall a. Num a => a -> a -> a
-Int
off_a)

-- | follow snake from southeast to northwest, x and y are absolute positions
findSnakeRev :: HArray -> HArray -> PArray -> PArray -> MapArray -> MapArray
             -> Int -> Int -> Int -> Int -> Int
findSnakeRev :: HArray
-> HArray
-> PArray
-> PArray
-> MapArray
-> MapArray
-> Int
-> Int
-> Int
-> Int
-> Int
findSnakeRev HArray
h_a HArray
h_b PArray
p_a PArray
p_b MapArray
m_a MapArray
m_b Int
x Int
y Int
off_a Int
off_b =
  if Int
x forall a. Ord a => a -> a -> Bool
> Int
off_a Bool -> Bool -> Bool
&& Int
y forall a. Ord a => a -> a -> Bool
> Int
off_b Bool -> Bool -> Bool
&& HArray
h_aforall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
x forall a. Eq a => a -> a -> Bool
== HArray
h_bforall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
y
       Bool -> Bool -> Bool
&& (HArray
h_aforall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
x forall a. Eq a => a -> a -> Bool
/= Int32
markColl Bool -> Bool -> Bool
|| PArray
p_aforall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!(MapArray
m_aforall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
x) forall a. Eq a => a -> a -> Bool
== PArray
p_bforall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!(MapArray
m_bforall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
y))
     then HArray
-> HArray
-> PArray
-> PArray
-> MapArray
-> MapArray
-> Int
-> Int
-> Int
-> Int
-> Int
findSnakeRev HArray
h_a HArray
h_b PArray
p_a PArray
p_b MapArray
m_a MapArray
m_b (Int
x forall a. Num a => a -> a -> a
- Int
1) (Int
y forall a. Num a => a -> a -> a
- Int
1) Int
off_a Int
off_b
     else Int
x

-- | try to create nicer diffs by shifting around regions of changed lines
shiftBoundaries :: BSTArray s -> BSTArray s -> PArray -> Int -> Int -> ST s ()
shiftBoundaries :: forall s.
BSTArray s -> BSTArray s -> PArray -> Int -> Int -> ST s ()
shiftBoundaries BSTArray s
c_a BSTArray s
c_b PArray
p_a Int
i_ Int
j_ =
  do Maybe Int
x <- forall s. BSTArray s -> Int -> ST s (Maybe Int)
nextChanged BSTArray s
c_a Int
i_
     case Maybe Int
x of
       Just Int
start ->
             do let skipped :: Int
skipped = Int
start forall a. Num a => a -> a -> a
- Int
i_
                Int
j1 <- forall s. BSTArray s -> Int -> Int -> ST s Int
nextUnchangedN BSTArray s
c_b Int
skipped Int
j_
                Int
end <- forall s. BSTArray s -> Int -> ST s Int
nextUnchanged BSTArray s
c_a Int
start
                Int
j2 <- forall s. BSTArray s -> Int -> ST s Int
nextUnchanged BSTArray s
c_b Int
j1
                (Int
i3,Int
j3) <- Int -> Int -> Int -> ST s (Int, Int)
expand Int
start Int
end Int
j2
                forall s.
BSTArray s -> BSTArray s -> PArray -> Int -> Int -> ST s ()
shiftBoundaries BSTArray s
c_a BSTArray s
c_b PArray
p_a Int
i3 Int
j3
       Maybe Int
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return () -- no change up to end of file
 where noline :: Int
noline = forall (a :: * -> * -> *) e. IArray a e => a Int e -> Int
aLen PArray
p_a forall a. Num a => a -> a -> a
+ Int
1
       expand :: Int -> Int -> Int -> ST s (Int, Int)
expand Int
start Int
i Int
j =
         do let len :: Int
len = Int
i forall a. Num a => a -> a -> a
- Int
start
            (Int
start0,Int
i0,Int
j0) <- Int -> Int -> Int -> ST s (Int, Int, Int)
shiftBackward Int
start Int
i Int
j
            Bool
b <- if Int
j0 forall a. Ord a => a -> a -> Bool
> Int
1 then forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray BSTArray s
c_b (Int
j0forall a. Num a => a -> a -> a
-Int
1) else forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
            let corr :: Int
corr = if Bool
b then Int
i0 else Int
noline
            let blank :: Int
blank = if PArray
p_aforall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!(Int
i0forall a. Num a => a -> a -> a
-Int
1) forall a. Eq a => a -> a -> Bool
== ByteString
B.empty then Int
i0
                                               else Int
noline
            (Int
start1,Int
i1,Int
j1,Int
corr1,Int
blank1) <- Int -> Int -> Int -> Int -> Int -> ST s (Int, Int, Int, Int, Int)
shiftForward Int
start0 Int
i0 Int
j0 Int
corr Int
blank
            -- prefer corresponding to ending with blank line
            let newi :: Int
newi = if Int
corr1 forall a. Eq a => a -> a -> Bool
== Int
noline then Int
blank1
                                          else Int
corr1
            (Int
start2,Int
i2,Int
j2) <- Int -> Int -> Int -> Int -> ST s (Int, Int, Int)
moveCorr Int
start1 Int
i1 Int
j1 Int
newi
            if Int
len forall a. Eq a => a -> a -> Bool
/= Int
i2 forall a. Num a => a -> a -> a
- Int
start2
                then Int -> Int -> Int -> ST s (Int, Int)
expand Int
start2 Int
i2 Int
j2
                else forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i2, Int
j2)
       shiftBackward :: Int -> Int -> Int -> ST s (Int, Int, Int)
shiftBackward Int
start Int
i Int
j =
         if Int
start forall a. Ord a => a -> a -> Bool
> Int
1 Bool -> Bool -> Bool
&& PArray
p_aforall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!(Int
iforall a. Num a => a -> a -> a
-Int
1) forall a. Eq a => a -> a -> Bool
== PArray
p_aforall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!(Int
startforall a. Num a => a -> a -> a
-Int
1)
            then do forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i forall a. Eq a => a -> a -> Bool
== Int
start) forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => [Char] -> a
error [Char]
"impossible case"
                    Bool
b1 <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray BSTArray s
c_a (Int
iforall a. Num a => a -> a -> a
-Int
1)
                    Bool
b2 <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray BSTArray s
c_a (Int
startforall a. Num a => a -> a -> a
-Int
1)
                    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
b1 Bool -> Bool -> Bool
|| Bool
b2) forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => [Char] -> a
error [Char]
"impossible case"
                    forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray BSTArray s
c_a (Int
iforall a. Num a => a -> a -> a
-Int
1) Bool
False
                    forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray BSTArray s
c_a (Int
startforall a. Num a => a -> a -> a
-Int
1) Bool
True
                    Bool
b <- if Int
start forall a. Ord a => a -> a -> Bool
> Int
2 then forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray BSTArray s
c_a (Int
startforall a. Num a => a -> a -> a
-Int
2)
                                      else forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                    Int
start' <- if Bool
b then forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int
1forall a. Num a => a -> a -> a
+) (forall s. BSTArray s -> Int -> ST s Int
prevUnchanged BSTArray s
c_a (Int
startforall a. Num a => a -> a -> a
-Int
2))
                                   else forall (m :: * -> *) a. Monad m => a -> m a
return (Int
startforall a. Num a => a -> a -> a
-Int
1)
                    Int
j' <- forall s. BSTArray s -> Int -> ST s Int
prevUnchanged BSTArray s
c_b (Int
jforall a. Num a => a -> a -> a
-Int
1)
                    Int -> Int -> Int -> ST s (Int, Int, Int)
shiftBackward Int
start' (Int
iforall a. Num a => a -> a -> a
-Int
1) Int
j'
            else forall (m :: * -> *) a. Monad m => a -> m a
return (Int
start,Int
i,Int
j)
       shiftForward :: Int -> Int -> Int -> Int -> Int -> ST s (Int, Int, Int, Int, Int)
shiftForward Int
start Int
i Int
j Int
corr Int
blank =
         if Int
i forall a. Ord a => a -> a -> Bool
<= forall (a :: * -> * -> *) e. IArray a e => a Int e -> Int
aLen PArray
p_a Bool -> Bool -> Bool
&& PArray
p_aforall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
i forall a. Eq a => a -> a -> Bool
== PArray
p_aforall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
start Bool -> Bool -> Bool
&&
             -- B.empty at the end of file marks empty line after final newline
             Bool -> Bool
not ((Int
i forall a. Eq a => a -> a -> Bool
== forall (a :: * -> * -> *) e. IArray a e => a Int e -> Int
aLen PArray
p_a) Bool -> Bool -> Bool
&& (PArray
p_aforall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
i forall a. Eq a => a -> a -> Bool
== ByteString
B.empty))
            then do forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i forall a. Eq a => a -> a -> Bool
== Int
start) forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => [Char] -> a
error [Char]
"impossible case"
                    Bool
b1 <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray BSTArray s
c_a Int
i
                    Bool
b2 <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray BSTArray s
c_a Int
start
                    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
b2 Bool -> Bool -> Bool
||  Bool
b1) forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => [Char] -> a
error [Char]
"impossible case"
                    forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray BSTArray s
c_a Int
i Bool
True
                    forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray BSTArray s
c_a Int
start Bool
False
                    Int
i0 <- forall s. BSTArray s -> Int -> ST s Int
nextUnchanged BSTArray s
c_a (Int
iforall a. Num a => a -> a -> a
+Int
1)
                    Int
j0 <- forall s. BSTArray s -> Int -> ST s Int
nextUnchanged BSTArray s
c_b (Int
jforall a. Num a => a -> a -> a
+Int
1)
                    let corr0 :: Int
corr0
                            | Int
i0 forall a. Ord a => a -> a -> Bool
> (Int
iforall a. Num a => a -> a -> a
+Int
1) = Int
noline
                            | Int
j0forall a. Num a => a -> a -> a
-Int
j forall a. Ord a => a -> a -> Bool
> Int
2 = Int
i0
                            | Bool
otherwise = Int
corr
                    let blank0 :: Int
blank0
                            | Int
i0 forall a. Ord a => a -> a -> Bool
> Int
iforall a. Num a => a -> a -> a
+Int
1 = Int
noline
                            | PArray
p_aforall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!(Int
i0forall a. Num a => a -> a -> a
-Int
1) forall a. Eq a => a -> a -> Bool
== ByteString
B.empty = Int
i0
                            | Bool
otherwise = Int
blank
                    Int -> Int -> Int -> Int -> Int -> ST s (Int, Int, Int, Int, Int)
shiftForward (Int
startforall a. Num a => a -> a -> a
+Int
1) Int
i0 Int
j0 Int
corr0 Int
blank0
            else forall (m :: * -> *) a. Monad m => a -> m a
return (Int
start,Int
i,Int
j,Int
corr,Int
blank)
       moveCorr :: Int -> Int -> Int -> Int -> ST s (Int, Int, Int)
moveCorr Int
start Int
i Int
j Int
corr =
         if Int
corr forall a. Ord a => a -> a -> Bool
>= Int
i
            then forall (m :: * -> *) a. Monad m => a -> m a
return (Int
start,Int
i,Int
j)
            else do Bool
b1 <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray BSTArray s
c_a (Int
iforall a. Num a => a -> a -> a
-Int
1)
                    Bool
b2 <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray BSTArray s
c_a (Int
startforall a. Num a => a -> a -> a
-Int
1)
                    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
b1 Bool -> Bool -> Bool
|| Bool
b2) forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => [Char] -> a
error [Char]
"impossible case"
                    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PArray
p_aforall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!(Int
iforall a. Num a => a -> a -> a
-Int
1) forall a. Eq a => a -> a -> Bool
/= PArray
p_aforall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!(Int
startforall a. Num a => a -> a -> a
-Int
1)) forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => [Char] -> a
error [Char]
"impossible case"
                    forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray BSTArray s
c_a (Int
iforall a. Num a => a -> a -> a
-Int
1) Bool
False
                    forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray BSTArray s
c_a (Int
startforall a. Num a => a -> a -> a
-Int
1) Bool
True
                    Int
j' <- forall s. BSTArray s -> Int -> ST s Int
prevUnchanged BSTArray s
c_b (Int
jforall a. Num a => a -> a -> a
-Int
1)
                    Int -> Int -> Int -> Int -> ST s (Int, Int, Int)
moveCorr (Int
startforall a. Num a => a -> a -> a
-Int
1) (Int
iforall a. Num a => a -> a -> a
-Int
1) Int
j' Int
corr

-- | goto next unchanged line, return the given line if unchanged
nextUnchanged :: BSTArray s -> Int -> ST s Int
nextUnchanged :: forall s. BSTArray s -> Int -> ST s Int
nextUnchanged BSTArray s
c Int
i = do
  Int
len <- forall (a :: * -> * -> *) e (m :: * -> *).
MArray a e m =>
a Int e -> m Int
aLenM BSTArray s
c
  if Int
i forall a. Eq a => a -> a -> Bool
== Int
len forall a. Num a => a -> a -> a
+ Int
1 then forall (m :: * -> *) a. Monad m => a -> m a
return Int
i
     else do Bool
b <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray BSTArray s
c Int
i
             if Bool
b then forall s. BSTArray s -> Int -> ST s Int
nextUnchanged BSTArray s
c (Int
iforall a. Num a => a -> a -> a
+Int
1)
                  else forall (m :: * -> *) a. Monad m => a -> m a
return Int
i

-- | skip at least one unchanged line, if there is none advance
--   behind the last line
skipOneUnChanged :: BSTArray s -> Int -> ST s Int
skipOneUnChanged :: forall s. BSTArray s -> Int -> ST s Int
skipOneUnChanged BSTArray s
c Int
i = do
  Int
len <- forall (a :: * -> * -> *) e (m :: * -> *).
MArray a e m =>
a Int e -> m Int
aLenM BSTArray s
c
  if Int
i forall a. Eq a => a -> a -> Bool
== Int
len forall a. Num a => a -> a -> a
+ Int
1
     then forall (m :: * -> *) a. Monad m => a -> m a
return Int
i
     else do Bool
b <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray BSTArray s
c Int
i
             if Bool -> Bool
not Bool
b then forall (m :: * -> *) a. Monad m => a -> m a
return (Int
iforall a. Num a => a -> a -> a
+Int
1)
                      else forall s. BSTArray s -> Int -> ST s Int
skipOneUnChanged BSTArray s
c (Int
iforall a. Num a => a -> a -> a
+Int
1)

-- | goto n-th next unchanged line
nextUnchangedN :: BSTArray s -> Int -> Int -> ST s Int
nextUnchangedN :: forall s. BSTArray s -> Int -> Int -> ST s Int
nextUnchangedN BSTArray s
c Int
n Int
i =
  if Int
n forall a. Eq a => a -> a -> Bool
== Int
0 then forall (m :: * -> *) a. Monad m => a -> m a
return Int
i
            else do Int
i' <- forall s. BSTArray s -> Int -> ST s Int
skipOneUnChanged BSTArray s
c Int
i
                    forall s. BSTArray s -> Int -> Int -> ST s Int
nextUnchangedN BSTArray s
c (Int
nforall a. Num a => a -> a -> a
-Int
1) Int
i'

-- | goto next changed line, return the given line if changed
nextChanged :: BSTArray s -> Int -> ST s (Maybe Int)
nextChanged :: forall s. BSTArray s -> Int -> ST s (Maybe Int)
nextChanged BSTArray s
c Int
i = do
  Int
len <- forall (a :: * -> * -> *) e (m :: * -> *).
MArray a e m =>
a Int e -> m Int
aLenM BSTArray s
c
  if Int
i forall a. Ord a => a -> a -> Bool
<= Int
len
    then do Bool
b <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray BSTArray s
c Int
i
            if Bool -> Bool
not Bool
b then forall s. BSTArray s -> Int -> ST s (Maybe Int)
nextChanged BSTArray s
c (Int
iforall a. Num a => a -> a -> a
+Int
1)
                     else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Int
i
    else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

-- | goto previous unchanged line, return the given line if unchanged
prevUnchanged :: BSTArray s -> Int -> ST s Int
prevUnchanged :: forall s. BSTArray s -> Int -> ST s Int
prevUnchanged BSTArray s
c Int
i = do
  Bool
b <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray BSTArray s
c Int
i
  if Bool
b then forall s. BSTArray s -> Int -> ST s Int
prevUnchanged BSTArray s
c (Int
iforall a. Num a => a -> a -> a
-Int
1)
       else forall (m :: * -> *) a. Monad m => a -> m a
return Int
i

type HArray = UArray Int Int32
type BArray = UArray Int Bool
type PArray = Array Int B.ByteString
type MapArray = UArray Int Int
type VSTArray s = STUArray s Int Int
type BSTArray s = STUArray s Int Bool

initV :: Int -> ST s (VSTArray s)
initV :: forall s. Int -> ST s (VSTArray s)
initV Int
dmax = forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (-(Int
dmax forall a. Num a => a -> a -> a
+ Int
1), Int
dmax forall a. Num a => a -> a -> a
+ Int
1) (-Int
1)

initVRev :: Int -> Int -> ST s (VSTArray s)
initVRev :: forall s. Int -> Int -> ST s (VSTArray s)
initVRev Int
dmax Int
xmax = forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (-(Int
dmax forall a. Num a => a -> a -> a
+ Int
1), Int
dmax forall a. Num a => a -> a -> a
+ Int
1) (Int
xmax forall a. Num a => a -> a -> a
+ Int
1)

-- 1 indexed, v[0] is used as a guard element
initVChanged :: Int -> ST s (BSTArray s)
initVChanged :: forall s. Int -> ST s (BSTArray s)
initVChanged Int
l = do
  BSTArray s
a <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (Int
0, Int
l) Bool
True
  forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray BSTArray s
a Int
0 Bool
False
  forall (m :: * -> *) a. Monad m => a -> m a
return BSTArray s
a
  -- set to false for all lines which have a mapping later
  -- other lines are only present in one of the files

initH :: [Int32] -> HArray
initH :: [Int32] -> HArray
initH [Int32]
a = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0, forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int32]
a) (Int32
0forall a. a -> [a] -> [a]
:[Int32]
a)

initM :: [Int] -> MapArray
initM :: [Int] -> MapArray
initM [Int]
a = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0, forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
a) (Int
0forall a. a -> [a] -> [a]
:[Int]
a)

initP :: [B.ByteString] -> PArray
initP :: [ByteString] -> PArray
initP [ByteString]
a = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0, forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
a) (ByteString
B.emptyforall a. a -> [a] -> [a]
:[ByteString]
a)

aLen :: (IArray a e) => a Int e -> Int
aLen :: forall (a :: * -> * -> *) e. IArray a e => a Int e -> Int
aLen a Int e
a = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds a Int e
a
aLenM :: (MArray a e m) => a Int e -> m Int
aLenM :: forall (a :: * -> * -> *) e (m :: * -> *).
MArray a e m =>
a Int e -> m Int
aLenM a Int e
a = forall a b. (a, b) -> b
snd forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> m (i, i)
getBounds a Int e
a

convertPatch :: Int -> PArray -> PArray -> (Int, Int, Int, Int)
             -> (Int,[B.ByteString],[B.ByteString])
convertPatch :: Int
-> PArray
-> PArray
-> (Int, Int, Int, Int)
-> (Int, [ByteString], [ByteString])
convertPatch Int
off PArray
a PArray
b (Int
a0,Int
a1,Int
b0,Int
b1)
 | Int
b0 forall a. Eq a => a -> a -> Bool
== Int
b1 = (Int
b0forall a. Num a => a -> a -> a
+Int
off,PArray -> Int -> Int -> [ByteString]
getDelete PArray
a Int
a0 Int
a1,[])
 | Int
a0 forall a. Eq a => a -> a -> Bool
== Int
a1 = (Int
b0forall a. Num a => a -> a -> a
+Int
off,[],PArray -> Int -> Int -> [ByteString]
getInsert PArray
b Int
b0 Int
b1)
 | Bool
otherwise = (Int
b0forall a. Num a => a -> a -> a
+Int
off,PArray -> Int -> Int -> [ByteString]
getDelete PArray
a Int
a0 Int
a1,PArray -> Int -> Int -> [ByteString]
getInsert PArray
b Int
b0 Int
b1)

getInsert :: PArray -> Int -> Int -> [B.ByteString]
getInsert :: PArray -> Int -> Int -> [ByteString]
getInsert PArray
b Int
from Int
to
  | Int
from forall a. Ord a => a -> a -> Bool
>= Int
to = []
  | Bool
otherwise = (PArray
bforall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!(Int
fromforall a. Num a => a -> a -> a
+Int
1))forall a. a -> [a] -> [a]
:PArray -> Int -> Int -> [ByteString]
getInsert PArray
b (Int
fromforall a. Num a => a -> a -> a
+Int
1) Int
to
getDelete :: PArray -> Int -> Int -> [B.ByteString]
getDelete :: PArray -> Int -> Int -> [ByteString]
getDelete PArray
a Int
from Int
to
  | Int
from forall a. Ord a => a -> a -> Bool
>= Int
to = []
  | Bool
otherwise = (PArray
aforall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!(Int
fromforall a. Num a => a -> a -> a
+Int
1))forall a. a -> [a] -> [a]
:PArray -> Int -> Int -> [ByteString]
getDelete PArray
a (Int
fromforall a. Num a => a -> a -> a
+Int
1) Int
to

createPatch :: BArray -> BArray -> [(Int, Int, Int, Int)]
createPatch :: BArray -> BArray -> [(Int, Int, Int, Int)]
createPatch BArray
c_a BArray
c_b =
  forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ BArray -> BArray -> Int -> Int -> [(Int, Int, Int, Int)]
createP BArray
c_a BArray
c_b (forall (a :: * -> * -> *) e. IArray a e => a Int e -> Int
aLen BArray
c_a) (forall (a :: * -> * -> *) e. IArray a e => a Int e -> Int
aLen BArray
c_b)

createP :: BArray -> BArray -> Int -> Int -> [(Int, Int, Int, Int)]
createP :: BArray -> BArray -> Int -> Int -> [(Int, Int, Int, Int)]
createP BArray
_ BArray
_ Int
0 Int
0 = []
createP BArray
c_a BArray
c_b Int
ia Int
ib =
  if BArray
c_aforall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
ia Bool -> Bool -> Bool
|| BArray
c_bforall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
ib
     then let ia' :: Int
ia' = BArray -> Int -> Int
skipChangedRev BArray
c_a Int
ia
              ib' :: Int
ib' = BArray -> Int -> Int
skipChangedRev BArray
c_b Int
ib
          in (Int
ia',Int
ia,Int
ib',Int
ib)forall a. a -> [a] -> [a]
:BArray -> BArray -> Int -> Int -> [(Int, Int, Int, Int)]
createP BArray
c_a BArray
c_b Int
ia' Int
ib'
     else BArray -> BArray -> Int -> Int -> [(Int, Int, Int, Int)]
createP BArray
c_a BArray
c_b (Int
iaforall a. Num a => a -> a -> a
-Int
1) (Int
ibforall a. Num a => a -> a -> a
-Int
1)

skipChangedRev :: BArray -> Int -> Int
skipChangedRev :: BArray -> Int -> Int
skipChangedRev BArray
c Int
i = if Int
i forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& BArray
cforall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
i then BArray -> Int -> Int
skipChangedRev BArray
c (Int
iforall a. Num a => a -> a -> a
-Int
1) else Int
i