2:- module(printDrs,[printDrs/1,printDrs/2,printDrs/3]).    3
    4:- use_module(library(lists),[append/3]).    5
    6/* ========================================================================
    7     Counter for discourse referents
    8======================================================================== */
    9
   10:- dynamic counter/1. counter(0).
   11
   12
   13/* ========================================================================
   14   Main Predicate
   15======================================================================== */
   16
   17printDrs(B):- 
   18   printDrs(user_output,B).
   19
   20printDrs(Stream,B):-
   21   LeftMargin = '%%% ',
   22   printDrs(Stream,B,LeftMargin).
   23
   24printDrs(Stream,xdrs(_,B),LeftMargin):- !, 
   25   printDrs(Stream,B,LeftMargin).
   26
   27printDrs(Stream,Drs,LeftMargin):- 
   28   retract(counter(_)), 
   29   assert(counter(1)),
   30   \+ \+ (formatDrs(Drs,Lines,_), 
   31          printDrsLines(Lines,Stream,LeftMargin)),
   32   nl(Stream).
   33
   34
   35/* ========================================================================
   36     Print DRS Lines
   37======================================================================== */
   38
   39printDrsLines([],_,_):- !.
   40
   41printDrsLines([Line|Rest],Stream,LeftMargin):-
   42   write(Stream,LeftMargin),
   43   atom_codes(L,Line), 
   44   write(Stream,L), 
   45   nl(Stream),
   46   printDrsLines(Rest,Stream,LeftMargin).
   47
   48
   49/* ========================================================================
   50    Dealing with a variable
   51======================================================================== */
   52
   53avar(Var):- var(Var), !.
   54avar(Var):- atom(Var), !.
   55avar(Var):- nonvar(Var), functor(Var,'$VAR',1), !.
   56
   57
   58/* ========================================================================
   59
   60     formatDrs(+DRS,    % any DRS exression
   61               +Lines,  % List of lists of character codes of equal length
   62               +Width)  % Length of the lines
   63
   64======================================================================== */
   65
   66formatDrs(Var,[Line,Line,Line,Codes,Line],N):- 
   67   avar(Var), !,
   68   makeConstant(Var,Codes),
   69   length(Codes,N),
   70   length(Line,N),
   71   append(Line,_,[32,32,32,32,32,32,32,32,32,32]).
   72
   73formatDrs(sdrs(Conds,Rel),Lines,Width):- !,
   74   cleanConds(Rel,CleanRel),
   75   formatConds(CleanRel,[]-ConLines0,0-RelLength),
   76   formatCond(cons(Conds),[]-DrsLines0,RelLength-ConLength),
   77   Length is max(ConLength,RelLength),
   78   closeConds(ConLines0,ConLines1,Length),
   79   closeConds(DrsLines0,DrsLines1,Length),
   80   Width is Length + 2,
   81   formatLine(95,Length,[32]-Top),
   82   formatLine(32,Length,[124]-Middle),
   83   append([[32|Top]|DrsLines1],[[124|Middle]|ConLines1],Lines).
   84
   85formatDrs(_:drs(D,C),Codes,Width):- !, formatDrs(drs(D,C),Codes,Width).
   86
   87formatDrs(drs(Dom,Conds),[[32|Top],Refs3,[124|Line]|CondLines2],Width):- !,
   88   cleanConds(Conds,CleanConds), sortConds(CleanConds,SortedConds),
   89   formatConds(SortedConds,[]-CondLines1,0-CondLength),
   90   formatRefs(Dom,Refs1),
   91   length(Refs1,RefLength),
   92   Length is max(RefLength,CondLength),
   93   closeConds(CondLines1,CondLines2,Length),
   94   Width is Length + 2,
   95   closeLine(Width,[124|Refs1],[124],Refs3),
   96   formatLine(95,Length,[32]-Top),   
   97   formatLine(46,Length,[124]-Line). 
   98
   99formatDrs(Complex,Lines3,Length):- 
  100   complexDrs(Complex,Op,Drs1,Drs2), !,
  101   atom_codes(Op,OpCode),
  102   length(OpCode,OpLen),
  103   formatDrs(Drs1,Lines1,N1),
  104   formatDrs(Drs2,Lines2,N2),
  105   combLinesDrs(Lines1,Lines2,Lines3,Op,N1,N2),
  106   Length is N1 + N2 + 2 + OpLen.
  107
  108formatDrs(lam(X,Drs),Lines3,Length):- !,
  109   formatLambda(X,Lines1,N1),
  110   formatDrs(Drs,Lines2,N2),
  111   M1 is N1 + 3, M2 is N2 + 3,
  112   combLinesDrs(Lines1,Lines2,Lines3,'.',M1,M2),
  113   Length is N1 + N2 + 3.
  114
  115formatDrs(lab(X,Drs),Lines4,Length):- !,
  116   LeftMargin = 32,      % space
  117   makeConstant(X,Var),
  118   length(Var,VarLen),
  119   OpWidth is VarLen + 2,  % +1 for colon
  120   length(Dummy,OpWidth),
  121   formatDrs(Drs,Lines1,DrsWidth),
  122   addLeftMargin(Lines1,Lines2,LeftMargin,OpWidth),
  123   Lines2=[Line1,Line2,Line3|Rest],
  124   append(Dummy,Tail,Line3),
  125   append([32|Var],[58|Tail],Line4),
  126   Lines4=[Line1,Line2,Line4|Rest],
  127   Length is DrsWidth + OpWidth.
  128
  129formatDrs(sub(Drs1,Drs2),Lines,Length):- !,
  130   formatDrs(Drs1,Lines1,Length1),
  131   formatDrs(Drs2,Lines2,Length2),
  132   Length is max(Length1,Length2),
  133   append(Lines1,Lines2,Lines).
  134
  135
  136/*========================================================================
  137     Format Complex DRSs
  138========================================================================*/
  139
  140complexDrs(merge(Drs1,Drs2),'+',Drs1,Drs2):- !.
  141complexDrs(alfa(_,Drs1,Drs2),'*',Drs1,Drs2):- !.
  142complexDrs(app(Drs1,Drs2),'@',Drs1,Drs2):- !.
  143
  144
  145/*========================================================================
  146     Format Discourse Referents
  147========================================================================*/
  148
  149formatRefs([],[]):- !.
  150
  151formatRefs([X],Code):- !, 
  152   ( nonvar(X), X=_:_:Ref, !
  153   ; nonvar(X), X=_:Ref, !
  154   ; var(X), X=Ref ),
  155   makeConstant(Ref,Code).
  156
  157formatRefs([X,Ref2|Rest],Out):- 
  158   ( nonvar(X), X=_:_:Ref1, !
  159   ; nonvar(X), X=_:Ref1, !
  160   ; var(X), X=Ref1 ),
  161   makeConstant(Ref1,Code),
  162   append(Code,[32|Codes],Out), 
  163   formatRefs([Ref2|Rest],Codes).
  164
  165
  166/*========================================================================
  167     Format Lambda bound Variable
  168========================================================================*/
  169
  170formatLambda(Var,Out,N):-
  171   makeConstant(Var,Code), 
  172   Lambda = [92|Code],
  173   length(Lambda,N),
  174   length(Line,N),
  175   append(Line,_,[32,32,32,32,32,32,32,32,32,32]),
  176   Out=[Line,Line,Line,Lambda,Line]. 
  177
  178
  179/*========================================================================
  180   Turn a discourse referent into a Prolog constant
  181========================================================================*/
  182
  183makeConstant(X,Code):- !,
  184   makeConst(X,Code,120).
  185
  186makeConstant(X,CodeTail,Tail):- !,
  187   makeConst(X,Code,120),
  188   append([32|Code],Tail,CodeTail).
  189
  190makeConst(X,Code,_):- 
  191   atom(X), !,
  192   atom_codes(X,Code).
  193
  194makeConst(X,[Var|Codes],Var):-
  195   nonvar(X),
  196   functor(X,'$VAR',1),
  197   arg(1,X,Number),
  198   number(Number), !,
  199   number_codes(Number,Codes).
  200
  201makeConst(X,[Var|Number],Var):- 
  202   var(X), !,
  203   retract(counter(N)),
  204   number_codes(N,Number), 
  205   atom_codes(X,[Var|Number]),
  206   M is N+1,
  207   assert(counter(M)).
  208
  209
  210/*========================================================================
  211     Format a Line
  212========================================================================*/
  213
  214formatLine(_,0,L-L):- !.
  215
  216formatLine(Code,N,In-[Code|Out]):-
  217   M is N - 1, 
  218   formatLine(Code,M,In-Out).
  219
  220
  221/*========================================================================
  222     Clean DRS-Conditions
  223========================================================================*/
  224
  225cleanConds(C1,C3):-
  226   select(_:_:C,C1,C2), !,
  227   cleanConds([C|C2],C3).
  228
  229cleanConds(C1,C3):-
  230   select(_:C,C1,C2), !,
  231   cleanConds([C|C2],C3).
  232
  233cleanConds(C1,C3):-
  234   select(_:C,C1,C2), !,
  235   cleanConds([C|C2],C3).
  236
  237cleanConds(C,C).
  238
  239
  240/*========================================================================
  241    Sort DRS-Conditions
  242========================================================================*/
  243
  244sortConds(C1,[named(A,B,C,D)|C3]):-
  245   select(named(A,B,C,D),C1,C2), !,
  246   sortConds(C2,C3).
  247
  248sortConds(C1,[pred(A,B,C,D),Mod1,Mod2,Mod3,Mod4|C7]):-
  249   select(pred(A,B,C,D),C1,C2),
  250   selectModifier(A,Mod1,C2,C3),
  251   selectModifier(A,Mod2,C3,C4),
  252   selectModifier(A,Mod3,C4,C5),
  253   selectModifier(A,Mod4,C5,C6), !,
  254   sortConds(C6,C7).
  255
  256sortConds(C1,[pred(A,B,C,D),Mod1,Mod2,Mod3|C6]):-
  257   select(pred(A,B,C,D),C1,C2),
  258   selectModifier(A,Mod1,C2,C3),
  259   selectModifier(A,Mod2,C3,C4),
  260   selectModifier(A,Mod3,C4,C5), !,
  261   sortConds(C5,C6).
  262
  263sortConds(C1,[pred(A,B,C,D),Mod1,Mod2|C5]):-
  264   select(pred(A,B,C,D),C1,C2),
  265   selectModifier(A,Mod1,C2,C3),
  266   selectModifier(A,Mod2,C3,C4), !,
  267   sortConds(C4,C5).
  268
  269sortConds(C1,[pred(A,B,C,D),Mod|C4]):-
  270   select(pred(A,B,C,D),C1,C2),
  271   selectModifier(A,Mod,C2,C3), !,
  272   sortConds(C3,C4).
  273
  274sortConds(C1,[pred(A,B,C,D)|C3]):-
  275   select(pred(A,B,C,D),C1,C2), !,
  276   sortConds(C2,C3).
  277
  278sortConds(C,C).
  279
  280
  281selectModifier(E,role(E,Y,S,1),C1,C2):- select(role(E,Y,S,1),C1,C2), !.
  282selectModifier(E,role(E,Y,S,1),C1,C2):- select(role(Y,E,S,-1),C1,C2), !.
  283selectModifier(E,rel(E,Y,S,T),C1,C2):- select(rel(E,Y,S,T),C1,C2), !.
  284selectModifier(E,card(E,Y,S),C1,C2):- select(card(E,Y,S),C1,C2), !.
  285
  286
  287/*========================================================================
  288     Formatting DRS-Conditions
  289========================================================================*/
  290
  291formatConds([],L-L,N-N):- !.
  292
  293formatConds([X|Rest],L1-L3,N1-N3):-
  294   formatCond(X,L2-L3,N1-N2), !,
  295   formatConds(Rest,L1-L2,N2-N3).
  296
  297
  298/*========================================================================
  299     Formatting Condition
  300========================================================================*/
  301
  302formatCond(cons([C]),L1-L2,N1-N3):- !,
  303   formatDrs(C,Lines,N2),
  304   append(Lines,L1,L2),
  305   N3 is max(N2,N1).
  306
  307formatCond(cons([C|Cs]),L1-L2,N0-N4):- !,
  308   formatDrs(C,Lines1,N1),
  309   formatCond(cons(Cs),[]-Lines2,0-N2),
  310   combLinesDrs(Lines1,Lines2,Lines3,N1,N2),
  311   append(Lines3,L1,L2),
  312   Length is N1 + N2 + 3,
  313   N4 is max(Length,N0).
  314
  315formatCond(Complex,L1-L2,N0-N4):- 
  316   complexCond(Complex,Op,Drs1,Drs2), !,
  317   atom_codes(Op,OpCode),
  318   length(OpCode,OpLen),
  319   formatDrs(Drs1,Lines1,N1),
  320   formatDrs(Drs2,Lines2,N2),
  321   combLinesConds(Lines1,Lines2,Lines3,OpCode,N1,N2),
  322   append(Lines3,L1,L2),
  323   Length is N1 + N2 + OpLen + 2,
  324   N4 is max(Length,N0).
  325
  326formatCond(Basic,L-[Line|L],N1-N2):-
  327   formatBasic(Basic,Line), !,
  328   length(Line,Length),
  329   N2 is max(Length,N1).
  330
  331formatCond(Cond,L1-L2,N0-N3):- 
  332   member(Cond:[O1,O2],[not(Drs):[32,172],
  333                        pos(Drs):[60,62],
  334                        nec(Drs):[91,93]]), !,
  335   OpWidth = 4,
  336   LeftMargin = 32,
  337   formatDrs(Drs,Lines1,N2),
  338   addLeftMargin(Lines1,Lines2,LeftMargin,OpWidth),
  339   Lines2=[Line1,Line2,[_,_,_,_|Line3]|Rest],    
  340   Lines4=[Line1,Line2,[32,O1,O2,32|Line3]|Rest],
  341   append(Lines4,L1,L2),
  342   Length is N2 + OpWidth,
  343   N3 is max(Length,N0).
  344
  345formatCond(prop(X,Drs),L1-L2,N0-N3):- !,
  346   LeftMargin = 32,      % space
  347   makeConstant(X,Var),
  348   length(Var,VarLen),
  349   OpWidth is VarLen + 2,  % one extra for colon, one for space
  350   length(Dummy,OpWidth),
  351   formatDrs(Drs,Lines1,DrsWidth),
  352   addLeftMargin(Lines1,Lines2,LeftMargin,OpWidth),
  353   Lines2=[Line1,Line2,Line3|Rest],  
  354   append(Dummy,Tail,Line3),
  355   append([32|Var],[58|Tail],Line4),
  356   Lines4=[Line1,Line2,Line4|Rest],
  357   append(Lines4,L1,L2),
  358   Length is DrsWidth + OpWidth,
  359   N3 is max(Length,N0).
  360
  361formatCond(eq(A,B),L-[Line|L],N0-N2):- !,
  362   makeConstant(A,L1),
  363   makeConstant(B,L2),
  364   append(L1,[32,61,32|L2],Line),
  365   length(Line,Length),
  366   N2 is max(Length,N0).
  367
  368formatCond(card(Arg,Integer,Type),L-[Line|L],N0-N2):- !,
  369   makeConstant(Arg,A),
  370   ( number(Integer), number_codes(Integer,D) ;
  371     \+ number(Integer), makeConstant(Integer,D) ),
  372   ( Type = eq, !, 
  373     append([32,32,124|A],[124,32,61,32|D],Line)            %%% =
  374   ; Type = ge, !, 
  375     append([32,32,124|A],[124,32,62,61,32|D],Line)         %%% >=
  376   ; Type = le, !, 
  377     append([32,32,124|A],[124,32,61,60,32|D],Line)         %%% =<
  378   ),
  379   length(Line,Length),
  380   N2 is max(Length,N0).
  381
  382formatCond(timex(Arg,Timex),L-[Line|L],N0-N2):- !,
  383   atom_codes('timex',F),          
  384   makeConstant(Arg,A),
  385   timex(Timex,D),
  386   append(F,[40|A],T),
  387   append(T,[41,61|D],Line),
  388   length(Line,Length),
  389   N2 is max(Length,N0).
  390
  391
  392/*========================================================================
  393     Formatting Complex Conditions
  394========================================================================*/
  395
  396complexCond(imp(Drs1,Drs2), '>' ,Drs1,Drs2).
  397complexCond(or(Drs1,Drs2),  'V' ,Drs1,Drs2).
  398complexCond(duplex(most, Drs1,_,Drs2), 'M' ,Drs1,Drs2).
  399complexCond(duplex(two,  Drs1,_,Drs2), '2' ,Drs1,Drs2).
  400complexCond(duplex(three,Drs1,_,Drs2), '3' ,Drs1,Drs2).
  401complexCond(duplex(Type, Drs1,_,Drs2), '?' ,Drs1,Drs2):- 
  402   \+ member(Type,[most,two,three]).
  403
  404
  405/*========================================================================
  406     Formatting Constant Relations
  407========================================================================*/
  408
  409specialRel(temp_before,   60):- !.          %%% <
  410specialRel(temp_included, 91):- !.          %%% [ 
  411specialRel(temp_includes, 93):- !.          %%% ]
  412specialRel(temp_abut,    124):- !.          %%% |
  413specialRel(temp_overlap,  79):- !.          %%% O
  414specialRel(member_of,    101):- !.          %%% e
  415specialRel(subset_of,     67):- !.          %%% C
  416
  417
  418/*========================================================================
  419     Formatting Basic Conditions
  420========================================================================*/
  421
  422%formatBasic(pred(Arg,Functor,a,_),Line):- !,
  423%   atom_codes(Functor,F),
  424%   makeConstant(Arg,A),   
  425%   append([98,101,45|F],[40|A],T),
  426%   append(T,[41],Line).
  427
  428formatBasic(pred(Arg,Functor,_,_),Line):- !,
  429   atom_codes(Functor,F),
  430   makeConstant(Arg,A),   
  431   append(F,[40|A],T),
  432   append(T,[41],Line).
  433   
  434formatBasic(role(Arg1,Arg2,Rel,1),Line):- !,
  435   formatBasic(rel(Arg1,Arg2,Rel,0),Line).
  436
  437formatBasic(role(Arg1,Arg2,Rel,-1),Line):- !,
  438   formatBasic(rel(Arg2,Arg1,Rel,0),Line).
  439
  440formatBasic(rel(Arg1,Arg2,Rel,1),Line):-
  441   specialRel(Rel,Sym), !, 
  442   makeConstant(Arg1,A1),
  443   makeConstant(Arg2,A2),
  444   append(A1,[32,Sym,32|A2],Line).
  445
  446formatBasic(rel(Arg1,Arg2,Functor,_),Line):- !,
  447   atom_codes(Functor,F),
  448   makeConstant(Arg1,A1),
  449   makeConstant(Arg2,A2),
  450   append([32,32|F],[40|A1],T1),
  451   append(T1,[44|A2],T2),
  452   append(T2,[41],Line).
  453
  454formatBasic(rel(Arg1,Arg2,Functor),Line):- !,
  455   atom_codes(Functor,F),
  456   makeConstant(Arg1,A1),
  457   makeConstant(Arg2,A2),
  458   append(F,[40|A1],T1),
  459   append(T1,[44|A2],T2),
  460   append(T2,[41],Line).
  461
  462formatBasic(named(Arg,Sym,Type,_),Line):- !,
  463   atom_codes(named,F),
  464   makeConstant(Arg,A),
  465   makeConstant(Sym,S),
  466   makeConstant(Type,T),
  467   append(F,[40|A],T1),
  468   append(T1,[44|S],T2),
  469   append(T2,[44|T],T3),
  470   append(T3,[41],Line).
  471 
  472
  473/*========================================================================
  474   Combining Lines of Characters (Complex DRS-Conditions)
  475========================================================================*/
  476    
  477combLinesConds([A1,B1,C1,D1|Rest1],[A2,B2,C2,D2|Rest2],Result,Op,N1,N2):-
  478   combLinesDrs([A1,B1,C1],[A2,B2,C2],Firsts,N1,N2),
  479   append([32|D1],Op,D3), append(D3,D2,D4),
  480   combLinesDrs(Rest1,Rest2,Rest,N1,N2),
  481   append(Firsts,[D4|Rest],Result).
  482
  483
  484/*========================================================================
  485   Add Left Margin
  486========================================================================*/
  487
  488addLeftMargin([],[],_,_):- !.
  489
  490addLeftMargin([A2|Rest1],[A|Rest2],LeftMargin,Width):- !,
  491   closeLine(Width,[LeftMargin],[],A1),
  492   append(A1,A2,A),
  493   addLeftMargin(Rest1,Rest2,LeftMargin,Width).
  494
  495
  496/*========================================================================
  497   Combining Lines of Characters (Complex DRSs)
  498========================================================================*/
  499    
  500combLinesDrs([A1,B1,C1,D1|Rest1],[A2,B2,C2,D2|Rest2],Result,Op,N1,N2):-
  501   combLinesDrs([A1,B1,C1],[A2,B2,C2],Firsts,N1,N2),
  502   atom_codes(Op,Code),
  503   append(Code,D2,T1),
  504   append(T1,[41],T2),
  505   append([40|D1],T2,D),
  506   combLinesDrs(Rest1,Rest2,Rest,N1,N2),
  507   append(Firsts,[D|Rest],Result).
  508
  509combLinesDrs([],[],[],_,_):- !.
  510
  511combLinesDrs([],[A2|Rest2],[A3|Rest],N1,N2):- !,
  512   N is N1+N2+3,
  513   append(A2,[32],A4),
  514   closeLine(N,[32],A4,A3),
  515   combLinesDrs([],Rest2,Rest,N1,N2).
  516
  517combLinesDrs([A1|Rest1],[],[Closed|Rest],N1,N2):- !,
  518   N is N1+N2+3,
  519   closeLine(N,[32|A1],[],Closed),
  520   combLinesDrs(Rest1,[],Rest,N1,N2).
  521
  522combLinesDrs([A1|Rest1],[A2|Rest2],[A3|Rest],N1,N2):- !,
  523   N is N1+N2+3,
  524   append(A2,[32],A4),
  525   closeLine(N,[32|A1],A4,A3),
  526   combLinesDrs(Rest1,Rest2,Rest,N1,N2).
  527
  528
  529/*========================================================================
  530     Close Conditions (add '|')
  531========================================================================*/
  532
  533closeConds([],[[124|Bottom]],Width):- !,
  534   formatLine(95,Width,[124]-Bottom).
  535
  536closeConds([Line|Rest1],[[124|New]|Rest2],Width):-
  537   Length is Width+1,
  538   closeLine(Length,Line,[124],New),
  539   closeConds(Rest1,Rest2,Width)
  539.
  540
  541
  542/*========================================================================
  543     Close Line 
  544========================================================================*/
  545
  546closeLine(Number,Left,Right,Result):-
  547   length(Left,N1),
  548   length(Right,N2),
  549   N is Number-(N1+N2),
  550   closeLine2(N,Left,Right,Result).
  551
  552closeLine2(N,Left,Right,New):- 
  553   N < 1, !, 
  554   append(Left,Right,New).
  555
  556closeLine2(N,Left,Right,New):- 
  557   M is N - 1, !,
  558   closeLine2(M,Left,[32|Right],New).
  559
  560
  561/*========================================================================
  562   Time Expressions
  563========================================================================*/
  564
  565timex(date(_:Y,_:M,_:D),Timex):- !,
  566   timex(date('+',Y,M,D),Timex).
  567
  568timex(date(_:C,_:Y,_:M,_:D),Timex):- !,
  569   timex(date(C,Y,M,D),Timex).
  570
  571timex(time(_:Y,_:M,_:D),Timex):- !,
  572   timex(time(Y,M,D),Timex).
  573
  574timex(date(C,Y,M,D),Timex):- !,
  575   plusminus(C,[PM]),
  576   year(Y,[Y1,Y2,Y3,Y4]),
  577   month(M,[M1,M2]),
  578   day(D,[D1,D2]),
  579   Timex = [PM,Y1,Y2,Y3,Y4,M1,M2,D1,D2].
  580
  581timex(time(H,M,S),Timex):-
  582   day(H,[H1,H2]),
  583   day(M,[M1,M2]),
  584   day(S,[S1,S2]),
  585   Timex = [H1,H2,58,M1,M2,58,S1,S2].
  586
  587plusminus(Y,C):- var(Y), !, C = [88].
  588plusminus(Y,C):- atom_codes(Y,C).
  589
  590year(Y,C):- var(Y), !, C = [88,88,88,88].
  591year(Y,C):- atom_codes(Y,C).
  592
  593month(Y,C):- var(Y), !, C = [88,88].
  594month(Y,C):- atom_codes(Y,C).
  595
  596day(Y,C):- var(Y), !, C = [88,88].
  597day(Y,C):- atom_codes(Y,C)