Safe Haskell | None |
---|---|
Language | Haskell2010 |
The data types that define a CFG.
- newtype IndexName = IndexName {}
- getIndexName :: Iso' IndexName String
- data IOP
- data Index = Index {
- _indexName :: IndexName
- _indexHere :: Integer
- _indexOp :: IOP
- _indexRange :: [Integer]
- _indexStep :: Integer
- indexStep :: Lens' Index Integer
- indexRange :: Lens' Index [Integer]
- indexOp :: Lens' Index IOP
- indexName :: Lens' Index IndexName
- indexHere :: Lens' Index Integer
- newtype SymbolName = SymbolName {}
- getSteName :: Iso' SymbolName String
- newtype Tape = Tape {}
- getTape :: Iso' Tape Int
- data SynTermEps
- splitN :: Traversal' SynTermEps Integer
- splitK :: Traversal' SynTermEps Integer
- name :: Traversal' SynTermEps SymbolName
- index :: Traversal' SynTermEps [Index]
- _Epsilon :: Prism' SynTermEps ()
- _Deletion :: Prism' SynTermEps ()
- _Term :: Prism' SynTermEps (SymbolName, [Index])
- _SynTerm :: Prism' SynTermEps (SymbolName, [Index])
- _SynVar :: Prism' SynTermEps (SymbolName, [Index], Integer, Integer)
- newtype Symbol = Symbol {
- _getSymbolList :: [SynTermEps]
- getSymbolList :: Iso' Symbol [SynTermEps]
- newtype AttributeFunction = Attr {}
- getAttr :: Iso' AttributeFunction String
- data Rule = Rule {}
- rhs :: Lens' Rule [Symbol]
- lhs :: Lens' Rule Symbol
- attr :: Lens' Rule [AttributeFunction]
- data DerivedGrammar
- isOutside :: DerivedGrammar -> Bool
- data Grammar = Grammar {}
- write :: Lens' Grammar Bool
- termvars :: Lens' Grammar (Map SymbolName SynTermEps)
- synvars :: Lens' Grammar (Map SymbolName SynTermEps)
- synterms :: Lens' Grammar (Map SymbolName SynTermEps)
- start :: Lens' Grammar Symbol
- rules :: Lens' Grammar (Set Rule)
- params :: Lens' Grammar (Map IndexName Index)
- outside :: Lens' Grammar DerivedGrammar
- indices :: Lens' Grammar (Map IndexName Index)
- grammarName :: Lens' Grammar String
Documentation
Encode the index of the syntactic or terminal variable.
In case of grammar-based indexing, keep indexRange
empty. The
indexStep
keeps track of any +k
/ -k
given in the production
rules.
We allow indexing terminals now, too. When glueing together terminals, one might want to be able to differentiate between terminals.
Index | |
|
newtype SymbolName Source #
Newtype wrapper for symbol names.
The tape, a terminal operates on. Terminals on different tapes could
still have the same SymbolName
but different type and input!
data SynTermEps Source #
Symbols, potentially with an index or more than one.
SynVar | Syntactic variables. |
SynTerm | |
| |
Term | Regular old terminal symbol -- reads stuff from the input. |
| |
Deletion | This sym denotes the case, where we have an |
Epsilon | Finally, a real epsilon. Again, these are somewhat regular terminal symbols, but it is important to be able to recognize these, when trying to create outside variants of our algorithms. |
index :: Traversal' SynTermEps [Index] Source #
_Epsilon :: Prism' SynTermEps () Source #
_Deletion :: Prism' SynTermEps () Source #
_Term :: Prism' SynTermEps (SymbolName, [Index]) Source #
_SynTerm :: Prism' SynTermEps (SymbolName, [Index]) Source #
_SynVar :: Prism' SynTermEps (SymbolName, [Index], Integer, Integer) Source #
The length of the list encodes the dimension of the symbol. Forms a monoid over dimensional concatenation.
getSymbolList :: Iso' Symbol [SynTermEps] Source #
newtype AttributeFunction Source #
The name of an attribute function
Production rules for at-most CFGs.
data DerivedGrammar Source #
isOutside :: DerivedGrammar -> Bool Source #
Complete descrition of a grammar. In principle it would be enough to hold
_rules
and the _start
symbol name. We also store dimensionless names for
syntactiv variables, and terminals. This makes certain checks easier or
possible.
We store all single-tape symbol names dimensionless. This means that, for terminals, symbols with the same name have the same tape. This is slightly inconvenient for special applications (say Protein-DNA alignment) but one can easily rename terminals.
TODO better way to handle indexed symbols?
Grammar | |
|