A.11 Parser.oz

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


Denys Duchier
Version 1.2.0 (20010221)