1
1
mirror of https://github.com/github/semantic.git synced 2024-12-26 00:12:29 +03:00
semantic/src/Term.hs

35 lines
1.5 KiB
Haskell
Raw Normal View History

2015-11-18 22:27:09 +03:00
module Term where
2016-01-06 19:56:58 +03:00
import Data.OrderedMap hiding (size)
2015-11-19 04:11:13 +03:00
import Data.Maybe
import Control.Comonad.Cofree
import Syntax
2016-01-13 23:35:40 +03:00
-- | An annotated node (Syntax) in an abstract syntax tree.
type Term a annotation = Cofree (Syntax a) annotation
2016-01-13 23:35:40 +03:00
-- | Zip two terms by combining their annotations into a pair of annotations.
-- | If the structure of the two terms don't match, then Nothing will be returned.
2015-11-27 17:31:56 +03:00
zipTerms :: Term a annotation -> Term a annotation -> Maybe (Term a (annotation, annotation))
2015-11-19 04:33:09 +03:00
zipTerms (annotation1 :< a) (annotation2 :< b) = annotate $ zipUnwrap a b
2015-11-19 03:58:37 +03:00
where
2015-11-19 04:33:09 +03:00
annotate = fmap ((annotation1, annotation2) :<)
2015-11-27 20:02:28 +03:00
zipUnwrap (Leaf _) (Leaf b') = Just $ Leaf b'
zipUnwrap (Indexed a') (Indexed b') = Just . Indexed . catMaybes $ zipWith zipTerms a' b'
zipUnwrap (Fixed a') (Fixed b') = Just . Fixed . catMaybes $ zipWith zipTerms a' b'
zipUnwrap (Keyed a') (Keyed b') | keys a' == keys b' = Just . Keyed . fromList . catMaybes $ zipUnwrapMaps a' b' <$> keys a'
zipUnwrap _ _ = Nothing
zipUnwrapMaps a' b' key = (,) key <$> zipTerms (a' ! key) (b' ! key)
2015-11-20 04:17:17 +03:00
2016-01-14 00:19:48 +03:00
-- | Fold a term into some other value, starting with the leaves.
2015-11-20 04:17:17 +03:00
cata :: (annotation -> Syntax a b -> b) -> Term a annotation -> b
cata f (annotation :< syntax) = f annotation $ cata f <$> syntax
2015-12-01 03:13:20 +03:00
2016-01-13 23:35:40 +03:00
-- | Return the number of leaves in the node.
2015-12-01 03:13:20 +03:00
termSize :: Term a annotation -> Integer
2016-01-13 23:32:03 +03:00
termSize = cata size where
2015-12-01 03:13:20 +03:00
size _ (Leaf _) = 1
size _ (Indexed i) = sum i
size _ (Fixed f) = sum f
size _ (Keyed k) = sum $ snd <$> toList k