From aa4aa4438fa3d17bf2efcb86cbf079d2d1e47a9f Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 22 Mar 2017 16:18:49 -0400 Subject: [PATCH] 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)