github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-22 14:21:31 +03:00
Code Issues Projects Releases Wiki Activity

Maintain call-stacks.

Browse Source
This commit is contained in:
Rob Rix 2017-03-10 13:12:05 -05:00
parent a8222cf0d8
commit 91694c4999
1 changed files with 11 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
src/SES/Myers.hs
View File

@ -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