diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
18c74933af
yap-6.3/library/mapargs.yap
Vitor Santos Costa faf3c930c8 docs
2017-04-07 23:10:59 +01:00

385 lines
13 KiB
Prolog
Raw Blame History

/**
* @file library/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).
Reference in New Issue View Git Blame Copy Permalink