|
|
Logical Optimization (2)
wrapper.pl=
% wrapper
% prefix T with one get call for each ?X in T.
% suffix T with one set call for each !Y in T.
:- op(1,fx, ?),op(1,fx, !).
/* --------------------------
e.g.
demo1 :- wrap(( !x is ?x + 1, % 1
?a=L, % 2
member(!b,L), % 3
!c = [a|?c], % 4
?X=Y, % 5
print(X=Y) % 6
),Z),numbervars(Z,0,_),format('~p\n',[Z]).
prints:
?(A=B), ?(a=C), ?(c=D), ?(x=E),
( F is E+1, % 1
C=G, % 2
member(H, G), % 3
I=[a|D], % 4
B=J, % 5
print(A=J) % 6
),
!(b=H), !(c=I), !(x=F)
--------------------------- */
% uses a naughty sorting trick to place the
% goal (marked with a "2") after the gets
% (marked with a "1") and before the sets
% (marked with a "3"). this is perhaps
% over-tricky- but the option is to carry six
% I/O variables around- yucko
wrap(Goals0,Out) :-
wrap1(Goals0,Goals,Do,[]),
% fails if no wrapping needed
Do \= [],
sort(['2'(Goals)|Do],Ordered),
% remove the ordering markers
maplist(arg(1),Ordered,Temp),
l2c(Temp,Out).
l2c([H],(H)) :- !.
l2c([H|T],(H,Rest)) :- l2c(T,Rest).
wrap1(Goals0,Goals,Do,Done) :-
% standard top-down parser.
% once = sugar for cut
once(wrap2(Goals0,Goals,Do,Done)).
% standard base case1: dodge vars
wrap2(X,X,Do, Do) :-
var(X).
% standard base case2: leaf of term
wrap2(X, X,Do, Do) :-
atomic(X).
% replace get/set symbols with a variable;
% store that symbol and var.
wrap2(?X,Y,['1'(?(X=Y))|Do],Do).
wrap2(!X,Y,['3'(!(X=Y))|Do],Do).
% termination case
wrap2([], [],Do, Do).
% recursive over list
wrap2([H0|T0],[H|T]) -->
wrap1(H0,H), wrap1(T0,T).
% recurse into term
wrap2(Term0, Term,Do0,Do) :-
% standard recustive univ trick.
% ONE: bust up the term into a list
Term0 =.. L0,
% TWO: run over the list to build a new list
wrap2(L0,L,Do0,Do),
% THREE: piece back together a new list
Term =.. L. |
fastereg2.pl=
% fastereg2.pl
% define named accessors to a term with
% four arguments (defined using capsule)
d=date(year,month,day,daysThisMonth).
% define predicates that query and update
% arguements in the date term
% top-level driver
d(X) :- d(X,_,_).
% does the work
d`leapYear -->
0 is ?year mod 4.
d`days(D) -->
?month=M,
`days1(M,D),
!daysThisMonth=D.
d`days1(sept,30).
d`days1(apr,30).
d`days1(jun,30).
d`days1(nov,30).
d`days1(feb,29) -->
`leapYear,!.
d`days1(feb,28).
d`days1(jan,31).
d`days1(mar,31).
d`days1(jul,31).
d`days1(aug,31).
d`days1(oct,31).
d`days1(dec,31).
d`showOff1 -->
!daysThisMonth is ?daysThisMonth + 1.
d`showOff2 -->
!year = [],
!year = [a|?year],
!year = [b|?year],
!year = [c|?year],
?year = [_|T],
!year = T.
d`error1 --> !badRef = 1.
d`showOff3 -->
0 is 10 mod ?date
-> print(?date)
; print(boo).
d`demo1 -->
!year = 2000,
!month= oct,
member(!day,[16,17,18]),
`days(D),
ToGo is D - ?day,
print(ToGo),
nl,
fail.
d`demo1 --> [].
d`demo2 -->
!year = 2000,
!month= oct,
!day=16,
`days(_),
?A=B,
print(A=B),
nl,
fail.
d`demo2 --> [].
|
faster2.out=
% output from faster2.pl
d(A) :-
d(A, B, C).
d(leapYear, date(A, B, C, D), date(A, B, C, D)) :-
0 is A mod 4.
d(days(A), date(B, C, D, E), date(F, G, H, A)) :-
d(days1(C, A), date(B, C, D, E), date(F, G, H, I)).
d(days1(sept, 30), A, A).
d(days1(apr, 30), A, A).
d(days1(jun, 30), A, A).
d(days1(nov, 30), A, A).
d(days1(feb, 29), date(A, B, C, D), date(A, B, C, D)) :-
0 is A mod 4, !.
d(days1(feb, 28), A, A).
d(days1(jan, 31), A, A).
d(days1(mar, 31), A, A).
d(days1(jul, 31), A, A).
d(days1(aug, 31), A, A).
d(days1(oct, 31), A, A).
d(days1(dec, 31), A, A).
d(showOff1, date(A, B, C, D), date(A, B, C, E)) :-
E is D+1.
d(showOff2, date(A, B, C, D), date([b, a], B, C, D)).
d(error1, A, B) :-
d(badRef, C, 1, A, B).
d(showOff3, A, A) :-
( d(date, B, B, A, C),
0 is 10 mod B
-> d(date, D, D, C, A),
print(D)
; print(boo)
).
d(demo1, date(A, B, C, D), date(2000, oct, E, 31)) :-
member(E, [16, 17, 18]),
F is 31-E,
print(F),
nl,
fail.
d(demo1, A, A) :-
[].
d(demo2, date(A, B, C, D), E) :-
d(F, G, G, date(2000, oct, 16, 31), E),
print(F=G),
nl,
fail.
d(demo2, A, A) :-
[].
d(year, A, B, date(A, C, D, E), date(B, C, D, E)).
d(month, A, B, date(C, A, D, E), date(C, B, D, E)).
d(day, A, B, date(C, D, A, E), date(C, D, B, E)).
d(daysThisMonth, A, B, date(C, D, E, A), date(C, D, E, B)).
15
14
13
year=2000
month=oct
day=16
daysThisMonth=31
|
faster2.pl=
% faster.pl
% an optimizer using a meta-interpreter
% and the wrapper
:- [lib], -[demos,capsule,reduce,
tidyTrue,wrapper,format].
:- op(999,xfx,`), op(998,fx,`).
demof :- demos(faster2).
demo1 :- listing(d), nl, d(demo1), nl, d(demo2).
% for rules
term_expansion((C`X --> Y),Z) :-
% C is magic context symbol
faster(C,X,Y,Z).
% for facts
term_expansion(C`X,Z) :-
faster(C,X,true,Z).
% as before- do the pe.
% but add in In/Out arguments for the
% term we are querying and updating.
faster(C,X,Y0,Out) :-
pe(Y0,C,Y1,W0,W),
Head =.. [C,X,W0,W],
tidy((Head :- Y1),Out).
pe(X,Y,C,W0,W) :-
% standard top-down parser.
% block backtracking
once(pe1(X,Y,C,W0,W)).
% standard base cases: yawn
pe1(X, _,X, W,W) :- var(X).
pe1(true,_,true,W,W).
% for "not", input W is not changed by the not
pe1(\+ X0,C,\+X, W,W) :-
pe(X0,C,X,W,_).
% for "ors", have to pass the same input W into both
pe1((X0;Y0),C,(X;Y),W0,W) :-
pe(X0,C,X,W0,W),
pe(Y0,C,Y,W0,W).
% "|" a.k.a. ";"
pe1((X|Y),C,Z,W0,W) :-
pe((X;Y),C,Z,W0,W).
% conjunction: input gets changed by term1 into temp,
% then passed to term2 to be changed into out
pe1((X0,Y0),C, (X,Y),W0,W) :-
pe(X0,C,X,W0,W1),
pe(Y0,C,Y,W1,W).
% implication
pe1((X0->Y0) ,C,(X->Y),W0,W) :-
pe(X0,C,X,W0,W1),
pe(Y0,C,Y,W1,W).
% X -> Y | Z = (X -> Y) | Z
% catch the get, set methods
pe1(!(X=Y), C,Z, W0,W) :-
Z0 =.. [C,X,_,Y,W0,W1],
pe(Z0,C,Z,W1,W).
pe1(?(X=Y), C,Z, W0,W) :-
Z0 =.. [C,X,Y,Y,W0,W1],
pe(Z0,C,Z,W1,W).
% catch the method sub-calls
pe1(`X,C,Z, W0,W) :-
Z0 =.. [C,X,W0,W1],
pe(Z0,C,Z,W1,W).
% catch calls to other methods
% in other contexts (not tested)
pe1(C1`X,_,Z, W,W) :-
Z0 =.. [C1,X,W0,W1],
pe(Z0,C1,Z,W0,W1).
% generate get, sets if we need to
pe1(X,C,Y, W0,W) :-
wrap(X,Z),
pe(Z,C,Y,W0,W).
% reduce, if possible
pe1(X,C,Y, W0,W) :-
reduce(X,Z),
pe(Z,C,Y,W0,W).
%else, do nothing
pe1(X,_,X, W, W).
:- [fastereg2]. |
capsule.pl=
% capsule.pl
% auto-build accessors
/* ---------------------------
e.g.
d=date(year,month,day,daysThisMonth).
becomes
d(year, A,B,date(A,C,D,E),date(B,C,D,E)).
d(month, A,B,date(C,A,D,E),date(C,B,D,E)).
d(day, A,B,date(C,D,A,E),date(C,D,B,E)).
d(daysThisMonth,A,B,date(C,D,E,A),date(C,D,E,B)).
---------------------------- */
term_expansion(X=Y,Z) :-
capsules(X=Y,Z).
capsules(X = Y,Out) :-
% the bagof trick- define a method
% to find one solution. wrap it in
% a bagof to find them all.
bagof(Z,X^Y^capsule(X=Y,Z),Out).
capsule(Handle = Term,Out) :-
functor(Term,F,Arity),
% arg backtracks through all Items in Pos
arg(Pos,Term,Item),
joinArgs(F,Arity,Pos,Old,New,Term1,Term2),
% names accessor generated here
Out =.. [Handle,Item,Old,New,Term1,Term2].
joinArgs(F,Arity,Pos,Old,New,Term1,Term2) :-
length(L1,Arity),
Pos0 is Pos - 1,
length(Before,Pos0),
append(Before,[Old|After],L1),
append(Before,[New|After],L2),
Term1 =.. [F|L1],
Term2 =.. [F|L2].
|
reduce.pl=
% reduce.pl
% things we can run at load time.
% unification can happen right now.
reduce(X = X, true).
% if we have enough info to do
% a calculation, do it now
reduce(X is Y,true) :-
ground(Y),
X is Y.
% lists can be appended if
% the lists are defined enoug
% at runtime
reduce(append(L1,L2,L3),true) :-
proper_list(L1),
proper_list(L2),
append(L1,L2,L3).
% univs can be called at
% runtime, if the list is
% well-defined and the head is
% bound
reduce(Term =.. [H|T],true) :-
proper_list(T),
ground(H),
Term =.. [H|T].
% if there is only one fact
% for X, we can call it at
% compile time
reduce(X,true) :-
singleton(X),
clause(X,true).
% if there is only one rule
% that defines X, we can ust
% swap the head for the rule
% body.
reduce(X,Y) :-
singleton(X),
clause(X,Y).
singleton(X) :-
\+ predicate_property(X,built_in),
findall(Y,clause(X,Y),[_]).
|
tidyTrue.pl=
% tidy.pl
% author= lindsay mason & timm
% "reduce"drops in all these bogus "true"
% sub-goals. tidy removes these "true"s.
tidy(A,B) :- once(tidy1(A,B)).
tidy1(A, A) :- var(A).
tidy1((A :- true), A).
tidy1((A :- B), Out) :-
tidy(B,TB),
(TB=true -> Out = A; Out=(A :- TB)).
tidy1((A,B), (A,TB)) :- var(A), tidy(B,TB).
tidy1((A,B), (TA,B)) :- var(B), tidy(A,TA).
tidy1(((A,B),C), R) :- tidy((A,B,C), R).
tidy1((true,A), R) :- tidy(A,R).
tidy1((A,true), R) :- tidy(A,R).
tidy1((A,B), Out) :-
tidy(A,TA), tidy(B,TB),
(TB=true -> Out=TA ; Out=(TA,TB)).
tidy1((A;B), (TA;TB)) :- tidy(A,TA), tidy(B,TB).
tidy1((A->B), (TA->TB)) :- tidy(A,TA), tidy(B,TB).
tidy1((\+ A), (\+ TA)) :- tidy(A,TA).
tidy1(A, A).
|
format.pl=
% format.pl
%--------------------------------------
% stuff to simplify printing clauses.
% swi-prolog lets a programmer customize
% the format statement.
% FIRST, a predicate of arity 2 is registerred
% next to some letter
:- format_predicate('P',p(_,_)).
% SECOND, write the predicate.
p(default,X) :- !, p(0,X).
p(_,(X :- true)) :- !, format('~p.\n',X).
p(_,(X :- Y )) :- !, portray_clause((X :- Y)).
p(N,[H|T] ) :- !, not(not((numbervars([H|T],N,_),
format('~p',[[H|T]])))).
p(N,X ) :- not(not((numbervars(X,N,_),
format('~p',X)))).
%--------------------------------------
% stuff to simplify right justifying text
% FIRST:
:- format_predicate('>',padChars(_,_)).
% SECOND:
padChars(default,A) :-
padChars(5,A).
% the first arg "S" is the optional argument
% someone may have given with the "~" command
padChars(S,A) :-
writeThing(A,Thing,N),
Pad is S - N,
% standard trick to emulate
% for(i=1;i<=N;i++) { doThis }
forall(between(1,Pad,_),put(32)),
write(Thing).
writeThing(X,S,L) :-
% sformat returns the string in
% the first arg
sformat(S,'~w',[X]), string_length(S,L).
%--------------------------------------
% stuff to simplify left justifying text
% FIRST:
:- format_predicate('<',charsPad(_,_)).
% SECOND:
charsPad(default,A) :- charsPad(5,A).
charsPad(S,A) :-
writeThing(A,Thing,N),
atom_length(A,N),
Pad is S - N,
write(Thing),
forall(between(1,Pad,_),put(32)).
%--------------------------------------
% stuff to simplify printing N twiddles,
% scaled to some factor
% FIRST:
:- format_predicate('S',twiddle(_,_)).
% SECOND:
twiddle(default,A) :- twiddle(25,A).
twiddle(W,N) :-
N1 is round(N/W),
forall(between(1,N1,_),put(126)).
%--------------------------------------
% stuff to simplify printing lists
% scaled to some factor
% FIRST:
:- format_predicate('L',printL(_,_)).
% SECOND:
printL(default,List) :- printL(10^6,List).
printL(TooLong,List) :-
forall((nth1(Pos,List,Item),
Pos < TooLong),
format('\t~w\n',Item)).
|
demos.pl=
% demos.pl
% handle the generic demo stuff
% run the demo predicate, saving output
demos(F) :-
sformat(Out,'~w.out',F),
write(Out),nl,
tell(Out),
format('% output from ~w.pl\n',F),
% never fail
ignore(demo),
told.
% run through all the demo1's
demo :- demo1,fail.
demo.
|
Not © Tim Menzies, 2001
Share and enjoy- information wants to be free.
But if you take anything from this site, please credit tim@menzies.com.
|
|