fix the apply_macros/maplist conundrum!
This commit is contained in:
Vítor Santos Costa
parent
71d63dacac
commit
23e258bdd4
@ -38,6 +38,7 @@ PROGRAMS= \
|
|||||||
$(srcdir)/dbqueues.yap \
|
$(srcdir)/dbqueues.yap \
|
||||||
$(srcdir)/dbusage.yap \
|
$(srcdir)/dbusage.yap \
|
||||||
$(srcdir)/dgraphs.yap \
|
$(srcdir)/dgraphs.yap \
|
||||||
|
$(srcdir)/expand_macros.yap \
|
||||||
$(srcdir)/gensym.yap \
|
$(srcdir)/gensym.yap \
|
||||||
$(srcdir)/hacks.yap \
|
$(srcdir)/hacks.yap \
|
||||||
$(srcdir)/heaps.yap \
|
$(srcdir)/heaps.yap \
|
||||||
@ -46,6 +47,7 @@ PROGRAMS= \
|
|||||||
$(srcdir)/lists.yap \
|
$(srcdir)/lists.yap \
|
||||||
$(srcdir)/nb.yap \
|
$(srcdir)/nb.yap \
|
||||||
$(srcdir)/ordsets.yap \
|
$(srcdir)/ordsets.yap \
|
||||||
|
$(srcdir)/maplist.yap \
|
||||||
$(srcdir)/matlab.yap \
|
$(srcdir)/matlab.yap \
|
||||||
$(srcdir)/matrix.yap \
|
$(srcdir)/matrix.yap \
|
||||||
$(srcdir)/prandom.yap \
|
$(srcdir)/prandom.yap \
|
||||||
|
|||||||
@ -4,15 +4,7 @@
|
|||||||
% Purpose: Macros to apply a predicate to all elements
|
% Purpose: Macros to apply a predicate to all elements
|
||||||
% of a list or to all sub-terms of a term.
|
% of a list or to all sub-terms of a term.
|
||||||
|
|
||||||
% Also has code from:
|
:- reexport(apply_macros, [selectlist/3,
|
||||||
% 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
|
|
||||||
|
|
||||||
|
|
||||||
:- module(apply_macros, [selectlist/3,
|
|
||||||
checklist/2,
|
checklist/2,
|
||||||
maplist/2,
|
maplist/2,
|
||||||
maplist/3,
|
maplist/3,
|
||||||
@ -31,709 +23,7 @@
|
|||||||
partition/5
|
partition/5
|
||||||
]).
|
]).
|
||||||
|
|
||||||
:- meta_predicate
|
|
||||||
selectlist(:,+,-),
|
|
||||||
checklist(:,+),
|
|
||||||
maplist(:,+),
|
|
||||||
maplist(:,+,-),
|
|
||||||
maplist(:,+,+,-),
|
|
||||||
maplist(:,+,+,+,-),
|
|
||||||
convlist(:,+,-),
|
|
||||||
mapargs(:,+,-),
|
|
||||||
mapargs_args(:,+,-,+),
|
|
||||||
sumargs(:,+,+,-),
|
|
||||||
sumargs_args(:,+,+,-,+),
|
|
||||||
mapnodes(:,+,-),
|
|
||||||
mapnodes_list(:,+,-),
|
|
||||||
checknodes(:,+),
|
|
||||||
checknodes_list(:,+),
|
|
||||||
sumlist(:,+,+,-),
|
|
||||||
sumnodes(:,+,+,-),
|
|
||||||
sumnodes_body(:,+,+,-,+,+),
|
|
||||||
include(:,+,-),
|
|
||||||
exclude(:,+,-),
|
|
||||||
partition(:,+,-,-),
|
|
||||||
partition(:,+,-,-,-).
|
|
||||||
|
|
||||||
|
|
||||||
:- multifile user:goal_expansion/3.
|
|
||||||
|
|
||||||
:- use_module(library(lists), [append/3]).
|
:- use_module(library(expand_macros)).
|
||||||
:- use_module(library(charsio), [format_to_chars/3, read_from_chars/2]).
|
|
||||||
:- use_module(library(error), [must_be/2]).
|
|
||||||
|
|
||||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
|
||||||
%
|
|
||||||
% Definitions for Metacalls
|
|
||||||
%
|
|
||||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
|
||||||
|
|
||||||
include(G,In,Out) :-
|
|
||||||
selectlist(G, In, Out).
|
|
||||||
|
|
||||||
selectlist(_, [], []).
|
|
||||||
selectlist(Pred, [In|ListIn], ListOut) :-
|
|
||||||
(call(Pred, In) ->
|
|
||||||
ListOut = [In|NewListOut]
|
|
||||||
;
|
|
||||||
ListOut = NewListOut
|
|
||||||
),
|
|
||||||
selectlist(Pred, ListIn, NewListOut).
|
|
||||||
|
|
||||||
exclude(_, [], []).
|
|
||||||
exclude(Pred, [In|ListIn], ListOut) :-
|
|
||||||
(call(Pred, In) ->
|
|
||||||
ListOut = NewListOut
|
|
||||||
;
|
|
||||||
ListOut = [In|NewListOut]
|
|
||||||
),
|
|
||||||
exclude(Pred, ListIn, NewListOut).
|
|
||||||
|
|
||||||
partition(_, [], [], []).
|
|
||||||
partition(Pred, [In|ListIn], List1, List2) :-
|
|
||||||
(call(Pred, In) ->
|
|
||||||
List1 = [In|RList1],
|
|
||||||
List2 = RList2
|
|
||||||
;
|
|
||||||
List1 = RList1,
|
|
||||||
List2 = [In|RList2]
|
|
||||||
),
|
|
||||||
partition(Pred, ListIn, RList1, RList2).
|
|
||||||
|
|
||||||
partition(_, [], [], [], []).
|
|
||||||
partition(Pred, [In|ListIn], List1, List2, List3) :-
|
|
||||||
call(Pred, In, Diff),
|
|
||||||
( Diff == (<) ->
|
|
||||||
List1 = [In|RList1],
|
|
||||||
List2 = RList2,
|
|
||||||
List3 = RList3
|
|
||||||
;
|
|
||||||
Diff == (=) ->
|
|
||||||
List1 = RList1,
|
|
||||||
List2 = [In|RList2],
|
|
||||||
List3 = RList3
|
|
||||||
;
|
|
||||||
Diff == (>) ->
|
|
||||||
List1 = RList1,
|
|
||||||
List2 = RList2,
|
|
||||||
List3 = [In|RList3]
|
|
||||||
;
|
|
||||||
must_be(oneof([<,=,>]), Diff)
|
|
||||||
),
|
|
||||||
partition(Pred, ListIn, RList1, RList2, RList3).
|
|
||||||
|
|
||||||
checklist(_, []).
|
|
||||||
checklist(Pred, [In|ListIn]) :-
|
|
||||||
call(Pred, In),
|
|
||||||
checklist(Pred, ListIn).
|
|
||||||
|
|
||||||
% maplist(Pred, OldList)
|
|
||||||
% succeeds when Pred(Old,New) succeeds for each corresponding
|
|
||||||
% Old in OldList, New in NewList. In InterLisp, this is MAPCAR.
|
|
||||||
% It is also MAP2C. Isn't bidirectionality wonderful?
|
|
||||||
maplist(_, []).
|
|
||||||
maplist(Pred, [In|ListIn]) :-
|
|
||||||
call(Pred, In),
|
|
||||||
maplist(Pred, ListIn).
|
|
||||||
|
|
||||||
% maplist(Pred, OldList, NewList)
|
|
||||||
% succeeds when Pred(Old,New) succeeds for each corresponding
|
|
||||||
% Old in OldList, New in NewList. In InterLisp, this is MAPCAR.
|
|
||||||
% It is also MAP2C. Isn't bidirectionality wonderful?
|
|
||||||
maplist(_, [], []).
|
|
||||||
maplist(Pred, [In|ListIn], [Out|ListOut]) :-
|
|
||||||
call(Pred, In, Out),
|
|
||||||
maplist(Pred, ListIn, ListOut).
|
|
||||||
|
|
||||||
% maplist(Pred, List1, List2, List3)
|
|
||||||
% succeeds when Pred(Old,New) succeeds for each corresponding
|
|
||||||
% Gi in Listi, New in NewList. In InterLisp, this is MAPCAR.
|
|
||||||
% It is also MAP2C. Isn't bidirectionality wonderful?
|
|
||||||
maplist(_, [], [], []).
|
|
||||||
maplist(Pred, [A1|L1], [A2|L2], [A3|L3]) :-
|
|
||||||
call(Pred, A1, A2, A3),
|
|
||||||
maplist(Pred, L1, L2, L3).
|
|
||||||
|
|
||||||
% maplist(Pred, List1, List2, List3, List4)
|
|
||||||
% succeeds when Pred(Old,New) succeeds for each corresponding
|
|
||||||
% Gi in Listi, New in NewList. In InterLisp, this is MAPCAR.
|
|
||||||
% It is also MAP2C. Isn't bidirectionality wonderful?
|
|
||||||
maplist(_, [], [], [], []).
|
|
||||||
maplist(Pred, [A1|L1], [A2|L2], [A3|L3], [A4|L4]) :-
|
|
||||||
call(Pred, A1, A2, A3, A4),
|
|
||||||
maplist(Pred, L1, L2, L3, L4).
|
|
||||||
|
|
||||||
% convlist(Rewrite, OldList, NewList)
|
|
||||||
% is a sort of hybrid of maplist/3 and sublist/3.
|
|
||||||
% Each element of NewList is the image under Rewrite of some
|
|
||||||
% element of OldList, and order is preserved, but elements of
|
|
||||||
% OldList on which Rewrite is undefined (fails) are not represented.
|
|
||||||
% Thus if foo(X,Y) :- integer(X), Y is X+1.
|
|
||||||
% then convlist(foo, [1,a,0,joe(99),101], [2,1,102]).
|
|
||||||
convlist(_, [], []).
|
|
||||||
convlist(Pred, [Old|Olds], NewList) :-
|
|
||||||
call(Pred, Old, New),
|
|
||||||
!,
|
|
||||||
NewList = [New|News],
|
|
||||||
convlist(Pred, Olds, News).
|
|
||||||
convlist(Pred, [_|Olds], News) :-
|
|
||||||
convlist(Pred, Olds, News).
|
|
||||||
|
|
||||||
mapargs(Pred, TermIn, TermOut) :-
|
|
||||||
functor(TermIn, F, N),
|
|
||||||
functor(TermOut, F, N),
|
|
||||||
mapargs_args(Pred, TermIn, TermOut, N).
|
|
||||||
|
|
||||||
mapargs_args(_, _, _, 0) :- !.
|
|
||||||
mapargs_args(Pred, TermIn, TermOut, I) :-
|
|
||||||
arg(I, TermIn, InArg),
|
|
||||||
arg(I, TermOut, OutArg),
|
|
||||||
I1 is I-1,
|
|
||||||
call(Pred, InArg, OutArg),
|
|
||||||
mapargs_args(Pred, TermIn, TermOut, I1).
|
|
||||||
|
|
||||||
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).
|
|
||||||
|
|
||||||
mapnodes(Pred, TermIn, TermOut) :-
|
|
||||||
(atomic(TermIn); var(TermOut)), !,
|
|
||||||
call(Pred, TermIn, TermOut).
|
|
||||||
mapnodes(Pred, TermIn, TermOut) :-
|
|
||||||
call(Pred, TermIn, Temp),
|
|
||||||
Temp =.. [Func|ArgsIn],
|
|
||||||
mapnodes_list(Pred, ArgsIn, ArgsOut),
|
|
||||||
TermOut =.. [Func|ArgsOut].
|
|
||||||
|
|
||||||
mapnodes_list(_, [], []).
|
|
||||||
appnodes_list(Pred, [TermIn|ArgsIn], [TermOut|ArgsOut]) :-
|
|
||||||
mapnodes(Pred, TermIn, TermOut),
|
|
||||||
mapnodes_list(Pred, ArgsIn, ArgsOut).
|
|
||||||
|
|
||||||
checknodes(Pred, Term) :-
|
|
||||||
(atomic(Term); var(Term)), !,
|
|
||||||
call(Pred, Term).
|
|
||||||
checknodes(Pred, Term) :-
|
|
||||||
call(Pred, Term),
|
|
||||||
Term =.. [_|Args],
|
|
||||||
checknodes_list(Pred, Args).
|
|
||||||
|
|
||||||
checknodes_list(_, []).
|
|
||||||
checknodes_list(Pred, [Term|Args]) :-
|
|
||||||
checknodes_body(Pred, Term),
|
|
||||||
checknodes_list(Pred, Args).
|
|
||||||
|
|
||||||
sumlist(_, [], Acc, Acc).
|
|
||||||
sumlist(Pred, [H|T], AccIn, AccOut) :-
|
|
||||||
call(Pred, H, AccIn, A1),
|
|
||||||
sumlist(Pred, T, A1, AccOut).
|
|
||||||
|
|
||||||
sumnodes(Pred, Term, A0, A2) :-
|
|
||||||
call(Pred, Term, A0, A1),
|
|
||||||
(compound(Term) ->
|
|
||||||
functor(Term, _, N),
|
|
||||||
sumnodes_body(Pred, Term, A1, A2, 0, N)
|
|
||||||
; % simple term or variable
|
|
||||||
A1 = A2
|
|
||||||
).
|
|
||||||
|
|
||||||
sumnodes_body(Pred, Term, A1, A3, N0, Ar) :-
|
|
||||||
N0 < Ar ->
|
|
||||||
N is N0+1,
|
|
||||||
arg(N, Term, Arg),
|
|
||||||
sumnodes(Pred, Arg, A1, A2),
|
|
||||||
sumnodes_body(Pred, Term, A2, A3, N, Ar)
|
|
||||||
;
|
|
||||||
A1 = A3.
|
|
||||||
|
|
||||||
|
|
||||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
|
||||||
%%
|
|
||||||
%% preprocessing for meta-calls
|
|
||||||
%%
|
|
||||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
|
||||||
|
|
||||||
user:goal_expansion(maplist(Meta, ListIn, ListOut), Mod, Goal) :-
|
|
||||||
goal_expansion_allowed,
|
|
||||||
callable(Meta),
|
|
||||||
!,
|
|
||||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
|
|
||||||
% the new goal
|
|
||||||
pred_name(maplist, 3, 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), Mod, Goal) :-
|
|
||||||
goal_expansion_allowed,
|
|
||||||
callable(Meta),
|
|
||||||
!,
|
|
||||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
|
|
||||||
% the new goal
|
|
||||||
pred_name(checklist, 2, 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(maplist(Meta, List), Mod, Goal) :-
|
|
||||||
goal_expansion_allowed,
|
|
||||||
callable(Meta),
|
|
||||||
!,
|
|
||||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
|
|
||||||
% the new goal
|
|
||||||
pred_name(maplist, 2, 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(maplist(Meta, L1, L2, L3), Mod, Goal) :-
|
|
||||||
goal_expansion_allowed,
|
|
||||||
callable(Meta),
|
|
||||||
!,
|
|
||||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
|
|
||||||
% the new goal
|
|
||||||
pred_name(maplist, 4, Proto, GoalName),
|
|
||||||
append(MetaVars, [L1, L2, L3], GoalArgs),
|
|
||||||
Goal =.. [GoalName|GoalArgs],
|
|
||||||
% the new predicate declaration
|
|
||||||
HeadPrefix =.. [GoalName|PredVars],
|
|
||||||
append_args(HeadPrefix, [[], [], []], Base),
|
|
||||||
append_args(HeadPrefix, [[A1|A1s], [A2|A2s], [A3|A3s]], RecursionHead),
|
|
||||||
append_args(Pred, [A1, A2, A3], Apply),
|
|
||||||
append_args(HeadPrefix, [A1s, A2s, A3s], RecursiveCall),
|
|
||||||
compile_aux([
|
|
||||||
Base,
|
|
||||||
(RecursionHead :- Apply, RecursiveCall)
|
|
||||||
], Module).
|
|
||||||
|
|
||||||
user:goal_expansion(maplist(Meta, L1, L2, L3, L4), Mod, Goal) :-
|
|
||||||
goal_expansion_allowed,
|
|
||||||
callable(Meta),
|
|
||||||
!,
|
|
||||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
|
|
||||||
% the new goal
|
|
||||||
pred_name(maplist, 5, Proto, GoalName),
|
|
||||||
append(MetaVars, [L1, L2, L3, L4], GoalArgs),
|
|
||||||
Goal =.. [GoalName|GoalArgs],
|
|
||||||
% the new predicate declaration
|
|
||||||
HeadPrefix =.. [GoalName|PredVars],
|
|
||||||
append_args(HeadPrefix, [[], [], [], []], Base),
|
|
||||||
append_args(HeadPrefix, [[A1|A1s], [A2|A2s], [A3|A3s], [A4|A4s]], RecursionHead),
|
|
||||||
append_args(Pred, [A1, A2, A3, A4], Apply),
|
|
||||||
append_args(HeadPrefix, [A1s, A2s, A3s, A4s], RecursiveCall),
|
|
||||||
compile_aux([
|
|
||||||
Base,
|
|
||||||
(RecursionHead :- Apply, RecursiveCall)
|
|
||||||
], Module).
|
|
||||||
|
|
||||||
user:goal_expansion(selectlist(Meta, ListIn, ListOut), Mod, Goal) :-
|
|
||||||
goal_expansion_allowed,
|
|
||||||
callable(Meta),
|
|
||||||
!,
|
|
||||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
|
|
||||||
% the new goal
|
|
||||||
pred_name(selectlist, 3, 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).
|
|
||||||
|
|
||||||
% same as selectlist
|
|
||||||
user:goal_expansion(include(Meta, ListIn, ListOut), Mod, Goal) :-
|
|
||||||
goal_expansion_allowed,
|
|
||||||
callable(Meta),
|
|
||||||
!,
|
|
||||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
|
|
||||||
% the new goal
|
|
||||||
pred_name(include, 3, 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(exclude(Meta, ListIn, ListOut), Mod, Goal) :-
|
|
||||||
goal_expansion_allowed,
|
|
||||||
callable(Meta),
|
|
||||||
!,
|
|
||||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
|
|
||||||
% the new goal
|
|
||||||
pred_name(exclude, 3, 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(partition(Meta, ListIn, List1, List2), Mod, Goal) :-
|
|
||||||
goal_expansion_allowed,
|
|
||||||
callable(Meta),
|
|
||||||
!,
|
|
||||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
|
|
||||||
% the new goal
|
|
||||||
pred_name(partition, 4, Proto, GoalName),
|
|
||||||
append(MetaVars, [ListIn, List1, List2], GoalArgs),
|
|
||||||
Goal =.. [GoalName|GoalArgs],
|
|
||||||
% the new predicate declaration
|
|
||||||
HeadPrefix =.. [GoalName|PredVars],
|
|
||||||
append_args(HeadPrefix, [[], [], []], Base),
|
|
||||||
append_args(HeadPrefix, [[In|Ins], Outs1, Outs2], RecursionHead),
|
|
||||||
append_args(Pred, [In], Apply),
|
|
||||||
append_args(HeadPrefix, [Ins, NOuts1, NOuts2], RecursiveCall),
|
|
||||||
compile_aux([
|
|
||||||
Base,
|
|
||||||
(RecursionHead :-
|
|
||||||
(Apply -> Outs1 = [In|NOuts1], Outs2 = NOuts2; Outs1 = NOuts1, Outs2 = [In|NOuts2]),
|
|
||||||
RecursiveCall)
|
|
||||||
], Module).
|
|
||||||
|
|
||||||
user:goal_expansion(partition(Meta, ListIn, List1, List2, List3), Mod, Goal) :-
|
|
||||||
goal_expansion_allowed,
|
|
||||||
callable(Meta),
|
|
||||||
!,
|
|
||||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
|
|
||||||
% the new goal
|
|
||||||
pred_name(partition2, 5, Proto, GoalName),
|
|
||||||
append(MetaVars, [ListIn, List1, List2, List3], GoalArgs),
|
|
||||||
Goal =.. [GoalName|GoalArgs],
|
|
||||||
% the new predicate declaration
|
|
||||||
HeadPrefix =.. [GoalName|PredVars],
|
|
||||||
append_args(HeadPrefix, [[], [], [], []], Base),
|
|
||||||
append_args(HeadPrefix, [[In|Ins], Outs1, Outs2, Outs3], RecursionHead),
|
|
||||||
append_args(Pred, [In,Diff], Apply),
|
|
||||||
append_args(HeadPrefix, [Ins, NOuts1, NOuts2, NOuts3], RecursiveCall),
|
|
||||||
compile_aux([
|
|
||||||
Base,
|
|
||||||
(RecursionHead :-
|
|
||||||
Apply,
|
|
||||||
(Diff == (<) ->
|
|
||||||
Outs1 = [In|NOuts1],
|
|
||||||
Outs2 = NOuts2,
|
|
||||||
Outs3 = NOuts3
|
|
||||||
;
|
|
||||||
Diff == (=) ->
|
|
||||||
Outs1 = NOuts1,
|
|
||||||
Outs2 = [In|NOuts2],
|
|
||||||
Outs3 = NOuts3
|
|
||||||
;
|
|
||||||
Diff == (>) ->
|
|
||||||
Outs1 = NOuts1,
|
|
||||||
Outs2 = NOuts2,
|
|
||||||
Outs3 = [In|NOuts3]
|
|
||||||
;
|
|
||||||
error:must_be(oneof([<,=,>]), Diff)
|
|
||||||
),
|
|
||||||
RecursiveCall)
|
|
||||||
], Module).
|
|
||||||
|
|
||||||
user:goal_expansion(convlist(Meta, ListIn, ListOut), Mod, Goal) :-
|
|
||||||
goal_expansion_allowed,
|
|
||||||
callable(Meta),
|
|
||||||
!,
|
|
||||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
|
|
||||||
% the new goal
|
|
||||||
pred_name(convlist, 3, 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), Mod, Goal) :-
|
|
||||||
goal_expansion_allowed,
|
|
||||||
callable(Meta),
|
|
||||||
!,
|
|
||||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
|
|
||||||
% the new goal
|
|
||||||
pred_name(sumlist, 4, 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) :-
|
|
||||||
goal_expansion_allowed,
|
|
||||||
( 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_expansion_allowed,
|
|
||||||
Goal = (
|
|
||||||
Term =.. [_|TermArgs],
|
|
||||||
sumlist(Meta, TermArgs, AccIn, AccOut)
|
|
||||||
).
|
|
||||||
|
|
||||||
user:goal_expansion(mapnodes(Meta, InTerm, OutTerm), Mod, Goal) :-
|
|
||||||
goal_expansion_allowed,
|
|
||||||
callable(Meta),
|
|
||||||
!,
|
|
||||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
|
|
||||||
% the new goal
|
|
||||||
pred_name(mapnodes, 3, 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), Mod, Goal) :-
|
|
||||||
goal_expansion_allowed,
|
|
||||||
callable(Meta),
|
|
||||||
!,
|
|
||||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
|
|
||||||
% the new goal
|
|
||||||
pred_name(checknodes, 2, 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), Mod, Goal) :-
|
|
||||||
goal_expansion_allowed,
|
|
||||||
callable(Meta),
|
|
||||||
!,
|
|
||||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
|
|
||||||
% the new goal
|
|
||||||
pred_name(sumnodes, 4, 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).
|
|
||||||
% stolen from SWI-Prolog
|
|
||||||
user:goal_expansion(phrase(NT,Xs), NTXsNil) :-
|
|
||||||
user:goal_expansion(phrase(NT,Xs,[]), NTXsNil).
|
|
||||||
user:goal_expansion(phrase(NT,Xs0,Xs), _Mod, NewGoal) :-
|
|
||||||
goal_expansion_allowed,
|
|
||||||
Goal = phrase(NT,Xs0,Xs),
|
|
||||||
nonvar(NT),
|
|
||||||
catch('$translate_rule'((pseudo_nt --> NT), Rule),
|
|
||||||
error(Pat,ImplDep),
|
|
||||||
( \+ harmless_dcgexception(Pat),
|
|
||||||
throw(error(Pat,ImplDep))
|
|
||||||
)),
|
|
||||||
Rule = (pseudo_nt(Xs0c,Xsc) :- NewGoal0),
|
|
||||||
Goal \== NewGoal0,
|
|
||||||
% apply translation only if we are safe
|
|
||||||
\+ contains_illegal_dcgnt(NT), !,
|
|
||||||
( var(Xsc), Xsc \== Xs0c
|
|
||||||
-> Xs = Xsc, NewGoal1 = NewGoal0
|
|
||||||
; NewGoal1 = (NewGoal0, Xsc = Xs)
|
|
||||||
),
|
|
||||||
( var(Xs0c)
|
|
||||||
-> Xs0 = Xs0c,
|
|
||||||
NewGoal = NewGoal1
|
|
||||||
; ( Xs0 = Xs0c, NewGoal1 ) = NewGoal
|
|
||||||
).
|
|
||||||
|
|
||||||
%%%%%%%%%%%%%%%%%%%%
|
|
||||||
% 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(Module:Meta, MetaVars, Pred, PredVars, Proto, _, OModule) :- !,
|
|
||||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Module, OModule).
|
|
||||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Module, Module) :-
|
|
||||||
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, Arity, Proto, Name) :-
|
|
||||||
format_to_chars('\'~a(~d,~w)\'.',[Macro, Arity, Proto], Chars),
|
|
||||||
read_from_chars(Chars, Name).
|
|
||||||
|
|
||||||
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 :-
|
|
||||||
\+ current_prolog_flag(xref, true).
|
|
||||||
|
|||||||
@ -33,6 +33,9 @@
|
|||||||
:- use_module(library(arg),
|
:- use_module(library(arg),
|
||||||
[genarg/3]).
|
[genarg/3]).
|
||||||
|
|
||||||
|
:- use_module(library(apply_macros),
|
||||||
|
[]).
|
||||||
|
|
||||||
:- use_module(library(terms),
|
:- use_module(library(terms),
|
||||||
[subsumes/2,
|
[subsumes/2,
|
||||||
term_hash/2,
|
term_hash/2,
|
||||||
@ -54,6 +57,9 @@
|
|||||||
|
|
||||||
:- multifile user:term_expansion/2.
|
:- multifile user:term_expansion/2.
|
||||||
:- multifile user:goal_expansion/3.
|
:- multifile user:goal_expansion/3.
|
||||||
|
:- multifile user:goal_expansion/2.
|
||||||
|
|
||||||
|
:- dynamic user:goal_expansion/2.
|
||||||
|
|
||||||
:- multifile swi_predicate_table/4.
|
:- multifile swi_predicate_table/4.
|
||||||
|
|
||||||
@ -344,12 +350,7 @@ prolog:(Term1 =@= Term2) :-
|
|||||||
% the predicate deterministic under normal circumstances.
|
% the predicate deterministic under normal circumstances.
|
||||||
|
|
||||||
prolog:maplist(Goal, List) :-
|
prolog:maplist(Goal, List) :-
|
||||||
maplist2(List, Goal).
|
apply_macros:maplist(List, Goal).
|
||||||
|
|
||||||
maplist2([], _).
|
|
||||||
maplist2([Elem|Tail], Goal) :-
|
|
||||||
call(Goal, Elem),
|
|
||||||
maplist2(Tail, Goal).
|
|
||||||
|
|
||||||
% maplist(:Goal, ?List1, ?List2)
|
% maplist(:Goal, ?List1, ?List2)
|
||||||
%
|
%
|
||||||
@ -357,12 +358,7 @@ maplist2([Elem|Tail], Goal) :-
|
|||||||
% of elements of List1 and List2.
|
% of elements of List1 and List2.
|
||||||
|
|
||||||
prolog:maplist(Goal, List1, List2) :-
|
prolog:maplist(Goal, List1, List2) :-
|
||||||
maplist2(List1, List2, Goal).
|
apply_macros:maplist(List1, Goal, List2).
|
||||||
|
|
||||||
maplist2([], [], _).
|
|
||||||
maplist2([Elem1|Tail1], [Elem2|Tail2], Goal) :-
|
|
||||||
call(Goal, Elem1, Elem2),
|
|
||||||
maplist2(Tail1, Tail2, Goal).
|
|
||||||
|
|
||||||
% maplist(:Goal, ?List1, ?List2, ?List3)
|
% maplist(:Goal, ?List1, ?List2, ?List3)
|
||||||
%
|
%
|
||||||
@ -370,12 +366,7 @@ maplist2([Elem1|Tail1], [Elem2|Tail2], Goal) :-
|
|||||||
% of elements of List1..List3.
|
% of elements of List1..List3.
|
||||||
|
|
||||||
prolog:maplist(Goal, List1, List2, List3) :-
|
prolog:maplist(Goal, List1, List2, List3) :-
|
||||||
maplist2(List1, List2, List3, Goal).
|
apply_macros:maplist(List1, Goal, List2, List3).
|
||||||
|
|
||||||
maplist2([], [], [], _).
|
|
||||||
maplist2([Elem1|Tail1], [Elem2|Tail2], [Elem3|Tail3], Goal) :-
|
|
||||||
call(Goal, Elem1, Elem2, Elem3),
|
|
||||||
maplist2(Tail1, Tail2, Tail3, Goal).
|
|
||||||
|
|
||||||
% maplist(:Goal, ?List1, ?List2, ?List3, List4)
|
% maplist(:Goal, ?List1, ?List2, ?List3, List4)
|
||||||
%
|
%
|
||||||
@ -383,12 +374,7 @@ maplist2([Elem1|Tail1], [Elem2|Tail2], [Elem3|Tail3], Goal) :-
|
|||||||
% quadruples of elements of List1..List4
|
% quadruples of elements of List1..List4
|
||||||
|
|
||||||
prolog:maplist(Goal, List1, List2, List3, List4) :-
|
prolog:maplist(Goal, List1, List2, List3, List4) :-
|
||||||
maplist2(List1, List2, List3, List4, Goal).
|
apply_macros:maplist(List1, Goal, List2, List3, List4).
|
||||||
|
|
||||||
maplist2([], [], [], [], _).
|
|
||||||
maplist2([Elem1|Tail1], [Elem2|Tail2], [Elem3|Tail3], [Elem4|Tail4], Goal) :-
|
|
||||||
call(Goal, Elem1, Elem2, Elem3, Elem4),
|
|
||||||
maplist2(Tail1, Tail2, Tail3, Tail4, Goal).
|
|
||||||
|
|
||||||
prolog:compile_aux_clauses([]).
|
prolog:compile_aux_clauses([]).
|
||||||
prolog:compile_aux_clauses([(:- G)|Cls]) :-
|
prolog:compile_aux_clauses([(:- G)|Cls]) :-
|
||||||
|
|||||||
488
library/expand_macros.yap
Normal file
488
library/expand_macros.yap
Normal file
@ -0,0 +1,488 @@
|
|||||||
|
|
||||||
|
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||||
|
%%
|
||||||
|
%% preprocessing for meta-calls
|
||||||
|
%%
|
||||||
|
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||||
|
|
||||||
|
:- use_module(library(lists), [append/3]).
|
||||||
|
:- use_module(library(charsio), [format_to_chars/3, read_from_chars/2]).
|
||||||
|
:- use_module(library(error), [must_be/2]).
|
||||||
|
|
||||||
|
:- multifile user:goal_expansion/3.
|
||||||
|
|
||||||
|
user:goal_expansion(maplist(Meta, ListIn, ListOut), Mod, Goal) :-
|
||||||
|
goal_expansion_allowed,
|
||||||
|
callable(Meta),
|
||||||
|
!,
|
||||||
|
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
|
||||||
|
% the new goal
|
||||||
|
pred_name(maplist, 3, 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), Mod, Goal) :-
|
||||||
|
goal_expansion_allowed,
|
||||||
|
callable(Meta),
|
||||||
|
!,
|
||||||
|
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
|
||||||
|
% the new goal
|
||||||
|
pred_name(checklist, 2, 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(maplist(Meta, List), Mod, Goal) :-
|
||||||
|
goal_expansion_allowed,
|
||||||
|
callable(Meta),
|
||||||
|
!,
|
||||||
|
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
|
||||||
|
% the new goal
|
||||||
|
pred_name(maplist, 2, 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(maplist(Meta, L1, L2, L3), Mod, Goal) :-
|
||||||
|
goal_expansion_allowed,
|
||||||
|
callable(Meta),
|
||||||
|
!,
|
||||||
|
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
|
||||||
|
% the new goal
|
||||||
|
pred_name(maplist, 4, Proto, GoalName),
|
||||||
|
append(MetaVars, [L1, L2, L3], GoalArgs),
|
||||||
|
Goal =.. [GoalName|GoalArgs],
|
||||||
|
% the new predicate declaration
|
||||||
|
HeadPrefix =.. [GoalName|PredVars],
|
||||||
|
append_args(HeadPrefix, [[], [], []], Base),
|
||||||
|
append_args(HeadPrefix, [[A1|A1s], [A2|A2s], [A3|A3s]], RecursionHead),
|
||||||
|
append_args(Pred, [A1, A2, A3], Apply),
|
||||||
|
append_args(HeadPrefix, [A1s, A2s, A3s], RecursiveCall),
|
||||||
|
compile_aux([
|
||||||
|
Base,
|
||||||
|
(RecursionHead :- Apply, RecursiveCall)
|
||||||
|
], Module).
|
||||||
|
|
||||||
|
user:goal_expansion(maplist(Meta, L1, L2, L3, L4), Mod, Goal) :-
|
||||||
|
goal_expansion_allowed,
|
||||||
|
callable(Meta),
|
||||||
|
!,
|
||||||
|
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
|
||||||
|
% the new goal
|
||||||
|
pred_name(maplist, 5, Proto, GoalName),
|
||||||
|
append(MetaVars, [L1, L2, L3, L4], GoalArgs),
|
||||||
|
Goal =.. [GoalName|GoalArgs],
|
||||||
|
% the new predicate declaration
|
||||||
|
HeadPrefix =.. [GoalName|PredVars],
|
||||||
|
append_args(HeadPrefix, [[], [], [], []], Base),
|
||||||
|
append_args(HeadPrefix, [[A1|A1s], [A2|A2s], [A3|A3s], [A4|A4s]], RecursionHead),
|
||||||
|
append_args(Pred, [A1, A2, A3, A4], Apply),
|
||||||
|
append_args(HeadPrefix, [A1s, A2s, A3s, A4s], RecursiveCall),
|
||||||
|
compile_aux([
|
||||||
|
Base,
|
||||||
|
(RecursionHead :- Apply, RecursiveCall)
|
||||||
|
], Module).
|
||||||
|
|
||||||
|
user:goal_expansion(selectlist(Meta, ListIn, ListOut), Mod, Goal) :-
|
||||||
|
goal_expansion_allowed,
|
||||||
|
callable(Meta),
|
||||||
|
!,
|
||||||
|
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
|
||||||
|
% the new goal
|
||||||
|
pred_name(selectlist, 3, 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).
|
||||||
|
|
||||||
|
% same as selectlist
|
||||||
|
user:goal_expansion(include(Meta, ListIn, ListOut), Mod, Goal) :-
|
||||||
|
goal_expansion_allowed,
|
||||||
|
callable(Meta),
|
||||||
|
!,
|
||||||
|
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
|
||||||
|
% the new goal
|
||||||
|
pred_name(include, 3, 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(exclude(Meta, ListIn, ListOut), Mod, Goal) :-
|
||||||
|
goal_expansion_allowed,
|
||||||
|
callable(Meta),
|
||||||
|
!,
|
||||||
|
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
|
||||||
|
% the new goal
|
||||||
|
pred_name(exclude, 3, 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(partition(Meta, ListIn, List1, List2), Mod, Goal) :-
|
||||||
|
goal_expansion_allowed,
|
||||||
|
callable(Meta),
|
||||||
|
!,
|
||||||
|
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
|
||||||
|
% the new goal
|
||||||
|
pred_name(partition, 4, Proto, GoalName),
|
||||||
|
append(MetaVars, [ListIn, List1, List2], GoalArgs),
|
||||||
|
Goal =.. [GoalName|GoalArgs],
|
||||||
|
% the new predicate declaration
|
||||||
|
HeadPrefix =.. [GoalName|PredVars],
|
||||||
|
append_args(HeadPrefix, [[], [], []], Base),
|
||||||
|
append_args(HeadPrefix, [[In|Ins], Outs1, Outs2], RecursionHead),
|
||||||
|
append_args(Pred, [In], Apply),
|
||||||
|
append_args(HeadPrefix, [Ins, NOuts1, NOuts2], RecursiveCall),
|
||||||
|
compile_aux([
|
||||||
|
Base,
|
||||||
|
(RecursionHead :-
|
||||||
|
(Apply -> Outs1 = [In|NOuts1], Outs2 = NOuts2; Outs1 = NOuts1, Outs2 = [In|NOuts2]),
|
||||||
|
RecursiveCall)
|
||||||
|
], Module).
|
||||||
|
|
||||||
|
user:goal_expansion(partition(Meta, ListIn, List1, List2, List3), Mod, Goal) :-
|
||||||
|
goal_expansion_allowed,
|
||||||
|
callable(Meta),
|
||||||
|
!,
|
||||||
|
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
|
||||||
|
% the new goal
|
||||||
|
pred_name(partition2, 5, Proto, GoalName),
|
||||||
|
append(MetaVars, [ListIn, List1, List2, List3], GoalArgs),
|
||||||
|
Goal =.. [GoalName|GoalArgs],
|
||||||
|
% the new predicate declaration
|
||||||
|
HeadPrefix =.. [GoalName|PredVars],
|
||||||
|
append_args(HeadPrefix, [[], [], [], []], Base),
|
||||||
|
append_args(HeadPrefix, [[In|Ins], Outs1, Outs2, Outs3], RecursionHead),
|
||||||
|
append_args(Pred, [In,Diff], Apply),
|
||||||
|
append_args(HeadPrefix, [Ins, NOuts1, NOuts2, NOuts3], RecursiveCall),
|
||||||
|
compile_aux([
|
||||||
|
Base,
|
||||||
|
(RecursionHead :-
|
||||||
|
Apply,
|
||||||
|
(Diff == (<) ->
|
||||||
|
Outs1 = [In|NOuts1],
|
||||||
|
Outs2 = NOuts2,
|
||||||
|
Outs3 = NOuts3
|
||||||
|
;
|
||||||
|
Diff == (=) ->
|
||||||
|
Outs1 = NOuts1,
|
||||||
|
Outs2 = [In|NOuts2],
|
||||||
|
Outs3 = NOuts3
|
||||||
|
;
|
||||||
|
Diff == (>) ->
|
||||||
|
Outs1 = NOuts1,
|
||||||
|
Outs2 = NOuts2,
|
||||||
|
Outs3 = [In|NOuts3]
|
||||||
|
;
|
||||||
|
error:must_be(oneof([<,=,>]), Diff)
|
||||||
|
),
|
||||||
|
RecursiveCall)
|
||||||
|
], Module).
|
||||||
|
|
||||||
|
user:goal_expansion(convlist(Meta, ListIn, ListOut), Mod, Goal) :-
|
||||||
|
goal_expansion_allowed,
|
||||||
|
callable(Meta),
|
||||||
|
!,
|
||||||
|
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
|
||||||
|
% the new goal
|
||||||
|
pred_name(convlist, 3, 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), Mod, Goal) :-
|
||||||
|
goal_expansion_allowed,
|
||||||
|
callable(Meta),
|
||||||
|
!,
|
||||||
|
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
|
||||||
|
% the new goal
|
||||||
|
pred_name(sumlist, 4, 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) :-
|
||||||
|
goal_expansion_allowed,
|
||||||
|
( 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_expansion_allowed,
|
||||||
|
Goal = (
|
||||||
|
Term =.. [_|TermArgs],
|
||||||
|
sumlist(Meta, TermArgs, AccIn, AccOut)
|
||||||
|
).
|
||||||
|
|
||||||
|
user:goal_expansion(mapnodes(Meta, InTerm, OutTerm), Mod, Goal) :-
|
||||||
|
goal_expansion_allowed,
|
||||||
|
callable(Meta),
|
||||||
|
!,
|
||||||
|
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
|
||||||
|
% the new goal
|
||||||
|
pred_name(mapnodes, 3, 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), Mod, Goal) :-
|
||||||
|
goal_expansion_allowed,
|
||||||
|
callable(Meta),
|
||||||
|
!,
|
||||||
|
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
|
||||||
|
% the new goal
|
||||||
|
pred_name(checknodes, 2, 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), Mod, Goal) :-
|
||||||
|
goal_expansion_allowed,
|
||||||
|
callable(Meta),
|
||||||
|
!,
|
||||||
|
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
|
||||||
|
% the new goal
|
||||||
|
pred_name(sumnodes, 4, 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).
|
||||||
|
% stolen from SWI-Prolog
|
||||||
|
user:goal_expansion(phrase(NT,Xs), Mod, NTXsNil) :-
|
||||||
|
user:goal_expansion(phrase(NT,Xs,[]), Mod, NTXsNil).
|
||||||
|
user:goal_expansion(phrase(NT,Xs0,Xs), _Mod, NewGoal) :-
|
||||||
|
goal_expansion_allowed,
|
||||||
|
Goal = phrase(NT,Xs0,Xs),
|
||||||
|
nonvar(NT),
|
||||||
|
catch('$translate_rule'((pseudo_nt --> NT), Rule),
|
||||||
|
error(Pat,ImplDep),
|
||||||
|
( \+ harmless_dcgexception(Pat),
|
||||||
|
throw(error(Pat,ImplDep))
|
||||||
|
)),
|
||||||
|
Rule = (pseudo_nt(Xs0c,Xsc) :- NewGoal0),
|
||||||
|
Goal \== NewGoal0,
|
||||||
|
% apply translation only if we are safe
|
||||||
|
\+ contains_illegal_dcgnt(NT), !,
|
||||||
|
( var(Xsc), Xsc \== Xs0c
|
||||||
|
-> Xs = Xsc, NewGoal1 = NewGoal0
|
||||||
|
; NewGoal1 = (NewGoal0, Xsc = Xs)
|
||||||
|
),
|
||||||
|
( var(Xs0c)
|
||||||
|
-> Xs0 = Xs0c,
|
||||||
|
NewGoal = NewGoal1
|
||||||
|
; ( Xs0 = Xs0c, NewGoal1 ) = NewGoal
|
||||||
|
).
|
||||||
|
|
||||||
|
%%%%%%%%%%%%%%%%%%%%
|
||||||
|
% 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(Module:Meta, MetaVars, Pred, PredVars, Proto, _, OModule) :- !,
|
||||||
|
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Module, OModule).
|
||||||
|
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Module, Module) :-
|
||||||
|
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, Arity, Proto, Name) :-
|
||||||
|
format_to_chars('\'~a(~d,~w)\'.',[Macro, Arity, Proto], Chars),
|
||||||
|
read_from_chars(Chars, Name).
|
||||||
|
|
||||||
|
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 :-
|
||||||
|
\+ current_prolog_flag(xref, true).
|
||||||
@ -1,103 +0,0 @@
|
|||||||
/* $Id: maplist.pl,v 1.2 2008-06-05 19:33:51 rzf Exp $
|
|
||||||
|
|
||||||
Part of SWI-Prolog
|
|
||||||
|
|
||||||
Author: Jan Wielemaker
|
|
||||||
E-mail: jan@swi.psy.uva.nl
|
|
||||||
WWW: http://www.swi-prolog.org
|
|
||||||
Copyright (C): 1985-2002, University of Amsterdam
|
|
||||||
|
|
||||||
This program is free software; you can redistribute it and/or
|
|
||||||
modify it under the terms of the GNU General Public License
|
|
||||||
as published by the Free Software Foundation; either version 2
|
|
||||||
of the License, or (at your option) any later version.
|
|
||||||
|
|
||||||
This program is distributed in the hope that it will be useful,
|
|
||||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
||||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
||||||
GNU General Public License for more details.
|
|
||||||
|
|
||||||
You should have received a copy of the GNU Lesser General Public
|
|
||||||
License along with this library; if not, write to the Free Software
|
|
||||||
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
|
||||||
|
|
||||||
As a special exception, if you link this library with other files,
|
|
||||||
compiled with a Free Software compiler, to produce an executable, this
|
|
||||||
library does not by itself cause the resulting executable to be covered
|
|
||||||
by the GNU General Public License. This exception does not however
|
|
||||||
invalidate any other reasons why the executable file might be covered by
|
|
||||||
the GNU General Public License.
|
|
||||||
*/
|
|
||||||
|
|
||||||
:- module(maplist,
|
|
||||||
[ maplist/2, % :Goal, +List
|
|
||||||
maplist/3, % :Goal, ?List1, ?List2
|
|
||||||
maplist/4, % :Goal, ?List1, ?List2, ?List3
|
|
||||||
maplist/5, % :Goal, ?List1, ?List2, ?List3, List4
|
|
||||||
forall/2 % :Goal, :Goal
|
|
||||||
]).
|
|
||||||
|
|
||||||
:- module_transparent
|
|
||||||
maplist/2,
|
|
||||||
maplist2/2,
|
|
||||||
maplist/3,
|
|
||||||
maplist2/3,
|
|
||||||
maplist/4,
|
|
||||||
maplist2/4,
|
|
||||||
maplist/5,
|
|
||||||
maplist2/5,
|
|
||||||
forall/2.
|
|
||||||
|
|
||||||
% maplist(:Goal, +List)
|
|
||||||
%
|
|
||||||
% True if Goal can succesfully be applied on all elements of List.
|
|
||||||
% Arguments are reordered to gain performance as well as to make
|
|
||||||
% the predicate deterministic under normal circumstances.
|
|
||||||
|
|
||||||
maplist(Goal, List) :-
|
|
||||||
maplist2(List, Goal).
|
|
||||||
|
|
||||||
maplist2([], _).
|
|
||||||
maplist2([Elem|Tail], Goal) :-
|
|
||||||
call(Goal, Elem),
|
|
||||||
maplist2(Tail, Goal).
|
|
||||||
|
|
||||||
% maplist(:Goal, ?List1, ?List2)
|
|
||||||
%
|
|
||||||
% True if Goal can succesfully be applied to all succesive pairs
|
|
||||||
% of elements of List1 and List2.
|
|
||||||
|
|
||||||
maplist(Goal, List1, List2) :-
|
|
||||||
maplist2(List1, List2, Goal).
|
|
||||||
|
|
||||||
maplist2([], [], _).
|
|
||||||
maplist2([Elem1|Tail1], [Elem2|Tail2], Goal) :-
|
|
||||||
call(Goal, Elem1, Elem2),
|
|
||||||
maplist2(Tail1, Tail2, Goal).
|
|
||||||
|
|
||||||
% maplist(:Goal, ?List1, ?List2, ?List3)
|
|
||||||
%
|
|
||||||
% True if Goal can succesfully be applied to all succesive triples
|
|
||||||
% of elements of List1..List3.
|
|
||||||
|
|
||||||
maplist(Goal, List1, List2, List3) :-
|
|
||||||
maplist2(List1, List2, List3, Goal).
|
|
||||||
|
|
||||||
maplist2([], [], [], _).
|
|
||||||
maplist2([Elem1|Tail1], [Elem2|Tail2], [Elem3|Tail3], Goal) :-
|
|
||||||
call(Goal, Elem1, Elem2, Elem3),
|
|
||||||
maplist2(Tail1, Tail2, Tail3, Goal).
|
|
||||||
|
|
||||||
% maplist(:Goal, ?List1, ?List2, ?List3, List4)
|
|
||||||
%
|
|
||||||
% True if Goal can succesfully be applied to all succesive
|
|
||||||
% quadruples of elements of List1..List4
|
|
||||||
|
|
||||||
maplist(Goal, List1, List2, List3, List4) :-
|
|
||||||
maplist2(List1, List2, List3, List4, Goal).
|
|
||||||
|
|
||||||
maplist2([], [], [], [], _).
|
|
||||||
maplist2([Elem1|Tail1], [Elem2|Tail2], [Elem3|Tail3], [Elem4|Tail4], Goal) :-
|
|
||||||
call(Goal, Elem1, Elem2, Elem3, Elem4),
|
|
||||||
maplist2(Tail1, Tail2, Tail3, Tail4, Goal).
|
|
||||||
|
|
||||||
242
library/maplist.yap
Normal file
242
library/maplist.yap
Normal file
@ -0,0 +1,242 @@
|
|||||||
|
% 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(maplist,
|
||||||
|
[ maplist/2, % :Goal, +List
|
||||||
|
maplist/3, % :Goal, ?List1, ?List2
|
||||||
|
maplist/4, % :Goal, ?List1, ?List2, ?List3
|
||||||
|
maplist/5, % :Goal, ?List1, ?List2, ?List3, List4
|
||||||
|
forall/2 % :Goal, :Goal
|
||||||
|
]).
|
||||||
|
|
||||||
|
:- meta_predicate
|
||||||
|
selectlist(:,+,-),
|
||||||
|
checklist(:,+),
|
||||||
|
maplist(:,+),
|
||||||
|
maplist(:,+,-),
|
||||||
|
maplist(:,+,+,-),
|
||||||
|
maplist(:,+,+,+,-),
|
||||||
|
convlist(:,+,-),
|
||||||
|
mapargs(:,+,-),
|
||||||
|
mapargs_args(:,+,-,+),
|
||||||
|
sumargs(:,+,+,-),
|
||||||
|
sumargs_args(:,+,+,-,+),
|
||||||
|
mapnodes(:,+,-),
|
||||||
|
mapnodes_list(:,+,-),
|
||||||
|
checknodes(:,+),
|
||||||
|
checknodes_list(:,+),
|
||||||
|
sumlist(:,+,+,-),
|
||||||
|
sumnodes(:,+,+,-),
|
||||||
|
sumnodes_body(:,+,+,-,+,+),
|
||||||
|
include(:,+,-),
|
||||||
|
exclude(:,+,-),
|
||||||
|
partition(:,+,-,-),
|
||||||
|
partition(:,+,-,-,-).
|
||||||
|
|
||||||
|
|
||||||
|
:- use_module(library(error), [must_be/2]).
|
||||||
|
|
||||||
|
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||||
|
%
|
||||||
|
% Definitions for Metacalls
|
||||||
|
%
|
||||||
|
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||||
|
|
||||||
|
include(G,In,Out) :-
|
||||||
|
selectlist(G, In, Out).
|
||||||
|
|
||||||
|
selectlist(_, [], []).
|
||||||
|
selectlist(Pred, [In|ListIn], ListOut) :-
|
||||||
|
(call(Pred, In) ->
|
||||||
|
ListOut = [In|NewListOut]
|
||||||
|
;
|
||||||
|
ListOut = NewListOut
|
||||||
|
),
|
||||||
|
selectlist(Pred, ListIn, NewListOut).
|
||||||
|
|
||||||
|
exclude(_, [], []).
|
||||||
|
exclude(Pred, [In|ListIn], ListOut) :-
|
||||||
|
(call(Pred, In) ->
|
||||||
|
ListOut = NewListOut
|
||||||
|
;
|
||||||
|
ListOut = [In|NewListOut]
|
||||||
|
),
|
||||||
|
exclude(Pred, ListIn, NewListOut).
|
||||||
|
|
||||||
|
partition(_, [], [], []).
|
||||||
|
partition(Pred, [In|ListIn], List1, List2) :-
|
||||||
|
(call(Pred, In) ->
|
||||||
|
List1 = [In|RList1],
|
||||||
|
List2 = RList2
|
||||||
|
;
|
||||||
|
List1 = RList1,
|
||||||
|
List2 = [In|RList2]
|
||||||
|
),
|
||||||
|
partition(Pred, ListIn, RList1, RList2).
|
||||||
|
|
||||||
|
partition(_, [], [], [], []).
|
||||||
|
partition(Pred, [In|ListIn], List1, List2, List3) :-
|
||||||
|
call(Pred, In, Diff),
|
||||||
|
( Diff == (<) ->
|
||||||
|
List1 = [In|RList1],
|
||||||
|
List2 = RList2,
|
||||||
|
List3 = RList3
|
||||||
|
;
|
||||||
|
Diff == (=) ->
|
||||||
|
List1 = RList1,
|
||||||
|
List2 = [In|RList2],
|
||||||
|
List3 = RList3
|
||||||
|
;
|
||||||
|
Diff == (>) ->
|
||||||
|
List1 = RList1,
|
||||||
|
List2 = RList2,
|
||||||
|
List3 = [In|RList3]
|
||||||
|
;
|
||||||
|
must_be(oneof([<,=,>]), Diff)
|
||||||
|
),
|
||||||
|
partition(Pred, ListIn, RList1, RList2, RList3).
|
||||||
|
|
||||||
|
checklist(_, []).
|
||||||
|
checklist(Pred, [In|ListIn]) :-
|
||||||
|
call(Pred, In),
|
||||||
|
checklist(Pred, ListIn).
|
||||||
|
|
||||||
|
% maplist(Pred, OldList)
|
||||||
|
% succeeds when Pred(Old,New) succeeds for each corresponding
|
||||||
|
% Old in OldList, New in NewList. In InterLisp, this is MAPCAR.
|
||||||
|
% It is also MAP2C. Isn't bidirectionality wonderful?
|
||||||
|
maplist(_, []).
|
||||||
|
maplist(Pred, [In|ListIn]) :-
|
||||||
|
call(Pred, In),
|
||||||
|
maplist(Pred, ListIn).
|
||||||
|
|
||||||
|
% maplist(Pred, OldList, NewList)
|
||||||
|
% succeeds when Pred(Old,New) succeeds for each corresponding
|
||||||
|
% Old in OldList, New in NewList. In InterLisp, this is MAPCAR.
|
||||||
|
% It is also MAP2C. Isn't bidirectionality wonderful?
|
||||||
|
maplist(_, [], []).
|
||||||
|
maplist(Pred, [In|ListIn], [Out|ListOut]) :-
|
||||||
|
call(Pred, In, Out),
|
||||||
|
maplist(Pred, ListIn, ListOut).
|
||||||
|
|
||||||
|
% maplist(Pred, List1, List2, List3)
|
||||||
|
% succeeds when Pred(Old,New) succeeds for each corresponding
|
||||||
|
% Gi in Listi, New in NewList. In InterLisp, this is MAPCAR.
|
||||||
|
% It is also MAP2C. Isn't bidirectionality wonderful?
|
||||||
|
maplist(_, [], [], []).
|
||||||
|
maplist(Pred, [A1|L1], [A2|L2], [A3|L3]) :-
|
||||||
|
call(Pred, A1, A2, A3),
|
||||||
|
maplist(Pred, L1, L2, L3).
|
||||||
|
|
||||||
|
% maplist(Pred, List1, List2, List3, List4)
|
||||||
|
% succeeds when Pred(Old,New) succeeds for each corresponding
|
||||||
|
% Gi in Listi, New in NewList. In InterLisp, this is MAPCAR.
|
||||||
|
% It is also MAP2C. Isn't bidirectionality wonderful?
|
||||||
|
maplist(_, [], [], [], []).
|
||||||
|
maplist(Pred, [A1|L1], [A2|L2], [A3|L3], [A4|L4]) :-
|
||||||
|
call(Pred, A1, A2, A3, A4),
|
||||||
|
maplist(Pred, L1, L2, L3, L4).
|
||||||
|
|
||||||
|
% convlist(Rewrite, OldList, NewList)
|
||||||
|
% is a sort of hybrid of maplist/3 and sublist/3.
|
||||||
|
% Each element of NewList is the image under Rewrite of some
|
||||||
|
% element of OldList, and order is preserved, but elements of
|
||||||
|
% OldList on which Rewrite is undefined (fails) are not represented.
|
||||||
|
% Thus if foo(X,Y) :- integer(X), Y is X+1.
|
||||||
|
% then convlist(foo, [1,a,0,joe(99),101], [2,1,102]).
|
||||||
|
convlist(_, [], []).
|
||||||
|
convlist(Pred, [Old|Olds], NewList) :-
|
||||||
|
call(Pred, Old, New),
|
||||||
|
!,
|
||||||
|
NewList = [New|News],
|
||||||
|
convlist(Pred, Olds, News).
|
||||||
|
convlist(Pred, [_|Olds], News) :-
|
||||||
|
convlist(Pred, Olds, News).
|
||||||
|
|
||||||
|
mapargs(Pred, TermIn, TermOut) :-
|
||||||
|
functor(TermIn, F, N),
|
||||||
|
functor(TermOut, F, N),
|
||||||
|
mapargs_args(Pred, TermIn, TermOut, N).
|
||||||
|
|
||||||
|
mapargs_args(_, _, _, 0) :- !.
|
||||||
|
mapargs_args(Pred, TermIn, TermOut, I) :-
|
||||||
|
arg(I, TermIn, InArg),
|
||||||
|
arg(I, TermOut, OutArg),
|
||||||
|
I1 is I-1,
|
||||||
|
call(Pred, InArg, OutArg),
|
||||||
|
mapargs_args(Pred, TermIn, TermOut, I1).
|
||||||
|
|
||||||
|
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).
|
||||||
|
|
||||||
|
mapnodes(Pred, TermIn, TermOut) :-
|
||||||
|
(atomic(TermIn); var(TermOut)), !,
|
||||||
|
call(Pred, TermIn, TermOut).
|
||||||
|
mapnodes(Pred, TermIn, TermOut) :-
|
||||||
|
call(Pred, TermIn, Temp),
|
||||||
|
Temp =.. [Func|ArgsIn],
|
||||||
|
mapnodes_list(Pred, ArgsIn, ArgsOut),
|
||||||
|
TermOut =.. [Func|ArgsOut].
|
||||||
|
|
||||||
|
mapnodes_list(_, [], []).
|
||||||
|
appnodes_list(Pred, [TermIn|ArgsIn], [TermOut|ArgsOut]) :-
|
||||||
|
mapnodes(Pred, TermIn, TermOut),
|
||||||
|
mapnodes_list(Pred, ArgsIn, ArgsOut).
|
||||||
|
|
||||||
|
checknodes(Pred, Term) :-
|
||||||
|
(atomic(Term); var(Term)), !,
|
||||||
|
call(Pred, Term).
|
||||||
|
checknodes(Pred, Term) :-
|
||||||
|
call(Pred, Term),
|
||||||
|
Term =.. [_|Args],
|
||||||
|
checknodes_list(Pred, Args).
|
||||||
|
|
||||||
|
checknodes_list(_, []).
|
||||||
|
checknodes_list(Pred, [Term|Args]) :-
|
||||||
|
checknodes_body(Pred, Term),
|
||||||
|
checknodes_list(Pred, Args).
|
||||||
|
|
||||||
|
sumlist(_, [], Acc, Acc).
|
||||||
|
sumlist(Pred, [H|T], AccIn, AccOut) :-
|
||||||
|
call(Pred, H, AccIn, A1),
|
||||||
|
sumlist(Pred, T, A1, AccOut).
|
||||||
|
|
||||||
|
sumnodes(Pred, Term, A0, A2) :-
|
||||||
|
call(Pred, Term, A0, A1),
|
||||||
|
(compound(Term) ->
|
||||||
|
functor(Term, _, N),
|
||||||
|
sumnodes_body(Pred, Term, A1, A2, 0, N)
|
||||||
|
; % simple term or variable
|
||||||
|
A1 = A2
|
||||||
|
).
|
||||||
|
|
||||||
|
sumnodes_body(Pred, Term, A1, A3, N0, Ar) :-
|
||||||
|
N0 < Ar ->
|
||||||
|
N is N0+1,
|
||||||
|
arg(N, Term, Arg),
|
||||||
|
sumnodes(Pred, Arg, A1, A2),
|
||||||
|
sumnodes_body(Pred, Term, A2, A3, N, Ar)
|
||||||
|
;
|
||||||
|
A1 = A3.
|
||||||
|
|
||||||
Reference in New Issue
Block a user