GenI-0.20.1: A natural language generator (specifically, an FB-LTAG surface realiser)Source codeContentsIndex
NLP.GenI.Btypes
Synopsis
data GNode = GN {
gnname :: NodeName
gup :: Flist
gdown :: Flist
ganchor :: Bool
glexeme :: [String]
gtype :: GType
gaconstr :: Bool
gorigin :: String
}
data GType
= Subs
| Foot
| Lex
| Other
type NodeName = String
data Ttree a = TT {
params :: [GeniVal]
pfamily :: String
pidname :: String
pinterface :: Flist
ptype :: Ptype
psemantics :: Maybe Sem
ptrace :: [String]
tree :: Tree a
}
type MTtree = Ttree GNode
type SemPols = [Int]
data TestCase = TestCase {
tcName :: String
tcSemString :: String
tcSem :: SemInput
tcExpected :: [String]
tcOutputs :: [(String, Map (String, String) [String])]
}
data Ptype
= Initial
| Auxiliar
| Unspecified
type Pred = (GeniVal, GeniVal, [GeniVal])
type Flist = [AvPair]
data AvPair = AvPair {
avAtt :: String
avVal :: GeniVal
}
data GeniVal
= GConst [String]
| GVar String
| GAnon
type Lexicon = Map String [ILexEntry]
data ILexEntry = ILE {
iword :: [String]
ifamname :: String
iparams :: [GeniVal]
iinterface :: Flist
ifilters :: Flist
iequations :: Flist
iptype :: Ptype
isemantics :: Sem
isempols :: [SemPols]
}
type MorphLexEntry = (String, String, Flist)
type Macros = [MTtree]
type Sem = [Pred]
type LitConstr = (Pred, [String])
type SemInput = (Sem, Flist, [LitConstr])
type Subst = Map String GeniVal
emptyLE :: ILexEntry
emptyGNode :: GNode
emptyMacro :: MTtree
gCategory :: Flist -> Maybe GeniVal
showLexeme :: [String] -> String
lexemeAttributes :: [String]
gnnameIs :: NodeName -> GNode -> Bool
plugTree :: Tree NodeName -> NodeName -> Tree NodeName -> Tree NodeName
spliceTree :: NodeName -> Tree NodeName -> NodeName -> Tree NodeName -> Tree NodeName
root :: Tree a -> a
rootUpd :: Tree a -> a -> Tree a
foot :: Tree GNode -> GNode
setLexeme :: [String] -> Tree GNode -> Tree GNode
setAnchor :: [String] -> Tree GNode -> Tree GNode
toKeys :: Sem -> [String]
subsumeSem :: Sem -> Sem -> [(Sem, Subst)]
sortSem :: Sem -> Sem
showSem :: Sem -> String
showPred :: Pred -> String
emptyPred :: Pred
sortFlist :: Flist -> Flist
unify :: Monad m => [GeniVal] -> [GeniVal] -> m ([GeniVal], Subst)
unifyFeat :: Monad m => Flist -> Flist -> m (Flist, Subst)
mergeSubst :: Subst -> Subst -> Subst
showFlist :: Flist -> String
showPairs :: Flist -> String
showAv :: AvPair -> String
replace :: DescendGeniVal a => Subst -> a -> a
class DescendGeniVal a where
descendGeniVal :: (GeniVal -> GeniVal) -> a -> a
replaceList :: DescendGeniVal a => [(String, GeniVal)] -> a -> a
class Collectable a where
collect :: a -> Set String -> Set String
class Idable a where
idOf :: a -> Integer
alphaConvert :: (Collectable a, DescendGeniVal a) => String -> a -> a
alphaConvertById :: (Collectable a, DescendGeniVal a, Idable a) => a -> a
fromGConst :: GeniVal -> [String]
fromGVar :: GeniVal -> String
isConst :: GeniVal -> Bool
isVar :: GeniVal -> Bool
isAnon :: GeniVal -> Bool
Documentation
data GNode Source
A single node of a TAG tree.
Constructors
GN
gnname :: NodeName
gup :: Flisttop feature structure
gdown :: Flistbottom feature structure
ganchor :: BoolFalse for na nodes
glexeme :: [String][] for na nodes
gtype :: GType
gaconstr :: Bool
gorigin :: Stringfor TAG, this would be the elementary tree that this node originally came from
show/hide Instances
data GType Source
Constructors
Subs
Foot
Lex
Other
show/hide Instances
type NodeName = StringSource
data Ttree a Source
Constructors
TT
params :: [GeniVal]
pfamily :: String
pidname :: String
pinterface :: Flist
ptype :: Ptype
psemantics :: Maybe Sem
ptrace :: [String]
tree :: Tree a
show/hide Instances
type MTtree = Ttree GNodeSource
type SemPols = [Int]Source
data TestCase Source
Constructors
TestCase
tcName :: String
tcSemString :: Stringfor gui
tcSem :: SemInput
tcExpected :: [String]expected results (for testing)
tcOutputs :: [(String, Map (String, String) [String])]results we actually got, and their traces (for testing)
show/hide Instances
data Ptype Source
Constructors
Initial
Auxiliar
Unspecified
show/hide Instances
type Pred = (GeniVal, GeniVal, [GeniVal])Source
type Flist = [AvPair]Source
data AvPair Source
Constructors
AvPair
avAtt :: String
avVal :: GeniVal
show/hide Instances
data GeniVal Source
Constructors
GConst [String]atomic disjunction - constant x | y | z
GVar Stringvariable
GAnonanonymous
show/hide Instances
type Lexicon = Map String [ILexEntry]Source
A lexicon maps semantic predicates to lexical entries.
data ILexEntry Source
Constructors
ILE
iword :: [String]
ifamname :: String
iparams :: [GeniVal]
iinterface :: Flist
ifilters :: Flist
iequations :: Flist
iptype :: Ptype
isemantics :: Sem
isempols :: [SemPols]
show/hide Instances
type MorphLexEntry = (String, String, Flist)Source
type Macros = [MTtree]Source
type Sem = [Pred]Source
type LitConstr = (Pred, [String])Source
type SemInput = (Sem, Flist, [LitConstr])Source
type Subst = Map String GeniValSource
emptyLE :: ILexEntrySource
emptyGNode :: GNodeSource
A null GNode which you can use for various debugging or display purposes.
emptyMacro :: MTtreeSource
A null tree which you can use for various debugging or display purposes.
gCategory :: Flist -> Maybe GeniValSource
Return the value of the cat attribute, if available
showLexeme :: [String] -> StringSource
lexemeAttributes :: [String]Source
Attributes recognised as lexemes, in order of preference
gnnameIs :: NodeName -> GNode -> BoolSource
plugTree :: Tree NodeName -> NodeName -> Tree NodeName -> Tree NodeNameSource
Plug the first tree into the second tree at the specified node. Anything below the second node is silently discarded. We assume the trees are pluggable; it is treated as a bug if they are not!
spliceTreeSource
:: NodeNamefoot node of the aux tree
-> Tree NodeNameaux tree
-> NodeNameplace to adjoin in target tree
-> Tree NodeNametarget tree
-> Tree NodeName
Given two trees auxt and t, splice the tree auxt into t via the TAG adjunction rule.
root :: Tree a -> aSource
rootUpd :: Tree a -> a -> Tree aSource
foot :: Tree GNode -> GNodeSource
setLexeme :: [String] -> Tree GNode -> Tree GNodeSource
Given a lexical item l and a tree node n (actually a subtree with no children), return the same node with the lexical item as its unique child. The idea is that it converts terminal lexeme nodes into preterminal nodes where the actual terminal is the given lexical item
setAnchor :: [String] -> Tree GNode -> Tree GNodeSource
Given a lexical item s and a Tree GNode t, returns the tree t' where l has been assigned to the anchor node in t'
toKeys :: Sem -> [String]Source
Given a Semantics, return the string with the proper keys (propsymbol+arity) to access the agenda
subsumeSem :: Sem -> Sem -> [(Sem, Subst)]Source
sortSem :: Sem -> SemSource
Sort semantics first according to its predicate, and then to its handles.
showSem :: Sem -> StringSource
showPred :: Pred -> StringSource
emptyPred :: PredSource
sortFlist :: Flist -> FlistSource
Sort an Flist according with its attributes
unify :: Monad m => [GeniVal] -> [GeniVal] -> m ([GeniVal], Subst)Source
unify performs unification on two lists of GeniVal. If unification succeeds, it returns Just (r,s) where verb!r! is the result of unification and verb!s! is a list of substitutions that this unification results in.
unifyFeat :: Monad m => Flist -> Flist -> m (Flist, Subst)Source

unifyFeat performs feature structure unification, under the these assumptions about the input:

  • Features are ordered
  • The Flists do not share variables (renaming has already been done.

The features are allowed to have different sets of attributes, beacuse we use alignFeat to realign them.

mergeSubst :: Subst -> Subst -> SubstSource

Note that the first Subst is assumed to come chronologically before the second one; so merging { X -> Y } and { Y -> 3 } should give us { X -> 3; Y -> 3 };

See prependToSubst for a warning!

showFlist :: Flist -> StringSource
showPairs :: Flist -> StringSource
showAv :: AvPair -> StringSource
replace :: DescendGeniVal a => Subst -> a -> aSource
class DescendGeniVal a whereSource
Methods
descendGeniVal :: (GeniVal -> GeniVal) -> a -> aSource
show/hide Instances
replaceList :: DescendGeniVal a => [(String, GeniVal)] -> a -> aSource
Here it is safe to say (X -> Y; Y -> Z) because this would be crushed down into a final value of (X -> Z; Y -> Z)
class Collectable a whereSource
Methods
collect :: a -> Set String -> Set StringSource
show/hide Instances
class Idable a whereSource
An Idable is something that can be mapped to a unique id. You might consider using this to implement Ord, but I won't. Note that the only use I have for this so far (20 dec 2005) is in alpha-conversion.
Methods
idOf :: a -> IntegerSource
show/hide Instances
alphaConvert :: (Collectable a, DescendGeniVal a) => String -> a -> aSource
alphaConvertById :: (Collectable a, DescendGeniVal a, Idable a) => a -> aSource
fromGConst :: GeniVal -> [String]Source
(assumes that it's a GConst!)
fromGVar :: GeniVal -> StringSource
(assumes that it's a GVar!)
isConst :: GeniVal -> BoolSource
isVar :: GeniVal -> BoolSource
isAnon :: GeniVal -> BoolSource
Produced by Haddock version 2.6.0