2016-01-04 17:25:37 +03:00
|
|
|
{-# LANGUAGE FlexibleInstances #-}
|
2016-02-04 21:59:33 +03:00
|
|
|
module Category where
|
2015-11-18 22:23:35 +03:00
|
|
|
|
2015-11-27 20:02:15 +03:00
|
|
|
import Term
|
|
|
|
import Control.Comonad.Cofree
|
2015-11-18 22:23:35 +03:00
|
|
|
import Data.Set
|
|
|
|
|
2016-02-05 00:35:42 +03:00
|
|
|
-- | A standardized category of AST node. Used to determine the semantics for
|
|
|
|
-- | semantic diffing and define comparability of nodes.
|
|
|
|
data Category =
|
2016-02-06 00:59:38 +03:00
|
|
|
-- | An operator with 2 operands.
|
|
|
|
BinaryOperator
|
2016-02-05 00:35:42 +03:00
|
|
|
-- | A literal key-value data structure.
|
2016-02-06 00:59:38 +03:00
|
|
|
| DictionaryLiteral
|
2016-02-14 05:01:52 +03:00
|
|
|
-- | A pair, e.g. of a key & value
|
|
|
|
| Pair
|
2016-02-06 00:54:08 +03:00
|
|
|
-- | A call to a function.
|
|
|
|
| FunctionCall
|
2016-02-24 23:47:53 +03:00
|
|
|
-- | A string literal.
|
|
|
|
| StringLiteral
|
|
|
|
-- | An integer literal.
|
|
|
|
| IntegerLiteral
|
|
|
|
-- | A symbol literal.
|
|
|
|
| SymbolLiteral
|
2016-02-05 00:35:42 +03:00
|
|
|
-- | A non-standard category, which can be used for comparability.
|
|
|
|
| Other String
|
2016-02-05 00:47:33 +03:00
|
|
|
deriving (Eq, Show, Ord)
|
2016-02-05 00:35:42 +03:00
|
|
|
|
2016-01-14 17:17:12 +03:00
|
|
|
-- | The class of types that have categories.
|
2015-11-18 22:23:35 +03:00
|
|
|
class Categorizable a where
|
2016-02-05 21:48:13 +03:00
|
|
|
categories :: a -> Set Category
|
2015-11-18 22:25:53 +03:00
|
|
|
|
2015-11-27 20:02:15 +03:00
|
|
|
instance Categorizable annotation => Categorizable (Term a annotation) where
|
|
|
|
categories (annotation :< _) = categories annotation
|
|
|
|
|
2016-01-14 17:17:12 +03:00
|
|
|
-- | Test whether the categories from the categorizables intersect.
|
2015-11-18 22:25:53 +03:00
|
|
|
comparable :: Categorizable a => a -> a -> Bool
|
2015-12-09 18:59:13 +03:00
|
|
|
comparable a b = catsA == catsB || (not . Data.Set.null $ intersection catsA catsB)
|
|
|
|
where
|
|
|
|
catsA = categories a
|
|
|
|
catsB = categories b
|