Erick Alphonse's Eclipse style apply macro library

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@138 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2001-08-09 18:00:45 +00:00
parent 2da8c719a3
commit 5384e3b4d7
3 changed files with 386 additions and 5 deletions

View File

@ -16,6 +16,7 @@
<h2>Yap-4.3.20:</h2>
<ul>
<li>NEW: Erik Alphonse's apply_macros library.</li>
<li>FIXED: ord_del_element/3 (Nicos Angelopoulos).</li>
<li>FIXED: texinfo warnings (Stasinos).</li>
<li>FIXED: under emacs/win32: prompt if $EMACS=t and buf NULL.</li>

View File

@ -209,10 +209,11 @@ Subnodes of Database
* BlackBoard:: Storing and Fetching Terms in the BlackBoard
Subnodes of Library
* Association Lists:: Binary Tree Implementation of Association Lists
* Apply Macros:: Apply a Predicate to a list or to sub-terms.
* Association Lists:: Binary Tree Implementation of Association Lists.
* AVL Trees:: Predicates to add and lookup balanced binary trees.
* Heaps:: Labelled binary tree where the key of each node is less
than or equal to the keys of its sons
than or equal to the keys of its children.
* Lists:: List Manipulation
* Ordered Sets:: Ordered Set Manipulation
* Pseudo Random:: Pseudo Random Numbers
@ -6271,10 +6272,11 @@ most files in the library are from the Edinburgh Prolog library.
@menu
Library, Extensions, Builtins, Top
* Association Lists:: Binary Tree Implementation of Association Lists
* Apply Macros:: Apply a Predicate to a list or to sub-terms.
* Association Lists:: Binary Tree Implementation of Association Lists.
* AVL Trees:: Predicates to add and lookup balanced binary trees.
* Heaps:: Labelled binary tree where the key of each node is less
than or equal to the keys of its sons
than or equal to the keys of its children.
* Lists:: List Manipulation
* Ordered Sets:: Ordered Set Manipulation
* Pseudo Random:: Pseudo Random Numbers
@ -6292,7 +6294,124 @@ Library, Extensions, Builtins, Top
@end menu
@node Association Lists, AVL Trees, , Library
@node Apply Macros, Association Trees, , Library
@section Apply Macros
@cindex macros
This library provides a set of utilities to apply a predicate to all
elements of a list or to all sub-terms of a term. They allow one to
easily perform the most common do-loop constructs in Prolog. To avoid
performance degradation due to @code{apply/2}, each call creates an
equivalent Prolog program, without meta-calls, which is executed by the
Prolog engine instead. Note that if the equivalent Prolog program
already exists, it will be simply used.
The following routines are available once included with the
@code{use_module(library(apply_macros))} command.
@table @code
@item maplist(+@var{Pred}, ?@var{ListIn}, ?@var{ListOut})
@findex maplist/3
@snindex maplist/3
@cnindex maplist/3
Creates @var{ListOut} by applying the predicate @var{Pred} to all
elements of @var{ListIn}.
@item checklist(+@var{Pred}, +@var{List})
@findex checklist/2
@snindex checklist/2
@cnindex checklist/2
Succeeds if the predicate @var{Pred} succeeds on all elements of @var{List}.
@item selectlist(+@var{Pred}, +@var{ListIn}, ?@var{ListOut})
@findex selectlist/3
@snindex selectlist/3
@cnindex selectlist/3
Creates @var{ListOut} of all list elements of @var{ListIn} that pass a given test
@item convlist(+@var{Pred}, +@var{ListIn}, ?@var{ListOut})
@findex convlist/3
@snindex convlist/3
@cnindex convlist/3
A combination of maplist and selectlist: creates @var{ListOut} by
applying the predicate @var{Pred} to all list elements on which
@var{Pred} succeeds
@item sumlist(+@var{Pred}, +@var{List}, ?@var{AccIn}, ?@var{AccOut})
@findex sumlist/4
@snindex sumlist/4
@cnindex sumlist/4
Calls @var{Pred} on all elements of List and collects a result in
@var{Accumulator}.
@item mapargs(+@var{Pred}, ?@var{TermIn}, ?@var{TermOut})
@findex mapargs/3
@snindex mapargs/3
@cnindex mapargs/3
Creates @var{TermOut} by applying the predicate @var{Pred} to all
arguments of @var{TermIn}
@item sumargs(+@var{Pred}, +@var{Term}, ?@var{AccIn}, ?@var{AccOut})
@findex sumargs/3
@snindex sumargs/3
@cnindex sumargs/3
Calls the predicate @var{Pred} on all arguments of @var{Term} and collects a
result in @var{Accumulator}
@item mapnodes(+@var{Pred}, +@var{TermIn}, ?@var{TermOut})
@findex mapnodes/3
@snindex mapnodes/3
@cnindex mapnodes/3
Creates @var{TermOut} by applying the predicate @var{Pred}
to all sub-terms of @var{TermIn} (depth-first and left-to-right order)
@item checknodes(+@var{Pred}, +@var{Term})
@findex checknodes/3
@snindex checknodes/3
@cnindex checknodes/3
Succeeds if the predicate @var{Pred} succeeds on all sub-terms of
@var{Term} (depth-first and left-to-right order)
@item sumnodes(+@var{Pred}, +var{Term}, ?@var{AccIn}, ?@var{AccOut})
@findex sumnodes/3
@snindex sumnodes/3
@cnindex sumnodes/3
Calls the predicate @var{Pred} on all sub-terms of @var{Term} and
collect a result in @var{Accumulator} (depth-first and left-to-right order)
@end table
Examples:
@example
%given
plus(X,Y,Z) :- Z is X + Y.
plus_if_pos(X,Y,Z) :- Y > 0, Z is X + Y.
vars(X, Y, [X|Y]) :- var(X), !.
vars(_, Y, Y).
trans(TermIn, TermOut) :-
(compound(TermIn) ; atom(TermIn)),
TermIn =.. [p|Args],
TermOut =..[q|Args],
!.
trans(X,X).
%success
maplist(plus(1), [1,2,3,4], [2,3,4,5]).
checklist(var, [X,Y,Z]).
selectlist(<(0), [-1,0,1], [1]).
convlist(plus_if_pos(1), [-1,0,1], [2]).
sumlist(plus, [1,2,3,4], 1, 11).
mapargs(number_atom,s(1,2,3), s('1','2','3')).
sumargs(vars, s(1,X,2,Y), [], [Y,X]).
mapnodes(trans, p(a,p(b,a),c), q(a,q(b,a),c)).
checknodes(\==(T), p(X,p(Y,X),Z)).
sumnodes(vars, [c(X), p(X,Y), q(Y)], [], [Y,Y,X,X]).
% another one
maplist(mapargs(number_atom),[c(1),s(1,2,3)],[c('1'),s('1','2','3')]).
@end example
@node Association Lists, AVL Trees, Apply Macros, Library
@section Association Lists
@cindex association list

261
library/apply_macros.yap Normal file
View File

@ -0,0 +1,261 @@
:- module(apply_macros, []).
:- multifile user:goal_expansion/3.
:- use_module(library(lists), [append/3]).
:- use_module(library(charsio), [format_to_chars/3, read_from_chars/2]).
user:goal_expansion(maplist(Meta, ListIn, ListOut), Module, Goal) :-
callable(Meta),
!,
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
% the new goal
pred_name(maplist, Proto, GoalName),
append(MetaVars, [ListIn, ListOut], GoalArgs),
Goal =.. [GoalName|GoalArgs],
% the new predicate declaration
HeadPrefix =.. [GoalName|PredVars],
append_args(HeadPrefix, [[], []], Base),
append_args(HeadPrefix, [[In|Ins], [Out|Outs]], RecursionHead),
append_args(Pred, [In, Out], Apply),
append_args(HeadPrefix, [Ins, Outs], RecursiveCall),
compile_aux([
Base,
(RecursionHead :- Apply, RecursiveCall)
], Module).
user:goal_expansion(checklist(Meta, List), Module, Goal) :-
callable(Meta),
!,
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
% the new goal
pred_name(checklist, Proto, GoalName),
append(MetaVars, [List], GoalArgs),
Goal =.. [GoalName|GoalArgs],
% the new predicate declaration
HeadPrefix =.. [GoalName|PredVars],
append_args(HeadPrefix, [[]], Base),
append_args(HeadPrefix, [[In|Ins]], RecursionHead),
append_args(Pred, [In], Apply),
append_args(HeadPrefix, [Ins], RecursiveCall),
compile_aux([
Base,
(RecursionHead :- Apply, RecursiveCall)
], Module).
user:goal_expansion(selectlist(Meta, ListIn, ListOut), Module, Goal) :-
callable(Meta),
!,
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
% the new goal
pred_name(selectlist, Proto, GoalName),
append(MetaVars, [ListIn, ListOut], GoalArgs),
Goal =.. [GoalName|GoalArgs],
% the new predicate declaration
HeadPrefix =.. [GoalName|PredVars],
append_args(HeadPrefix, [[], []], Base),
append_args(HeadPrefix, [[In|Ins], Outs], RecursionHead),
append_args(Pred, [In], Apply),
append_args(HeadPrefix, [Ins, NOuts], RecursiveCall),
compile_aux([
Base,
(RecursionHead :-
(Apply -> Outs = [In|NOuts]; Outs = NOuts),
RecursiveCall)
], Module).
user:goal_expansion(convlist(Meta, ListIn, ListOut), Module, Goal) :-
callable(Meta),
!,
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
% the new goal
pred_name(convlist, Proto, GoalName),
append(MetaVars, [ListIn, ListOut], GoalArgs),
Goal =.. [GoalName|GoalArgs],
% the new predicate declaration
HeadPrefix =.. [GoalName|PredVars],
append_args(HeadPrefix, [[], []], Base),
append_args(HeadPrefix, [[In|Ins], Outs], RecursionHead),
append_args(Pred, [In, Out], Apply),
append_args(HeadPrefix, [Ins, NOuts], RecursiveCall),
compile_aux([
Base,
(RecursionHead :-
(Apply -> Outs = [Out|NOuts]; Outs = NOuts),
RecursiveCall)
], Module).
user:goal_expansion(sumlist(Meta, List, AccIn, AccOut), Module, Goal) :-
callable(Meta),
!,
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
% the new goal
pred_name(sumlist, Proto, GoalName),
append(MetaVars, [List, AccIn, AccOut], GoalArgs),
Goal =.. [GoalName|GoalArgs],
% the new predicate declaration
HeadPrefix =.. [GoalName|PredVars],
append_args(HeadPrefix, [[], Acc, Acc], Base),
append_args(HeadPrefix, [[In|Ins], Acc1, Acc2], RecursionHead),
append_args(Pred, [In, Acc1, Acc3], Apply),
append_args(HeadPrefix, [Ins, Acc3, Acc2], RecursiveCall),
compile_aux([
Base,
(RecursionHead :- Apply, RecursiveCall)
], Module).
user:goal_expansion(mapargs(Meta, In, Out), Module, NewGoal) :-
( var(Out)
->
NewGoal = (
In =.. [F|InArgs],
maplist(Meta, InArgs, OutArgs),
Out =.. [F|OutArgs]
)
;
NewGoal = (
Out =.. [F|OutArgs],
maplist(Meta, InArgs, OutArgs),
In =.. [F|InArgs]
)
).
user:goal_expansion(sumargs(Meta, Term, AccIn, AccOut), Module, Goal) :-
Goal = (
Term =.. [_|TermArgs],
sumlist(Meta, TermArgs, AccIn, AccOut)
).
user:goal_expansion(mapnodes(Meta, InTerm, OutTerm), Module, Goal) :-
callable(Meta),
!,
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
% the new goal
pred_name(mapnodes, Proto, GoalName),
append(MetaVars, [[InTerm], [OutTerm]], GoalArgs),
Goal =.. [GoalName|GoalArgs],
% the new predicate declaration
HeadPrefix =.. [GoalName|PredVars],
append_args(HeadPrefix, [[], []], Base),
append_args(HeadPrefix, [[In|Ins], [Out|Outs]], RecursionHead),
append_args(Pred, [In, Temp], Apply),
append_args(HeadPrefix, [InArgs, OutArgs], SubRecursiveCall),
append_args(HeadPrefix, [Ins, Outs], RecursiveCall),
compile_aux([
Base,
(RecursionHead :-
Apply,
(compound(Temp)
->
Temp =.. [F|InArgs],
SubRecursiveCall,
Out =.. [F|OutArgs]
;
Out = Temp
),
RecursiveCall)
], Module).
user:goal_expansion(checknodes(Meta, Term), Module, Goal) :-
callable(Meta),
!,
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
% the new goal
pred_name(checknodes, Proto, GoalName),
append(MetaVars, [[Term]], GoalArgs),
Goal =.. [GoalName|GoalArgs],
% the new predicate declaration
HeadPrefix =.. [GoalName|PredVars],
append_args(HeadPrefix, [[]], Base),
append_args(HeadPrefix, [[In|Ins]], RecursionHead),
append_args(Pred, [In], Apply),
append_args(HeadPrefix, [Args], SubRecursiveCall),
append_args(HeadPrefix, [Ins], RecursiveCall),
compile_aux([
Base,
(RecursionHead :-
Apply,
(compound(In)
->
In =.. [_|Args],SubRecursiveCall
;
true
),
RecursiveCall)
], Module).
user:goal_expansion(sumnodes(Meta, Term, AccIn, AccOut), Module, Goal) :-
callable(Meta),
!,
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
% the new goal
pred_name(sumnodes, Proto, GoalName),
append(MetaVars, [[Term], AccIn, AccOut], GoalArgs),
Goal =.. [GoalName|GoalArgs],
% the new predicate declaration
HeadPrefix =.. [GoalName|PredVars],
append_args(HeadPrefix, [[], Acc, Acc], Base),
append_args(HeadPrefix, [[In|Ins], Acc1, Acc2], RecursionHead),
append_args(Pred, [In, Acc1, Acc3], Apply),
append_args(HeadPrefix, [Args, Acc3, Acc4], SubRecursiveCall),
append_args(HeadPrefix, [Ins, Acc4, Acc2], RecursiveCall),
compile_aux([
Base,
(RecursionHead :-
Apply,
(compound(In)
->
In =.. [_|Args],SubRecursiveCall
;
Acc3 = Acc4
),
RecursiveCall)
], Module).
%%%%%%%%%%%%%%%%%%%%
% utilities
%%%%%%%%%%%%%%%%%%%%
compile_aux([Clause|Clauses], Module) :-
% compile the predicat declaration if needed
( Clause = (Head :- _)
; Clause = Head ),
!,
functor(Head, F, N),
( current_predicate(Module:F/N)
->
true
;
% format("*** Creating auxiliary predicate ~q~n", [F/N]),
% checklist(portray_clause, [Clause|Clauses]),
compile_term([Clause|Clauses], Module)
).
compile_term([], _).
compile_term([Clause|Clauses], Module) :-
assert_static(Module:Clause),
compile_term(Clauses, Module).
append_args(Term, Args, NewTerm) :-
Term =.. [Meta|OldArgs],
append(OldArgs, Args, GoalArgs),
NewTerm =.. [Meta|GoalArgs].
aux_preds(Meta, MetaVars, Pred, PredVars, Proto) :-
Meta =.. [F|Args],
aux_args(Args, MetaVars, PredArgs, PredVars, ProtoArgs),
Pred =.. [F|PredArgs],
Proto =.. [F|ProtoArgs].
aux_args([], [], [], [], []).
aux_args([Arg|Args], [Arg|MVars], [PVar|PArgs], [PVar|PVars], ['_'|ProtoArgs]) :-
var(Arg),
!,
aux_args(Args, MVars, PArgs, PVars, ProtoArgs).
aux_args([Arg|Args], MVars, [Arg|PArgs], PVars, [Arg|ProtoArgs]) :-
aux_args(Args, MVars, PArgs, PVars, ProtoArgs).
pred_name(Macro, Proto, Name) :-
format_to_chars("'~a(~w)'.",[Macro, Proto], Chars),
read_from_chars(Chars, Name).