yap-6.3/library/mapargs.yap

/**
 * @file   mapargs.yap
 * @author Lawrence Byrd + Richard A. O'Keefe, VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
 * @author : E. Alphonse from code by Joachim Schimpf, Jan Wielemaker, Vitor Santos Costa
 * @date    4 August 1984 and Ken Johnson 11-8-87
 *
 * @brief  Macros to apply a predicate to all sub-terms of a term.
 *
 *
*/


:- module(mapargs,[ mapargs/2,                 % :Goal, +S
		    mapargs/3,                 % :Goal, +S, -S
		    mapargs/4,                 % :Goal, +S, -S1, -S2
		    mapargs/5,                 % :Goal, +S, -S1, -S2, -S3
		    mapargs/6,                 % :Goal, +S, -S1, -S2, -S3, -S4
		    sumargs/4,
		    foldargs/4, 		% :Pred, +S, ?V0, ?V
		    foldargs/5, 		% :Pred, +S, ?S1,  ?V0, ?V
		    foldargs/6, 		% :Pred, +S, ?S1, ?S2, ?V0, ?V
		    foldargs/7	 		% :Pred, +S, ?S1, ?S2, ?S3, ?V0, ?V
                  ]).

/**
* @defgroup mapargs Apply a predicate to all  arguments of a term
* @ingroup library
*/


:- use_module(library(maputils)).
:- use_module(library(lists), [append/3]).

:- meta_predicate
	mapargs(1,+),
	mapargs_args(1,+,+),
	mapargs(2,+,-),
	mapargs_args(2,+,-,+),
	mapargs(3,+,-,-),
	mapargs_args(2,+,-,-,+),
	mapargs(4,+,-,-,-),
	mapargs_args(2,+,-,-,-,+),
	mapargs(5,+,-,-,-,-),
	mapargs_args(2,+,-,-,-,-,+),
	sumargs(3,+,+,-),
	sumargs_args(3,+,+,-,+),
	foldargs(3, +, +, -),
	foldargs(4, +, ?, +, -),
	foldargs(5, +, ?, ?, +, -),
	foldargs(6, +, ?, ?, ?, +, -).


mapargs(Pred, TermIn) :-
    functor(TermIn, _F, N),
    mapargs_args(Pred, TermIn, 0, N).

mapargs_args(Pred, TermIn, I, N) :-
    ( I == N -> true ;
      I1 is I+1,
      arg(I1, TermIn, InArg),
      call(Pred, InArg),
      mapargs_args(Pred, TermIn, I1, N) ).

mapargs(Pred, TermIn, TermOut) :-
    functor(TermIn, F, N),
    functor(TermOut, F, N),
    mapargs_args(Pred, TermIn, TermOut, 0, N).

mapargs_args(Pred, TermIn, TermOut, I, N) :-
    ( I == N -> true ;
      I1 is I+1,
      arg(I1, TermIn, InArg),
      arg(I1, TermOut, OutArg),
      call(Pred, InArg, OutArg),
      mapargs_args(Pred, TermIn, TermOut, I1, N) ).

mapargs(Pred, TermIn, TermOut1, TermOut2) :-
    functor(TermIn, F, N),
    functor(TermOut1, F, N),
    functor(TermOut2, F, N),
    mapargs_args(Pred, TermIn, TermOut1, TermOut2, 0, N).

mapargs_args(Pred, TermIn, TermOut1, TermOut2, I, N) :-
    ( I == N -> true ;
      I1 is I+1,
      arg(I1, TermIn, InArg),
      arg(I1, TermOut1, OutArg1),
      arg(I1, TermOut2, OutArg2),
      call(Pred, InArg, OutArg1, OutArg2),
      mapargs_args(Pred, TermIn, TermOut1, TermOut2, I1, N) ).

mapargs(Pred, TermIn, TermOut1, TermOut2, TermOut3) :-
    functor(TermIn, F, N),
    functor(TermOut1, F, N),
    functor(TermOut2, F, N),
    mapargs_args(Pred, TermIn, TermOut1, TermOut2, TermOut3, 0, N).

mapargs_args(Pred, TermIn, TermOut1, TermOut2, TermOut3, I, N) :-
    ( I == N -> true ;
      I1 is I+1,
      arg(I1, TermIn, InArg),
      arg(I1, TermOut1, OutArg1),
      arg(I1, TermOut2, OutArg2),
      arg(I1, TermOut3, OutArg3),
      call(Pred, InArg, OutArg1, OutArg2, OutArg3),
      mapargs_args(Pred, TermIn, TermOut1, TermOut2, TermOut3, I1, N) ).

mapargs(Pred, TermIn, TermOut1, TermOut2, TermOut3, TermOut4) :-
    functor(TermIn, F, N),
    functor(TermOut1, F, N),
    functor(TermOut2, F, N),
    functor(TermOut3, F, N),
    functor(TermOut4, F, N),
    mapargs_args(Pred, TermIn, TermOut1, TermOut2, TermOut3, TermOut4, 0, N).

mapargs_args(Pred, TermIn, TermOut1, TermOut2, TermOut3, TermOut4, I, N) :-
    ( I == 0 -> true ;
      I1 is I+1,
      arg(I1, TermIn, InArg),
      arg(I1, TermOut1, OutArg1),
      arg(I1, TermOut2, OutArg2),
      arg(I1, TermOut3, OutArg3),
      arg(I1, TermOut4, OutArg4),
      call(Pred, InArg, OutArg1, OutArg2, OutArg3, OutArg4),
      mapargs_args(Pred, TermIn, TermOut1, TermOut2, TermOut3, TermOut4, I1, N) ).

sumargs(Pred, Term, A0, A1) :-
    functor(Term, _, N),
    sumargs(Pred, Term, A0, A1, N).

sumargs_args(_, _, A0, A1, 0) :-
    !,
    A0 = A1.
sumargs_args(Pred, Term, A1, A3, N) :-
    arg(N, Term, Arg),
    N1 is N - 1,
    call(Pred, Arg, A1, A2),
    sumargs_args(Pred, Term, A2, A3, N1).


foldargs(Goal, S, V0, V) :-
	functor(S, _, Ar),
	foldargs_(Goal, S, V0, V, 0, Ar).

foldargs_(Goal, S, V0, V, I, N) :-
	( I == N ->  V0 = V ;
	    I1 is I+1,
	    arg(I1, S, A),
	    call(Goal, A, V0, V1),
	    foldargs_(Goal, S, V1, V, I1, N) ).

foldargs(Goal, S, O1, V0, V) :-
	functor(S, N, Ar),
	functor(O1, N, Ar),
	foldargs_(Goal, S, O1, V0, V, 0, Ar).

foldargs_(Goal, S, O1,  V0, V, I, N) :-
	( I == N ->  V0 = V ;
	    I1 is I+1,
	    arg(I1, S, A),
	    arg(I1, O1, A1),
	    call(Goal, A, A1, V0, V1),
	    foldargs_(Goal, S, O1, V1, V, I1, N) ).

foldargs(Goal, S, O1, O2, V0, V) :-
	functor(S, N, Ar),
	functor(O1, N, Ar),
	functor(O2, N, Ar),
	foldargs_(Goal, S, O1, O2, V0, V, 0, Ar).

foldargs_(Goal, S, O1, O2, V0, V, I, N) :-
	( I == N -> V0 = V ;
	    I1 is I+1,
	    arg(I1, S, A),
	    arg(I1, O1, A1),
	    arg(I1, O2, A2),
	    call(Goal, A, A1, A2, V0, V1),
	    foldargs_(Goal, S, O1, O2, V1, V, I1, N) ).

foldargs(Goal, S, O1, O2, O3, V0, V) :-
	functor(S, N, Ar),
	functor(O1, N, Ar),
	functor(O2, N, Ar),
	functor(O3, N, Ar),
	foldargs_(Goal, S, O1, O2, O3, V0, V, 0, Ar).

foldargs_(Goal, S, O1, O2, O3, V0, V, I, N) :-
	( I == N ->  V0 = V ;
	    I1 is I+1,
	    arg(I1, S, A),
	    arg(I1, O1, A1),
	    arg(I1, O2, A2),
	    arg(I1, O3, A3),
	    call(Goal, A, A1, A2, A3, V0, V1),
	    foldargs_(Goal, S, O1, O2, O3, V1, V, I1, N) ).


goal_expansion(mapargs(Meta, In), (functor(In, _Name, Ar), Mod:Goal)) :-
	goal_expansion_allowed,
	callable(Meta),
	prolog_load_context(module, Mod),
	aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
	!,
	% the new goal
	pred_name(mapargs, 1, Proto, GoalName),
	append(MetaVars, [In, 0, Ar], GoalArgs),
	Goal =.. [GoalName|GoalArgs],
	% the new predicate declaration
	HeadPrefix =.. [GoalName|PredVars],
	% the new predicate declaration
	append_args(HeadPrefix, [In, I, Ar], RecursionHead),
	append_args(Pred, [AIn], Apply),
	append_args(HeadPrefix, [In, I1, Ar], RecursiveCall),
	compile_aux([
		     (RecursionHead :- I == 0 -> true ; I1 is I+1, arg(I1, In, AIn), Apply, RecursiveCall )
		    ], Mod).

goal_expansion(mapargs(Meta, In, Out), (functor(In, Name, Ar), functor(Out, Name, Ar), Mod:Goal)) :-
	goal_expansion_allowed,
	callable(Meta),
	prolog_load_context(module, Mod),
	aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
	!,
	% the new goal
	pred_name(mapargs, 2, Proto, GoalName),
	append(MetaVars, [In, Out, Ar], GoalArgs),
	Goal =.. [GoalName|GoalArgs],
	% the new predicate declaration
	HeadPrefix =.. [GoalName|PredVars],
	% the new predicate declaration
	append_args(HeadPrefix, [In, Out, I], RecursionHead),
	append_args(Pred, [AIn, AOut], Apply),
	append_args(HeadPrefix, [In, Out, I1], RecursiveCall),
	compile_aux([
		     (RecursionHead :- I == 0 -> true ; arg(I, In, AIn), arg(I, Out, AOut), Apply, I1 is I-1, RecursiveCall )
		    ], Mod).

goal_expansion(mapargs(Meta, In, Out1, Out2), (functor(In, Name, Ar), functor(Out1, Name, Ar), functor(Out2, Name, Ar), Mod:Goal)) :-
	goal_expansion_allowed,
	callable(Meta),
	prolog_load_context(module, Mod),
	aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
	!,
	% the new goal
	pred_name(mapargs, 3, Proto, GoalName),
	append(MetaVars, [In, Out1, Out2, Ar], GoalArgs),
	Goal =.. [GoalName|GoalArgs],
	% the new predicate declaration
	HeadPrefix =.. [GoalName|PredVars],
	% the new predicate declaration
	append_args(HeadPrefix, [In, Out1, Out2, I], RecursionHead),
	append_args(Pred, [AIn, AOut1, AOut2], Apply),
	append_args(HeadPrefix, [In, Out1, Out2, I1], RecursiveCall),
	compile_aux([
		     (RecursionHead :- I == 0 -> true ; arg(I, In, AIn), arg(I, Out1, AOut1), arg(I, Out2, AOut2), Apply, I1 is I-1, RecursiveCall )
		    ], Mod).

goal_expansion(mapargs(Meta, In, Out1, Out2, Out3), (functor(In, Name, Ar), functor(Out1, Name, Ar), functor(Out3, Name, Ar), Mod:Goal)) :-
	goal_expansion_allowed,
	callable(Meta),
	prolog_load_context(module, Mod),
	aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
	!,
	% the new goal
	pred_name(mapargs, 4, Proto, GoalName),
	append(MetaVars, [In, Out1, Out2, Out3, Ar], GoalArgs),
	Goal =.. [GoalName|GoalArgs],
	% the new predicate declaration
	HeadPrefix =.. [GoalName|PredVars],
	% the new predicate declaration
	append_args(HeadPrefix, [In, Out1, Out2, Out3, I], RecursionHead),
	append_args(Pred, [AIn, AOut1, AOut2, AOut3], Apply),
	append_args(HeadPrefix, [In, Out1, Out2, Out3, I1], RecursiveCall),
	compile_aux([
		     (RecursionHead :- I == 0 -> true ; arg(I, In, AIn), arg(I, Out1, AOut1), arg(I, Out2, AOut2), arg(I, Out3, AOut3), Apply, I1 is I-1, RecursiveCall )
		    ], Mod).

goal_expansion(mapargs(Meta, In, Out1, Out2, Out3, Out4), (functor(In, Name, Ar), functor(Out1, Name, Ar), functor(Out3, Name, Ar), functor(Out4, Name, Ar), Mod:Goal)) :-
	goal_expansion_allowed,
	callable(Meta),
	prolog_load_context(module, Mod),
	aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
	!,
	% the new goal
	pred_name(mapargs, 4, Proto, GoalName),
	append(MetaVars, [In, Out1, Out2, Out3, Out4, Ar], GoalArgs),
	Goal =.. [GoalName|GoalArgs],
	% the new predicate declaration
	HeadPrefix =.. [GoalName|PredVars],
	% the new predicate declaration
	append_args(HeadPrefix, [In, Out1, Out2, Out3, Out4, I], RecursionHead),
	append_args(Pred, [AIn, AOut1, AOut2, AOut3, AOut4], Apply),
	append_args(HeadPrefix, [In, Out1, Out2, Out3, Out4, I1], RecursiveCall),
	compile_aux([
		     (RecursionHead :- I == 0 -> true ; arg(I, In, AIn), arg(I, Out1, AOut1), arg(I, Out2, AOut2), arg(I, Out3, AOut3), arg(I, Out4, AOut4), Apply, I1 is I-1, RecursiveCall )
		    ], Mod).

goal_expansion(sumargs(Meta, Term, AccIn, AccOut), Mod:Goal) :-
	goal_expansion_allowed,
	prolog_load_context(module, Mod),
	Goal = (
		 Term =.. [_|TermArgs],
		 sumlist(Meta, TermArgs, AccIn, AccOut)
	       ).

goal_expansion(foldargs(Meta, In, Acc0, AccF), (functor(In, _Name, Ar), Mod:Goal)) :-
	goal_expansion_allowed,
	callable(Meta),
	prolog_load_context(module, Mod),
	aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
	!,
	% the new goal
	pred_name(foldargs, 1, Proto, GoalName),
	append(MetaVars, [In, Acc0, AccF, 0, Ar], GoalArgs),
	Goal =.. [GoalName|GoalArgs],
	% the new predicate declaration
	HeadPrefix =.. [GoalName|PredVars],
	% the new predicate declaration
	append_args(HeadPrefix, [In, VAcc0, VAccF, I, Ar], RecursionHead),
	append_args(Pred, [AIn, VAcc0, VAccI], Apply),
	append_args(HeadPrefix, [In, VAccI, VAccF, I1, Ar], RecursiveCall),
	compile_aux([
		     (RecursionHead :- I == Ar -> VAcc0 = VAccF ; I1 is I+1, arg(I1, In, AIn), Apply, RecursiveCall )
		    ], Mod).

goal_expansion(foldargs(Meta, In, Out1, Acc0, AccF), (functor(In, Name, Ar), functor(Out1, Name, Ar), Mod:Goal)) :-
	goal_expansion_allowed,
	callable(Meta),
	prolog_load_context(module, Mod),
	aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
	!,
	% the new goal
	pred_name(foldargs, 2, Proto, GoalName),
	append(MetaVars, [In, Out1, Acc0, AccF, 0, Ar], GoalArgs),
	Goal =.. [GoalName|GoalArgs],
	% the new predicate declaration
	HeadPrefix =.. [GoalName|PredVars],
	% the new predicate declaration
	append_args(HeadPrefix, [In, Out1, VAcc0, VAccF, I, Ar], RecursionHead),
	append_args(Pred, [AIn, AOut1, VAcc0, VAccI], Apply),
	append_args(HeadPrefix, [In, Out1, VAccI, VAccF, I1, Ar], RecursiveCall),
	compile_aux([
		     (RecursionHead :- I == Ar -> VAcc0 = VAccF ; I1 is I+1, arg(I1, In, AIn), arg(I1, Out1, AOut1), Apply, RecursiveCall )
		    ], Mod).

goal_expansion(foldargs(Meta, In, Out1, Out2, Acc0, AccF), (functor(In, Name, Ar), functor(Out1, Name, Ar), functor(Out2, Name, Ar), Mod:Goal)) :-
	goal_expansion_allowed,
	callable(Meta),
	prolog_load_context(module, Mod),
	aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
	!,
	% the new goal
	pred_name(foldargs, 3, Proto, GoalName),
	append(MetaVars, [In, Out1, Out2, Acc0, AccF, 0, Ar], GoalArgs),
	Goal =.. [GoalName|GoalArgs],
	% the new predicate declaration
	HeadPrefix =.. [GoalName|PredVars],
	% the new predicate declaration
	append_args(HeadPrefix, [In, Out1, Out2, VAcc0, VAccF, I, Ar], RecursionHead),
	append_args(Pred, [AIn, AOut1, AOut2, VAcc0, VAccI], Apply),
	append_args(HeadPrefix, [In, Out1, Out2, VAccI, VAccF, I1, Ar], RecursiveCall),
	compile_aux([
		     (RecursionHead :- I == Ar -> VAcc0 = VAccF ; I1 is I+1, arg(I1, In, AIn), arg(I1, Out1, AOut1), arg(I1, Out2, AOut2), Apply, RecursiveCall )
		    ], Mod).

goal_expansion(foldargs(Meta, In, Out1, Out2, Out3, Acc0, AccF), (functor(In, Name, Ar), functor(Out1, Name, Ar), functor(Out2, Name, Ar), functor(Out3, Name, Ar), Mod:Goal)) :-
	goal_expansion_allowed,
	callable(Meta),
	prolog_load_context(module, Mod),
	aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
	!,
	% the new goal
	pred_name(foldargs, 4, Proto, GoalName),
	append(MetaVars, [In, Out1, Out2, Out3, Acc0, AccF, 0, Ar], GoalArgs),
	Goal =.. [GoalName|GoalArgs],
	% the new predicate declaration
	HeadPrefix =.. [GoalName|PredVars],
	% the new predicate declaration
	append_args(HeadPrefix, [In, Out1, Out2, Out3, VAcc0, VAccF, I, Ar], RecursionHead),
	append_args(Pred, [AIn, AOut1, AOut2, AOut3, VAcc0, VAccI], Apply),
	append_args(HeadPrefix, [In, Out1, Out2, Out3, VAccI, VAccF, I1, Ar], RecursiveCall),
	compile_aux([
		     (RecursionHead :- I == Ar -> VAcc0 = VAccF ; I1 is I+1, arg(I1, In, AIn), arg(I1, Out1, AOut1), arg(I1, Out2, AOut2), arg(I1, Out3, AOut3), Apply, RecursiveCall )
		    ], Mod).