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

Rearrange the definition of constructAndRun a little.

Browse Source
This commit is contained in:
Rob Rix 2016-08-04 10:56:20 -04:00
parent 7809ae1756
commit 0953d430b9
1 changed files with 8 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
src/Interpreter.hs
View File

@ -38,16 +38,15 @@ diffComparableTerms construct comparable cost a b
-- | Constructs an algorithm and runs it
constructAndRun :: (Eq leaf, Hashable leaf, Eq (Record fields), HasField fields Category) => DiffConstructor leaf (Record fields) -> Comparable leaf (Record fields) -> SES.Cost (Diff leaf (Record fields)) -> Term leaf (Record fields) -> Term leaf (Record fields) -> Maybe (Diff leaf (Record fields))
constructAndRun construct comparable cost t1 t2
| not $ comparable t1 t2 = Nothing
| (category <$> t1) == (category <$> t2) = hylo construct runCofree <$> zipTerms t1 t2
| otherwise =
run construct comparable cost $ algorithm (unwrap t1) (unwrap t2) where
algorithm (Indexed a') (Indexed b') = do
diffs <- byIndex a' b'
annotate (Indexed diffs)
algorithm (Leaf a') (Leaf b') | a' == b' = annotate $ Leaf b'
algorithm _ _ = recursively t1 t2
annotate = pure . construct . (both (extract t1) (extract t2) :<)
| comparable t1 t2 = run construct comparable cost $ algorithm (unwrap t1) (unwrap t2)
| otherwise = Nothing
where algorithm (Indexed a') (Indexed b') = do
diffs <- byIndex a' b'
annotate (Indexed diffs)
algorithm (Leaf a') (Leaf b') | a' == b' = annotate $ Leaf b'
algorithm _ _ = recursively t1 t2
annotate = pure . construct . (both (extract t1) (extract t2) :<)
algorithmWithTerms :: Eq leaf => Term leaf (Record fields) -> Term leaf (Record fields) -> Algorithm (Term leaf (Record fields)) (Diff leaf (Record fields)) (Diff leaf (Record fields))
algorithmWithTerms t1 t2 = case (unwrap t1, unwrap t2) of