From 1b98349e92a765f1a3d4bccd447e3c9b2b95d950 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Xavier=20G=C3=B3ngora?= Date: Thu, 7 May 2026 10:01:01 -0600 Subject: [PATCH 1/4] Enable benchmark --- Diff.cabal | 10 ++++++++++ bench/bench.hs | 11 +++++++++-- 2 files changed, 19 insertions(+), 2 deletions(-) diff --git a/Diff.cabal b/Diff.cabal index 155ef8b..7c4220b 100644 --- a/Diff.cabal +++ b/Diff.cabal @@ -62,3 +62,13 @@ test-suite diff-tests , QuickCheck , test-framework , test-framework-quickcheck2 + +benchmark simple + type: exitcode-stdio-1.0 + main-is: bench/bench.hs + build-depends: + Diff + , base >= 3 && <= 6 + , criterion + , deepseq + , random diff --git a/bench/bench.hs b/bench/bench.hs index c691237..a24391e 100644 --- a/bench/bench.hs +++ b/bench/bench.hs @@ -1,13 +1,20 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE StandaloneDeriving #-} +-- {-# OPTIONS_GHC -Wno-orphans #-} + module Main where import Criterion.Main import Control.DeepSeq +import GHC.Generics import System.Random import Data.Algorithm.Diff -instance NFData (Diff a) where - +deriving instance Generic (Diff a) + +instance NFData a => NFData (Diff a) main :: IO () main = doBenchMarks 37 From f15bb9427a3e8481ea770e546002c6952506511c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Xavier=20G=C3=B3ngora?= Date: Wed, 22 Apr 2026 13:25:15 -0600 Subject: [PATCH 2/4] Refactor `dstep` to a single list traversal --- src/Data/Algorithm/Diff.hs | 45 +++++++++++++++----------------------- 1 file changed, 18 insertions(+), 27 deletions(-) diff --git a/src/Data/Algorithm/Diff.hs b/src/Data/Algorithm/Diff.hs index 9288954..ff18b77 100644 --- a/src/Data/Algorithm/Diff.hs +++ b/src/Data/Algorithm/Diff.hs @@ -189,35 +189,26 @@ canDiag eq as bs lena lenb = \ i j -> -- 'addsnake' is applied to each candidate immediately to extend it along any -- available sequence of matching elements. -- --- The resulting candidate list interleaves the 'F' and 'S' successors of each --- wave front node. The head ('F' successor of the first node) is kept as-is, and --- 'selectBestDLFromPairs' is applied to the tail — pairing each 'S' successor with the 'F' --- successor of the next wave front node. When this function is iterated from a --- single-node seed (as in 'ses'), each such pair always lies on the same --- diagonal: an 'F' edge advances to the next higher diagonal while an 'S' edge --- retreats to the next lower one, so the two members of each pair straddle the --- same diagonal from opposite sides. +-- The resulting candidates are merged pairwise: the vertical successor of each +-- node is paired with the horizontal successor of the next node in the wave +-- front. When this function is iterated from a single-node seed (as in 'ses'), +-- each such pair always lies on the same diagonal: an 'F' edge advances to the +-- next higher diagonal while an 'S' edge retreats to the next lower one, so the +-- two members of each pair straddle the same diagonal from opposite sides. dstep :: (Int -> Int -> Bool) -- ^ Diagonal predicate - -> [DL] -- ^ Wave front of D-paths at edit distance D - -> [DL] -- ^ Wave front of D-paths at edit distance D+1 -dstep cd dls = hd:selectBestDLFromPairs rst - where (hd:rst) = nextDLs dls - -- Extend each node by one edit step in both possible directions - -- and then follow any available snake from the resulting position. - nextDLs [] = [] - nextDLs (dl:rest) = dl':dl'':nextDLs rest - where dl' = addsnake cd $ dl {poi=poi dl + 1, path=(F : pdl)} - dl'' = addsnake cd $ dl {poj=poj dl + 1, path=(S : pdl)} - pdl = path dl - -- Select the furthest-reaching candidate from adjacent pairs of nodes. - -- Note that candidate pairs are always on the same /k-diagonal/ by construction - -- at call site (in 'ses' where it iterates starting from a single node - -- wave front), meaning that each compared pair @x@ and @y@ are such that: - -- @(poi x - poj x) = (poi y - poj y)@ - selectBestDLFromPairs [] = [] - selectBestDLFromPairs [x] = [x] - selectBestDLFromPairs (x:y:rest) = furthestReaching x y:selectBestDLFromPairs rest + -> [DL] -- ^ A non-empty wave front of nodes at edit distance D + -> [DL] -- ^ A non-empty wave front of nodes at edit distance D+1 +dstep cd (dl:dls) = hStep dl : stepAndMerge dl dls + where + hStep node = addsnake cd $ node {poi = poi node + 1, path = F : path node} + vStep node = addsnake cd $ node {poj = poj node + 1, path = S : path node} + -- Merge vertical step of previous node with horizontal step of next node, + -- selecting the furthest-reaching candidate for each shared k-diagonal. + stepAndMerge :: DL -> [DL] -> [DL] + stepAndMerge prev [] = [vStep prev] + stepAndMerge prev (next:rest) = + furthestReaching (vStep prev) (hStep next) : stepAndMerge next rest -- | Follow a /snake/ from the current position of a 'DL' node. -- From 69c113279139b2573dd07aea29fbf06f8449e9e4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Xavier=20G=C3=B3ngora?= Date: Wed, 13 May 2026 08:58:46 -0600 Subject: [PATCH 3/4] Add equation with error call to fix exhaustiveness check --- src/Data/Algorithm/Diff.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Data/Algorithm/Diff.hs b/src/Data/Algorithm/Diff.hs index ff18b77..43328cb 100644 --- a/src/Data/Algorithm/Diff.hs +++ b/src/Data/Algorithm/Diff.hs @@ -195,10 +195,13 @@ canDiag eq as bs lena lenb = \ i j -> -- each such pair always lies on the same diagonal: an 'F' edge advances to the -- next higher diagonal while an 'S' edge retreats to the next lower one, so the -- two members of each pair straddle the same diagonal from opposite sides. +-- +-- Precondition: The node list must be non-empty. dstep :: (Int -> Int -> Bool) -- ^ Diagonal predicate -> [DL] -- ^ A non-empty wave front of nodes at edit distance D -> [DL] -- ^ A non-empty wave front of nodes at edit distance D+1 +dstep _ [] = error "dstep: Cannot perform expansion on an empty list of nodes" dstep cd (dl:dls) = hStep dl : stepAndMerge dl dls where hStep node = addsnake cd $ node {poi = poi node + 1, path = F : path node} From 616c5184c7f675013ed0fad2e6f60a3fb7c89d82 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Xavier=20G=C3=B3ngora?= Date: Wed, 13 May 2026 10:21:27 -0600 Subject: [PATCH 4/4] Add `default-language` to `Diff.cabal` MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Facundo Domínguez --- Diff.cabal | 1 + 1 file changed, 1 insertion(+) diff --git a/Diff.cabal b/Diff.cabal index 7c4220b..2866881 100644 --- a/Diff.cabal +++ b/Diff.cabal @@ -64,6 +64,7 @@ test-suite diff-tests , test-framework-quickcheck2 benchmark simple + default-language: Haskell2010 type: exitcode-stdio-1.0 main-is: bench/bench.hs build-depends: