fix the apply_macros/maplist conundrum!

This commit is contained in:
Vítor Santos Costa 2009-04-24 22:43:08 +01:00
parent 71d63dacac
commit 23e258bdd4
6 changed files with 744 additions and 839 deletions

View File

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

View File

@ -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(:,+,-), :- use_module(library(expand_macros)).
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(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).

View File

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

View File

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