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

changes4.3.html

@@ -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>

docs/yap.tex

@@ -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
 

library/apply_macros.yap

@@ -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).
+