1
1
mirror of https://github.com/github/semantic.git synced 2024-12-22 14:21:31 +03:00

Equate terms with respect to their categories.

This commit is contained in:
Rob Rix 2016-07-14 11:27:54 -04:00
parent 8f84d93a8e
commit 02e836d364

View File

@ -32,7 +32,7 @@ diffTerms construct comparable cost a b = fromMaybe (pure $ Replace a b) $ const
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 :: (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 construct comparable cost t1 t2 constructAndRun construct comparable cost t1 t2
| not $ comparable t1 t2 = Nothing | not $ comparable t1 t2 = Nothing
| (() <$ t1) == (() <$ t2) = hylo construct runCofree <$> zipTerms t1 t2 | (category <$> t1) == (category <$> t2) = hylo construct runCofree <$> zipTerms t1 t2
| otherwise = | otherwise =
run construct comparable cost $ algorithm a b where run construct comparable cost $ algorithm a b where
algorithm (Indexed a') (Indexed b') = wrap $! ByIndex a' b' (annotate . Indexed) algorithm (Indexed a') (Indexed b') = wrap $! ByIndex a' b' (annotate . Indexed)