libGenI-0.16ContentsIndex
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]
type AvPair = (String, 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
class Replacable a where
replace :: Subst -> a -> a
replaceMap :: Map String GeniVal -> a -> a
replaceOne :: (String, GeniVal) -> a -> a
replaceList :: [(String, GeniVal)] -> a -> a
replaceOneAsMap :: Replacable 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, Replacable a) => String -> a -> a
alphaConvertById :: (Collectable a, Replacable a, Idable a) => a -> a
fromGConst :: GeniVal -> [String]
fromGVar :: GeniVal -> String
isConst :: GeniVal -> Bool
isVar :: GeniVal -> Bool
isAnon :: GeniVal -> Bool
prop_unify_anon :: [GeniVal] -> Bool
prop_unify_self :: [GeniVal] -> Property
prop_unify_sym :: [GeniVal] -> [GeniVal] -> Property
Documentation
data GNode
Constructors
GN
gnname :: NodeName
gup :: Flist
gdown :: Flist
ganchor :: Bool
glexeme :: [String]
gtype :: GType
gaconstr :: Bool
gorigin :: Stringfor TAG, this would be the elementary tree that this node originally came from
show/hide Instances
data GType
Constructors
Subs
Foot
Lex
Other
show/hide Instances
type NodeName = String
data Ttree a
Constructors
TT
params :: [GeniVal]
pfamily :: String
pidname :: String
pinterface :: Flist
ptype :: Ptype
psemantics :: (Maybe Sem)
ptrace :: [String]
tree :: (Tree a)
show/hide Instances
Binary a => Binary (Ttree a)
Collectable a => Collectable (Ttree a)
??? a => Data (Ttree a)
GeniShow a => GeniShow (Ttree a)
Replacable a => Replacable (Ttree a)
??? a => Show (Ttree a)
??? a => Typeable (Ttree a)
type MTtree = Ttree GNode
type SemPols = [Int]
data TestCase
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
Constructors
Initial
Auxiliar
Unspecified
show/hide Instances
type Pred = (GeniVal, GeniVal, [GeniVal])
type Flist = [AvPair]
type AvPair = (String, GeniVal)
data GeniVal
Constructors
GConst [String]
GVar !String
GAnon
show/hide Instances
type Lexicon = Map String [ILexEntry]
A lexicon maps semantic predicates to lexical entries.
data ILexEntry
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)
type Macros = [MTtree]
type Sem = [Pred]
type LitConstr = (Pred, [String])
type SemInput = (Sem, Flist, [LitConstr])
type Subst = Map String GeniVal
emptyLE :: ILexEntry
emptyGNode :: GNode
A null GNode which you can use for various debugging or display purposes.
emptyMacro :: MTtree
A null tree which you can use for various debugging or display purposes.
gCategory :: Flist -> Maybe GeniVal
Return the value of the cat attribute, if available
showLexeme :: [String] -> String
lexemeAttributes :: [String]
Attributes recognised as lexemes, in order of preference
gnnameIs :: NodeName -> GNode -> Bool
plugTree :: Tree NodeName -> NodeName -> Tree NodeName -> Tree NodeName
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!
spliceTree
:: 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 -> a
rootUpd :: Tree a -> a -> Tree a
foot :: Tree GNode -> GNode
setLexeme :: [String] -> Tree GNode -> Tree GNode
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 GNode
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]
Given a Semantics, return the string with the proper keys (propsymbol+arity) to access the agenda
subsumeSem :: Sem -> Sem -> [(Sem, Subst)]
sortSem :: Sem -> Sem
Sort semantics first according to its predicate, and then to its handles.
showSem :: Sem -> String
showPred :: Pred -> String
emptyPred :: Pred
sortFlist :: Flist -> Flist
Sort an Flist according with its attributes
unify :: Monad m => [GeniVal] -> [GeniVal] -> m ([GeniVal], Subst)
unifyFeat :: Monad m => Flist -> Flist -> m (Flist, Subst)
mergeSubst :: Subst -> Subst -> Subst

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 -> String
showPairs :: Flist -> String
showAv :: AvPair -> String
class Replacable a where
Methods
replace :: Subst -> a -> a
replaceMap :: Map String GeniVal -> a -> a
replaceOne :: (String, GeniVal) -> a -> a
replaceList :: [(String, GeniVal)] -> a -> a
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)
show/hide Instances
replaceOneAsMap :: Replacable a => (String, GeniVal) -> a -> a
Default implementation for replaceOne but not a good idea for the core stuff; which is why it is not a typeclass default
class Collectable a where
Methods
collect :: a -> Set String -> Set String
show/hide Instances
class Idable a where
Methods
idOf :: a -> Integer
show/hide Instances
alphaConvert :: (Collectable a, Replacable a) => String -> a -> a
alphaConvertById :: (Collectable a, Replacable a, Idable a) => a -> a
fromGConst :: GeniVal -> [String]
(assumes that it's a GConst!)
fromGVar :: GeniVal -> String
(assumes that it's a GVar!)
isConst :: GeniVal -> Bool
isVar :: GeniVal -> Bool
isAnon :: GeniVal -> Bool
prop_unify_anon :: [GeniVal] -> Bool
prop_unify_self :: [GeniVal] -> Property
prop_unify_sym :: [GeniVal] -> [GeniVal] -> Property
Produced by Haddock version 0.8