563 lines
		
	
	
		
			18 KiB
		
	
	
	
		
			Prolog
		
	
	
	
	
	
			
		
		
	
	
			563 lines
		
	
	
		
			18 KiB
		
	
	
	
		
			Prolog
		
	
	
	
	
	
| 
 | |
| %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 | |
| %%
 | |
| %% preprocessing for meta-calls
 | |
| %%
 | |
| %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 | |
| 
 | |
| :- 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
 | |
| %%%%%%%%%%%%%%%%%%%%
 | |
| 
 | |
| 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], 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(Pred, Mod) :-
 | |
| 	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(_,_,_),_).
 |