EECE 571F= Domain-Specific Languages  
  
This is a page from yet
another great ECE, UBC subject.
[ Home | Assignments | Lectures |
DSL rules | Articles | Resources ]

Logical Optimization (2)

Lectures:
Old: 1 | 2 | 3 | 4 | 5
New: DCGnums | Parsing | Meta-prolog | Faster1 | Faster2 | Rand-nums
Not done: Abduction | Stochastic abs

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.