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

Unpack the annotations &c inline.

Browse Source
This commit is contained in:
Rob Rix 2016-08-04 10:54:36 -04:00
parent 99b076df80
commit 7809ae1756
1 changed files with 2 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
src/Interpreter.hs
View File

@ -41,14 +41,13 @@ 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 a b where
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
(annotation1 :< a, annotation2 :< b) = (runCofree t1, runCofree t2)
annotate = pure . construct . (both annotation1 annotation2 :<)
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