1
1
mirror of https://github.com/github/semantic.git synced 2024-12-03 00:16:52 +03:00

Pass decoratingWith the comparability & equivalence relations.

This commit is contained in:
Rob Rix 2017-09-25 12:05:31 -04:00
parent fb56d8b604
commit e142157ab9

View File

@ -30,24 +30,25 @@ diffSyntaxTerms :: (HasField fields1 Category, HasField fields2 Category)
=> Term Syntax (Record fields1) -- ^ A term representing the old state.
-> Term Syntax (Record fields2) -- ^ A term representing the new state.
-> Diff Syntax (Record fields1) (Record fields2)
diffSyntaxTerms = decoratingWith getLabel getLabel (diffTermsWith comparableByCategory (equalTerms comparableByCategory))
diffSyntaxTerms = decoratingWith comparableByCategory (equalTerms comparableByCategory) getLabel getLabel
-- | Diff two à la carte terms recursively.
diffTerms :: (Declaration.Method :< fs, Declaration.Function :< fs, Syntax.Context :< fs, Apply GAlign fs, Apply Show1 fs, Apply Foldable fs, Apply Functor fs, Apply Traversable fs, Apply Diffable fs)
=> Term (Union fs) (Record fields1)
-> Term (Union fs) (Record fields2)
-> Diff (Union fs) (Record fields1) (Record fields2)
diffTerms = decoratingWith constructorNameAndConstantFields constructorNameAndConstantFields (diffTermsWith comparableByConstructor equivalentTerms)
diffTerms = decoratingWith comparableByConstructor equivalentTerms constructorNameAndConstantFields constructorNameAndConstantFields
-- | Diff two terms by decorating with feature vectors computed using the supplied labelling algebra, and stripping the feature vectors from the resulting diff.
decoratingWith :: (Hashable label, Traversable syntax)
=> (forall a. TermF syntax (Record fields1) a -> label)
decoratingWith :: (Hashable label, Diffable syntax, GAlign syntax, Traversable syntax)
=> ComparabilityRelation syntax (Record (FeatureVector ': fields1)) (Record (FeatureVector ': fields2)) -- ^ A relation on terms used to determine comparability and equality.
-> (Term syntax (Record (FeatureVector ': fields1)) -> Term syntax (Record (FeatureVector ': fields2)) -> Bool) -- ^ A relation used to determine term equivalence.
-> (forall a. TermF syntax (Record fields1) a -> label)
-> (forall a. TermF syntax (Record fields2) a -> label)
-> (Term syntax (Record (FeatureVector ': fields1)) -> Term syntax (Record (FeatureVector ': fields2)) -> Diff syntax (Record (FeatureVector ': fields1)) (Record (FeatureVector ': fields2)))
-> Term syntax (Record fields1)
-> Term syntax (Record fields2)
-> Diff syntax (Record fields1) (Record fields2)
decoratingWith getLabel1 getLabel2 differ t1 t2 = stripDiff (differ (defaultFeatureVectorDecorator getLabel1 t1) (defaultFeatureVectorDecorator getLabel2 t2))
decoratingWith comparability equivalence getLabel1 getLabel2 t1 t2 = stripDiff (diffTermsWith comparability equivalence (defaultFeatureVectorDecorator getLabel1 t1) (defaultFeatureVectorDecorator getLabel2 t2))
-- | Diff a pair of terms recurisvely, using the supplied continuation and 'ComparabilityRelation'.
diffTermsWith :: forall syntax fields1 fields2