fix macro expansion stuff. Everything bounces from maplist now.
This commit is contained in:
Vítor Santos Costa II
parent
ff135d53d2
commit
d957569e83
@ -1,7 +1,7 @@
|
||||
|
||||
:- module(apply,[]).
|
||||
|
||||
:- reexport(library(apply_macros),
|
||||
:- reexport(library(maplist),
|
||||
[maplist/2,
|
||||
maplist/3,
|
||||
maplist/4,
|
||||
|
||||
@ -26,6 +26,3 @@
|
||||
]).
|
||||
|
||||
|
||||
:- use_module(expand_macros,[]).
|
||||
|
||||
|
||||
|
||||
@ -500,6 +500,63 @@ contains_illegal_dcgnt(NT) :-
|
||||
% nl.
|
||||
|
||||
goal_expansion_allowed(Pred, Mod) :-
|
||||
predicate_property(Mod:Pred, number_of_clauses(_)),
|
||||
prolog_load_context(_, _), % make sure we are compiling.
|
||||
allowed_module(Pred,Mod),
|
||||
once( prolog_load_context(_, _) ), % make sure we are compiling.
|
||||
\+ current_prolog_flag(xref, true).
|
||||
|
||||
allowed_module(checklist(_,_),expand_macros).
|
||||
allowed_module(checklist(_,_),apply_macros).
|
||||
allowed_module(checklist(_,_),maplist).
|
||||
allowed_module(maplist(_,_),expand_macros).
|
||||
allowed_module(maplist(_,_),apply_macros).
|
||||
allowed_module(maplist(_,_),maplist).
|
||||
allowed_module(maplist(_,_,_),expand_macros).
|
||||
allowed_module(maplist(_,_,_),apply_macros).
|
||||
allowed_module(maplist(_,_,_),maplist).
|
||||
allowed_module(maplist(_,_,_,_),expand_macros).
|
||||
allowed_module(maplist(_,_,_,_),apply_macros).
|
||||
allowed_module(maplist(_,_,_,_),maplist).
|
||||
allowed_module(maplist(_,_,_,_,_),expand_macros).
|
||||
allowed_module(maplist(_,_,_,_,_),apply_macros).
|
||||
allowed_module(maplist(_,_,_,_,_),maplist).
|
||||
allowed_module(maplist(_,_,_,_,_,_),expand_macros).
|
||||
allowed_module(maplist(_,_,_,_,_,_),apply_macros).
|
||||
allowed_module(maplist(_,_,_,_,_,_),maplist).
|
||||
allowed_module(selectlist(_,_,_),expand_macros).
|
||||
allowed_module(selectlist(_,_,_),apply_macros).
|
||||
allowed_module(selectlist(_,_,_),maplist).
|
||||
allowed_module(include(_,_,_),expand_macros).
|
||||
allowed_module(include(_,_,_),apply_macros).
|
||||
allowed_module(include(_,_,_),maplist).
|
||||
allowed_module(exclude(_,_,_),expand_macros).
|
||||
allowed_module(exclude(_,_,_),apply_macros).
|
||||
allowed_module(exclude(_,_,_),maplist).
|
||||
allowed_module(partition(_,_,_,_),expand_macros).
|
||||
allowed_module(partition(_,_,_,_),apply_macros).
|
||||
allowed_module(partition(_,_,_,_),maplist).
|
||||
allowed_module(partition(_,_,_,_,_),expand_macros).
|
||||
allowed_module(partition(_,_,_,_,_),apply_macros).
|
||||
allowed_module(partition(_,_,_,_,_),maplist).
|
||||
allowed_module(convlist(_,_,_),expand_macros).
|
||||
allowed_module(convlist(_,_,_),apply_macros).
|
||||
allowed_module(convlist(_,_,_),maplist).
|
||||
allowed_module(sumlist(_,_,_,_),expand_macros).
|
||||
allowed_module(sumlist(_,_,_,_),apply_macros).
|
||||
allowed_module(sumlist(_,_,_,_),maplist).
|
||||
allowed_module(mapargs(_,_,_),expand_macros).
|
||||
allowed_module(mapargs(_,_,_),apply_macros).
|
||||
allowed_module(mapargs(_,_,_),maplist).
|
||||
allowed_module(sumargs(_,_,_,_),expand_macros).
|
||||
allowed_module(sumargs(_,_,_,_),apply_macros).
|
||||
allowed_module(sumargs(_,_,_,_),maplist).
|
||||
allowed_module(mapnodes(_,_,_),expand_macros).
|
||||
allowed_module(mapnodes(_,_,_),apply_macros).
|
||||
allowed_module(mapnodes(_,_,_),maplist).
|
||||
allowed_module(checknodes(_,_),expand_macros).
|
||||
allowed_module(checknodes(_,_),apply_macros).
|
||||
allowed_module(checknodes(_,_),maplist).
|
||||
allowed_module(sumnodes(_,_,_,_),expand_macros).
|
||||
allowed_module(sumnodes(_,_,_,_),apply_macros).
|
||||
allowed_module(sumnodes(_,_,_,_),maplist).
|
||||
allowed_module(phrase(_,_),_).
|
||||
allowed_module(phrase(_,_,_),_).
|
||||
|
||||
@ -57,7 +57,10 @@
|
||||
partition(:,+,-,-,-).
|
||||
|
||||
|
||||
:- 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]).
|
||||
:- use_module(library(occurs), [sub_term/2]).
|
||||
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
%
|
||||
@ -139,8 +142,8 @@ maplist(Pred, [In|ListIn]) :-
|
||||
% It is also MAP2C. Isn't bidirectionality wonderful?
|
||||
maplist(_, [], []).
|
||||
maplist(Pred, [In|ListIn], [Out|ListOut]) :-
|
||||
call(Pred, In, Out),
|
||||
maplist(Pred, ListIn, ListOut).
|
||||
call(Pred, In, Out),
|
||||
maplist(Pred, ListIn, ListOut).
|
||||
|
||||
% maplist(Pred, List1, List2, List3)
|
||||
% succeeds when Pred(Old,New) succeeds for each corresponding
|
||||
@ -252,3 +255,511 @@ sumnodes_body(Pred, Term, A1, A3, N0, Ar) :-
|
||||
;
|
||||
A1 = A3.
|
||||
|
||||
|
||||
:- dynamic number_of_expansions/1.
|
||||
|
||||
number_of_expansions(0).
|
||||
|
||||
goal_expansion(checklist(Meta, List), Mod:Goal) :-
|
||||
goal_expansion_allowed,
|
||||
callable(Meta),
|
||||
!,
|
||||
prolog_load_context(module, Mod),
|
||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
|
||||
% 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)
|
||||
], Mod).
|
||||
|
||||
goal_expansion(maplist(Meta, List), Mod:Goal) :-
|
||||
goal_expansion_allowed,
|
||||
callable(Meta),
|
||||
!,
|
||||
prolog_load_context(module, Mod),
|
||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
|
||||
% 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)
|
||||
], Mod).
|
||||
|
||||
goal_expansion(maplist(Meta, ListIn, ListOut), Mod:Goal) :-
|
||||
goal_expansion_allowed,
|
||||
callable(Meta),
|
||||
!,
|
||||
prolog_load_context(module, Mod),
|
||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
|
||||
% 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)
|
||||
], Mod).
|
||||
|
||||
goal_expansion(maplist(Meta, L1, L2, L3), Mod:Goal) :-
|
||||
goal_expansion_allowed,
|
||||
callable(Meta),
|
||||
!,
|
||||
prolog_load_context(module, Mod),
|
||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
|
||||
% 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)
|
||||
], Mod).
|
||||
|
||||
goal_expansion(maplist(Meta, L1, L2, L3, L4), Mod:Goal) :-
|
||||
goal_expansion_allowed,
|
||||
callable(Meta),
|
||||
!,
|
||||
prolog_load_context(module, Mod),
|
||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
|
||||
% 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)
|
||||
], Mod).
|
||||
|
||||
goal_expansion(selectlist(Meta, ListIn, ListOut), Mod:Goal) :-
|
||||
goal_expansion_allowed,
|
||||
callable(Meta),
|
||||
!,
|
||||
prolog_load_context(module, Mod),
|
||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
|
||||
% 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)
|
||||
], Mod).
|
||||
|
||||
% same as selectlist
|
||||
goal_expansion(include(Meta, ListIn, ListOut), Mod:Goal) :-
|
||||
goal_expansion_allowed,
|
||||
callable(Meta),
|
||||
!,
|
||||
prolog_load_context(module, Mod),
|
||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
|
||||
% 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)
|
||||
], Mod).
|
||||
|
||||
goal_expansion(exclude(Meta, ListIn, ListOut), Mod:Goal) :-
|
||||
goal_expansion_allowed,
|
||||
callable(Meta),
|
||||
!,
|
||||
prolog_load_context(module, Mod),
|
||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
|
||||
% 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)
|
||||
], Mod).
|
||||
|
||||
goal_expansion(partition(Meta, ListIn, List1, List2), Mod:Goal) :-
|
||||
goal_expansion_allowed,
|
||||
callable(Meta),
|
||||
!,
|
||||
prolog_load_context(module, Mod),
|
||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
|
||||
% 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)
|
||||
], Mod).
|
||||
|
||||
goal_expansion(partition(Meta, ListIn, List1, List2, List3), Mod:Goal) :-
|
||||
goal_expansion_allowed,
|
||||
callable(Meta),
|
||||
!,
|
||||
prolog_load_context(module, Mod),
|
||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
|
||||
% 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)
|
||||
], Mod).
|
||||
|
||||
goal_expansion(convlist(Meta, ListIn, ListOut), Mod:Goal) :-
|
||||
goal_expansion_allowed,
|
||||
callable(Meta),
|
||||
!,
|
||||
prolog_load_context(module, Mod),
|
||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
|
||||
% 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)
|
||||
], Mod).
|
||||
|
||||
goal_expansion(sumlist(Meta, List, AccIn, AccOut), Mod:Goal) :-
|
||||
goal_expansion_allowed,
|
||||
callable(Meta),
|
||||
!,
|
||||
prolog_load_context(module, Mod),
|
||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
|
||||
% 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)
|
||||
], Mod).
|
||||
|
||||
goal_expansion(mapargs(Meta, In, Out), Mod:NewGoal) :-
|
||||
goal_expansion_allowed,
|
||||
prolog_load_context(module, Mod),
|
||||
( var(Out)
|
||||
->
|
||||
NewGoal = (
|
||||
In =.. [F|InArgs],
|
||||
maplist(Meta, InArgs, OutArgs),
|
||||
Out =.. [F|OutArgs]
|
||||
)
|
||||
;
|
||||
NewGoal = (
|
||||
Out =.. [F|OutArgs],
|
||||
maplist(Meta, InArgs, OutArgs),
|
||||
In =.. [F|InArgs]
|
||||
)
|
||||
).
|
||||
|
||||
goal_expansion(sumargs(Meta, Term, AccIn, AccOut), Mod:Goal) :-
|
||||
goal_expansion_allowed,
|
||||
prolog_load_context(module, Mod),
|
||||
Goal = (
|
||||
Term =.. [_|TermArgs],
|
||||
sumlist(Meta, TermArgs, AccIn, AccOut)
|
||||
).
|
||||
|
||||
goal_expansion(mapnodes(Meta, InTerm, OutTerm), Mod:Goal) :-
|
||||
goal_expansion_allowed,
|
||||
callable(Meta),
|
||||
!,
|
||||
prolog_load_context(module, Mod),
|
||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
|
||||
% 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)
|
||||
], Mod).
|
||||
|
||||
goal_expansion(checknodes(Meta, Term), Mod:Goal) :-
|
||||
goal_expansion_allowed,
|
||||
callable(Meta),
|
||||
!,
|
||||
prolog_load_context(module, Mod),
|
||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
|
||||
% 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)
|
||||
], Mod).
|
||||
|
||||
goal_expansion(sumnodes(Meta, Term, AccIn, AccOut), Mod:Goal) :-
|
||||
goal_expansion_allowed,
|
||||
callable(Meta),
|
||||
!,
|
||||
prolog_load_context(module, Mod),
|
||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
|
||||
% 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)
|
||||
], Mod).
|
||||
|
||||
/*
|
||||
:- unhide('$translate_rule').
|
||||
% 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
|
||||
).
|
||||
:- hide('$translate_rule').
|
||||
*/
|
||||
|
||||
%%%%%%%%%%%%%%%%%%%%
|
||||
% 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(_:Meta, MetaVars, Pred, PredVars, Proto) :- !,
|
||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto).
|
||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto) :-
|
||||
Meta =.. [F|Args],
|
||||
aux_args(Args, MetaVars, PredArgs, PredVars, ProtoArgs),
|
||||
Pred =.. [F|PredArgs],
|
||||
Proto =.. [F|ProtoArgs].
|
||||
|
||||
aux_args([], [], [], [], []).
|
||||
aux_args([Arg|Args], MVars, [Arg|PArgs], PVars, [Arg|ProtoArgs]) :-
|
||||
ground(Arg), !,
|
||||
aux_args(Args, MVars, PArgs, PVars, ProtoArgs).
|
||||
aux_args([Arg|Args], [Arg|MVars], [PVar|PArgs], [PVar|PVars], ['_'|ProtoArgs]) :-
|
||||
aux_args(Args, MVars, PArgs, PVars, ProtoArgs).
|
||||
|
||||
pred_name(Macro, Arity, _ , Name) :-
|
||||
transformation_id(Id),
|
||||
atomic_concat(['$$$__Auxiliary_predicate__ for ',Macro,'/',Arity,' ',Id], Name).
|
||||
|
||||
transformation_id(Id) :-
|
||||
retract(number_of_expansions(Id)),
|
||||
Id1 is Id+1,
|
||||
assert(number_of_expansions(Id1)).
|
||||
|
||||
harmless_dcgexception(instantiation_error). % ex: phrase(([1],x:X,[3]),L)
|
||||
harmless_dcgexception(type_error(callable,_)). % ex: phrase(27,L)
|
||||
|
||||
|
||||
%% contains_illegal_dcgnt(+Term) is semidet.
|
||||
%
|
||||
% True if Term contains a non-terminal we cannot deal with using
|
||||
% goal-expansion. The test is too general approximation, but safe.
|
||||
|
||||
contains_illegal_dcgnt(NT) :-
|
||||
sub_term(I, NT),
|
||||
nonvar(I),
|
||||
( I = ! ; I = phrase(_,_,_) ), !.
|
||||
% write(contains_illegal_nt(NT)), % JW: we do not want to write
|
||||
% nl.
|
||||
|
||||
goal_expansion_allowed :-
|
||||
once( prolog_load_context(_, _) ), % make sure we are compiling.
|
||||
\+ current_prolog_flag(xref, true).
|
||||
|
||||
|
||||
Reference in New Issue
Block a user