From 74c136b986200686e2ed7092aaaea74d94a27e84 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Thu, 2 Oct 2014 14:31:14 +0100 Subject: [PATCH] reorganise code to avoid duplicate goal_expansion. --- library/expand_macros.yap | 425 -------------------------------------- library/maplist.yap | 30 --- library/maputils.yap | 19 +- 3 files changed, 3 insertions(+), 471 deletions(-) diff --git a/library/expand_macros.yap b/library/expand_macros.yap index 43b5029ab..d181b7b82 100644 --- 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). diff --git a/library/maplist.yap b/library/maplist.yap index 7b97bf297..ff0a597e1 100644 --- 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'). -*/ - /** @} */ diff --git a/library/maputils.yap b/library/maputils.yap index 262bacc10..5c5648a3e 100644 --- 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