/*basic Basic utilities for PRESS (to be compiled) Alan Bundy 31.1.80 */ /*service routines (for util?)*/ /*convert lists to conjunctions*/ dottoand([],true) :- !. dottoand([Hd|Tl],Hd&Rest) :- dottoand(Tl,Rest), !. /*convert conjunctions to lists*/ andtodot(true,[]) :- !. andtodot(Hd&Tl,[Hd|Rest]) :- !, andtodot(Tl,Rest). andtodot(Exp,[Exp]) :- !. /*some element of list has property*/ some(Prop,[Hd | Tl]) :- apply(Prop,[Hd]), !. some(Prop,[Hd | Tl]) :- some(Prop,Tl), !. /*Exp is a least dominating expression of X (i.e. 2 args contain X)*/ least_dom(X,Exp) :- Exp=..[F|Args], sublist(contains(X),Args,XArgs), length(XArgs,N), N>1, !. /*****************************************/ /* PATTERN MATCHER*/ /*****************************************/ /* Rewrite Old into New */ rewrite(Rule,Old,New) :- functor(Old,Sym,Arity), functor(Lhs,Sym,Arity), apply(Rule,[Lhs,Rhs]), apply_rule(Old,Lhs,Rhs,New). /* Apply rule Lhs => Rhs to Old to produce New */ apply_rule(O1+O2,L1+L2,R,N) :- !, decomp(O1+O2,[+|Os]), split2ways(Os,[C1|Cs1],[B|Bs]), split2ways([B|Bs],[C2|Cs2],Ns), recomp(D1,[+,C1|Cs1]), recomp(D2,[+,C2|Cs2]), match(D1,L1), match(D2,L2), recomp(N,[+,R|Ns]). apply_rule(O1*O2,L1*L2,R,N) :- !, decomp(O1*O2,[*|Os]), split2ways(Os,[C1|Cs1],[B|Bs]), split2ways([B|Bs],[C2|Cs2],Ns), recomp(D1,[*,C1|Cs1]), recomp(D2,[*,C2|Cs2]), match(D1,L1), match(D2,L2), recomp(N,[*,R|Ns]). apply_rule(O,L,N,N) :- match(O,L). /*Negative Numbers Hack*/ match(NN,-N) :- integer(NN), NN<0, N is -NN, !. match(-N,NN) :- integer(NN), NN<0, N is -NN, !. /* BUILT-IN COMMUTATIVITY AND ASSOCIATIVITY OF + AND */ match(A1+A2, U1+U2) :- decomp(A1+A2,[+|As]), split2ways(As,[B1|Bs1],[B2|Bs2]), recomp(C1,[+,B1|Bs1]), recomp(C2,[+,B2|Bs2]), match(C1,U1), match(C2,U2). match(A1*A2, U1*U2) :- decomp(A1*A2,[*|As]), split2ways(As,[B1|Bs1],[B2|Bs2]), recomp(C1,[*,B1|Bs1]), recomp(C2,[*,B2|Bs2]), match(C1,U1), match(C2,U2). /* Unify if X is atomic */ match(X,X) :- atomic(X), !. /* MATCH ARGUMENTS OF OTHER DOMINANT FUNCTION SYMBOLS*/ match(X,Y) :- functor(X,F,Arity), functor(Y,F,Arity), X=..[F|As], Y=..[F|Bs], maplist(match,As,Bs). /* Split bag into 2 parts */ split2ways([],[],[]). split2ways([Hd|Tl],L1,R1) :- split2ways(Tl,L,R), add_to_one(Hd,L,R,L1,R1). /* Add Hd to one of L or R */ add_to_one(Hd,L,R,[Hd|L],R). add_to_one(Hd,L,R,L,[Hd|R]). /*****************************************/ /* DECOMPOSITION AND RECOMPOSITION OF EXPRESSIONS*/ /*****************************************/ /* DECOMP AND RECOMP ARE GENERALISATIONS OF UNIV TREATING +, *, & and # */ /* AS FUNCTION SYMBOLS HAVING ANY NUMBER OF ARGUMENTS*/ decomp(E+(X+Y),L) :- !, decomp(E+X+Y,L). decomp(E+X+Y,[+,Y|L]) :- !, decomp(E+X,[+|L]). decomp(E+X,[+,X,E]) :- !. decomp(X*(Y*E),L) :- !, decomp(X*Y*E,L). decomp(E*X*Y,[*,Y|L]) :- !, decomp(E*X,[*|L]). decomp(Y*E,[*,Y,E]) :- !. decomp((E&X)&Y,L) :- !, decomp(E&X&Y,L). decomp(Y&E&X,[&,Y|L]) :- !, decomp(E&X,[&|L]). decomp(X&E,[&,X,E]) :- !. decomp((E#X)#Y,L) :- !, decomp(E#X#Y,L). decomp(Y#E#X,[#,Y|L]) :- !, decomp(E#X,[#|L]). decomp(X#E,[#,X,E]) :- !. decomp(E,F) :- E=..F, !. recomp(E,[+,E]) :- !. recomp(E+X,[+,X|L]) :- !, recomp(E,[+|L]). recomp(0,[+]) :- !. recomp(E,[*,E]) :- !. recomp(E*X,[*,X|L]) :- !, recomp(E,[*|L]). recomp(1,[*]) :- !. recomp(E,[&,E]) :- !. recomp(X&E,[&,X|L]) :- !, recomp(E,[&|L]). recomp(true,[&]) :- !. recomp(E,[#,E]) :- !. recomp(X#E,[#,X|L]) :- !, recomp(E,[#|L]). recomp(false,[#]) :- !. recomp(E,F) :- E=..F, !. /*********************************************/ /* MISCELLANEOUS ROUTINES*/ /*********************************************/ freeof(X,E) :- occ(X,E,0), !. singleocc(X,E) :- occ(X,E,1), !. contains(X,E) :- not occ(X,E,0), !. /*closeness of all occurences of x in exp is num*/ closeness(X,Exp,Num) :- findall(Path,position(X,Exp,Path),Paths), closeness(Paths,Num), !. /*closeness of occurences defined by paths is c*/ closeness(Paths,C) :- split(Paths,Top,Groups), maplist(size,Groups,Sizes), sumlist(Sizes,C), !. /*size of tree defined by paths is size*/ size(Paths,Size) :- split(Paths,Top,Groups), maplist(size,Groups,Sizes), sumlist(Sizes,S), length(Top,T), Size is S+T, !. /*split tree defined by paths into common top and groups of remaining subtrees where each group has common top*/ split([],[],[]) :- !. split([Path],Path,[]) :- !. split(Paths,[F|Rest],Groups) :- maplist(cons(F),Rests,Paths), !, split(Rests,Rest,Groups). split(Paths,[],Groups) :- group(Paths,Groups), !. /*partition tree defined by paths into groups of subtrees which start the same*/ group([],[]) :- !. group([[F|Rest]|Paths], [[[F|Rest]|Group]|Groups]) :- sublist(hd(F),Paths,Group), subtract(Paths,Group,Others), group(Others,Groups), !. /*Head and Cons*/ hd(F,[F|Rest]) :- !. cons(F,Rest,[F|Rest]) :- !. /*X occurs in E at a position definded by path*/ position(X,E,[]):- E=..[X|Args]. position(X,E,L):- argn(N,E,T), L=[N|L1], position(X,T,L1). /* X is the nth member of the list*/ nmember(X,[X|_],1). nmember(X,[_|L],N):- nmember(X,L,M),N is M+1. /* x is the nth argument of t*/ argn(N,T,X):-T=..[_|L],nmember(X,L,N). /*Add up all numbers in list*/ sumlist([],0) :- !. sumlist([Hd|Tl],Sum) :- sumlist(Tl,TlSum), Sum is Hd+TlSum, !. /* GENERATE IDENTIFIERS DENOTING ARBITRARY INTEGERS*/ arbint(N) :- gensym(n,N), trace('\twhere %t denotes an arbitrary integer.\n',[N],1), assert(integral(N)), !. identifier(Id) :- gensym(x,Id), assert(intermediate(Id)), !. subterm(T,E) :- E=..[_|As], member(A,As), subterm(T,A). subterm(E,E) . /*****************************************/ /* LIST PROCESSING put in usvw*/ /*****************************************/ twofrom(L,X,Y,Rem) :- select(X,L,R), select(Y,R,Rem). any1(P,[X|Xs],[Y|Xs]) :- apply(P,[X,Y]). any1(P,[X|Xs],[X|Ys]) :- any1(P,Xs,Ys). /*apply procedure recursively*/ recurse(Proc,Old,New) :- Old=..[Sym|Args], maplist(Proc,Args,Nargs), New=..[Sym|Nargs], !. /*apply Proc to Exp to get New*/ try_rewrite(Proc,Old,New) :- apply(Proc,[Old,New]), !. try_rewrite(Proc,Old,Old) :- !. /* Version of rewrite using matcher */ try_rewrite2(Proc,Old,New) :- rewrite(Proc,Old,Exp), !, try_rewrite2(Proc,Exp,New). try_rewrite2(Proc,Old,Old) :- !.