functor
import
FD FS
Entry(
category : Category
agreement : Agreement
roles : Roles
marks : Marks
allRoles : AllRoles
complementRoles:ComplementRoles)
Lexicon(get)
Gamma
Select(fs fd union) at 'x-ozlib://duchier/cp/Select.ozf'
export
ParsePredicate
define
MARK_ZU = Marks.toint.zu
CAT_VINF = Category.toint.vinf
fun {GetYield R} R.yield end
fun {GetCats R} R.cats end
fun {GetAgrs R} R.agrs end
fun {GetCompsLo R} R.comps_lo end
fun {GetCompsHi R} R.comps_hi end
fun {GetVpref R} R.vpref end
fun {GetMarks R} R.marks end
fun {GetAux R} R.aux end
fun {GetEntryIndex R} R.entryindex end
fun {MakeNode Word I Positions Entries RootSet}
EntryIndex EntryIndex::1#{Length Entries}
E_CATS = {Select.fs {Map Entries GetCats } EntryIndex}
E_AGRS = {Select.fs {Map Entries GetAgrs } EntryIndex}
E_COMPS_LO = {Select.fs {Map Entries GetCompsLo} EntryIndex}
E_COMPS_HI = {Select.fs {Map Entries GetCompsHi} EntryIndex}
E_VPREF = {Select.fs {Map Entries GetVpref } EntryIndex}
E_MARKS = {Select.fs {Map Entries GetMarks } EntryIndex}
E_AUX = {Select.fs {Map Entries GetAux } EntryIndex}
CAT CAT::Category.range {FS.include CAT E_CATS}
AGR AGR::Agreement.range {FS.include AGR E_AGRS}
COMPS {FS.subset COMPS Roles.full}
{FS.subset COMPS E_COMPS_HI}
{FS.subset E_COMPS_LO COMPS}
DTRSETS = {List.toRecord o
{Map AllRoles
fun {$ R} R#{FS.subset $ Positions} end}}
for R in ComplementRoles do
{FS.reified.include Roles.toint.R COMPS}={FS.card DTRSETS.R}
end
DAUGHTERS = {FS.unionN DTRSETS}
YIELDS = {FS.subset $ Positions}
YIELD = {FS.partition [{FS.value.singl I} YIELDS]}
MOTHER = {FS.subset $ Positions} {FS.cardRange 0 1 MOTHER}
IS_ROOT=({FS.card MOTHER}=:0)
{FS.reified.include I RootSet}=IS_ROOT
HAS_ZU HAS_ZU::0#1
{FD.exor
{FS.reified.include MARK_ZU E_MARKS}
{FS.card DTRSETS.zu}
HAS_ZU}
{FD.impl HAS_ZU CAT=:CAT_VINF 1}
in
node(
isroot : IS_ROOT
word : Word
index : I
entryindex : EntryIndex
cat : CAT
agr : AGR
comps : COMPS
vpref : E_VPREF
marks : E_MARKS
aux : E_AUX
yieldS : YIELDS
yield : YIELD
dtrsets : DTRSETS
daughters : DAUGHTERS
mother : MOTHER
haszu : HAS_ZU
role : _
)
end
fun {ParsePredicate Words}
N = {Length Words}
WordEntriesPairs
= {Map Words fun {$ W} W#{Lexicon.get W} end}
Positions = {FS.value.make 1#N}
proc {ParseTree Nodes}
RootSet={FS.subset $ Positions}
{FS.cardRange 1 1 RootSet}
!Nodes = {List.mapInd WordEntriesPairs
fun {$ I Word#Entries}
{MakeNode Word I Positions Entries RootSet}
end}
Yields = {Map Nodes GetYield}
for N in Nodes do
N.yieldS = {Select.union Yields N.daughters}
for M in Nodes do
{FS.reified.include M.index N.mother}=
{FS.reified.include N.index M.daughters}
for R in AllRoles do
thread
or {FS.include N.index M.dtrsets.R}
N.role=R {Gamma.R M N}
[] {FS.exclude N.index M.dtrsets.R}
end
end
end
end
end
AllDtrSets =
RootSet|
{FoldL Nodes
fun {$ L N}
{Append {Record.toList N.dtrsets} L}
end nil}
{FS.partition AllDtrSets Positions}
in
{FS.distribute naive AllDtrSets}
{FD.distribute ff {Map Nodes GetEntryIndex}}
end
in
ParseTree
end
end