1:- module(pac_demo, [demo/1]).    2:- use_module(pacword).    3term_expansion --> expand_pac.
    4:- include(op).    5
    6		/*************************************************
    7		*     Demo :  Compile clause / DCG with regex    *
    8		*************************************************/
    9
   10% ?- ['pac-demo'].
   11
   12% ?- demo(a).
   13% ?- demo("zip(P,Q):-maplist(pred([X,Y,X-Y]), P, Q)").
   14% ?- demo("a :- call(pred([X]))").
   15% ?- demo("a --> b").
   16% ?- demo('a --> w(".*")').
   17% ?- demo('trim_white(A) --> wl("[ \t]*"), w(".*", A), wl("[ \t]*")').
   18
   19demo(X) :- expand_pacword_display(X).
   20
   21%
   22expand_pacword_display(S):- term_string(X, S, 
   23										[module(web), 
   24										 variable_names(Eqs)]),
   25	compile_pred_word(X, Eqs, H0, R0),
   26	smash(["\n", H0, ".\n\n", R0, "\n"]).
   27
   28% a :- call(pred(['a#1']), X).
   29% a :- call(pred(['A']), X).
   30% a :- maplist(pred([X, Y, X-Y]), [1,2,3], A).
   31% trim_white(A) --> wl("[ \t]*"), w(".*", A), wl("[ \t]*").
   32
   33% ?- ejockey:new_names([X,Y], Eqs, 1, 'A', [a1,a2,a3]).
   34
   35new_names([V|Vs], [A=V|Eqs], N, Prefix, As):-
   36	new_name(N, As, A, Prefix, K),
   37	new_names(Vs, Eqs, K, Prefix, As).
   38new_names([], [], _, _, _).
   39
   40%
   41new_name(N, As, B, Prx, K):- atom_concat(Prx, N, B),
   42						\+ memberchk(B, As),
   43						!,
   44						succ(N, K).
   45new_name(N, As, A, Prx, K):- succ(N, N1),
   46						new_name(N1, As, A, Prx, K).
   47
   48% ?- pac_demo:subtractq([X,Y,X,Y,X,Y], [X], R).
   49subtractq([], _, []).
   50subtractq([A|As], B,  C):- memq(A, B), !,
   51	subtractq(As, B, C).
   52subtractq([A|As], B, [A|C]):- subtractq(As, B, C).
   53
   54%
   55expand_clause_slim(X, Y):- 
   56	expand_clause(X, [], Y0),
   57	maplist(pred([X:-true, X] & [C, C]),  Y0, Y).
   58%
   59compile_pred_word(X-->X0, Eqs, H0, R0):-!, 
   60		maplist(pred([A=P, A, P]), Eqs, As, Vs),
   61		expand_clause_slim(X-->X0, [H|R]),
   62		term_variables(H, HVs),
   63		subtractq(HVs, Vs, SVs),
   64		new_names(SVs, Eqs0, 1, 'A', As),
   65		append(Eqs0, Eqs, Eqs1),
   66		term_string(H, H0, [variable_names(Eqs1), 
   67							quoted(true)]),
   68		maplist(pred(([U, [V,".\n"]] :- 
   69								numbervars(U, 0, _),
   70								term_string(U, V, [ numbervars(true), 
   71													quoted(true)]))),  
   72				R, R0).
   73compile_pred_word(X, Eqs, H0, R0):- 
   74		expand_clause_slim(X, [H|R]),
   75		term_string(H, H0, [variable_names(Eqs), 
   76							quoted(true)]),
   77		maplist(pred(([U, [V,".\n"]] :- 
   78								numbervars(U, 0, _),
   79								term_string(U, V, [ numbervars(true), 
   80													quoted(true)]))),  
   81				R, R0)