deep-transformations-0.2: Deep natural and unnatural tree transformations, including attribute grammars
Safe HaskellNone
LanguageHaskell2010

Transformation.AG

Description

An attribute grammar is a particular kind of Transformation that assigns attributes to nodes in a tree. Different node types may have different types of attributes, so the transformation is not natural. All attributes are divided into Inherited and Synthesized attributes.

Synopsis

Documentation

type family Atts (f :: * -> *) a Source #

Type family that maps a node type to the type of its attributes, indexed per type constructor.

Instances

Instances details
type Atts (Synthesized (Keep t)) x Source # 
Instance details

Defined in Transformation.AG.Generics

type Atts (Synthesized (Keep t)) x = Atts (Synthesized t) x
type Atts (Synthesized (Auto t)) x Source # 
Instance details

Defined in Transformation.AG.Generics

type Atts (Synthesized (Auto t)) x = Atts (Synthesized t) x
type Atts (Inherited (Keep t)) x Source # 
Instance details

Defined in Transformation.AG.Generics

type Atts (Inherited (Keep t)) x = Atts (Inherited t) x
type Atts (Inherited (Auto t)) x Source # 
Instance details

Defined in Transformation.AG.Generics

type Atts (Inherited (Auto t)) x = Atts (Inherited t) x

newtype Inherited t a Source #

Type constructor wrapping the inherited attributes for the given transformation.

Constructors

Inherited 

Fields

Instances

Instances details
(sem ~ Semantics t, Domain t ~ shallow, Revelation t, Functor (PassDown t sem (Atts (Inherited t) (g sem sem))) (g sem)) => Bequether t g (Semantics t) shallow Source # 
Instance details

Defined in Transformation.AG.Generics

Methods

bequest :: forall (sem :: Type -> Type). sem ~ Semantics t => t -> shallow (g (Semantics t) (Semantics t)) -> Atts (Inherited t) (g sem sem) -> g sem (Synthesized t) -> g sem (Inherited t) Source #

(Revelation (Keep t), p ~ Domain (Keep t), Apply (g q), q ~ Codomain (Keep t), q ~ PreservingSemantics (Keep t) p, s ~ Semantics (Keep t), Atts (Inherited (Keep t)) (g q q) ~ Atts (Inherited (Keep t)) (g s s), Atts (Synthesized (Keep t)) (g q q) ~ Atts (Synthesized (Keep t)) (g s s), g q (Synthesized (Keep t)) ~ g s (Synthesized (Keep t)), g q (Inherited (Keep t)) ~ g s (Inherited (Keep t)), Attribution (Keep t) g q p) => At (Keep t) (g (PreservingSemantics (Keep t) p) (PreservingSemantics (Keep t) p)) Source # 
Instance details

Defined in Transformation.AG.Generics

(Revelation (Auto t), Domain (Auto t) ~ f, Codomain (Auto t) ~ Semantics (Auto t), Apply (g (Semantics (Auto t))), Attribution (Auto t) g (Semantics (Auto t)) f) => At (Auto t) (g (Semantics (Auto t)) (Semantics (Auto t))) Source # 
Instance details

Defined in Transformation.AG.Generics

Methods

($) :: Auto t -> Domain (Auto t) (g (Semantics (Auto t)) (Semantics (Auto t))) -> Codomain (Auto t) (g (Semantics (Auto t)) (Semantics (Auto t))) Source #

Show (Atts (Inherited t) a) => Show (Inherited t a) Source # 
Instance details

Defined in Transformation.AG

Methods

showsPrec :: Int -> Inherited t a -> ShowS #

show :: Inherited t a -> String #

showList :: [Inherited t a] -> ShowS #

type Atts (Inherited (Keep t)) x Source # 
Instance details

Defined in Transformation.AG.Generics

type Atts (Inherited (Keep t)) x = Atts (Inherited t) x
type Atts (Inherited (Auto t)) x Source # 
Instance details

Defined in Transformation.AG.Generics

type Atts (Inherited (Auto t)) x = Atts (Inherited t) x

newtype Synthesized t a Source #

Type constructor wrapping the synthesized attributes for the given transformation.

Constructors

Synthesized 

Fields

Instances

Instances details
(sem ~ Semantics t, Domain t ~ shallow, Revelation t, Functor (PassDown t sem (Atts (Inherited t) (g sem sem))) (g sem)) => Bequether t g (Semantics t) shallow Source # 
Instance details

Defined in Transformation.AG.Generics

Methods

bequest :: forall (sem :: Type -> Type). sem ~ Semantics t => t -> shallow (g (Semantics t) (Semantics t)) -> Atts (Inherited t) (g sem sem) -> g sem (Synthesized t) -> g sem (Inherited t) Source #

(Revelation (Auto t), Domain (Auto t) ~ f, Codomain (Auto t) ~ Semantics (Auto t), Apply (g (Semantics (Auto t))), Attribution (Auto t) g (Semantics (Auto t)) f) => At (Auto t) (g (Semantics (Auto t)) (Semantics (Auto t))) Source # 
Instance details

Defined in Transformation.AG.Generics

Methods

($) :: Auto t -> Domain (Auto t) (g (Semantics (Auto t)) (Semantics (Auto t))) -> Codomain (Auto t) (g (Semantics (Auto t)) (Semantics (Auto t))) Source #

Show (Atts (Synthesized t) a) => Show (Synthesized t a) Source # 
Instance details

Defined in Transformation.AG

Methods

showsPrec :: Int -> Synthesized t a -> ShowS #

show :: Synthesized t a -> String #

showList :: [Synthesized t a] -> ShowS #

type Atts (Synthesized (Keep t)) x Source # 
Instance details

Defined in Transformation.AG.Generics

type Atts (Synthesized (Keep t)) x = Atts (Synthesized t) x
type Atts (Synthesized (Auto t)) x Source # 
Instance details

Defined in Transformation.AG.Generics

type Atts (Synthesized (Auto t)) x = Atts (Synthesized t) x

type Semantics t = Inherited t ~> Synthesized t Source #

A node's Semantics is a natural tranformation from the node's inherited attributes to its synthesized attributes.

type PreservingSemantics t f = Arrow (Inherited t) (Product (AllAtts t) f) Source #

A node's PreservingSemantics is a natural tranformation from the node's inherited attributes to all its attributes paired with the preserved node.

data AllAtts t a Source #

All inherited and synthesized attributes

Constructors

AllAtts 

Fields

Instances

Instances details
(Revelation (Keep t), p ~ Domain (Keep t), Apply (g q), q ~ Codomain (Keep t), q ~ PreservingSemantics (Keep t) p, s ~ Semantics (Keep t), Atts (Inherited (Keep t)) (g q q) ~ Atts (Inherited (Keep t)) (g s s), Atts (Synthesized (Keep t)) (g q q) ~ Atts (Synthesized (Keep t)) (g s s), g q (Synthesized (Keep t)) ~ g s (Synthesized (Keep t)), g q (Inherited (Keep t)) ~ g s (Inherited (Keep t)), Attribution (Keep t) g q p) => At (Keep t) (g (PreservingSemantics (Keep t) p) (PreservingSemantics (Keep t) p)) Source # 
Instance details

Defined in Transformation.AG.Generics

type Rule t g = forall sem. sem ~ Semantics t => (Inherited t (g sem (Semantics t)), g sem (Synthesized t)) -> (Synthesized t (g sem (Semantics t)), g sem (Inherited t)) Source #

An attribution rule maps a node's inherited attributes and its child nodes' synthesized attributes to the node's synthesized attributes and the children nodes' inherited attributes.

knit :: (Apply (g sem), sem ~ Semantics t) => Rule t g -> g sem sem -> sem (g sem sem) Source #

The core function to tie the recursive knot, turning a Rule for a node into its Semantics.

knitKeeping :: forall t f g sem. (sem ~ PreservingSemantics t f, Apply (g sem), Atts (Inherited t) (g sem sem) ~ Atts (Inherited t) (g (Semantics t) (Semantics t)), Atts (Synthesized t) (g sem sem) ~ Atts (Synthesized t) (g (Semantics t) (Semantics t)), g sem (Synthesized t) ~ g (Semantics t) (Synthesized t), g sem (Inherited t) ~ g (Semantics t) (Inherited t)) => (forall a. f a -> a) -> Rule t g -> f (g (PreservingSemantics t f) (PreservingSemantics t f)) -> PreservingSemantics t f (g (PreservingSemantics t f) (PreservingSemantics t f)) Source #

Another way to tie the recursive knot, using a Rule to add AllAtts information to every node

class Attribution t g deep shallow where Source #

The core type class for defining the attribute grammar. The instances of this class typically have a form like

instance Attribution MyAttGrammar MyNode (Semantics MyAttGrammar) Identity where
  attribution MyAttGrammar{} (Identity MyNode{})
              (Inherited   fromParent,
               Synthesized MyNode{firstChild= fromFirstChild, ...})
            = (Synthesized _forMyself,
               Inherited   MyNode{firstChild= _forFirstChild, ...})

If you prefer to separate the calculation of different attributes, you can split the above instance into two instances of the Bequether and Synthesizer classes instead. If you derive Generic instances for your attributes, you can even define each synthesized attribute individually with a SynthesizedField instance.

Methods

attribution :: t -> shallow (g deep deep) -> Rule t g Source #

The attribution rule for a given transformation and node.

Instances

Instances details
(Bequether (Auto t) g d s, Synthesizer (Auto t) g d s) => Attribution (Auto t) g d s Source # 
Instance details

Defined in Transformation.AG.Generics

Methods

attribution :: Auto t -> s (g d d) -> Rule (Auto t) g Source #

applyDefault :: (q ~ Semantics t, x ~ g q q, Apply (g q), Attribution t g q p) => (forall a. p a -> a) -> t -> p x -> q x Source #

Drop-in implementation of $

applyDefaultWithAttributes :: (p ~ Domain t, q ~ PreservingSemantics t p, x ~ g q q, Apply (g q), Atts (Inherited t) (g q q) ~ Atts (Inherited t) (g (Semantics t) (Semantics t)), Atts (Synthesized t) (g q q) ~ Atts (Synthesized t) (g (Semantics t) (Semantics t)), g q (Synthesized t) ~ g (Semantics t) (Synthesized t), g q (Inherited t) ~ g (Semantics t) (Inherited t), Attribution t g (PreservingSemantics t p) p) => (forall a. p a -> a) -> t -> p (g (PreservingSemantics t p) (PreservingSemantics t p)) -> PreservingSemantics t p (g (PreservingSemantics t p) (PreservingSemantics t p)) Source #

Drop-in implementation of $ that preserves all attributes with every original node