reorganise code to avoid duplicate goal_expansion.

2014-10-02 14:31:14 +01:00
parent 3ab27ad588
commit 74c136b986
3 changed files with 3 additions and 471 deletions
--- a/library/expand_macros.yap
+++ b/library/expand_macros.yap
@@ -5,429 +5,16 @@
 %%
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

-:- module(expand_macros, []).
-
 :- 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]).

-:- multifile user:goal_expansion/3.
-
 :- dynamic number_of_expansions/1.

 number_of_expansions(0).

-user:goal_expansion(checklist(Meta, List), Mod, Goal) :-
-	goal_expansion_allowed(checklist(Meta, List), Mod),
-	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(maplist(Meta, List), Mod),
-	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, ListIn, ListOut), Mod, Goal) :-
-	goal_expansion_allowed(maplist(Meta, ListIn, ListOut), Mod),
-	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(maplist(Meta, L1, L2, L3), Mod, Goal) :-
-	goal_expansion_allowed(maplist(Meta, L1, L2, L3), Mod),
-	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(maplist(Meta, L1, L2, L3, L4), Mod),
-	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(selectlist(Meta, ListIn, ListOut), Mod),
-	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(include(Meta, ListIn, ListOut), Mod),
-	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(exclude(Meta, ListIn, ListOut), Mod),
-	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(partition(Meta, ListIn, List1, List2), Mod),
-	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(partition(Meta, ListIn, List1, List2, List3), Mod),
-	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(convlist(Meta, ListIn, ListOut), Mod),
-	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(sumlist(Meta, List, AccIn, AccOut), Mod),
-	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(mapargs(Meta, In, Out), Module),
-	( 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(sumargs(Meta, Term, AccIn, AccOut), Module),
-	Goal = (
-		 Term =.. [_|TermArgs],
-		 sumlist(Meta, TermArgs, AccIn, AccOut)
-	       ).
-
-user:goal_expansion(mapnodes(Meta, InTerm, OutTerm), Mod, Goal) :-
-	goal_expansion_allowed(mapnodes(Meta, InTerm, OutTerm), Mod),
-	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(checknodes(Meta, Term), Mod),
-	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(sumnodes(Meta, Term, AccIn, AccOut), Mod),
-	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).
-
-:- 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(phrase(NT,Xs0,Xs), Mod),
-	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
@@ -487,18 +74,6 @@ 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.
-
 '$expand':allowed_expansion(QExpand) :-
    strip_module(QExpand, Mod, Pred),
    goal_expansion_allowed(Pred, Mod).
--- a/library/maplist.yap
+++ b/library/maplist.yap
@@ -1248,36 +1248,6 @@ goal_expansion(sumnodes(Meta, Term, AccIn, AccOut), Mod:Goal) :-
 			 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').
-*/
-
 /**
@}
 */
--- a/library/maputils.yap
+++ b/library/maputils.yap
@@ -24,6 +24,9 @@

 number_of_expansions(0).

+%
+% compile auxiliary routines for term expansion
+%
 compile_aux([Clause|Clauses], Module) :-
 	% compile the predicate declaration if needed
 	( Clause = (Head :- _)
@@ -83,22 +86,6 @@ transformation_id(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 is semidet.
 %
 %	`True` if we can use