home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l216 / 1.ddi / PARSGEN.PRO < prev    next >
Encoding:
Text File  |  1987-03-23  |  33.6 KB  |  1,051 lines
  1. /**********************************************************************
  2.  
  3.      Turbo Prolog Toolbox
  4.      (C) Copyright 1987 Borland International.
  5.  
  6.             Parser generator
  7.  
  8.             Invariants
  9.             ==========
  10.  
  11. About names
  12.   Production names are always in upper case.
  13.   Functors are in lowercase
  14.  
  15. **********************************************************************/
  16.  
  17. nobreak
  18. code=3500
  19. project "parser"
  20. include "parser.def"
  21. include "tpreds.pro"
  22.  
  23. CLAUSES
  24. /**********************************************************************
  25.         Internal representation of the parser
  26. **********************************************************************/
  27. /*
  28.   p(prodname,groups([[prod([tok(cmp(upper,[string]))],dom(string))]])).
  29.   p(prodnames,list(prodname,plus,sep(comma))).
  30.   p(parser,list(section,plus,none)).
  31.   p(section,groups([[
  32.     prod([tok(name(userdefined_)),prodname(prodnames)],term(userdefined,[prodnames])),
  33.     prod([tok(name(leftassoc_)),prodname(namel)],term(leftassoc,[namel])),
  34.     prod([tok(name(productions_)),prodname(productions)],term(productions,[productions]))
  35.     ]])).
  36.   p(namel,list(name,star,sep(comma))).
  37.  
  38.   p(name,groups([[prod([tok(cmp(id,[string]))],dom(string))]])).
  39.  
  40.   p(productions,list(production,plus,none)).
  41.  
  42.   p(production,groups([[prod([prodname(prodname),tok(name(equal)),prodname(prodbody)],term(p,[prodname,prodbody]))]])).
  43.  
  44.   p(prodbody,groups([[
  45.     prod([prodname(prodname),prodname(star_plus),prodname(separator_)],term(list,[prodname,star_plus,separator_])),
  46.     prod([prodname(prodgroups)],term(groups,[prodgroups]))
  47.     ]])).
  48.  
  49.   p(star_plus,groups([[
  50.     prod([tok(name(star))],name(star)),
  51.     prod([tok(name(plus))],name(plus))
  52.     ]])).
  53.  
  54.   p(separator_,groups([[
  55.     prod([tok(name(separator_)),tok(cmp(id,[string]))],term(separator,[string])),
  56.     prod([],name(none))
  57.     ]])).
  58.  
  59.   p(prodgroups,list(priorgroup,plus,sep(priorsepp))).
  60.  
  61.   p(priorgroup,list(singprod,plus,sep(comma))).
  62.  
  63.   p(singprod,groups([[prod([prodname(gramtokl),tok(name(arrow)),prodname(term)],term(prod,[gramtokl,term]))]])).
  64.  
  65.   p(gramtokl,list(gramtok,star,none)).
  66.  
  67.   p(gramtok,groups([[
  68.     prod([prodname(prodname)],term(prodname,[prodname])),
  69.     prod([prodname(tokk)],term(tok,[tokk]))
  70.     ]])).
  71.  
  72.   p(tokk,groups([[
  73.     prod([tok(cmp(id,[string]))],term(name,[string])),
  74.     prod([tok(cmp(id,[string])),tok(name(lpar)),prodname(prodnames),tok(name(rpar))],term(cmp,[string,prodnames]))
  75.     ]])).
  76.  
  77.   p(term,groups([[
  78.     prod([prodname(name)],term(name,[name])),
  79.     prod([prodname(name),tok(name(lpar)),prodname(prodnames),tok(name(rpar))],term(term,[name,prodnames])),
  80.     prod([prodname(prodname)],term(dom,[prodname]))
  81.     ]])).
  82. */
  83.  
  84. /**********************************************************************
  85.             HELP PREDICATES
  86. **********************************************************************/
  87.  
  88. PREDICATES
  89.   unikterml(TERML,TERML)
  90.   append(PRODNAMES,PRODNAMES,PRODNAMES)
  91.   reverse(PRIORGROUP,PRIORGROUP,PRIORGROUP)
  92.   nondeterm member(TERM,TERML)
  93.   nondeterm member(TOKK,TOKKL)
  94.   nondeterm member(PRODNAME,PRODNAMES)
  95.   nondeterm member(PRODUCTION,PRODUCTIONS)
  96.   nondeterm member(PRIORGROUP,PRODGROUPS)
  97.   nondeterm member(SINGPROD,PRIORGROUP)
  98.   nondeterm member(GRAMTOK,GRAMTOKL)
  99.   strlist_str(STRINGLIST,STRING)
  100.   wr(DBASEDOM)
  101.  
  102. CLAUSES
  103.   wr(X):-write(X).
  104.  
  105.   member(X,[X|_]).
  106.   member(X,[_|L]):-member(X,L).
  107.  
  108.   append([],L,L).
  109.   append([X|L1],L2,[X|L3]):-append(L1,L2,L3).  
  110.  
  111.   unikterml([],[]).
  112.   unikterml([dom(DOM,_)|T],T1):-member(dom(DOM,_),T),!,unikterml(T,T1).
  113.   unikterml([name(ID,_)|T],T1):-member(name(ID,_),T),!,unikterml(T,T1).
  114.   unikterml([term(ID,_,DOML)|T],T1):-member(term(ID,_,DOML),T),!,unikterml(T,T1).
  115.   unikterml([H|T],[H|T1]):-unikterml(T,T1).
  116.  
  117.   strlist_str([],"").
  118.   strlist_str([H|T],STR):-
  119.     strlist_str(T,STR1),
  120.     concat(H,STR1,STR).
  121.  
  122.   reverse([],L,L).
  123.   reverse([H|T],L1,L2):-reverse(T,[H|L1],L2).
  124.  
  125.  
  126. /**********************************************************************
  127.         Generate domain definitions
  128. **********************************************************************/
  129.  
  130. PREDICATES
  131.   wterml(TERML)  
  132.   wterm(TERM)
  133.   wdoml(PRODNAMES)
  134.   wtok(TOKK)
  135.  
  136. CLAUSES
  137.   gendomaindef:-
  138.     write("/***********************************************************\n"),
  139.     write("\t\tDOMAIN DEFINITIONS"),nl,
  140.     write("***********************************************************/\n"),
  141.     write("\nDOMAINS\n"),
  142.     prodname(PRODNAME),
  143.     findall(TERMS,terms(PRODNAME,TERMS),TERML),
  144.     unikterml(TERML,TERML1),not(TERML1=[]),
  145.     writef("  %-15 = ",PRODNAME),
  146.     wterml(TERML1),
  147.     nl,nl,
  148.     fail.
  149.   gendomaindef:-
  150.     write("\n  TOK\t\t  = "),
  151.     decltok(_,TOK),
  152.     wtok(TOK),write(";\n\t\t    "),
  153.     fail.
  154.   gendomaindef:-write("nill\n\n").
  155.  
  156.   terms(PRODNAME,TERM):-
  157.     p(PRODNAME,groups(PRODUCTIONGROUPS)),
  158.     member(PRODUCTIONGROUP,PRODUCTIONGROUPS),
  159.     member(prod(_,_,_,TERM),PRODUCTIONGROUP),
  160.     not(TERM=dom(PRODNAME,_)).
  161.   terms(PRODNAME,list(DOM)):-
  162.     p(PRODNAME,list(DOM,_,_,_)).
  163.  
  164.   wterml([TERM]):-!,wterm(TERM).
  165.   wterml([H|T]):-wterm(H),write(";\n\t\t    "),wterml(T).
  166.  
  167.   wterm(term(FUNC,_,DOML)):-
  168.     write(FUNC,'('),
  169.     wdoml(DOML),
  170.     write(')').
  171.   wterm(dom(DOM,_)):-wdoml([DOM]).
  172.   wterm(list(DOM)):-wdoml([DOM]),write('*').
  173.   wterm(name(FUNCTOR,_)):-write(FUNCTOR,"()").
  174.  
  175.   wdoml([DOM]):-!,write(DOM).
  176.   wdoml([H|T]):-write(H,','),wdoml(T).
  177.   wdoml([]).
  178.  
  179.   wtok(name(NAME,_)):-write(NAME,"()").
  180.   wtok(cmp(FUNC,_,DOML)):-
  181.     write(FUNC,"("),wdoml(DOML),write(')').
  182.  
  183.  
  184. /**********************************************************************
  185.         Declare parse predicates
  186. **********************************************************************/
  187.  
  188. DOMAINS
  189.   DECLLIST=DECL*
  190.   DECL=decl(STRINGLIST,PRODNAMES)
  191.  
  192. PREDICATES
  193.   declarepred(DECLLIST)
  194.   declare1(DECLLIST)
  195.   writestrlist(STRINGLIST)
  196.  
  197. CLAUSES
  198.   writestrlist([]).
  199.   writestrlist([H|T]):-upper_lower(H,H1),write(H1),writestrlist(T).
  200.  
  201.   declarepred(DECLLIST):-
  202.     declare1(DECLLIST).
  203.  
  204.   declare1([]).
  205.   declare1([decl(STRL,DOML)|R]):-
  206.     decl(STRL,DOML),!,
  207.     declare1(R).
  208.   declare1([decl(STRL,DOML)|R]):-
  209.     writestrlist(["  "|STRL]),
  210.     write("(TOKL,TOKL,"),wdoml(DOML),
  211.     write(")\n"),
  212.     assert(decl(STRL,DOML)),
  213.     declare1(R).
  214.  
  215.  
  216. /**********************************************************************
  217.         Help predicates around gramtokl's
  218. **********************************************************************/
  219.  
  220. PREDICATES
  221.   split(INTEGER,GRAMTOKL,GRAMTOKL,GRAMTOKL)
  222.   frontconst(GRAMTOKL)
  223.   lastselfref(PRODNAME,GRAMTOKL)
  224.  
  225. CLAUSES
  226.   /* split(NO,LIST,FIRST,SECOND) */
  227.   split(0,L,[],L):-!.
  228.   split(N,[H|L],[H|L1],L2):-N1=N-1,split(N1,L,L1,L2).
  229.  
  230.   frontconst([tok(_,_)|_]).
  231.  
  232.   lastselfref(PRODNAME,[prodname(PRODNAME,_)]):-!.
  233.   lastselfref(PRODNAME,[_|T]):-lastselfref(PRODNAME,T).
  234.  
  235.  
  236. /**********************************************************************
  237.     Writing variables with unique names in the clauses
  238. **********************************************************************/
  239.  
  240. PREDICATES
  241.   wclausetok(TOKK,CURSORDEMAND)
  242.   checkwclausevarl(PRODNAMES)
  243.   wclausevarl(PRODNAMES)
  244.   wclausevar(PRODNAME)
  245.   biggerno(PRODNAME,INTEGER)
  246.   wexpecttok(TOKK,CURSORDEMAND)
  247.  
  248.  
  249. CLAUSES
  250.   wclausetok(name(NAME,_),curdemand(CURSOR)):-!,
  251.     write("t(",NAME,','),wclausevar(CURSOR),write(')').
  252.   wclausetok(name(NAME,_),_):-!,
  253.     write("t(",NAME,",_)").
  254.   wclausetok(cmp(FUNC,_,DOML),curdemand(CURSOR)):-!,
  255.     write("t(",FUNC,"("),
  256.     wclausevarl(DOML),
  257.     write("),"),
  258.     wclausevar(CURSOR),
  259.     write(')').
  260.   wclausetok(cmp(FUNC,_,DOML),_):-
  261.     write("t(",FUNC,"("),wclausevarl(DOML),write("),_)").
  262.  
  263.   checkwclausevarl([]):-!.
  264.   checkwclausevarl(DOML):-wclausevarl(DOML),write(",").
  265.  
  266.   wclausevarl([DOM]):-!,wclausevar(DOM).
  267.   wclausevarl([H|T]):-wclausevar(H),write(','),wclausevarl(T).
  268.   wclausevarl([]).
  269.  
  270.   biggerno(DOM,NO):-
  271.     clausevar(DOM,NO1),NO1>NO,!.
  272.  
  273.   wclausevar(DOM):-
  274.     clausevar(DOM,NO),
  275.     not(biggerno(DOM,NO)),!,
  276.     NO1=NO+1,
  277.     assert(clausevar(DOM,NO1)),
  278.     write(DOM,NO1).
  279.   wclausevar(DOM):-
  280.     assert(clausevar(DOM,0)),
  281.     write(DOM).
  282.  
  283.   wexpecttok(name(NAME,_),curdemand(PRODNAME)):-!,
  284.     write("t(",NAME,','),wclausevar(PRODNAME),write(')').
  285.   wexpecttok(name(NAME,_),_):-
  286.     write("t(",NAME,",_)").
  287.   wexpecttok(cmp(NAME,_,DOML),curdemand(PRODNAME)):-!,
  288.     write("t("),
  289.     write(NAME,'('),
  290.     wclausevarl(DOML),
  291.     write("),"),
  292.     wclausevar(PRODNAME),
  293.     write(')').
  294.   wexpecttok(cmp(NAME,_,DOML),_):-
  295.     write("t("),
  296.     write(NAME,'('),
  297.     wclausevarl(DOML),
  298.     write("),_)").
  299.  
  300.  
  301. /**********************************************************************
  302.     Writing variables with unique names in the output term
  303. **********************************************************************/
  304.  
  305. PREDICATES
  306.   wClauseOutpTerm(TERM)
  307.   checkwoutptermdoml(PRODNAMES)
  308.   woutptermdoml(PRODNAMES)
  309.   woutptermvar(PRODNAME)
  310.   biggertermno(PRODNAME,INTEGER)
  311.  
  312. CLAUSES
  313.   checkwoutptermdoml([]):-!.
  314.   checkwoutptermdoml(DOML):-woutptermdoml(DOML),write(",").
  315.  
  316.   woutptermdoml([DOM]):-!,woutptermvar(DOM).
  317.   woutptermdoml([H|T]):-woutptermvar(H),write(','),woutptermdoml(T).
  318.   woutptermdoml([]).
  319.  
  320.   biggertermno(DOM,NO):-
  321.     outptermvar(DOM,NO1),NO1>NO,!.
  322.  
  323.   woutptermvar(DOM):-
  324.     outptermvar(DOM,NO),
  325.     not(biggertermno(DOM,NO)),!,
  326.     NO1=NO+1,assert(outptermvar(DOM,NO1)),
  327.     write(DOM,NO1).
  328.   woutptermvar(DOM):-
  329.     assert(outptermvar(DOM,0)),
  330.     write(DOM).
  331.  
  332.   wClauseOutpTerm(term(FUNC,_,DOML)):-
  333.     write(FUNC,'('),
  334.     woutptermdoml(DOML),
  335.     write(')').
  336.   wClauseOutpTerm(dom(DOM,_)):-
  337.     woutptermdoml([DOM]).
  338.   wClauseOutpTerm(name(FUNCTOR,_)):-
  339.     write(FUNCTOR).
  340.  
  341.  
  342. DOMAINS
  343.   DBAL = DBASEDOM*
  344.  
  345. PREDICATES
  346.   conversions
  347.   nondeterm var1(DBASEDOM)
  348.   nondeterm var2(DBASEDOM)
  349.   genconversions(DBAL,DBAL)
  350.   genconversion(DBASEDOM,DBASEDOM)
  351.   wvar(PRODNAME,INTEGER)
  352.   check_convmove(PRODNAMES,GRAMTOKL)
  353.  
  354. CLAUSES
  355.   var1(clausevar(X,Y)):-clausevar(X,Y).
  356.   var2(outptermvar(X,Y)):-outptermvar(X,Y).
  357.  
  358.   conversions:-
  359.     findall(X1,var1(X1),L1),
  360.     findall(X2,var2(X2),L2),
  361.     genconversions(L1,L2),!.
  362.   conversions:-save("d:dd.dat"),exit.
  363.  
  364.   genconversions([],[]):-write(".\n").
  365.   genconversions([H1|T1],[H2|T2]):-
  366.     genconversion(H1,H2),
  367.     genconversions(T1,T2).
  368.  
  369.   genconversion(clausevar(X,_),outptermvar(X,_)):-!.
  370.   genconversion(clausevar(X,NO1),outptermvar(Y,NO2)):-
  371.     write(','),wvar(X,NO1),write('='),wvar(Y,NO2).
  372.  
  373.   wvar(ID,0):-!,write(ID).
  374.   wvar(ID,NO):-write(ID,NO).
  375.  
  376.   /* If the first token contains a variable it should be placed
  377.      after the domain list */
  378.   check_convmove([],_):-!.
  379.   check_convmove(_,[prodname(_,_)|_]):-!.
  380.   check_convmove(_,[tok(name(_,_),_)|_]):-!.
  381.   check_convmove(_,_):-
  382.     retract(clausevar(DOM,NO)),!,
  383.     assertz(clausevar(DOM,NO)).
  384.  
  385.  
  386. /**********************************************************************
  387.     Generate unique variable names for difference lists
  388.     and unique predicate numbers
  389. **********************************************************************/
  390.  
  391. PREDICATES
  392.   newdifflist(STRING)
  393.  
  394.   initsuffix(INTEGER)
  395.   newsuffix(SUFFIX)
  396.  
  397. CLAUSES
  398.   newdifflist(DIFFLIST):-
  399.     retract(difflist(N)),N1=N+1,assert(difflist(N1)),!,
  400.     N2=N1 div 2,
  401.     str_int(DD,N2),concat("LL",DD,DIFFLIST).
  402.  
  403.   initsuffix(_):-retract(suffix(_)),fail.
  404.   initsuffix(N):-assert(suffix(N)).
  405.  
  406.   newsuffix(SUFFIX):-
  407.     retract(suffix(N)),
  408.     N1=N+1,assert(suffix(N1)),!,
  409.     str_int(SUFFIX,N1).
  410.  
  411.  
  412. /**********************************************************************
  413.         Find first symbols
  414. **********************************************************************/
  415.  
  416. DOMAINS
  417.   EMPTY = emptymeet; false
  418.  
  419. PREDICATES
  420.   firstsymbols(PRODNAME,PRODNAMES,PRODNAMES,TOKKL,TOKKL,EMPTY)
  421.   firstsymbols1(PRODBODY,PRODNAMES,PRODNAMES,TOKKL,TOKKL,EMPTY)
  422.   firstsymbols11(PRODGROUPS,PRODNAMES,PRODNAMES,TOKKL,TOKKL,EMPTY,EMPTY)
  423.   firstsymbols2(PRIORGROUP,PRODNAMES,PRODNAMES,TOKKL,TOKKL,EMPTY,EMPTY)
  424.   firstsymbols3(GRAMTOKL,PRODNAMES,PRODNAMES,TOKKL,TOKKL,EMPTY,EMPTY)
  425.   firstsymbols4(GRAMTOKL,PRODNAMES,PRODNAMES,TOKKL,TOKKL,EMPTY,EMPTY,EMPTY)
  426.   firstsymbols5(GRAMTOK,PRODNAMES,PRODNAMES,TOKKL,TOKKL,EMPTY)
  427.  
  428. CLAUSES
  429.   firstsymbols(PRODNAME,SEENPRODS,SEENPRODS1,IL,OL,EMPTY):-
  430.     p(PRODNAME,PRODBODY),!,
  431.     firstsymbols1(PRODBODY,[PRODNAME|SEENPRODS],SEENPRODS1,IL,OL,EMPTY).
  432.  
  433.   firstsymbols1(list(PRODNAME,_,star,_),SEENPRODS,SEENPRODS1,IL,OL,emptymeet):-
  434.     firstsymbols(PRODNAME,SEENPRODS,SEENPRODS1,IL,OL,_).
  435.   firstsymbols1(list(PRODNAME,_,plus,_),SEENPRODS,SEENPRODS1,IL,OL,EMPTY):-
  436.     firstsymbols(PRODNAME,SEENPRODS,SEENPRODS1,IL,OL,EMPTY).
  437.   firstsymbols1(groups(PRODGROUPS),SEENPRODS,SEENPRODS1,IL,OL,EMPTY):-
  438.     firstsymbols11(PRODGROUPS,SEENPRODS,SEENPRODS1,IL,OL,false,EMPTY).
  439.  
  440.   firstsymbols11([],SEENPRODS,SEENPRODS,IL,IL,EMPTY,EMPTY).
  441.   firstsymbols11([H|T],SEENPRODS,SEENPRODS2,IL,OL2,EMPTY1,EMPTY3):-
  442.     firstsymbols2(H,SEENPRODS,SEENPRODS1,IL,OL1,EMPTY1,EMPTY2),
  443.     firstsymbols11(T,SEENPRODS1,SEENPRODS2,OL1,OL2,EMPTY2,EMPTY3).
  444.  
  445.   firstsymbols2([],SEENPRODS,SEENPRODS,L,L,EMPTY,EMPTY).
  446.   firstsymbols2([prod(_,GRAML,_,_)|T],SEENPRODS,SEENPRODS2,IL,OL2,EMPTY1,EMPTY3):-
  447.     firstsymbols3(GRAML,SEENPRODS,SEENPRODS1,IL,OL1,EMPTY1,EMPTY2),
  448.     firstsymbols2(T,SEENPRODS1,SEENPRODS2,OL1,OL2,EMPTY2,EMPTY3).
  449.  
  450.   firstsymbols3([],SEENPRODS,SEENPRODS,IL,IL,_,emptymeet).
  451.   firstsymbols3([H|T],SEENPRODS,SEENPRODS2,IL,OL2,EMPTY1,EMPTY2):-
  452.     firstsymbols5(H,SEENPRODS,SEENPRODS1,IL,OL1,EMPTYMEET),
  453.     firstsymbols4(T,SEENPRODS1,SEENPRODS2,OL1,OL2,EMPTYMEET,EMPTY1,EMPTY2).
  454.  
  455.   firstsymbols4(_,SEENPRODS,SEENPRODS,IL,IL,false,EMPTY,EMPTY):-!.
  456.   firstsymbols4(T,SEENPRODS1,SEENPRODS2,IL,OL,_,EMPTY1,EMPTY2):-
  457.     firstsymbols3(T,SEENPRODS1,SEENPRODS2,IL,OL,EMPTY1,EMPTY2).
  458.  
  459.   firstsymbols5(prodname(PROD,_),SEENPRODS,SEENPRODS1,IL,OL,EMPTY):-
  460.     not(member(PROD,SEENPRODS)),!,
  461.     firstsymbols(PROD,SEENPRODS,SEENPRODS1,IL,OL,EMPTY).
  462.   firstsymbols5(tok(TOK,_),SEENPRODS,SEENPRODS,IL,[TOK|IL],false):-
  463.     not(member(TOK,IL)),!.
  464.   firstsymbols5(_,SEENPRODS,SEENPRODS,L,L,false). /* Not quite enough */
  465.  
  466.  
  467. /**********************************************************************
  468.         HELP PREDICATE
  469. **********************************************************************/
  470.  
  471. PREDICATES
  472.   minprior(PRIORITY,PRIORITY,PRIORITY)
  473.  
  474. CLAUSES
  475.   minprior(X,Y,X):-X<=Y,!.
  476.   minprior(_,Y,Y).
  477.  
  478.  
  479. /**********************************************************************
  480.         Check for cut
  481. **********************************************************************/
  482.  
  483. PREDICATES
  484.   checkcuta(GRAMTOKL,FIRSTLIST,CUT)
  485.   checkcutb(CUT)
  486.   morematch(TOKK,FIRSTLIST)
  487.   do_match(TOKK,FIRST)
  488.   do_match1(TOKK,TOKKL,EMPTY)
  489.  
  490. CLAUSES
  491.   checkcutb(setcut):-!,write(",!").
  492.   checkcutb(_).
  493.  
  494.   checkcuta([prodname(_,_)|_],_,setcut):-!.
  495.   checkcuta([tok(TOK,_)|_],FIRSTL,setcut):-
  496.     morematch(TOK,FIRSTL),!.
  497.   checkcuta(_,_,nill):-write("!,").
  498.  
  499.   morematch(_,[]):-!,fail.
  500.   morematch(TOK,[H|_]):-do_match(TOK,H),!.
  501.   morematch(TOK,[_|T]):-morematch(TOK,T).
  502.  
  503.   do_match(TOK,first(_,_,prod(_,[tok(TOK,_)|_],_,_),_)):-!.
  504.   do_match(TOK,first(_,_,prod(_,GRAML,_,_),_)):-
  505.     firstsymbols3(GRAML,[],_,[],FIRSTSYMBOLS,false,EMPTY),
  506.     do_match1(TOK,FIRSTSYMBOLS,EMPTY).
  507.  
  508.   do_match1(_,_,emptymeet):-!.
  509.   do_match1(cmp(ID,_,_),FIRSTSYMBOLS,_):-
  510.     member(cmp(ID,_,_),FIRSTSYMBOLS),!.
  511.   do_match1(name(ID,_),FIRSTSYMBOLS,_):-
  512.     member(name(ID,_),FIRSTSYMBOLS),!.
  513.  
  514.  
  515. /**********************************************************************
  516.         Generate parse predicates for prefix op's
  517. **********************************************************************/
  518.  
  519. PREDICATES
  520.   genpred(PRODNAMES,ASSOC,GRAMTOKL,TERM,PRODNAME,SUFFIX,PRIORITY,FIRSTLIST)
  521.   genpredstart(PRODNAME,SUFFIX,GRAMTOKL,GRAMTOKL)
  522.   genbody_b(GRAMTOKL,PRODNAME,SUFFIX,SUFFIX)
  523.   genbody_a(GRAMTOKL,PRODNAME,SUFFIX)
  524.   gencall_a(GRAMTOK,PRODNAME,SUFFIX)
  525.   gencall_b(GRAMTOK,PRODNAME,SUFFIX)
  526.   regconstinhead
  527.   initgenpred
  528.  
  529. CLAUSES
  530.   initgenpred:-retract(clausevar(_,_)),fail.
  531.   initgenpred:-retract(outptermvar(_,_)),fail.
  532.   initgenpred:-retract(difflist(_)),fail.
  533.   initgenpred:-assert(difflist(1)).
  534.  
  535.   /* The rest of the list is empty */
  536.   genpred(DOML,_,[],TERM,PRODNAME,SUFFIX,_,_):-!,
  537.     assert(catchallflag),
  538.     upper_lower(PRODNAME,PID),
  539.     write("  s_",PID,SUFFIX,"(LL,LL,"),
  540.     checkwclausevarl(DOML),
  541.     wClauseOutpTerm(TERM),
  542.     write("):-!"),
  543.     conversions.
  544.  
  545.   /* The rest of the list is only one constant token */
  546.   genpred(DOML,_,[tok(TOK,CURSORDEMAND)],TERM,PRODNAME,SUFFIX,_,_):-!,
  547.     upper_lower(PRODNAME,PID),
  548.     write("  s_",PID,SUFFIX,"(["),
  549.     wclausetok(TOK,CURSORDEMAND),
  550.     write("|LL],LL,"),
  551.     regconstinhead,
  552.     checkwclausevarl(DOML),
  553.     check_convmove(DOML,[tok(TOK,CURSORDEMAND)]),
  554.     wClauseOutpTerm(TERM),
  555.     write("):-!"),
  556.     conversions.
  557.  
  558.   /*
  559.   A right associative operator:
  560.   s_exp1a([t(potens,_)|LL1],LL0,plus(EXP,EXP1),EXP_):-!,
  561.     s_exp2(LL1,LL2,EXP1),
  562.     s_exp1a(LL2,LL0,EXP,EXP_).
  563.   */
  564.   genpred(DOML,right(_),TOKL,TERM,PRODNAME,SUFFIX,PRIORITY,_):-
  565.     PRIORITY>0,
  566.     lastselfref(PRODNAME,TOKL),!,
  567.     genpredstart(PRODNAME,SUFFIX,TOKL,TOKL1),
  568.     checkwclausevarl(DOML),
  569.     check_convmove(DOML,TOKL),
  570.     wClauseOutpTerm(TERM),
  571.     write("):-!,"),
  572.     str_int(SUFFIX1,PRIORITY),
  573.     genbody_b(TOKL1,PRODNAME,"",SUFFIX1),
  574.     conversions.
  575.  
  576.   /*
  577.   A left associative operator:
  578.   s_exp1a([t(plus,_)|LL1],LL0,EXP,EXP_):-!,
  579.     s_exp2(LL1,LL2,EXP1),
  580.     s_exp1a(LL2,LL0,plus(EXP,EXP1),EXP_).
  581.   */
  582.   genpred(DOML,_,TOKL,TERM,PRODNAME,SUFFIX,PRIORITY,_):-
  583.     PRIORITY>0,lastselfref(PRODNAME,TOKL),
  584.     frontconst(TOKL),
  585.     str_int(SUFFIX,DD),DD><PRIORITY,!, /* NOT predfirst */
  586.     genpredstart(PRODNAME,SUFFIX,TOKL,TOKL1),
  587.     checkwclausevarl(DOML),
  588.     check_convmove(DOML,TOKL),
  589.     DOM=PRODNAME,
  590.     write(DOM,"_):-!,"),
  591.     PRIOR2=PRIORITY+1,
  592.     exist_prior(PRODNAME,MAXPRIOR),
  593.     minprior(PRIOR2,MAXPRIOR,PRIOR22),
  594.     str_int(SUFFIX2,PRIOR22),
  595.     genbody_a(TOKL1,PRODNAME,SUFFIX2),
  596.     newdifflist(LL3),
  597.     upper_lower(PRODNAME,PID),
  598.     write("\n\ts_",PID,SUFFIX,"(",LL3,",LL0,"),
  599.     wClauseOutpTerm(TERM),
  600.     write(",",DOM,"_)"),
  601.     conversions,!.
  602.  
  603.   /* With A operator the last call must be a call to the same priority */
  604.   genpred(DOML,_,TOKL,TERM,PRODNAME,SUFFIX,PRIORITY,REST):-
  605.     PRIORITY>0,lastselfref(PRODNAME,TOKL),!,
  606.     genpredstart(PRODNAME,SUFFIX,TOKL,TOKL1),
  607.     checkwclausevarl(DOML),
  608.     check_convmove(DOML,TOKL),
  609.     wClauseOutpTerm(TERM),
  610.     write("):-"),checkcuta(TOKL,REST,CUT),
  611.     str_int(SUFFIX2,PRIORITY),
  612.     genbody_b(TOKL1,PRODNAME,"",SUFFIX2),
  613.     checkcutb(CUT),
  614.     conversions.
  615.  
  616.   /* The general form of a production */
  617.   genpred(DOML,_,TOKL,TERM,PRODNAME,SUFFIX,_,REST):-
  618.     genpredstart(PRODNAME,SUFFIX,TOKL,TOKL1),
  619.     checkwclausevarl(DOML),
  620.     check_convmove(DOML,TOKL),
  621.     wClauseOutpTerm(TERM),
  622.     write("):-"),checkcuta(TOKL,REST,CUT),
  623.     genbody_b(TOKL1,PRODNAME,"",""),
  624.     checkcutb(CUT),
  625.     conversions.
  626.  
  627.   regconstinhead:-constinhead,!.
  628.   regconstinhead:-assert(constinhead).
  629.  
  630.   genpredstart(PRODNAME,SUFFIX,[tok(TOK,CURSORDEMAND)|TOKL],TOKL):-!,
  631.     upper_lower(PRODNAME,PID),
  632.     newdifflist(LL1),
  633.     write("  s_",PID,SUFFIX,"(["),
  634.     wclausetok(TOK,CURSORDEMAND),
  635.     write("|",LL1,"],LL0,"),
  636.     regconstinhead.
  637.   genpredstart(PRODNAME,SUFFIX,TOKL,TOKL):-
  638.     upper_lower(PRODNAME,PID),
  639.     newdifflist(LL1),
  640.     write("  s_",PID,SUFFIX,"(",LL1,",LL0,").
  641.  
  642.  
  643. /*********************************************************************
  644.   genbody_b generates calls to productions in the body of the clause.
  645. *********************************************************************/
  646.  
  647.   genbody_a([],_,_).
  648.   genbody_a([H|T],PRODNAME,SUFFIX):-
  649.     gencall_a(H,PRODNAME,SUFFIX),write(','),
  650.     genbody_a(T,PRODNAME,SUFFIX).
  651.  
  652.  
  653. /*********************************************************************
  654.   genbody_b generates the body of the clause. The last call needs to
  655.   be handled specially so the name of the last difference list will
  656.   be the name of the output differencelist in the head.
  657.   The last call does also have a special suffix.
  658. *********************************************************************/
  659.  
  660.   genbody_b([],_,_,_).
  661.   genbody_b([H],PRODNAME,_,SUFFIX):-!,
  662.     gencall_b(H,PRODNAME,SUFFIX).
  663.   genbody_b([H|T],PRODNAME,SUFFIX,SUFFIX1):-
  664.     gencall_a(H,PRODNAME,SUFFIX),write(","),
  665.     genbody_b(T,PRODNAME,SUFFIX,SUFFIX1).
  666.  
  667. /*********************************************************************
  668.     Call productions in clause body except last call
  669. *********************************************************************/
  670.  
  671.   gencall_a(prodname(PROD1,_),_,SUFFIX):-
  672.     upper_lower(PROD1,PID),
  673.     newdifflist(LL1),newdifflist(LL2),DOM=PROD1,
  674.     write("\n\ts_",PID,SUFFIX,"(",LL1,",",LL2,","),wclausevar(DOM),write(")").
  675.   gencall_a(tok(TOK,CURSORDEMAND),_,_):-
  676.     newdifflist(LL1),newdifflist(LL2),
  677.     write("\n\texpect("),
  678.     wexpecttok(TOK,CURSORDEMAND),
  679.     write(",",LL1,",",LL2,")").
  680.  
  681. /*********************************************************************
  682.   Last call in clause body, handle name of differencelist specially
  683. *********************************************************************/
  684.  
  685.   gencall_b(prodname(PROD1,_),_,SUFFIX):-
  686.     upper_lower(PROD1,PID),
  687.     newdifflist(LL1),DOM=PROD1,
  688.     write("\n\ts_",PID,SUFFIX,"(",LL1,",LL0,"),wclausevar(DOM),write(")").
  689.   gencall_b(tok(TOK,CURDEMAND),_,_):-
  690.     newdifflist(LL1),
  691.     write("\n\texpect("),
  692.     wexpecttok(TOK,CURDEMAND),
  693.     write(",",LL1,",LL0)").
  694.  
  695. /*********************************************************************
  696.   Generate as many underscores as there are elements in the list
  697. *********************************************************************/
  698.  
  699. PREDICATES
  700.   writeuscores(PRODNAMES)
  701.  
  702. CLAUSES
  703.   writeuscores([]).
  704.   writeuscores([_|T]):-
  705.     write(",_"),
  706.     writeuscores(T).
  707.  
  708.  
  709. /*********************************************************************
  710.   genpred_first and genopred_second are introduced to get an efficient
  711.   parser. If more than one production in a group starts with the same
  712.   sequence of productions and tokens, these same 'gramtokens' are handled
  713.   by genpred_first and the rest is handled by genpred_second.
  714.  
  715.   Ex:
  716.  
  717.   SENT =  if_ EXP then SENT        -> ifthen(EXP,SENT),
  718.       if_ EXP then SENT else SENT    -> ifthenelse(EXP,SENT,SENT),
  719.  
  720. >> genpred_first generates:
  721.  
  722.  s_sent([t(if_,_)|LL1],LL0,SENT_):-!,
  723.     s_exp(LL1,LL2,EXP),
  724.     expect(then,LL2,LL3),
  725.     s_sent(LL3,LL4,SENT),
  726.     s_sent1(LL4,LL0,EXP,SENT,SENT_).
  727.  
  728.  
  729. >> genpred_second generates:
  730.  
  731.   s_sent1([t(else,_)|LL1],LL0,EXP,SENT,ifthenelse(EXP,SENT,SENT1)):-!,
  732.     s_sent(LL1,LL0,SENT1).
  733.   s_sent1(LL,LL,EXP,SENT,ifthen(EXP,SENT)).
  734.         
  735. **********************************************************************/
  736.  
  737. PREDICATES
  738.   genpred_firstlist(PRODNAME,SUFFIX,PRIORITY,FIRSTLIST)
  739.   genpred_first(INTEGER,PRODNAMES,SINGPROD,PRODNAME,SUFFIX,SUFFIX,PRIORITY,FIRSTLIST)
  740.   genpred_second(INTEGER,PRODNAMES,PRIORGROUP,PRODNAME,SUFFIX,PRIORITY)
  741.  
  742. CLAUSES
  743.   genpred_firstlist(_,_,_,[]):-catchallflag,!.
  744.   genpred_firstlist(_,_,_,[]):-not(constinhead),!.
  745.   genpred_firstlist(PRODNAME,SUFFIX,_,[]):-
  746.     upper_lower(PRODNAME,PID),
  747.     write("  s_",PID,SUFFIX,"(LL,_,_):-"),
  748.     SUFF=SUFFIX,
  749.     strlist_str([PID,SUFF],PIDD),
  750.     write("syntax_error(",PIDD,",LL),fail.\n").
  751.   genpred_firstlist(PRODNAME,SUFFIX,PRIORITY,[first(N,DOML,PROD,SUFFIX1)|T]):-
  752.     genpred_first(N,DOML,PROD,PRODNAME,SUFFIX,SUFFIX1,PRIORITY,T),
  753.     genpred_firstlist(PRODNAME,SUFFIX,PRIORITY,T).
  754.  
  755.   /* Make the entry predicate to a production with priorities    */
  756.   /* Ex.  s_exp(LL1,LL0,EXP):- s_exp1(LL1,LL0,EXP).        */
  757.   genpred_first(-1,[DOM],_,PRODNAME,_,_,_,_):-!,
  758.     upper_lower(PRODNAME,PID),
  759.     write("  s_",PID,"(LL1,LL0,",DOM,"):-\n"),
  760.     write("\ts_",PID,"1(LL1,LL0,",DOM,").\n").
  761.  
  762. /* Only one production which matches, genpred_second not used    */
  763.   genpred_first(0,DOML,prod(ASSOC,TOKL,_,TERM),PRODNAME,SUFFIX,_,PRIORITY,REST):-!,
  764.     initgenpred,
  765.     genpred(DOML,ASSOC,TOKL,TERM,PRODNAME,SUFFIX,PRIORITY,REST).
  766.  
  767.   /*
  768.   Self referential production: EXP :== EXP + EXP
  769.   >> genpred_first:
  770.   s_exp1(LL1,LL0,EXP_):-
  771.     s_exp2(LL1,LL2,EXP),
  772.     s_exp1a(LL2,LL0,EXP,EXP_).
  773.  
  774.   >> genpred_second:
  775.   s_exp1a([t(plus,_)|LL1],LL0,EXP,EXP_):-!,
  776.     s_exp2(LL1,LL2,EXP1),
  777.     s_exp1a(LL2,LL0,plus(EXP,EXP1),EXP_).
  778.   s_exp1a(LL,LL,EXP,EXP).
  779.   */
  780.   genpred_first(NOOFEQ,DOML,prod(_,[prodname(PRODNAME,CURSOR)|TOKL],_,_),PRODNAME,SUFFIX,SUFFIX1,PRIORITY,_):-!,
  781.     split(NOOFEQ,[prodname(PRODNAME,CURSOR)|TOKL],TOKL1,_),
  782.     upper_lower(PRODNAME,PID),
  783.     initgenpred,
  784.     newdifflist(LL1),
  785.     write("  s_",PID,SUFFIX,"(",LL1,",LL0,",PRODNAME,"_):-"),
  786.     PRIOR2=PRIORITY+1, str_int(SUFFIX2,PRIOR2),
  787.     genbody_a(TOKL1,PRODNAME,SUFFIX2),
  788.     newdifflist(LL3),
  789.     write("\n\ts_",PID,SUFFIX1,"(",LL3,",LL0,"),
  790.     checkwoutptermdoml(DOML),
  791.     write(PRODNAME,"_)"),
  792.     conversions.
  793.  
  794.   /* Production like: if EXP then SENT else SENT where NOOFEQ==4 */
  795.   genpred_first(NOOFEQ,DOML,prod(_,TOKL,_,_),PRODNAME,SUFFIX,SUFFIX1,_,REST):-
  796.     initgenpred,
  797.     split(NOOFEQ,TOKL,TOKL1,_),
  798.     genpredstart(PRODNAME,SUFFIX,TOKL1,TOKL2),
  799.     write(PRODNAME,"_):-"),checkcuta(TOKL,REST,CUT),
  800.     genbody_a(TOKL2,PRODNAME,""),
  801.     newdifflist(LL3),
  802.     upper_lower(PRODNAME,PID),
  803.     write("\n\ts_",PID,SUFFIX1,"(",LL3,",LL0,"),
  804.     checkwoutptermdoml(DOML),
  805.     write(PRODNAME,"_)"),checkcutb(CUT),
  806.     conversions.
  807.  
  808.   genpred_second(_,_,[],_,_,_):-catchallflag,!.
  809.   genpred_second(_,[PRODNAME],[],PRODNAME,SUFFIX,_):-!,
  810.     DOM=PRODNAME,upper_lower(PRODNAME,PID),
  811.     write("  s_",PID,SUFFIX,"(LL,LL,",DOM,",",DOM,").\n").
  812.   genpred_second(_,_,[],_,_,_):-not(constinhead),!.
  813.   genpred_second(_,DOML,[],PRODNAME,SUFFIX,_):-!,
  814.     upper_lower(PRODNAME,PID),
  815.     write("  s_",PID,SUFFIX,"(LL,_,_"),
  816.     writeuscores(DOML),write("):-"),
  817.     SUFF=SUFFIX,
  818.     strlist_str([PID,SUFF],PIDD),
  819.     write("syntax_error(",PIDD,",LL),fail.\n").
  820.   genpred_second(NOOFEQ,DOML,[prod(ASSOC,TOKL,_,TERM)|T],PRODNAME,SUFFIX,PRIORITY):-
  821.     initgenpred,
  822.     split(NOOFEQ,TOKL,_,TOKL1),
  823.     genpred(DOML,ASSOC,TOKL1,TERM,PRODNAME,SUFFIX,PRIORITY,[]),
  824.     genpred_second(NOOFEQ,DOML,T,PRODNAME,SUFFIX,PRIORITY).
  825.  
  826. /*********************************************************************
  827.         Generate parse predicates for lists
  828. **********************************************************************/
  829.  
  830. PREDICATES
  831.   genlist(PRODNAME,PRODNAME,STAR_PLUS,SEPARATOR)
  832.  
  833. CLAUSES
  834.   genlist(PRODNAME,PRODNAME1,plus,sep(SEPARATOR)):-
  835.     upper_lower(PRODNAME,PID),DOMID=PRODNAME,
  836.     upper_lower(PRODNAME1,PID1),DOMID1=PRODNAME1,
  837.     write("  s_",PID,"(LL1,LL0,[",DOMID1,"|",DOMID,"]):-\n"),
  838.     write("\ts_",PID1,"(LL1,LL2,",DOMID1,"),\n"),
  839.     write("\ts_",PID,"1(LL2,LL0,",DOMID,").\n\n"),
  840.     write("  s_",PID,"1(["),
  841.     wclausetok(name(SEPARATOR,0),none),
  842.     write("|LL1],LL2,",DOMID,"):-!,\n"),
  843.     write("\ts_",PID,"(LL1,LL2,",DOMID,").\n"),
  844.     write("  s_",PID,"1(LL,LL,[]).\n").
  845.   genlist(PRODNAME,PRODNAME1,plus,none):-
  846.     upper_lower(PRODNAME,PID),DOMID=PRODNAME,
  847.     upper_lower(PRODNAME1,PID1),DOMID1=PRODNAME1,
  848.     write("  s_",PID,"(LL1,LL0,[",DOMID1,"|",DOMID,"]):-\n"),
  849.     write("\ts_",PID1,"(LL1,LL2,",DOMID1,"),\n"),
  850.     write("\ts_",PID,"1(LL2,LL0,",DOMID,").\n"),
  851.     write("\n  s_",PID,"1(LL1,LL0,[",DOMID1,"|",DOMID,"]):-\n"),
  852.     write("\ts_",PID1,"(LL1,LL2,",DOMID1,"),!,\n"),
  853.     write("\ts_",PID,"1(LL2,LL0,",DOMID,").\n"),
  854.     write("  s_",PID,"1(LL,LL,[]).\n").
  855.   genlist(PRODNAME,PRODNAME1,star,sep(SEPARATOR)):-
  856.     upper_lower(PRODNAME,PID),DOMID=PRODNAME,
  857.     upper_lower(PRODNAME1,PID1),DOMID1=PRODNAME1,
  858.     write("  s_",PID,"(LL1,LL0,[",DOMID1,"|",DOMID,"]):-\n"),
  859.     write("\ts_",PID1,"(LL1,LL2,",DOMID1,"),!,\n"),
  860.     write("\ts_",PID,"1(LL2,LL0,",DOMID,").\n"),
  861.     write("  s_",PID,"(LL,LL,[]).\n\n"),
  862.     write("  s_",PID,"1(["),
  863.     wclausetok(name(SEPARATOR,0),none),
  864.     write("|LL1],LL2,",DOMID,"):-!,\n"),
  865.     write("\ts_",PID,"(LL1,LL2,",DOMID,").\n"),
  866.     write("  s_",PID,"1(LL,LL,[]).\n").
  867.   genlist(PRODNAME,PRODNAME1,star,none):-
  868.     upper_lower(PRODNAME,PID),DOMID=PRODNAME,
  869.     upper_lower(PRODNAME1,PID1),DOMID1=PRODNAME1,
  870.     write("  s_",PID,"(LL1,LL0,[",DOMID1,"|",DOMID,"]):-\n"),
  871.     write("\ts_",PID1,"(LL1,LL2,",DOMID1,"),!,\n"),
  872.     write("\ts_",PID,"(LL2,LL0,",DOMID,").\n"),
  873.     write("  s_",PID,"(LL,LL,[]).\n").
  874.  
  875.  
  876. /*********************************************************************
  877.         Generate parse predicates
  878. **********************************************************************/
  879.  
  880. PREDICATES
  881.   genprodgroup(PRODGROUPS,PRODNAME)
  882.   sortgroup(PRIORGROUP,PRODNAME,SUFFIX,PRIORITY,FIRSTLIST)
  883.   sortgroup1(PRIORGROUP,SINGPROD,INTEGER,INTEGER,PRIORGROUP,PRIORGROUP,PRIORGROUP,PRODNAME,SUFFIX)
  884.   handlesplit(PRODNAME,SUFFIX,PRIORITY,INTEGER,SINGPROD,PRIORGROUP,FIRST)
  885.   match(SINGPROD,SINGPROD,INTEGER,INTEGER)
  886.   matchlength(GRAMTOKL,GRAMTOKL,INTEGER)
  887.   tokmatch(GRAMTOK,GRAMTOK)
  888.   genpriorgroups(PRODGROUPS,PRODNAME,PRIORITY)
  889.   declarelist(PRODNAME,STAR_PLUS,SEPARATOR)
  890.   retract_catchallflag
  891.   maxprior(PRODGROUPS,PRIORITY)
  892.  
  893.  
  894. CLAUSES
  895.   genparser:-
  896.     write("/***********************************************************\n"),
  897.     write("\t\tPARSING PREDICATES"),nl,
  898.     write("***********************************************************/\n\n"),
  899.     write("PREDICATES\n"),
  900.     p(PRODNAME,list(_,_,STAR_PLUS,SEPP)),
  901.     declarelist(PRODNAME,STAR_PLUS,SEPP),
  902.     fail.
  903.   genparser:-
  904.     p(PRODNAME,groups(PRODUCTIONGROUPS)),
  905.     genprodgroup(PRODUCTIONGROUPS,PRODNAME),
  906.     fail.
  907.  
  908.   genparser:-
  909.     write("\nCLAUSES\n"),
  910.     fail.
  911.  
  912.   genparser:-
  913.     pred_first(PRODNAME,SUFFIX,PRIORITY,FIRSTLIST),
  914.     retract_catchallflag,
  915.     genpred_firstlist(PRODNAME,SUFFIX,PRIORITY,FIRSTLIST),
  916.     nl,
  917.     fail.
  918.  
  919.   genparser:-
  920.     pred_second(MATCHLENGTH,DOML,MATCH,PRODNAME,SUFFIX,PRIORITY),
  921.     retract_catchallflag,
  922.     genpred_second(MATCHLENGTH,DOML,MATCH,PRODNAME,SUFFIX,PRIORITY),
  923.     nl,
  924.     fail.
  925.  
  926.   genparser:-
  927.     p(PRODNAME,list(PRODNAME1,_,STAR_PLUS,SEPARATOR)),
  928.     genlist(PRODNAME,PRODNAME1,STAR_PLUS,SEPARATOR),
  929.     nl,
  930.     fail.
  931.  
  932.   genparser:-closefile(outfile).
  933.  
  934.   retract_catchallflag:-retract(catchallflag),fail.
  935.   retract_catchallflag:-retract(constinhead),fail.
  936.   retract_catchallflag.
  937.  
  938.  
  939.   declarelist(PRODNAME,star,none):-!,
  940.     DOM=PRODNAME,PRODNAME=PID,
  941.     declarepred([decl(["s_",PID],[DOM])]).
  942.   declarelist(PRODNAME,_,_):-
  943.     DOM=PRODNAME,PRODNAME=PID,
  944.     declarepred([decl(["s_",PID],[DOM]),decl(["s_",PID,"1"],[DOM])]).
  945.  
  946.   genprodgroup([PRODUCTIONS],PRODNAME):-!,
  947.     initsuffix(0),
  948.     sortgroup(PRODUCTIONS,PRODNAME,"",0,FIRSTLIST),
  949.     assert(pred_first(PRODNAME,"",0,FIRSTLIST)).
  950.  
  951.   genprodgroup(PRODUCTIONGROUPS,PRODNAME):-
  952.     maxprior(PRODUCTIONGROUPS,MAXPRIOR),
  953.     MAXPR=MAXPRIOR,
  954.     initsuffix(MAXPR),
  955.     PID=PRODNAME,DOM=PRODNAME,
  956.     declarepred([decl(["s_",PID],[DOM])]),
  957.     /* generate entry to prior group */
  958.     assert(pred_first(PRODNAME,"",0,[first(-1,[DOM],prod(left,[prodname(PRODNAME,0)],0,dom(DOM,0)),"")])),
  959.     assert(exist_prior(PRODNAME,MAXPRIOR)),
  960.     genpriorgroups(PRODUCTIONGROUPS,PRODNAME,1).
  961.  
  962.   maxprior([],0).
  963.   maxprior([_|T],N):-maxprior(T,N1),N=N1+1.
  964.  
  965. /************************************************************************
  966.         Generate predicate group with priority
  967. ************************************************************************/
  968.  
  969.   genpriorgroups([],_,_).
  970.   genpriorgroups([H|T],PRODNAME,PRIORITY):-
  971.     str_int(SUFFIX,PRIORITY),
  972.     sortgroup(H,PRODNAME,SUFFIX,PRIORITY,FIRSTLIST),
  973.     assert(pred_first(PRODNAME,SUFFIX,PRIORITY,FIRSTLIST)),
  974.     PRIORITY1=PRIORITY+1,
  975.     genpriorgroups(T,PRODNAME,PRIORITY1).
  976.  
  977. /************************************************************************
  978.         Generate predicate group with no priority
  979. ************************************************************************/
  980.  
  981.   sortgroup([],_,_,_,[]).
  982.   sortgroup([H|PRODUCTIONS],PRODNAME,SUFFIX,PRIORITY,[FIRST|FIRSTL]):-
  983.     sortgroup1(PRODUCTIONS,H,9999,RESMATCHLENGTH,[H],RESMATCH,RESNOMATCH,PRODNAME,SUFFIX),
  984.     handlesplit(PRODNAME,SUFFIX,PRIORITY,RESMATCHLENGTH,H,RESMATCH,FIRST),
  985.     sortgroup(RESNOMATCH,PRODNAME,SUFFIX,PRIORITY,FIRSTL).
  986.  
  987.   handlesplit(PRODNAME,SUFFIX,PRIORITY,_,prod(ASSOC,[prodname(PRODNAME,CURSOR)|TOKL],ACURSOR,TERM),[MATCH],
  988.         first(1,[DOM],prod(ASSOC,[prodname(PRODNAME,CURSOR)|TOKL],ACURSOR,TERM),SUFFIX1)):-!,
  989.     newsuffix(SUFFIX1),
  990.     PID=PRODNAME,DOM=PRODNAME,SUFF1=SUFFIX1,SUFF=SUFFIX,
  991.     declarepred([decl(["s_",PID,SUFF],[DOM]),decl(["s_",PID,SUFF1],[DOM,DOM])]),
  992.     assert(pred_second(1,[DOM],[MATCH],PRODNAME,SUFFIX1,PRIORITY)).
  993.   handlesplit(PRODNAME,SUFFIX,_,_,PRODUCTION,[_],
  994.         first(0,[],PRODUCTION,"")):-!,
  995.     PID=PRODNAME,DOM=PRODNAME,SUFF=SUFFIX,
  996.     declarepred([decl(["s_",PID,SUFF],[DOM])]).
  997.   handlesplit(PRODNAME,SUFFIX,PRIORITY,MATCHLENGTH,prod(ASSOC,GRAML,ACURSOR,TERM),MATCH,
  998.         first(MATCHLENGTH,DOML,prod(ASSOC,GRAML,ACURSOR,TERM),SUFFIX1)):-
  999.     getdoml(GRAML,MATCHLENGTH,DOML),
  1000.     newsuffix(SUFFIX1),
  1001.     PID=PRODNAME,DOM=PRODNAME,SUFF1=SUFFIX1,SUFF=SUFFIX,
  1002.     append(DOML,[DOM],DOML1),
  1003.     declarepred([decl(["s_",PID,SUFF],[DOM]),decl(["s_",PID,SUFF1],DOML1)]),
  1004.     reverse(MATCH,[],REVMATCH),
  1005.     assert(pred_second(MATCHLENGTH,DOML,REVMATCH,PRODNAME,SUFFIX1,PRIORITY)).
  1006. /*
  1007.   sortgroup1(PRODLIST,PROD,OLDMATCHLENGTH,RESMATCHLENGTH,MATCHLIST,RESMATCHLIST,
  1008.     NOMATCHLIST,PRODNAME,SUFFIX)
  1009. */
  1010.   sortgroup1([],_,MATCHLENGTH,MATCHLENGTH,MATCHLIST,MATCHLIST,[],_,_).
  1011.   sortgroup1([PROD2|T],PROD1,OLDMATCHLENGTH,RESMATCHLENGTH,MATCH,RESMATCH,NOMATCH,PRODNAME,SUFFIX):-
  1012.     match(PROD1,PROD2,OLDMATCHLENGTH,NEWMATCHLENGTH),!,
  1013.     sortgroup1(T,PROD1,NEWMATCHLENGTH,RESMATCHLENGTH,[PROD2|MATCH],RESMATCH,NOMATCH,PRODNAME,SUFFIX).
  1014.   sortgroup1([H|T],PROD,MATCHLENGTH,RESMATCHLENGTH,MATCH,RESMATCH,[H|NOMATCH],PRODNAME,SUFFIX):-
  1015.     sortgroup1(T,PROD,MATCHLENGTH,RESMATCHLENGTH,MATCH,RESMATCH,NOMATCH,PRODNAME,SUFFIX).
  1016.  
  1017.   match(prod(_,GRAML1,_,_),prod(_,GRAML2,_,_),OLDMATCHLENGTH,NEWMATCHLENGTH):-
  1018.     matchlength(GRAML1,GRAML2,LENGTH),
  1019.     LENGTH>0,
  1020.     min(LENGTH,OLDMATCHLENGTH,NEWMATCHLENGTH).
  1021.  
  1022.   matchlength([H1|T1],[H2|T2],N):-
  1023.       tokmatch(H1,H2),!,
  1024.       matchlength(T1,T2,N1),
  1025.       N=N1+1.
  1026.   matchlength(_,_,0).
  1027.  
  1028.   tokmatch(prodname(N,_),prodname(N,_)):-!.
  1029.   tokmatch(tok(cmp(ID,_,DOML),CURDEM),tok(cmp(ID,_,DOML),CURDEM)):-!.
  1030.   tokmatch(TOK,TOK).
  1031.  
  1032.   getdoml(_,0,[]):-!.
  1033.   getdoml([],_,[]):-!.
  1034.   getdoml([prodname(DOM,_)|T],N,[DOM|T1]):-!,
  1035.     N1=N-1,
  1036.     getdoml(T,N1,T1).
  1037.   getdoml([tok(name(_,_),curdemand(CURSOR))|T],N,[CURSOR|DOML]):-!,
  1038.     N1=N-1,
  1039.     getdoml(T,N1,DOML).
  1040.   getdoml([tok(cmp(_,_,DOML),curdemand(CURSOR))|T],N,DOML2):-!,
  1041.     N1=N-1,
  1042.     getdoml(T,N1,DOML1),
  1043.     append(DOML,[CURSOR|DOML1],DOML2).
  1044.   getdoml([tok(cmp(_,_,DOML),_)|T],N,DOML2):-!,
  1045.     N1=N-1,
  1046.     getdoml(T,N1,DOML1),
  1047.     append(DOML,DOML1,DOML2).
  1048.   getdoml([_|T],N,T1):-
  1049.     N1=N-1,
  1050.     getdoml(T,N1,T1).
  1051.