github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-11-24 00:42:33 +03:00
Code Issues Projects Releases Wiki Activity

Safe array subscripting.

Browse Source 
This halves our heap consumption. I don’t know how.
This commit is contained in:
Rob Rix 2017-06-21 15:46:36 -04:00
parent 139c9513d1
commit 9337631149
1 changed files with 19 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
src/SES/Myers.hs
View File

@ -4,7 +4,6 @@ module SES.Myers
, ses
) where
import Data.Array ((!))
import qualified Data.Array as Array
import Data.Ix
import Data.These
@ -37,27 +36,36 @@ ses eq as' bs'
-- Search an edit graph for the shortest edit script along a specific diagonal, moving onto a given diagonal from one of its in-bounds adjacent diagonals (if any).
searchAlongK !k
| k == -d = moveDownFrom (v ! succ k)
| k == d = moveRightFrom (v ! pred k)
| k == -m = moveDownFrom (v ! succ k)
| k == n = moveRightFrom (v ! pred k)
| k == -d = moveDownFrom (v Array.! succ k)
| k == d = moveRightFrom (v Array.! pred k)
| k == -m = moveDownFrom (v Array.! succ k)
| k == n = moveRightFrom (v Array.! pred k)
| otherwise =
let left = v ! pred k
up = v ! succ k in
let left = v Array.! pred k
up = v Array.! succ k in
if x left < x up then
moveDownFrom up
else
moveRightFrom left
-- | Move downward from a given vertex, inserting the element for the corresponding row.
moveDownFrom (Endpoint x y script) = Endpoint x (succ y) (if y >= 0 && y < m then That (bs ! y) : script else script)
moveDownFrom (Endpoint x y script) = Endpoint x (succ y) $ case bs ! y of
Just b -> That b : script
_ -> script
-- | Move rightward from a given vertex, deleting the element for the corresponding column.
moveRightFrom (Endpoint x y script) = Endpoint (succ x) y (if x < n then This (as ! x) : script else script)
moveRightFrom (Endpoint x y script) = Endpoint (succ x) y $ case as ! x of
Just a -> This a : script
_ -> script
-- | Slide down any diagonal edges from a given vertex.
slideFrom (Endpoint x y script)
| inRange (Array.bounds as) x, a <- as ! x
, inRange (Array.bounds bs) y, b <- bs ! y
| Just a <- as ! x
, Just b <- bs ! y
, a `eq` b = slideFrom (Endpoint (succ x) (succ y) (These a b : script))
| otherwise = Endpoint x y script
(!) :: Ix i => Array.Array i a -> i -> Maybe a
(!) v i | inRange (Array.bounds v) i = Just $! v Array.! i
| otherwise = Nothing