include mapargs as separate support
This commit is contained in:
Vítor Santos Costa
parent
efddaab558
commit
dd17f5a3aa
54
library/examples/mapargs.yap
Normal file
54
library/examples/mapargs.yap
Normal file
@ -0,0 +1,54 @@
|
|||||||
|
|
||||||
|
:- use_module(library(mapargs)).
|
||||||
|
|
||||||
|
ds(X,Y,Z) :- Y is 2*X, Z is X*X.
|
||||||
|
|
||||||
|
double(X,Y) :- Y is 2*X.
|
||||||
|
|
||||||
|
square(X,Y) :- Y is X*X.
|
||||||
|
|
||||||
|
plus2(X,Y,Z,A) :- A is X+Y+Z.
|
||||||
|
|
||||||
|
t1(X,Y) :- mapargs(double, X, Y).
|
||||||
|
|
||||||
|
t1 :- t1(a(1,2,3,4,5),S), writeln(S).
|
||||||
|
|
||||||
|
t2(G, X,Y) :- mapargs(G, X, Y).
|
||||||
|
|
||||||
|
t2 :- t2(double, a(1,2,3,4,5),S), writeln(S).
|
||||||
|
|
||||||
|
|
||||||
|
t3(X,Y,Z) :- mapargs(ds, X, Y, Z).
|
||||||
|
|
||||||
|
t3 :- t3(a(1,2,3,4,5),S,T), writeln(S:T).
|
||||||
|
|
||||||
|
|
||||||
|
t4(G, X,Y,Z) :- mapargs(G, X, Y, Z).
|
||||||
|
|
||||||
|
t4 :- t4(ds, a(1,2,3,4,5),S,T), writeln(S:T).
|
||||||
|
|
||||||
|
t5(X) :- mapargs(integer, X).
|
||||||
|
|
||||||
|
t5 :- t5(a(1,2,3,4,5)), writeln(ok).
|
||||||
|
|
||||||
|
t6(G, X) :- mapargs(G, X).
|
||||||
|
|
||||||
|
t6 :- t6(integer, a(1,2,3,4,5)), writeln(ok).
|
||||||
|
|
||||||
|
t7(X, S) :- foldargs(plus, X, 0, S).
|
||||||
|
|
||||||
|
t7 :- t7(a(1,2,3,4,5), S), writeln(S).
|
||||||
|
|
||||||
|
t8(G, X, S) :- foldargs(G, X, 0, S).
|
||||||
|
|
||||||
|
t8 :- t8(plus, a(1,2,3,4,5), S), writeln(S).
|
||||||
|
|
||||||
|
|
||||||
|
t9(X, Y, S) :- foldargs(plus2, X, Y, 0, S).
|
||||||
|
|
||||||
|
t9 :- t9(a(1,2,3,4,5), a(1,2,3,4,5), S), writeln(S).
|
||||||
|
|
||||||
|
t10(G, X, Y, S) :- foldargs(plus2, X, Y, 0, S).
|
||||||
|
|
||||||
|
t10 :- t10(plus2, a(1,2,3,4,5), a(1,2,3,4,5), S), writeln(S).
|
||||||
|
|
||||||
381
library/mapargs.yap
Normal file
381
library/mapargs.yap
Normal file
@ -0,0 +1,381 @@
|
|||||||
|
% Also has code from:
|
||||||
|
% File : APPLIC.PL
|
||||||
|
% Author : Lawrence Byrd + Richard A. O'Keefe
|
||||||
|
% Updated: 4 August 1984 and Ken Johnson 11-8-87
|
||||||
|
% Purpose: Various "function" application routines based on apply/2.
|
||||||
|
% Needs : append/3 from listut.pl
|
||||||
|
|
||||||
|
|
||||||
|
% File : apply_macros.yap
|
||||||
|
% Author : E. Alphonse from code by Joachim Schimpf, Jan Wielemaker, Vitor Santos Costa
|
||||||
|
% Purpose: Macros to apply a predicate to all elements
|
||||||
|
% of a list or 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
|
||||||
|
]).
|
||||||
|
|
||||||
|
:- 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 -> true ;
|
||||||
|
I1 is I+1,
|
||||||
|
arg(I1, S, A),
|
||||||
|
call(Goal, A, V0, V1),
|
||||||
|
foldargs_(Goal, S, V1, V, I, 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 -> true ;
|
||||||
|
I1 is I+1,
|
||||||
|
arg(I1, S, A),
|
||||||
|
arg(I1, O1, A1),
|
||||||
|
call(Goal, A, A1, V0, V1),
|
||||||
|
foldargs_(Goal, S, O1, V1, V, I, 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 -> true ;
|
||||||
|
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, I, 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 -> true ;
|
||||||
|
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, I, 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).
|
||||||
|
|
||||||
89
library/maputils.yap
Normal file
89
library/maputils.yap
Normal file
@ -0,0 +1,89 @@
|
|||||||
|
%%%%%%%%%%%%%%%%%%%%
|
||||||
|
% map utilities
|
||||||
|
%%%%%%%%%%%%%%%%%%%%
|
||||||
|
|
||||||
|
:- module(maputils,
|
||||||
|
[compile_aux/2,
|
||||||
|
goal_expansion_allowed/0,
|
||||||
|
pred_name/4,
|
||||||
|
aux_preds/5,
|
||||||
|
append_args/3]).
|
||||||
|
|
||||||
|
:- use_module(library(lists), [append/3]).
|
||||||
|
|
||||||
|
:- dynamic number_of_expansions/1.
|
||||||
|
|
||||||
|
number_of_expansions(0).
|
||||||
|
|
||||||
|
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, _, _, _, _) :-
|
||||||
|
var(Meta), !,
|
||||||
|
fail.
|
||||||
|
aux_preds(_:Meta, MetaVars, Pred, PredVars, Proto) :- !,
|
||||||
|
aux_preds(Meta, MetaVars, Pred, PredVars, Proto).
|
||||||
|
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], MVars, [Arg|PArgs], PVars, [Arg|ProtoArgs]) :-
|
||||||
|
ground(Arg), !,
|
||||||
|
aux_args(Args, MVars, PArgs, PVars, ProtoArgs).
|
||||||
|
aux_args([Arg|Args], [Arg|MVars], [PVar|PArgs], [PVar|PVars], ['_'|ProtoArgs]) :-
|
||||||
|
aux_args(Args, MVars, PArgs, PVars, ProtoArgs).
|
||||||
|
|
||||||
|
pred_name(Macro, Arity, _ , Name) :-
|
||||||
|
transformation_id(Id),
|
||||||
|
atomic_concat(['$$$__Auxiliary_predicate__ for ',Macro,'/',Arity,' ',Id], Name).
|
||||||
|
|
||||||
|
transformation_id(Id) :-
|
||||||
|
retract(number_of_expansions(Id)),
|
||||||
|
Id1 is Id+1,
|
||||||
|
assert(number_of_expansions(Id1)).
|
||||||
|
|
||||||
|
harmless_dcgexception(instantiation_error). % ex: phrase(([1],x:X,[3]),L)
|
||||||
|
harmless_dcgexception(type_error(callable,_)). % ex: phrase(27,L)
|
||||||
|
|
||||||
|
|
||||||
|
%% contains_illegal_dcgnt(+Term) is semidet.
|
||||||
|
%
|
||||||
|
% True if Term contains a non-terminal we cannot deal with using
|
||||||
|
% goal-expansion. The test is too general approximation, but safe.
|
||||||
|
|
||||||
|
contains_illegal_dcgnt(NT) :-
|
||||||
|
sub_term(I, NT),
|
||||||
|
nonvar(I),
|
||||||
|
( I = ! ; I = phrase(_,_,_) ), !.
|
||||||
|
% write(contains_illegal_nt(NT)), % JW: we do not want to write
|
||||||
|
% nl.
|
||||||
|
|
||||||
|
goal_expansion_allowed :-
|
||||||
|
once( prolog_load_context(_, _) ), % make sure we are compiling.
|
||||||
|
\+ current_prolog_flag(xref, true).
|
||||||
|
|
||||||
Reference in New Issue
Block a user