2:- module(noncomp,[noncomp/3]).    3
    4:- use_module(library(lists),[member/2,append/3,select/3]).    5:- use_module(semlib(errors),[warning/2]).    6:- use_module(semlib(options),[option/2]).    7
    8/* ========================================================================
    9   Non-compositional reduction rules
   10======================================================================== */
   11
   12noncomp(B1:I1:named(X1,Sym1,Sort,Type),B2:I2:named(X2,Sym2,Sort,Type),K):- 
   13   option('--mwe',yes),
   14   X1 == X2, B1 == B2, !,
   15   atomic_list_concat([Sym1,Sym2],'~',Sym3), 
   16   append(I1,I2,I3), sort(I3,I),
   17   K = B1:I:named(X1,Sym3,Sort,Type).
   18
   19noncomp(B1:I1:named(X1,Sym1,Sort,Type),B2:I2:named(X2,Sym2,_,_),K):- 
   20   option('--mwe',all),
   21   X1 == X2, B1 == B2, !,
   22   atomic_list_concat([Sym1,Sym2],'~',Sym3), 
   23   append(I1,I2,I3), sort(I3,I),
   24   K = B1:I:named(X1,Sym3,Sort,Type).
   25
   26noncomp(B1:I1:timex(X1,Date1),B2:I2:timex(X2,Date2),K):- 
   27   X1 == X2, B1 == B2, !,
   28   concat_dates(Date1,Date2,Date), 
   29   append(I1,I2,I3), sort(I3,I),
   30   K = B1:I:timex(X1,Date).
   31
   32noncomp(B1:I1:card(X1,Num1,Type),B2:I2:card(X2,Num2,Type),K):- 
   33   X1 == X2, B1 == B2, number(Num1), number(Num2), Num2 < 10, !,
   34   Num is Num1 + Num2,
   35   append(I1,I2,I3), sort(I3,I),
   36   K = B1:I:card(X1,Num,Type).
   37
   38noncomp(B1:I1:card(X1,Num1,Type),B2:I2:card(X2,Num2,Type),K):- 
   39   X1 == X2, B1 == B2, number(Num1), number(Num2), !,
   40   Num is round(Num1 * Num2),
   41   append(I1,I2,I3), sort(I3,I),
   42   K = B1:I:card(X1,Num,Type).
   43
   44
   45/*========================================================================
   46   Concatenate Dates
   47========================================================================*/
   48
   49concat_dates(date([]:'+', []:'XXXX', Month,  Day),
   50             date([]:'+',  Year,   []:'XX', Day),
   51             date([]:'+',  Year,    Month,  Day)).
   52
   53concat_dates(date([]:'+',  Year,   []:'XX', Day),
   54             date([]:'+', []:'XXXX', Month,  Day), 
   55             date([]:'+',  Year,    Month,  Day)).
   56
   57concat_dates(date([]:'+', Year, []:'XX', Day),
   58             date([]:'+', Year,  Month, []:'XX'), 
   59             date([]:'+', Year,  Month,  Day)).
   60
   61concat_dates(date([]:'+', Year,  Month, []:'XX'), 
   62             date([]:'+', Year, []:'XX', Day),
   63             date([]:'+', Year,  Month,  Day)).
   64
   65concat_dates(date([]:'+', []:'XXXX', []:'XX', Day),
   66             date([]:'+', Year,  Month, []:'XX'), 
   67             date([]:'+', Year,  Month,  Day)).
   68
   69concat_dates(date([]:'+', Year, []:'XX', []:'XX'), 
   70             date([]:'+', []:'XXXX', Month, Day),
   71             date([]:'+', Year, Month, Day) ).
   72
   73concat_dates(date([]:'+', []:'XXXX', Month, Day),
   74             date([]:'+', Year, []:'XX', []:'XX'),
   75             date([]:'+', Year, Month, Day) ).
   76
   77concat_dates(date([]:'+', []:'XXXX', Month, []:'XX'),
   78             date([]:'+', Year, []:'XX', Day),
   79             date([]:'+', Year, Month, Day) )