calligraphy-0.1.3: HIE-based Haskell call graph and source code visualizer
Safe HaskellSafe-Inferred
LanguageHaskell2010

Calligraphy.Util.LexTree

Description

A LexTree is a map designed to reconstruct the lexical structure (tree of scopes) of a source file, given an unordered list of scopes. Values are inserted with a pair source locations as its key. For a given key, we can then ask what the smallest enclosing scope is.

For example, in the snippet below the smallest scope containing x is b. x | a | | b | | c |

Scopes are not allowed to overlap.

The purpose of this data structure is to find out what surrounding definition a certain use site belongs to.

Synopsis

Documentation

data LexTree p a Source #

Constructors

Tip 
Bin 

Fields

  • !Int

    Height

  • !(LexTree p a)

    Scopes at the same level, left of this one

  • !p

    Left-hand bound of this scope (inclusive)

  • a
     
  • !(LexTree p a)

    Children

  • !p

    Right-hand bound of this scope (exclusive)

  • !(LexTree p a)

    Scopes at the same level, right of this entry

Instances

Instances details
Functor (LexTree p) Source # 
Instance details

Defined in Calligraphy.Util.LexTree

Methods

fmap :: (a -> b) -> LexTree p a -> LexTree p b #

(<$) :: a -> LexTree p b -> LexTree p a #

Foldable (LexTree p) Source # 
Instance details

Defined in Calligraphy.Util.LexTree

Methods

fold :: Monoid m => LexTree p m -> m #

foldMap :: Monoid m => (a -> m) -> LexTree p a -> m #

foldMap' :: Monoid m => (a -> m) -> LexTree p a -> m #

foldr :: (a -> b -> b) -> b -> LexTree p a -> b #

foldr' :: (a -> b -> b) -> b -> LexTree p a -> b #

foldl :: (b -> a -> b) -> b -> LexTree p a -> b #

foldl' :: (b -> a -> b) -> b -> LexTree p a -> b #

foldr1 :: (a -> a -> a) -> LexTree p a -> a #

foldl1 :: (a -> a -> a) -> LexTree p a -> a #

toList :: LexTree p a -> [a] #

null :: LexTree p a -> Bool #

length :: LexTree p a -> Int #

elem :: Eq a => a -> LexTree p a -> Bool #

maximum :: Ord a => LexTree p a -> a #

minimum :: Ord a => LexTree p a -> a #

sum :: Num a => LexTree p a -> a #

product :: Num a => LexTree p a -> a #

Traversable (LexTree p) Source # 
Instance details

Defined in Calligraphy.Util.LexTree

Methods

traverse :: Applicative f => (a -> f b) -> LexTree p a -> f (LexTree p b) #

sequenceA :: Applicative f => LexTree p (f a) -> f (LexTree p a) #

mapM :: Monad m => (a -> m b) -> LexTree p a -> m (LexTree p b) #

sequence :: Monad m => LexTree p (m a) -> m (LexTree p a) #

(Eq p, Eq a) => Eq (LexTree p a) Source # 
Instance details

Defined in Calligraphy.Util.LexTree

Methods

(==) :: LexTree p a -> LexTree p a -> Bool #

(/=) :: LexTree p a -> LexTree p a -> Bool #

(Show p, Show a) => Show (LexTree p a) Source # 
Instance details

Defined in Calligraphy.Util.LexTree

Methods

showsPrec :: Int -> LexTree p a -> ShowS #

show :: LexTree p a -> String #

showList :: [LexTree p a] -> ShowS #

data TreeError p a Source #

Constructors

InvalidBounds p a p

Nonsensical bounds, i.e. a left-hand bound larger than the right-hand obund

OverlappingBounds a a p p

Two identical scopes

MidSplit

An attempt to split halfway through a scope, usually the result of two partially overlapping scopes

LexicalError p a p (LexTree p a)

Attempting to insert a scope that would not form a tree structure

Instances

Instances details
Functor (TreeError p) Source # 
Instance details

Defined in Calligraphy.Util.LexTree

Methods

fmap :: (a -> b) -> TreeError p a -> TreeError p b #

(<$) :: a -> TreeError p b -> TreeError p a #

Foldable (TreeError p) Source # 
Instance details

Defined in Calligraphy.Util.LexTree

Methods

fold :: Monoid m => TreeError p m -> m #

foldMap :: Monoid m => (a -> m) -> TreeError p a -> m #

foldMap' :: Monoid m => (a -> m) -> TreeError p a -> m #

foldr :: (a -> b -> b) -> b -> TreeError p a -> b #

foldr' :: (a -> b -> b) -> b -> TreeError p a -> b #

foldl :: (b -> a -> b) -> b -> TreeError p a -> b #

foldl' :: (b -> a -> b) -> b -> TreeError p a -> b #

foldr1 :: (a -> a -> a) -> TreeError p a -> a #

foldl1 :: (a -> a -> a) -> TreeError p a -> a #

toList :: TreeError p a -> [a] #

null :: TreeError p a -> Bool #

length :: TreeError p a -> Int #

elem :: Eq a => a -> TreeError p a -> Bool #

maximum :: Ord a => TreeError p a -> a #

minimum :: Ord a => TreeError p a -> a #

sum :: Num a => TreeError p a -> a #

product :: Num a => TreeError p a -> a #

Traversable (TreeError p) Source # 
Instance details

Defined in Calligraphy.Util.LexTree

Methods

traverse :: Applicative f => (a -> f b) -> TreeError p a -> f (TreeError p b) #

sequenceA :: Applicative f => TreeError p (f a) -> f (TreeError p a) #

mapM :: Monad m => (a -> m b) -> TreeError p a -> m (TreeError p b) #

sequence :: Monad m => TreeError p (m a) -> m (TreeError p a) #

(Eq p, Eq a) => Eq (TreeError p a) Source # 
Instance details

Defined in Calligraphy.Util.LexTree

Methods

(==) :: TreeError p a -> TreeError p a -> Bool #

(/=) :: TreeError p a -> TreeError p a -> Bool #

(Show p, Show a) => Show (TreeError p a) Source # 
Instance details

Defined in Calligraphy.Util.LexTree

Methods

showsPrec :: Int -> TreeError p a -> ShowS #

show :: TreeError p a -> String #

showList :: [TreeError p a] -> ShowS #

lookup :: Ord p => p -> LexTree p a -> Maybe a Source #

lookupOuter :: Ord p => p -> LexTree p a -> Maybe a Source #

insert :: Ord p => p -> a -> p -> LexTree p a -> Either (TreeError p a) (LexTree p a) Source #

foldLexTree :: r -> (r -> p -> a -> r -> p -> r -> r) -> LexTree p a -> r Source #

toForest :: LexTree p a -> Forest (p, a, p) Source #

insertWith :: Ord p => (a -> a -> Maybe a) -> p -> a -> p -> LexTree p a -> Either (TreeError p a) (LexTree p a) Source #

toList :: LexTree p a -> [(p, a, p)] Source #

bin :: LexTree p a -> p -> a -> LexTree p a -> p -> LexTree p a -> LexTree p a Source #

Only works if the height difference of the two trees is at most 2

shift :: Num p => p -> LexTree p a -> LexTree p a Source #