1 % $Id: natded.pl,v 1.7 2001/04/26 12:22:56 geertk Exp geertk $
2 % NATURAL DEDUCTION CG PARSER WITH SEMANTICS
3 % =========================================================================
5 % Computational Linguistics Program, Department of Philosophy
6 % Carnegie Mellon University, Pittsburgh, PA 15213
8 % Voice: (412) 268-8043 Fax: (412) 268-1440
10 % Copyright 1995, Bob Carpenter
12 % Written: 12 March 1993
13 % Revised: 4 February 1994
14 % Further Revised: 2 May 1994
15 % Revised for CGI: 16 November 1995
16 % Revised for Lambek notation: ? Novemeber 1995
17 % Revised again: 30 November 1995
21 % =========================================================================
23 :- use_module(library(system)).
24 % :- use_module(library(random)).
28 % =========================================================================
30 % <lambda_term> ::= <lambda_var>
32 % | <lambda_term>@<lambda_term>
33 % | <lambda_var>^<lambda_term>
35 % <lambda_var> ::= var(<prolog_var>)
37 % <lambda_con> ::= con(<prolog_atom>)
39 % <tree> ::= tree(<rule>,<cat>,<list(<tree>)>)
40 % | ass(<syn>,<var>,<index>)
43 % <rule> ::= <prolog_atom>
45 % <cat> ::= <syn> : <lambda_term>
47 % <syn> ::= <basic_syn>
48 % | <syn> / <syn> | <syn> \ <syn>
52 % <basic_syn> ::= bas(<prolog_term>)
54 % <grammar> ::= <sequence(<lex_entry>)>
55 % <sequence(<empty_category>)>
56 % <sequence(<grammar_rule>)>
58 % <lex_entry> ::= <word> ==> <cat>.
60 % <empty_category> ::= empty <cat>.
62 % <grammar_rule> ::= <cat> ===> <list(<cat>)> if <prolog_goal>.
64 % <index> ::= <integer>
66 % <word> ::= <prolog_atom>
68 % <chart_edge> ::= edge(<int>, <int>, <cat>)
70 % Operator Declarations
71 % =========================================================================
73 :-op(150,yfx,@). % function application
74 % :-op(200,xfy,^). % lambda abstraction
75 % :-op(400,yfx,/). % forward slash
76 :-op(350,yfx,\). % backward slash
77 :-op(500,xfx,:). % category constructor
78 :-op(600,xfx,==>). % lexical rewriting
79 :-op(600,xfx,===>). % grammar rule
80 :-op(600,fx,empty). % empty categories
81 :- op(600,xfx,macro). % lexical macros
82 :- op(600,xfx,means). % meaning postulates
83 :-op(1200,xfx,if). % conditions on rule schemes
86 :- dynamic emptyedge/1.
93 % =========================================================================
95 % expandmng(+M:<term>, -MExp:<term>)
96 % ----------------------------------------------------------------------
97 % MExp is the result of recursively replacing constants with their
98 % definitions in M; disallows non-determinism
99 % ----------------------------------------------------------------------
100 expandmng(var(V),var(V)).
101 expandmng(con(C),MExp):-
104 expandmng(con(C),con(C)).
105 expandmng(V^M,V^MExp):-
107 expandmng(M@N,MExp@NExp):-
112 % normalize(+M:<term>, -MNorm:<term>)
113 % ----------------------------------------------------------------------
114 % MNorm is the normal form of M; all bound variables renamed
115 % ----------------------------------------------------------------------
118 normalize_fresh(MFr,MNorm).
120 % fresh_vars(+M:<term>, -MFr:<term>)
121 % ----------------------------------------------------------------------
122 % MFr is the result of renaming all bound variables
123 % in M to fresh instances, using alpha-reduction
124 % ----------------------------------------------------------------------
125 fresh_vars(var(V),var(V)).
126 fresh_vars(con(C),con(C)).
127 fresh_vars(M@N,MFr@NFr):-
130 fresh_vars(X^M,var(Y)^MFr):-
131 subst(M,X,var(Y),M2),
134 % substitute(+M:<term>, +X:<var>, +N:<term>, -L:<term>)
135 % ----------------------------------------------------------------------
137 % ----------------------------------------------------------------------
138 subst(var(Y),var(X),M,N):-
143 subst(con(C),_,_,con(C)).
144 subst(M@L,X,N,M2@L2):-
147 subst(Y^M,X,N,Y^M2):-
153 % normalize_fresh(+M:<term>, -N:<term>)
154 % ----------------------------------------------------------------------
155 % M is normalized to N
156 % -- all bound variables are made fresh
157 % -- cut corresponds to leftmost normalization
158 % ----------------------------------------------------------------------
159 normalize_fresh(M,N):-
161 !, normalize_fresh(L,N).
162 normalize_fresh(M,M).
164 % reduce_subterm(+M:<term>, -N:<term>)
165 % ----------------------------------------------------------------------
166 % N is the result of performing one beta- or
167 % eta-reduction on some subterm of M;
168 % -- reduces leftmost subterm first, but provides
169 % all reductions on backtracking
170 % ----------------------------------------------------------------------
171 reduce_subterm(M,M2):-
173 reduce_subterm(M@N,M2@N):-
174 reduce_subterm(M,M2).
175 reduce_subterm(M@N,M@N2):-
176 reduce_subterm(N,N2).
177 reduce_subterm(X^M,X^N):-
180 % reduce(+M:<term>, -N:<term>)
181 % ----------------------------------------------------------------------
182 % reduces M to N using beta- or eta-reduction
183 % -- assumes no variable clashes
184 % ----------------------------------------------------------------------
185 reduce((X^M)@N,L):- % beta reduction
187 reduce(X^(M@Y),M):- % eta reduction
192 % free_var(+M:<term>, -X:<var>)
193 % ----------------------------------------------------------------------
195 % ----------------------------------------------------------------------
196 free_var(var(V),var(V)).
205 % free_for(+N:<term>, +X:<var>, +M:<term>)
206 % ----------------------------------------------------------------------
207 % M is free for X in N
208 % ----------------------------------------------------------------------
209 free_for(var(_),_,_).
210 free_for(con(_),_,_).
221 % Right-Left, Bottom-Up Dynamic Chart Parser (after ALE)
222 % =========================================================================
225 % ----------------------------------------------------------------------
227 % compile_lex(+File:<file>)
228 % ----------------------------------------------------------------------
229 % compiles lexical entries into file
230 % ----------------------------------------------------------------------
233 write('% Lexical Entries'), nl,
234 write('% ---------------'), nl, nl,
236 numbervars(lexentry(W,Syn,Sem),0,_),
237 write('lexentry(\''), write(W), write('\','),
238 write(Syn),write(','), write(Sem), write(').'), nl,
245 % ----------------------------------------------------------------------
246 % consults lexicon in place
247 % ----------------------------------------------------------------------
249 retractall(lexentry(_,_,_)),
251 assert(lexentry(W,Syn,Sem)),
255 % lex(?W:<word>, ?Syn:<syn>, ?Sem:<lambda_term>)
256 % ----------------------------------------------------------------------
257 % word W has syntactic category Syn and smenantic term Sem
258 % ----------------------------------------------------------------------
261 expandsyn(Syn,SynOut).
263 % expandsyn(+SynIn:<syn>, ?SynOut:<syn>)
264 % ----------------------------------------------------------------------
265 % the category SynIn is macro expanded recursively to SynOut
266 % ----------------------------------------------------------------------
269 expandsyn(SynIn,SynOut):-
270 macro(SynIn,SynMid), % cut means unique macro expansion
271 !, expandsyn(SynMid,SynOut).
272 expandsyn(Syn1/Syn2,Syn1Out/Syn2Out):-
273 !, expandsyn(Syn1,Syn1Out),
274 expandsyn(Syn2,Syn2Out).
275 expandsyn(Syn1\Syn2,Syn1Out\Syn2Out):-
276 !, expandsyn(Syn1,Syn1Out),
277 expandsyn(Syn2,Syn2Out).
278 expandsyn(Syn1-Syn2,Syn1Out-Syn2Out):-
279 !, expandsyn(Syn1,Syn1Out),
280 expandsyn(Syn2,Syn2Out).
281 expandsyn(q(Syn1,Syn2,Syn3),q(Syn1Out,Syn2Out,Syn3Out)):-
282 !, expandsyn(Syn1,Syn1Out),
283 expandsyn(Syn2,Syn2Out),
284 expandsyn(Syn3,Syn3Out).
288 % bas_syn(?Syn:<syn>)
289 % ----------------------------------------------------------------------
290 % Syn is a basic syntactic category
291 % ----------------------------------------------------------------------
302 % Empty Edge Compilation
303 % ----------------------------------------------------------------------
306 % ----------------------------------------------------------------------
307 % compiles empty categories, asserting all active and inactive edges
308 % they can produce by themselves; always succeeds
309 % ----------------------------------------------------------------------
311 retractall(emptyedge(_)), retractall(active(_,_,_)),
313 expandsyn(SynIn,Syn),
314 complete(cat(Syn,Sem,[],[],empty(Syn,Sem))).
316 bagof(C,emptyedge(C),Cs),
318 nl, write(N), write(' complete empty edges'), nl,
319 bagof(D-Ds,G^active(Ds,D,G),Es),
321 write(M), write(' active rules with empty starts'), nl.
323 % complete_cat(Cat:+<cat>)
324 % ----------------------------------------------------------------------
325 % Cat is asserted as empty, and all current active edges are tested to
326 % see if Cat can extend them; fails for looping
327 % ----------------------------------------------------------------------
329 assert(emptyedge(Cat)),
330 ( (CatM ===> [Cat|Cats] if Goal)
331 ; active(CatM,[Cat|Cats],Goal)
333 add_active(Cats,CatM,Goal).
335 % add_active(Cats:+<list(<cat>)>, +Cat:<cat>, +Goal:<goal>)
336 % ----------------------------------------------------------------------
337 % the active edge Cat --> . Cats is asserted, and any extensions
338 % computed and themselves asserted; fails for looping
339 % ----------------------------------------------------------------------
340 add_active([],Cat,Goal):-
342 assert(emptyedge(Cat)),
344 add_active([Cat|Cats],CatM,Goal):-
345 assert(active([Cat|Cats],CatM,Goal)),
347 add_active(Cats,CatM,Goal).
349 % parse(Ws:+<list(<word>)>, Cat:?<cat>)
350 % ----------------------------------------------------------------------
351 % Cat can be derived from Ws
352 % ----------------------------------------------------------------------
354 derived_analyses(Ws,WsMid),
355 retractall(edge(_,_,_)),
356 reverse(WsMid,[],WsRev),
357 build(WsRev,0,Length),
360 % derived_analyses(WsIn:+<list(<word>)>, WsOut:-<list(<word>)>)
361 % ----------------------------------------------------------------------
362 % computes subderivations of WsIn
363 % ----------------------------------------------------------------------
364 derived_analyses([],[]).
365 derived_analyses([der(Ws)|Ws2],[der(Ws,Ass,Syn,Sem)|DerWs2]):-
366 !, parse(Ws,cat(Syn,Sem,Ass,[],_)),
367 \+ member(abs(_,_,_),Ass),
368 derived_analyses(Ws2,DerWs2).
369 derived_analyses([W|Ws],[W|DerWs]):-
370 derived_analyses(Ws,DerWs).
372 % build(Ws:+<list(<word>)>, Right:+<int>, Left:-<int>)
373 % ----------------------------------------------------------------------
374 % finishes building chart with Ws as remaing word, starting from
375 % right position Right and finishing on left position Left
376 % -- counts backwards, so Left > Right
377 % ----------------------------------------------------------------------
379 build([W|Ws],Right,FinalLeft):-
380 RightPlus1 is Right+1,
381 ( buildact(W,Right,RightPlus1)
382 ; build(Ws,RightPlus1,FinalLeft)
385 % build_act(+W:<inputword>, +Left:<int>, +Right:<int>)
386 % ----------------------------------------------------------------------
387 % take action basedon whether input W is:
388 % [SynCat] assume hypothetical category with syntax SynCat
389 % der(WsSub,Ass,Syn,Sem) add derived result
390 % W treat as input word
391 % ----------------------------------------------------------------------
392 buildact([SynIn],Right,RightPlus1):-
393 mapsyn(SynIn,Syn), % add unspecified features
394 !, add_edge(RightPlus1,Right,cat(Syn,var(X),[abs(Syn,var(X),N)],[],
396 buildact(der(WsSub,Ass,Syn,Sem),Right,RightPlus1):-
397 !, add_edge(RightPlus1,Right,cat(Syn,Sem,Ass,[],
398 tree(der,Syn:Sem,[ders(WsSub)]))).
399 buildact(W,Right,RightPlus1):-
401 add_edge(RightPlus1,Right,cat(Syn,Sem,[l],[],tree(lex,Syn:Sem,[leaf(W)]))).
404 nl, write('Input not recognized: '), write(W), write('<br>').
406 % mapsyn(+SynCat:<syncat>, -SynCatOut:<syncat)
407 % ----------------------------------------------------------------------
408 % SynCatOut is result of adding default features to subcategories of
409 % SynCat if any are missing; allows [SynCat] to specify cats without
410 % features for input; ones with features will be passed along
411 % ----------------------------------------------------------------------
413 mapsyn(A,AM), mapsyn(B,BM).
415 mapsyn(A,AM), mapsyn(B,BM).
417 mapsyn(A,AM), mapsyn(B,BM).
418 mapsyn(scop(A,B),scop(AM,BM)):-
419 mapsyn(A,AM), mapsyn(B,BM).
420 mapsyn(q(A,B,C),q(AM,BM,CM)):-
421 mapsyn(A,AM), mapsyn(B,BM), mapsyn(C,CM).
423 mapsyn(n,n(ind(sng))).
424 mapsyn(np,np(ind(sng),nm(_))).
425 mapsyn(np(X,Y),np(X,Y)).
429 % add_edge(Left:+<int>, Right:+<int>, Cat:+<cat>)
430 % ----------------------------------------------------------------------
431 % asserts edge into chart and then tries to extend it in all possible ways
432 % -- always fails to force backgracking
433 % ----------------------------------------------------------------------
434 add_edge(Left,Right,Cat):-
435 asserta(edge(Left,Right,Cat)),
436 ( (MotherCat ===> [Cat|Cats] if Goal)
437 ; active([Cat|Cats],MotherCat,Goal)
439 findcats(Cats,Right,NewRight),
441 add_edge(Left,NewRight,MotherCat).
443 % findcats(Left:+<int>, Cats:+<cats>, Right:-<int>)
444 % ----------------------------------------------------------------------
445 % Cats is a list of categories spanning Left to Right
446 % ----------------------------------------------------------------------
447 findcats([],Left,Left).
448 findcats([Cat|Cats],Left,Right):-
449 ( edge(Left,Mid,Cat),
450 findcats(Cats,Mid,Right)
452 findcats(Cats,Left,Right)
455 % edge(Left:?<nat>, Right:?<nat>, Cat:?<cat>) (dynamic)
456 % ----------------------------------------------------------------------
457 % There is an edge with category Cat from Left to Right;
458 % ----------------------------------------------------------------------
460 % normalize_tree(+TreeIn:<tree>, -TreeOut:<tree>)
461 % ----------------------------------------------------------------------
462 % TreeOut is isomorphic to TreeIn, with normalized semantics at
464 % ----------------------------------------------------------------------
465 normalize_tree(tree(Rule,Syn:Sem,Trees),
466 tree(Rule,Syn:SemNorm,TreesNorm)):-
467 normalize_fresh(Sem,SemNorm),
468 normalize_trees(Trees,TreesNorm).
469 normalize_tree(ass(Syn,Var,Index),ass(Syn,Var,Index)).
470 normalize_tree(leaf(Word),leaf(Word)).
471 normalize_tree(ders(Word),ders(Word)).
472 normalize_tree(empty(Syn,Sem),empty(Syn,SemNorm)):-
473 normalize_fresh(Sem,SemNorm).
475 normalize_trees([],[]).
476 normalize_trees([T|Ts],[TNorm|TsNorm]):-
477 normalize_tree(T,TNorm),
478 normalize_trees(Ts,TsNorm).
481 % expandmng_tree(+TreeIn:<tree>, -TreeOut:<tree>)
482 % ----------------------------------------------------------------------
483 % TreeOut is isomorphic to TreeIn, with expanded semantics
485 % ----------------------------------------------------------------------
486 expandmng_tree(tree(Rule,Syn:Sem,Trees),
487 tree(Rule,Syn:SemNorm,TreesNorm)):-
488 expandmng(Sem,SemNorm),
489 expandmng_trees(Trees,TreesNorm).
490 expandmng_tree(ass(Syn,Var,Index),ass(Syn,Var,Index)).
491 expandmng_tree(leaf(Word),leaf(Word)).
492 expandmng_tree(ders(Word),ders(Word)).
493 expandmng_tree(empty(Syn,Sem),empty(Syn,SemNorm)):-
494 expandmng(Sem,SemNorm).
496 expandmng_trees([],[]).
497 expandmng_trees([T|Ts],[TExp|TsExp]):-
498 expandmng_tree(T,TExp),
499 expandmng_trees(Ts,TsExp).
503 % =========================================================================
505 % C:<-cat> ===> Cs:<+list(<cat>)>
506 % ----------------------------------------------------------------------
507 % C can be composed of Cs; may be conditions
511 cat(A, Alpha@Beta, Ass3, Qs3, tree(fe,A:Alpha@Beta,[T1,T2]))
513 [ cat(A/B, Alpha, Ass1, Qs1, T1),
514 cat(B, Beta, Ass2, Qs2, T2)
516 append(Ass1,Ass2,Ass3),
521 cat(A, Alpha@Beta, Ass3, Qs3, tree(be,A:Alpha@Beta,[T1,T2]))
523 [ cat(B, Beta, Ass1, Qs1, T1),
524 cat(B\A, Alpha, Ass2, Qs2, T2)
526 append(Ass1,Ass2,Ass3),
531 cat(B\A, X^Alpha, Ass, Qs, tree(bi(N),B\A:X^Alpha,[T1]))
533 [ cat(A, Alpha, [abs(B,X,N)|Ass], Qs, T1)
535 \+ T1 = tree(be,_,[_,ass(_,_,N)]), % normal
536 at_least_one_member(l,Ass), % non-empty condition
537 \+ ( subtree(tree(AssumeM,_,Ts),T1), % properly nested
539 subtree(ass(_,_,'$VAR'(J)),TMid),
541 hypothetical_mem(AssumeM,Ass,Qs) ).
545 cat(A/B, X^Alpha, Ass2, Qs, tree(fi(N),A/B:X^Alpha,[T1]))
547 [ cat(A,Alpha,Ass1,Qs,T1)
549 \+ T1 = tree(fe,_,[_,ass(_,_,N)]), % normal
550 at_least_one_member(l,Ass1), % non-empty condition
551 select_last(Ass1,abs(B,X,N),Ass2),
552 \+ ( subtree(tree(AssumeM,_,Ts),T1), % properly nested
554 subtree(ass(_,_,'$VAR'(J)),TMid),
556 hypothetical_mem(AssumeM,Ass1,Qs) ).
560 cat(A-B, X^Alpha, Ass2, Qs, tree(gi(N),(A-B):X^Alpha,[T1]))
562 [ cat(A, Alpha, Ass1, Qs, T1)
564 at_least_one_member(l,Ass1), % non-empty condition
565 select(abs(B,X,N),Ass1,Ass2),
566 \+ ( subtree(tree(AssumeM,_,Ts),T1), % normalized?
568 subtree(ass(_,_,'$VAR'(J)),TMid),
570 hypothetical_mem(AssumeM,Ass1,Qs) ).
573 % q quantifier pushing (q-elimination part 1)
574 % ----------------------------------------------------------------------
575 cat(C, var(X), Ass, [gq(B,A,Q,var(X),N)|Qs],
576 tree(qqpush(N),C:var(X),[T1]))
578 [ cat(q(C,B,A), Q, Ass, Qs, T1)
580 \+ T1 = tree(qqi,_,_). % normal
582 % q quantifier popping (q-elimination part 2)
583 % ----------------------------------------------------------------------
584 cat(A, Q@(X^Alpha), Ass, Qs2, tree(qqpop(N),A:Q@(X^Alpha),[T1]))
586 [ cat(B,Alpha,Ass,Qs1,T1)
588 select(gq(B,A,Q,X,N),Qs1,Qs2),
589 \+ ( subtree(tree(AssumeM,_,Ts),T1),
591 subtree(tree(qqpush(J),_,_),TMid),
593 hypothetical_mem(AssumeM,Ass,Qs1) ).
595 % q quantifier introduction [restricted to q(np,s,s)]
596 % ----------------------------------------------------------------------
597 % restricted to A = s(_), B=np case for termination
598 cat(q(np(ind(Num),Case),s(VF),s(VF)), var(P)^(var(P)@Alpha), Ass, Qs1,
599 tree(qqi,q(np(ind(Num),Case),s(VF),s(VF)):var(P)^var(P)@Alpha,[T1]))
601 [ cat(np(ind(Num),Case),Alpha,Ass,Qs1,T1)
605 % coordination elimination
606 % ----------------------------------------------------------------------
607 cat(C, Sem, [], [], tree(coel,C:Sem,[T1,T2,T3]))
609 [ cat(C, Sem1, Ass1, [], T1),
610 cat(coor, Alpha, Ass2, [],T2),
611 cat(C, Sem2, Ass3, [], T3)
613 \+ member(abs(_,_,_),Ass1), % coordination condition
614 \+ member(abs(_,_,_),Ass2),
615 \+ member(abs(_,_,_),Ass3),
616 \+ T1 = tree(coel,_,_),
617 \+ T2 = tree(coel,_,_),
618 make_coor(C,Alpha,Sem1,Sem2,Sem).
620 % non-boolean coordination
621 % ----------------------------------------------------------------------
622 %cat(np(pl,-), con(union)@Alpha1P@Alpha3P, [], [],
623 % tree(nbc,np(pl,-):con(union)@Alpha1P@Alpha3P,[T1,T2,T3]))
625 %[ cat(NP1, Alpha1, Ass1, [], T1),
626 % cat(coor, nbc, Ass2, [],T2),
627 % cat(NP3, Alpha3, Ass3, [], T3)
629 % \+ member(abs(_,_,_),Ass1), % coordination condition
630 % \+ member(abs(_,_,_),Ass2),
631 % \+ member(abs(_,_,_),Ass3),
632 % make_nb_coor(NP1,Alpha1,Alpha1P),
633 % make_nb_coor(NP3,Alpha3,Alpha3P).
635 % make_nb_coor(np,Alpha,con(singleton)@Alpha).
636 % make_nb_coor(np(pl,+),Alpha,con(singleton)@Alpha).
637 % make_nb_coor(np(pl,-),Alpha,Alpha).
640 % subtree(-TSub:<tree>, +T:<tree>)
641 % ----------------------------------------------------------------------
642 % TSub is a subtree of T
643 % ----------------------------------------------------------------------
645 subtree(T,tree(_,_,Ts)):-
649 % hypothetical_mem(Rule,Assumptions,Qs)
650 % ----------------------------------------------------------------------
651 % Rule is a member of the assumptions
652 % ----------------------------------------------------------------------
653 hypothetical_mem(fi(N),Ass,_):-
654 member(abs(_,_,M),Ass), N == M.
655 hypothetical_mem(bi(N),Ass,_):-
656 member(abs(_,_,M),Ass), N == M.
657 hypothetical_mem(gi(N),Ass,_):-
658 member(abs(_,_,M),Ass), N == M.
659 hypothetical_mem(qqpush(N),_,Qs):-
660 member(gq(_,_,_,_,M),Qs), N == M.
662 % make_coor(Cat,CoorSem,Sem1,Sem2,SemOut)
663 % ----------------------------------------------------------------------
664 % generalized coordination semantics CoorSem is applied to
665 % Sem1 and Sem2 of type Cat, with result SemOut
666 % ----------------------------------------------------------------------
667 make_coor(s(_),Alpha,Sem1,Sem2,Alpha@Sem1@Sem2).
668 make_coor(n(_),Alpha,Sem1,Sem2,var(X)^Alpha@(Sem1@var(X))@(Sem2@var(X))).
669 make_coor(A/_,Alpha,Sem1,Sem2,var(X)^Sem):-
670 make_coor(A,Alpha,Sem1@var(X),Sem2@var(X),Sem).
671 make_coor(_\A,Alpha,Sem1,Sem2,var(X)^Sem):-
672 make_coor(A,Alpha,Sem1@var(X),Sem2@var(X),Sem).
673 make_coor(A-_,Alpha,Sem1,Sem2,var(X)^Sem):-
674 make_coor(A,Alpha,Sem1@var(X),Sem2@var(X),Sem).
675 make_coor(q(_,_,A),Alpha,Sem1,Sem2,var(X)^Sem):-
676 make_coor(A,Alpha,Sem1@var(X),Sem2@var(X),Sem).
679 % General CGI Handling
680 % =========================================================================
683 % ----------------------------------------------------------------------
684 % executed when saved state is restarted;
685 % tokenizes, parses and sends off input for handling;
686 % halts on termination
687 % ----------------------------------------------------------------------
689 % getenv('QUERY_STRING', Arg),
690 prolog_flag(argv,[Arg]),
692 % write('<p>'), write(Arg), nl, ttyflush,
693 ( tokenizeatom(Arg,TokenList)
694 % ,write('<p>'), write(TokenList), ttyflush
695 ; write('Input '), write(Arg), write(' could not be tokenized'), ttyflush, halt
697 ( parse_cgi(TokenList,KeyVals)
698 % , write('<p>'), write(KeyVals), ttyflush
699 ; write('Tokens '), write(TokenList), write(' could not be parsed'), halt
702 ; told, write('Action '), write(KeyVals), write(' could not be executed')
706 % tokenizeatom(+Input:<atom>, -Tokens:<list(<token>)>)
707 % ----------------------------------------------------------------------
708 % breaks input Input into list of tokens;
709 % ----------------------------------------------------------------------
710 tokenizeatom(Atom,Ws):-
712 tokenize(Cs,Xs-Xs,Ws).
714 % tokenize(+Chars:<list(<char>)>, +CharsSoFar:<d_list(<char>)>,
715 % -Tokens:<list(<token>)>)
716 % ----------------------------------------------------------------------
717 % Tokens is the list of tokens retrieved from Chars; ChrsSoFar
718 % accumulates prefixes of atoms being recognized
719 % ----------------------------------------------------------------------
720 tokenize([C1,C2,C3|Cs],Xs-Ys,TsResult):- % special symbol
722 specialsymbol(C2,C3,SpecialSymbol),
725 -> TsResult = [SpecialSymbol|TsOut]
728 TsResult = [CsAtom,SpecialSymbol|TsOut]
730 tokenize(Cs,Zs-Zs,TsOut).
731 tokenize([C|Cs],Xs-Ys,TsResult):- % one-character operator
733 !, name(OpToken,[C]),
735 -> TsResult = [OpToken|Ts]
738 TsResult = [CsAtom,OpToken|Ts]
740 tokenize(Cs,Zs-Zs,Ts).
741 tokenize([C|Cs],Xs-[C|Ys],Ts):- % more of string
742 tokenize(Cs,Xs-Ys,Ts).
743 tokenize([],Xs-_,[]):- % no more input; nothing accum.
745 tokenize([],Xs-[],[CsAtom]):- % no more input; stringg accum.
748 % isoperator(+Char:<char>)
749 % ----------------------------------------------------------------------
750 % Char is the name of an operator character
751 % ----------------------------------------------------------------------
761 % specialsymbol(+C1:<char>, +C2:<char>, -S:<token>)
762 % ----------------------------------------------------------------------
763 % C1 and C2 are the names of characters completing a % special symbol
764 % ----------------------------------------------------------------------
765 specialsymbol(C1,C2,S):-
766 name(N1,[C1]), name(N2,[C2]),
782 % parse_cgi(+TokenList:<list(<token>)>, -KeyVals:<list(<keyval>)>)
783 % ----------------------------------------------------------------------
784 % KeyVals is Key/Val list resulting from parsing TokenList using
785 % the compiled DCG to perform a top-down parse
786 % ----------------------------------------------------------------------
787 parse_cgi(TokenList,KeyVals):-
788 keyvalseq(KeyVals,TokenList,[]).
791 % ----------------------------------------------------------------------
792 keyvalseq([KeyVal|KeyVals]) -->
793 keyval(KeyVal), andkeyvalseq(KeyVals).
794 keyvalseq([]) --> [].
796 andkeyvalseq(KeyVals) --> ['&'], keyvalseq(KeyVals).
797 andkeyvalseq([]) --> [].
799 keyval(key(Key,Val)) --> [Key,'='], valseq(Val).
801 % valseq(rec(Ws,Cat)) --> valseq(Ws), as(Cat).
804 % as(Cat) --> optplus, ['=','>'], optplus, val(Cat).
806 % valseq([]) --> []. % subsumed by plusvalseq([]) --> []
807 valseq([Val|Vals]) --> val(Val), plusvalseq(Vals).
808 valseq(Vals) --> plusvalseq(Vals).
810 plusvalseq([]) --> [].
811 plusvalseq(Vals) --> ['+'], valseq(Vals).
816 val(X) --> ['['], valseq(X), [']'].
817 val(der(X)) --> [der,'('], valseq(X), [')'].
818 val(X) --> atomval(X).
819 val(X/Y) --> atomval(X), ['/'], atomval(Y).
820 val(Y\X) --> atomval(Y), ['\\'], atomval(X).
821 val(X-Y) --> atomval(Y), ['-'], atomval(X).
822 val(Term) --> atom(Fun), ['('], argvals(Args), [')'], {Term =.. [Fun|Args]}.
825 argvals([Arg|Args]) -->
826 val(Arg), commaargvals(Args).
828 commaargvals(Args) -->
829 [','], argvals(Args).
833 atomval(X) --> atom(X).
834 atomval(X) --> ['('], val(X), [')'].
836 atom(X) --> [X], {atomic(X)}.
839 % Specific CGI Query Handling
840 % =========================================================================
842 % action(+KeyVals:<list(<keyval>)>)
843 % ----------------------------------------------------------------------
844 % take an action based on list of KeyVals
845 % ----------------------------------------------------------------------
847 retractall(keyvalscgi(_)),
848 assert(keyvalscgi(KeyVals)),
849 member(key(inputfrom,[InputFrom]),KeyVals),
850 ( InputFrom = 'Typing'
851 -> member(key(parsestringone,Ws),KeyVals)
852 ; InputFrom = 'Corpus'
853 -> member(key(parsestringtwo,Ws),KeyVals)
855 % write('<p>'), write(Ws), nl,
856 nl, write('P<font size=-1>ARSE</font> R<font size=-1>ESULTS FOR:</font> <cite>'),
858 write('</cite><br><br>'), nl,
859 member(key(outputform,[OutForm]),KeyVals),
860 member(key(outputsyn,OutSynSym),KeyVals),
861 outsyn(OutSynSym,OutSyn),
862 act(OutForm,OutSyn,Ws).
866 member(key(Key,Val),KeyVals).
869 outsyn(['Finite','S'],s(fin)).
870 outsyn(['Noun','Phrase'],np(_,_)).
872 % act(+Form:<form>, ?Syn:<syn>, +Ws:<list(<word>)>)
873 % ----------------------------------------------------------------------
874 % the input Ws is parsed and output in form Form;
875 % ----------------------------------------------------------------------
876 act(OutForm,OutSyn,Ws):-
877 findall(Tree, ( parse(Ws,cat(OutSyn,_,Ass,[],Tree)),
878 \+ member(abs(_,_,_),Ass) ), Trees), % all parses
880 !, write('<BR> No Parses Found') % none found
881 ; ( keyvalcgi(expandmng,['Yes']),
882 !, expandmng_trees(Trees,Trees2)
885 ( keyvalcgi(normalize,['Yes']),
886 !, normalize_trees(Trees2,Trees3)
890 write_term(Ws,[quoted(true)]),
891 write(',Cat).<br>'), nl,
892 actout(OutForm,Trees3)
897 % actout(+Form:<form>, +Ts:<list(<tree>)>)
898 % ----------------------------------------------------------------------
899 % return output for list of trees Ts in form Form
900 % ----------------------------------------------------------------------
901 actout('Text',Trees):-
905 actout('Prawitz',Ts):-
913 texttreelist([T|Ts]):-
915 nl, write('<BR>'), nl,
919 htmltreelist([T|Ts]):-
920 pp_html_table_tree(T),
921 nl, write('<BR>'), nl,
925 fitchtreelist([T|Ts]):-
926 pp_html_table_fitch_tree(T),
927 nl, write('<BR>'), nl,
931 % PRETTY PRINTING ROUTINES
932 % ======================================================================
934 % pp_html_table_tree(+Tree:<tree>)
935 % ----------------------------------------------------------------------
936 % Tree is output as an HTML table; first numbered
937 % ----------------------------------------------------------------------
938 pp_html_table_tree(T):-
941 % write_term(T,[quoted(true)]),
945 % pp_html_tree(+Tree:<tree>)
946 % ----------------------------------------------------------------------
947 % Tree is output as an HTML table; assume numbered
948 % ----------------------------------------------------------------------
949 pp_html_tree(ass(Syn,V,'$VAR'(N))):-
950 write('['), pp_cat(Syn:V), write(']<sup>'), write(N), write('</sup>').
951 pp_html_tree(leaf(Word)):-
953 pp_html_tree(ders(Words)):-
955 pp_html_tree(empty(Syn,Sem)):-
956 nl, write('<TABLE BORDER=1>'), nl,
957 write('<TR VALIGN=bottom>
958 <TD ALIGN=CENTER>-</TD>
959 <TD ROWSPAN=2 ALIGN=CENTER>Nil</TD>
962 write('<TR VALIGN=bottom>
968 pp_html_tree(tree(Rule,Root,SubTrees)):-
969 nl, write('<TABLE BORDER=1>'), nl,
970 write('<TR VALIGN=bottom>'), nl,
971 pp_html_trees(SubTrees,0,N),
975 ; write('<TD ROWSPAN=2 ALIGN=CENTER>'), pp_rule(Rule), write('</TD>')
978 write('<TR VALIGN=bottom><TD ALIGN=CENTER COLSPAN='), write(N), write('>'),
981 nl, write('</TABLE>').
983 % pp_html_trees(+Trees: <list(<tree>)>,+N:<int>,-M:<int>)
984 % ----------------------------------------------------------------------
985 % prints the trees in Trees, where (M-N) is the length of the list (N
986 % acts as an accumulator, initialized to 0
987 % ----------------------------------------------------------------------
988 pp_html_trees([T|Ts],N,M):-
989 write('<TD ALIGN=center>'), pp_html_tree(T),
992 pp_html_trees(Ts,K,M).
993 pp_html_trees([],N,N).
995 % pp_html_table_fitch_tree(+T:<tree>)
996 % ----------------------------------------------------------------------
997 % T is numbered and output as a table Fitch-style
998 % ----------------------------------------------------------------------
999 pp_html_table_fitch_tree(T):-
1001 nl, write('<TABLE BORDER=1>'),
1002 pp_html_fitch_tree(T,1,_,_,_,[],_),
1003 nl, write('</TABLE>').
1005 % pp_html_fitch_tree(+Tree:<tree>, +Start:<int>, -Next:<int>, -Me:<int>,
1007 % +AssIn:<list(<assgn>)>, -AssOut:<list(<assgn>)>)
1008 % ----------------------------------------------------------------------
1009 % the rows of the table for Tree are printed;
1010 % Start is where the numbering begins; Next is the next available number
1011 % after last one used; Me is the row representing the output of the
1012 % derivation; Exp is the expression corresponding to Tree;
1013 % AssIn are existing assignments coming in and AssOut are assignments
1014 % going out (an <assgn> is a pair ass(M,X) where M is a row number on the
1015 % table and X is the abstracted variable)
1016 % ----------------------------------------------------------------------
1017 pp_html_fitch_tree(tree(der,Root,[ders(Words)]),M,N,M,Exp,Ass,Ass):-
1018 !, nl, write('<TR><TD>'),
1019 write(M), write('</TD><TD>'),
1020 map_word(Words,Exp), pp_exp(Exp),
1021 write('-'), pp_cat(Root),
1022 write('</TD><TD>'), write('Der'), write('</TD></TR>'), nl,
1024 pp_html_fitch_tree(tree(lex,Root,[leaf(Word)]),M,N,M,Word,Ass,Ass):-
1025 !, nl, write('<TR><TD>'),
1026 write(M), write('</TD><TD>'), pp_exp(Word), write('-'), pp_cat(Root),
1027 write('</TD><TD>'), write('Lex'), write('</TD></TR>'), nl,
1029 pp_html_fitch_tree(tree(fe,Root,[T1,T2]),M,N,L,Exp1+Exp2,AssIn,AssOut):-
1030 !, pp_html_fitch_tree(T1,M,K,Source1,Exp1,AssIn,AssMid),
1031 pp_html_fitch_tree(T2,K,L,Source2,Exp2,AssMid,AssOut),
1032 nl, write('<TR><TD>'),
1033 write(L), write('</TD><TD>'), pp_exp(Exp1+Exp2), write('-'), pp_cat(Root),
1034 write('</TD><TD>'), write('E/ '), write((Source1,Source2)), write('</TD></TR>'), nl,
1036 pp_html_fitch_tree(tree(be,Root,[T1,T2]),M,N,L,Exp1+Exp2,AssIn,AssOut):-
1037 !, pp_html_fitch_tree(T1,M,K,Source1,Exp1,AssIn,AssMid),
1038 pp_html_fitch_tree(T2,K,L,Source2,Exp2,AssMid,AssOut),
1039 nl, write('<TR><TD>'),
1040 write(L), write('</TD><TD>'), pp_exp(Exp1+Exp2), write('-'), pp_cat(Root),
1041 write('</TD><TD>'), write('E\\ '), write((Source1,Source2)), write('</TD></TR>'), nl,
1043 pp_html_fitch_tree(tree(qqi,Root,[T]),M,Next,Me,Exp,AssIn,AssOut):-
1044 !, pp_html_fitch_tree(T,M,Me,Source,Exp,AssIn,AssOut),
1045 nl, write('<TR><TD>'),
1046 write(Me), write('</TD><TD>'), pp_exp(Exp), write('-'), pp_cat(Root),
1047 write('</TD><TD>'), write('q I '), write(Source), write('</TD></TR>'), nl,
1049 pp_html_fitch_tree(tree(coel,Root,[T1,T2,T3]),M,N,L,Exp1+Exp2+Exp3,AssIn,AssOut):-
1050 !, pp_html_fitch_tree(T1,M,K,Source1,Exp1,AssIn,AssMid),
1051 pp_html_fitch_tree(T2,K,L1,Source2,Exp2,AssMid,AssMid2),
1052 pp_html_fitch_tree(T3,L1,L,Source3,Exp3,AssMid2,AssOut),
1053 nl, write('<TR><TD>'),
1054 write(L), write('</TD><TD>'), pp_exp(Exp1+Exp2+Exp3), write('-'), pp_cat(Root),
1055 write('</TD><TD>'), write('E co '), write((Source1,Source2,Source3)), write('</TD></TR>'), nl,
1057 pp_html_fitch_tree(tree(fi(_),(C1/C2):(var(X)^Sem),[T]),M,Q,N,ExpNew,AssIn,AssOut):-
1059 write('<TR><TD COLSPAN=3><TABLE BORDER=1>'),
1060 write('<TR><TD>'), write(M), write('</TD><TD>'),
1062 cat_atoms(Num,'</sub>',ExpMid),
1063 cat_atoms('e<sub>',ExpMid,ExpNum),
1064 pp_exp(ExpNum), write(' - '),
1065 pp_cat(C2:var(X)), write('</TD><TD>'), write('Assume</TD></TR>'),
1066 pp_html_fitch_tree(T,K,N,L, Exp, [ass(M,X)|AssIn],AssOut),
1067 write('<TR><TD>'), write(N), write('</TD><TD>'),
1068 removeexp(ExpNum,Exp,ExpNew),
1069 pp_exp(ExpNew), write(' - '), pp_cat(C1/C2:var(X)^Sem), write('</TD><TD>'),
1070 write('/I '), write((M,L)), write('</TD></TR>'),
1071 write('</TD></TR></TABLE>'),
1073 pp_html_fitch_tree(tree(bi(_),(C2\C1):(var(X)^Sem),[T]),M,Q,N,ExpNew,AssIn,AssOut):-
1075 write('<TR><TD COLSPAN=3><TABLE BORDER=1>'),
1076 write('<TR><TD>'), write(M), write('</TD><TD>'),
1078 cat_atoms(Num,'</sub>',ExpMid),
1079 cat_atoms('e<sub>',ExpMid,ExpNum),
1080 pp_exp(ExpNum), write(' - '),
1081 pp_cat(C2:var(X)), write('</TD><TD>'), write('Assume</TD></TR>'),
1082 pp_html_fitch_tree(T,K,N,L, Exp, [ass(M,X)|AssIn],AssOut),
1083 write('<TR><TD>'), write(N), write('</TD><TD>'),
1084 removeexp(ExpNum,Exp,ExpNew),
1085 pp_exp(ExpNew), write(' - '), pp_cat(C2\C1:var(X)^Sem), write('</TD><TD>'),
1086 write('/I '), write((M,L)), write('</TD></TR>'),
1087 write('</TD></TR></TABLE>'),
1089 pp_html_fitch_tree(tree(gi(_),(C1-C2):var(X)^Sem,[T]),M,Q,N,ExpNew,AssIn,AssOut):-
1091 write('<TR><TD COLSPAN=3><TABLE BORDER=1>'),
1092 write('<TR><TD>'), write(M), write('</TD><TD>'),
1094 cat_atoms(Num,'</sub>',ExpMid),
1095 cat_atoms('e<sub>',ExpMid,ExpNum),
1096 pp_exp(ExpNum), write(' - '),
1097 pp_cat(C2:var(X)), write('</TD><TD>'), write('Assume</TD></TR>'),
1098 pp_html_fitch_tree(T,K,N,L,Exp, [ass(M,X)|AssIn],AssOut),
1099 write('<TR><TD>'), write(N), write('</TD><TD>'),
1100 splitexp(ExpNum,Exp,ExpNew),
1101 pp_exp(ExpNew), write(' - '),
1102 pp_cat((C1-C2):var(X)^Sem), write('</TD><TD>'),
1103 write('I- '), write((M,L)), write('</TD></TR>'),
1104 write('</TD></TR></TABLE>'),
1106 % pp_html_fitch_tree(tree(qqpop(N),A:(Q@(X^Alpha)),[T1]),M,N,K,Exp,Ass,Ass):-
1107 % !, replace_qtree(qqpush(N),T1,T1Mid,T1Extract),
1108 % pp_html_fitch_tree(T1Extract,M,L,J,_,_,_),
1109 % pp_html_fitch_tree(T1Mid,L,P,I,_,_,_),
1110 % write('<TR><TD>'), write(P), write('</TD><TD>'),
1111 % pp_exp(Exp), write(' - '),
1112 % pp_cat(A:(Q@(X^Alpha))), write('</TD><TD>'),
1114 pp_html_fitch_tree(empty(Syn,Sem),M,N,M,[],Ass,Ass):-
1115 !, nl, write('<TR><TD>'),
1116 write(M), write('</TD><TD>'), write('NIL'), write(' '), pp_cat(Syn:Sem),
1117 write('</TD><TD>'), write('Empty'), write('</TD></TR>'), nl,
1119 pp_html_fitch_tree(ass(_Syn,var(Var),_),N,N,M,Exp,Ass,Ass):-
1120 member(ass(M,Var),Ass),
1122 cat_atoms(Num,'</sub>',ExpMid),
1123 cat_atoms('e<sub>',ExpMid,Exp).
1125 % removexp(+ExpRem:<exp>,+Exp:<exp>,-ExpOut:<exp>)
1126 % ----------------------------------------------------------------------
1127 % he expression ExpRem is removed from Exp with result ExpOut
1128 % ----------------------------------------------------------------------
1129 removeexp(E,E,'NIL'):-!.
1130 removeexp(E,E+E2,E2):-!.
1131 removeexp(E,E2+E,E2):-!.
1132 removeexp(E,E2+E3,E2New+E3New):-
1133 !, removeexp(E,E2,E2New),
1134 removeexp(E,E3,E3New).
1137 % splitexp(+ExpRem:<exp>, +Exp:<exp>, -ExpOut:<exp>)
1138 % ----------------------------------------------------------------------
1139 % ExpRem is removed from Exp with ExpOut left over; the extraction
1140 % site is represented as a split point
1141 % ----------------------------------------------------------------------
1142 splitexp(E,E,('NIL','NIL')):-!.
1143 splitexp(E,E+E2,('NIL',E2)):-!.
1144 splitexp(E,E2+E,(E2,'NIL')):-!.
1145 splitexp(E,E1+E2,(E3,E4+E2)):-
1146 splitexp(E,E1,(E3,E4)), !.
1147 splitexp(E,E1+E2,(E1+E3,E4)):-
1148 splitexp(E,E2,(E3,E4)).
1150 % pp_exp(+Exp:<exp>)
1151 % ----------------------------------------------------------------------
1152 % the expression Exp is output; concatenations are represented as
1153 % spaces and split points by (_,_) and empty by '0'
1154 % ----------------------------------------------------------------------
1162 !, pp_exp(A), write(' '), pp_exp(B).
1164 !, write('('), pp_exp(A), write(', '), pp_exp(B), write(')').
1168 map_word([[_]|Ws],Exp):-
1169 !, map_word(Ws,Exp).
1170 map_word([W|Ws],Exp):-
1174 map_word(Ws,[_],W):-
1177 map_word([W|Ws],W1,W1+Exp):-
1181 pp_exps([Exp|Exps]):-
1182 pp_exp(Exp), write('+'), pp_exp(Exps).
1184 % pp_tree(+T:<tree>)
1185 % ----------------------------------------------------------------------
1186 % tree T is output in indented list notation; first number
1187 % ----------------------------------------------------------------------
1192 % pp_tree(+T:<tree>, +Col:<int>)
1193 % ----------------------------------------------------------------------
1194 % print tree T beginning at column Col
1195 % ----------------------------------------------------------------------
1196 pp_tree(empty(Syn,Sem),Col):-
1197 nl, tab(Col), pp_cat(Syn:Sem), write(' via empty').
1198 pp_tree(ass(Syn,V,'$VAR'(N)),Column):-
1199 nl, tab(Column), write('['), pp_cat(Syn:V), write(']'),
1200 write('<SUP>'), write(N), write('</SUP>').
1201 pp_tree(leaf(Word),Column):-
1202 nl, tab(Column), pp_word(Word).
1203 pp_tree(ders(Words),Column):-
1204 nl, tab(Column), pp_word_list(Words).
1205 pp_tree(tree(Rule,Root,SubTrees),Column):-
1208 write(' via '), pp_rule(Rule),
1209 NewColumn is Column + 2,
1210 pp_trees(SubTrees,NewColumn).
1212 % pp_trees(+Ts:<list(<tree>)>, +Col:<int>)
1213 % ----------------------------------------------------------------------
1214 % print tree list Ts beginning at column Col
1215 % ----------------------------------------------------------------------
1216 pp_trees([T|Ts],Column):-
1218 pp_trees(Ts,Column).
1221 % pp_word_list(+Ws:<list(<word>)>)
1222 % ----------------------------------------------------------------------
1223 % the list of words Ws is output, ignoring non-atoms
1224 % ----------------------------------------------------------------------
1226 pp_word_list([W|Ws]):-
1227 atom(W), !, pp_word(W), pp_word_list_rest(Ws).
1228 pp_word_list([_|Ws]):-
1232 write('<I>'), write(W), write('</I>').
1234 % pp_word_list_rest(+Ws:<list(<word>)>)
1235 % ----------------------------------------------------------------------
1236 % word list Ws is output with an initial blank if Ws is non-empty
1237 % ----------------------------------------------------------------------
1238 pp_word_list_rest([]).
1239 pp_word_list_rest([W|Ws]):-
1240 atom(W), !, write(' '), pp_word(W), pp_word_list_rest(Ws).
1241 pp_word_list_rest([_|Ws]):-
1242 pp_word_list_rest(Ws).
1245 % ----------------------------------------------------------------------
1246 % pretty print category Cat
1247 % ----------------------------------------------------------------------
1249 pp_lam(Sem), write(' : '), pp_syn(Syn).
1251 % pp_syn(SynCat:<syncat>)
1252 % ----------------------------------------------------------------------
1253 % pretty print syntactic category
1254 % ----------------------------------------------------------------------
1256 !, pp_syn(A), write('/'), pp_syn_paren(B).
1258 !, pp_syn(A), write('-'), pp_syn_paren(B).
1260 !, pp_syn_paren(B), write('\\'), pp_syn_back(A).
1262 !, pp_syn(scop(A,B)).
1264 !, write('q('), pp_syn(A), write(','), pp_syn(B), write(','),
1265 pp_syn(C), write(')').
1267 !, pp_syn(A), write('^^'), pp_syn(B).
1271 % pp_syn_paren(SynCat:<syncat>)
1272 % ----------------------------------------------------------------------
1273 % pretty print syntactic category with enclosing parens if it
1274 % is functional (used for arguments)
1275 % ----------------------------------------------------------------------
1282 pp_syn_paren(q(A,B,B)):-
1283 !, pp_paren(q(A,B,B)).
1284 pp_syn_paren(q(A,B,C)):-
1285 !, pp_syn(q(A,B,C)).
1289 % pp_paren(+C:<cat>)
1290 % ----------------------------------------------------------------------
1291 % category Cat is pretty printed with surrounding parens
1292 % ----------------------------------------------------------------------
1294 write('('), pp_syn(C), write(')').
1296 % pp_syn_back(+Cat:<cat>)
1297 % ----------------------------------------------------------------------
1298 % Cat is pretty printed as the result of a backward functor
1299 % ----------------------------------------------------------------------
1301 !, pp_syn_paren(A/B).
1303 !, pp_syn_paren(A-B).
1307 % pp_bas_cat(+BasCat:<bascat>)
1308 % ----------------------------------------------------------------------
1309 % the basic category BasCat is pretty printed
1310 % ----------------------------------------------------------------------
1312 writecat(Cat,Atom,Subs,Sups),
1317 % writecat(+BasCat:<bascat>,-Root:<atom>,-Subs:<list>,-Sups:<list>)
1318 % ----------------------------------------------------------------------
1319 % basic category BasCat is printed as Root with superscripts Sups
1320 % and subscripts Subs
1321 % ----------------------------------------------------------------------
1322 writecat(np(ind(sng),nm(_)),np,[],[]):-!.
1323 writecat(np(ind(sng),pp(C)),np,[C],[]):-!.
1324 writecat(np(ind(plu),nm(_)),np,[p],[]):-!.
1325 writecat(np(ind(plu),pp(C)),np,[p,C],[]):-!.
1326 writecat(np(ind(_),nm(_)),np,[],[]):-!.
1327 writecat(np(set,nm(_)),np,[p],['*']):-!.
1328 writecat(np(set,pp(C)),np,[p,C],['*']):-!.
1329 writecat(np(_,_),np,[],[]):-!.
1330 writecat(s(fin),s,[],[]):-!.
1331 writecat(s('$VAR'(_)),s,[],[]):-!.
1332 writecat(s(V),s,[V],[]):-!.
1333 writecat(n(ind(plu)),n,[p],[]):-!.
1334 writecat(n(set),n,[p],['*']):-!.
1335 writecat(n(ind(sng)),n,[],[]):-!.
1336 writecat(n(_),n,[],[]):-!.
1337 writecat(sc(th(fin)),sc,[th,fin],[]):-!.
1338 writecat(sc(th(bse)),sc,[th,bse],[]):-!.
1339 writecat(sc(wh),sc,[wh],[]):-!.
1340 writecat(sc(if),sc,[if],[]):-!.
1341 writecat(sc(_),sc,[],[]):-!.
1342 writecat(ex(it),ex,[it],[]):-!.
1343 writecat(ex(th(_)),ex,[th],[]):-!.
1344 writecat(ex(_),ex,[],[]):-!.
1345 writecat(C,C,[],[]).
1347 % writesubs(+List:<list>)
1348 % ----------------------------------------------------------------------
1349 % List is output as a subscript
1350 % ----------------------------------------------------------------------
1354 writelistsubs(Xs,X),
1357 % writesups(+List:<list>)
1358 % ----------------------------------------------------------------------
1359 % List is output as a superscript
1360 % ----------------------------------------------------------------------
1364 writelistsubs(Xs,X),
1367 % writelistsubs(+Xs:<list>, +X:<term>)
1368 % ----------------------------------------------------------------------
1369 % Xs is written as a list with commas as separators
1370 % ----------------------------------------------------------------------
1371 writelistsubs([],X):-
1373 writelistsubs([X|Xs],Y):-
1374 write(Y), write(' ,'), writelistsubs(Xs,X).
1376 % pp_lam(+Term:<lambdaterm>)
1377 % ----------------------------------------------------------------------
1378 % lambda term Term is pretty printed
1379 % ----------------------------------------------------------------------
1381 !, pp_lam(Var), write('<B>. </B>'), pp_lam(Alpha).
1382 pp_lam(con(and)@Alpha@Beta):-
1383 !, pp_lam_paren(Alpha), write(' & '), pp_lam_paren(Beta).
1384 pp_lam(con(or)@Alpha@Beta):-
1385 !, pp_lam_paren(Alpha), write(' <b>or</b> '), pp_lam_paren(Beta).
1386 pp_lam(con(not)@Alpha):-
1387 !, write(' ¬ '), write('('), pp_lam_paren(Alpha), write(')').
1388 pp_lam(Alpha@Beta):-
1389 !, pp_lam_bracket(Alpha),
1393 pp_lam(var('$VAR'(N))):-
1394 !, write('<I>'), write(x), write('<SUB>'), write(N), write('</SUB></I>').
1396 write('<B>'), write(Con), write('</B>').
1398 pp_lam_bracket(A^B):-
1399 !, write('('), pp_lam(A^B), write(')').
1403 % pp_lam_paren(+Term:<lambdaterm>)
1404 % ----------------------------------------------------------------------
1405 % lambda term Term is pretty printed
1406 % ----------------------------------------------------------------------
1407 pp_lam_paren(Var^Alpha):-
1408 !, pp_lam(Var), write('<B>. </B>'), pp_lam(Alpha).
1409 pp_lam_paren(con(and)@Alpha@Beta):-
1410 !, write('('), pp_lam_paren(Alpha), write(' & '), pp_lam_paren(Beta), write(')').
1411 pp_lam_paren(con(or)@Alpha@Beta):-
1412 !, write('('), pp_lam_paren(Alpha), write(' <b>or</b> '), pp_lam_paren(Beta), write(')').
1413 pp_lam_paren(con(not)@Alpha):-
1414 !, write(' ¬ '), write('('), pp_lam_paren(Alpha), write(')').
1415 pp_lam_paren(Alpha@Beta):-
1420 pp_lam_paren(var('$VAR'(N))):-
1421 !, write('<I>'), write(x), write('<SUB>'), write(N), write('</SUB></I>').
1422 pp_lam_paren(con(Con)):-
1423 write('<B>'), write(Con), write('</B>').
1425 % pp_rule(+Rule:<rulename>)
1426 % ----------------------------------------------------------------------
1427 % rule Rule is pretty printed
1428 % ----------------------------------------------------------------------
1429 pp_rule(fe):-write('/E').
1430 pp_rule(be):-write('\\E').
1431 pp_rule(fi('$VAR'(N))):-write('/I<sup>'), write(N), write('</sup>').
1432 pp_rule(bi('$VAR'(N))):-write('\\I<sup>'), write(N), write('</sup>').
1433 pp_rule(gi('$VAR'(N))):-write('-I<sup>'), write(N), write('</sup>').
1434 pp_rule(qqpush('$VAR'(N))):-write('qE<sup>'), write(N), write('</sup>').
1435 pp_rule(qqpop('$VAR'(N))):-write(N).
1436 pp_rule(qqi):-write(qI).
1437 pp_rule(coel):-write('coE').
1438 pp_rule(lex):-write('L').
1439 pp_rule(der):-write('D').
1440 pp_rule(nbc):-write('NBC').
1441 pp_rule(qi):-write('qI').
1444 % Standard Utilities
1445 % ======================================================================
1452 append_list([Xs|Xss],Ys):-
1454 append_list(Xss,Zs).
1457 append([X|Xs],Ys,[X|Zs]):-
1460 at_least_one_member(X,[X|_]):-!.
1461 at_least_one_member(X,[_|Xs]):-
1462 at_least_one_member(X,Xs).
1468 reverse([W|Ws],WsAcc,WsRev):-
1469 reverse(Ws,[W|WsAcc],WsRev).
1471 select(X,[X|Xs],Xs).
1472 select(X,[Y|Xs],[Y|Zs]):-
1475 select_last([X],X,[]).
1476 select_last([X|Xs],Y,[X|Zs]):-
1477 select_last(Xs,Y,Zs).
1479 cat_atoms(A1,A2,A3):-
1485 writelist([der(Ws)|Ws2]):-
1486 !, writelist(Ws), write(' '), writelist(Ws2).
1488 write(W), write(' '),
1492 write_lex_cat(File):-
1494 write('<HTML><HEAD><TITLE>Natural Deduction CG Parser</TITLE></HEAD><BODY><b> L<FONT SIZE = -1>EXICON</FONT> </b><br><br><FONT SIZE=-1>'), nl, nl,
1495 setof(lexe(W,Syn:Sem),lexentry(W,Syn,Sem),Ws),
1496 !, writebreaklex(Ws),
1497 nl, write('</FONT></HEAD></HTML>'), nl,
1501 writebreaklex([W|Ws]):-
1502 writebreaklex(Ws,W).
1504 writebreaklex([],lexe(W,Cat)):-
1505 write(W), write(' ==> '),
1507 writebreaklex([W2|Ws],lexe(W,Cat)):-
1508 write(W), write(' ==> '),
1510 write(' <BR> '), nl,
1511 writebreaklex(Ws,W2).
1515 write('<HTML><HEAD><TITLE>Natural Deduction CG Parser</TITLE></HEAD><BODY><b> L<FONT SIZE = -1>EXICON</FONT> </b><br><FONT SIZE=-1><BR>'), nl,
1516 setof(W,C^(W==>C),Ws),
1518 nl, write('</FONT></HEAD></HTML>'), nl,
1522 writebreak([W|Ws]):-
1527 writebreak([W2|Ws],W):-
1528 write(W), write(' <BR> '), nl,
1532 consult(natded), consult(lexicon), consult_lex, compile_empty.
1535 consult(natded), consult(lexicon), consult_lex, compile_empty, save(test3), start_up.
1538 compile(natded), compile(lexicon), compile_lex('compilelex.pl'), compile_empty, save(test3), start_up.
1541 %%% Local Variables:
1543 %%% prolog-indent-width: 2