]> Git — Sourcephile - haskell/symantic.git/blob - symantic-grammar/Language/Symantic/Grammar/BinTree.hs
Update to lastest symantic-document
[haskell/symantic.git] / symantic-grammar / Language / Symantic / Grammar / BinTree.hs
1 -- | Binary tree, useful to build /Abstract Syntax Tree/ (AST)
2 -- made of applications of tokens.
3 module Language.Symantic.Grammar.BinTree where
4
5 import Control.Applicative (Applicative(..))
6 import Control.Monad (Monad(..))
7 import Data.Eq (Eq)
8 import Data.Foldable (Foldable(..))
9 import Data.Functor (Functor(..), (<$>))
10 import Data.Monoid (Monoid(..))
11 import Data.Semigroup (Semigroup(..))
12 import Data.Traversable (Traversable(..))
13 import Text.Show (Show)
14
15 -- * Type 'BinTree'
16 -- | /Binary Tree/.
17 data BinTree a
18 = BinTree0 a
19 | BinTree2 (BinTree a) (BinTree a)
20 deriving (Eq, Show)
21
22 instance Semigroup (BinTree a) where
23 (<>) = BinTree2
24 instance Functor BinTree where
25 fmap f (BinTree0 a) = BinTree0 (f a)
26 fmap f (BinTree2 x y) = BinTree2 (fmap f x) (fmap f y)
27 instance Applicative BinTree where
28 pure = BinTree0
29 BinTree0 f <*> BinTree0 a = BinTree0 (f a)
30 BinTree0 f <*> BinTree2 x y = BinTree2 (f <$> x) (f <$> y)
31 BinTree2 fx fy <*> a = BinTree2 (fx <*> a) (fy <*> a)
32 instance Monad BinTree where
33 return = BinTree0
34 BinTree0 a >>= f = f a
35 BinTree2 x y >>= f = BinTree2 (x >>= f) (y >>= f)
36 instance Foldable BinTree where
37 foldMap f (BinTree0 a) = f a
38 foldMap f (BinTree2 x y) = foldMap f x `mappend` foldMap f y
39 foldr f acc (BinTree0 a) = f a acc
40 foldr f acc (BinTree2 x y) = foldr f (foldr f acc y) x
41 foldl f acc (BinTree0 a) = f acc a
42 foldl f acc (BinTree2 x y) = foldl f (foldl f acc x) y
43 instance Traversable BinTree where
44 traverse f (BinTree0 a) = BinTree0 <$> f a
45 traverse f (BinTree2 x y) = BinTree2 <$> traverse f x <*> traverse f y
46
47 -- | Collapse depth-first given 'BinTree' with given function.
48 --
49 -- Useful to apply all arguments.
50 collapseBT :: (a -> a -> a) -> BinTree a -> a
51 collapseBT _f (BinTree0 x) = x
52 collapseBT f (BinTree2 x y) = collapseBT f x `f` collapseBT f y