1:- module(querysample, []).    2:- use_module(pac(engine)).    3term_expansion --> expand_pac.
    4
    5% ?- sqc(querysample).
    6% ?- calc(3, X).
    7% ?- calc(3+4+5, X).
    8% ?- numlist_to_plus(0, 100000, X),  time(Y is X).
    9%@ % 3 inferences, 0.004 CPU in 0.004 seconds (96% CPU, 802 Lips)
   10%@ X = 0+(1+(2+(3+(4+(5+(6+(7+(8+(... + ...))))))))),
   11%@ Y = 5000050000.
   12% ?- numlist_to_plus(0, 100000, X),  time(calc(X, Y)).
   13%@ % 300,003 inferences, 0.019 CPU in 0.025 seconds (77% CPU, 15779665 Lips)
   14%@ X = 0+(1+(2+(3+(4+(5+(6+(7+(8+(... + ...))))))))),
   15%@ Y = 5000050000.
   16
   17numlist_to_plus(I, J, P):- numlist(I, J, Is),
   18	numlist_to_plus(Is, P).
   19
   20numlist_to_plus([X], X):-!.
   21numlist_to_plus([X|R], X+E):- numlist_to_plus(R, E).
   22
   23% ?- listing(calc).
   24:-bekind(calc, []).   25X + Y = :plus@X@Y.
   26X - Y = xargs([A,B,C]:- plus(B,C,A))@X@Y.
   27- X  =  0 - X.
   28+ X  = X.
   29X  = `X.
   30:-ekind.
   31
   32% ?- list_concat_xargs((([a,b]^2+[c,d]^2)^3)^5, V), length(V, L).
   33% ?- time(repeat(1000, list_concat((([a,b]^2+[c,d]^2)^3)^5, V))), length(V, L).
   34% ?- time(repeat(1000, list_concat_xargs((([a,b]^2+[c,d]^2)^3)^5, V))), length(V,L).
   35
   36% ?- listing(list_concat).
   37:-bekind(list_concat, []).
   38X + Y	= :append@X@Y.
   39X - Y	= xargs([A,B,C]	:- append(B,C,A))@X@Y.
   40_X^0	= [].
   41X^N	= X + X^N0
   42	:- succ(N0, N).
   43X	= `X.
   44:-ekind.   45
   46% ?- listing(list_concat_xargs).
   47:-bekind(list_concat_xargs, []).   48X + Y	= :append@X@Y.
   49X - Y	= xargs([A,B,C]
   50	:- append(B,C,A))@X@Y.
   51_X^0	= [].
   52X^N	= xargs([A] -> A + A^N0)@X
   53	:- succ(N0, N).
   54X