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

Match the parameters only once.

Browse Source
This commit is contained in:
Rob Rix 2016-07-08 12:14:42 -04:00
parent 6961a9ac9c
commit 51d8fcd99a
1 changed files with 4 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
src/Interpreter.hs
View File

@ -34,11 +34,10 @@ diffTerms construct comparable cost a b = fromMaybe (pure $ Replace a b) $ const
-- | Constructs an algorithm and runs it
constructAndRun :: (Eq leaf, Hashable leaf, Ord (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 _ comparable _ a b | not $ comparable a b = Nothing
constructAndRun construct _ _ a b | (() <$ a) == (() <$ b) = hylo construct runCofree <$> zipTerms a b
constructAndRun construct comparable cost t1 t2 =
constructAndRun construct comparable cost t1 t2
| not $ comparable t1 t2 = Nothing
| (() <$ t2) == (() <$ t2) = hylo construct runCofree <$> zipTerms t1 t2
| otherwise =
run construct comparable cost $ algorithm a b where
algorithm (Indexed a') (Indexed b') = wrap $! ByIndex a' b' (annotate . Indexed)
algorithm (Keyed a') (Keyed b') = wrap $! ByKey a' b' (annotate . Keyed)