apply_macros.yap should do this (and more).
This commit is contained in:
Vítor Santos Costa
parent
1c053da021
commit
71d63dacac
|
|
@ -31,7 +31,7 @@ PROGRAMS= $(srcdir)/debug.pl \
|
|||
$(srcdir)/prolog_source.pl \
|
||||
$(srcdir)/prolog_xref.pl
|
||||
|
||||
SWI_PROGRAMS= $(srcdir)/apply_macros.pl
|
||||
SWI_PROGRAMS=
|
||||
|
||||
|
||||
install: $(PROGRAMS)
|
||||
|
|
|
|||
|
|
@ -1,185 +0,0 @@
|
|||
/* $Id: apply_macros.pl,v 1.3 2008-08-06 17:32:21 vsc Exp $
|
||||
|
||||
Part of SWI-Prolog
|
||||
|
||||
Author: Jan Wielemaker
|
||||
E-mail: wielemak@science.uva.nl
|
||||
WWW: http://www.swi-prolog.org
|
||||
Copyright (C): 1985-2007, 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 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(apply_macros,
|
||||
[
|
||||
]).
|
||||
:- use_module(library(lists)).
|
||||
:- use_module(library(occurs)).
|
||||
|
||||
/** <module> Goal expansion rules to avoid meta-calling
|
||||
|
||||
This module defines goal_expansion/2 rules to deal with commonly used,
|
||||
but fundamentally slow meta-predicates. Notable maplist/2... defines a
|
||||
useful set of predicates, but its exection is considerable slower than a
|
||||
traditional Prolog loop. Using this library calls to maplist/2... are
|
||||
translated into an call to a generated auxilary predicate that is
|
||||
compiled using compile_aux_clauses/1. Currently this module supports:
|
||||
|
||||
* maplist/2..
|
||||
* forall/2
|
||||
* once/1
|
||||
* ignore/1
|
||||
* phrase/2
|
||||
* phrase/3
|
||||
|
||||
@tbd Support more predicates
|
||||
@author Jan Wielemaker
|
||||
*/
|
||||
|
||||
:- dynamic
|
||||
user:goal_expansion/2.
|
||||
:- multifile
|
||||
user:goal_expansion/2.
|
||||
|
||||
|
||||
%% expand_maplist(+Callable, +Lists, -Goal) is det.
|
||||
%
|
||||
% Macro expansion for maplist/2 and higher arity.
|
||||
|
||||
expand_maplist(Callable0, Lists, Goal) :-
|
||||
( Callable0 = _:_
|
||||
-> strip_module(Callable0, M, Callable),
|
||||
NextGoal = M:NextCall
|
||||
; Callable = Callable0,
|
||||
NextGoal = NextCall
|
||||
),
|
||||
Callable =.. [Pred|Args],
|
||||
length(Args, Argc),
|
||||
length(Argv, Argc),
|
||||
length(Lists, N),
|
||||
length(Vars, N),
|
||||
MapArity is N + 1,
|
||||
format(atom(AuxName), '__aux_maplist/~d_~w+~d', [MapArity, Pred, Argc]),
|
||||
append(Lists, Args, AuxArgs),
|
||||
Goal =.. [AuxName|AuxArgs],
|
||||
|
||||
AuxArity is N+Argc,
|
||||
prolog_load_context(module, Module),
|
||||
( current_predicate(Module:AuxName/AuxArity)
|
||||
-> true
|
||||
; empty_lists(N, BaseLists),
|
||||
length(Anon, Argc),
|
||||
append(BaseLists, Anon, BaseArgs),
|
||||
BaseClause =.. [AuxName|BaseArgs],
|
||||
|
||||
heads_and_tails(N, NextArgs, Vars, Tails),
|
||||
append(NextArgs, Argv, AllNextArgs),
|
||||
NextHead =.. [AuxName|AllNextArgs],
|
||||
append(Argv, Vars, PredArgs),
|
||||
NextCall =.. [Pred|PredArgs],
|
||||
append(Tails, Argv, IttArgs),
|
||||
NextIterate =.. [AuxName|IttArgs],
|
||||
NextClause = (NextHead :- NextGoal, NextIterate),
|
||||
|
||||
( predicate_property(NextGoal, transparent)
|
||||
-> compile_aux_clauses([ (:- module_transparent(Module:AuxName/AuxArity)),
|
||||
BaseClause,
|
||||
NextClause
|
||||
])
|
||||
; compile_aux_clauses([BaseClause, NextClause])
|
||||
)
|
||||
).
|
||||
|
||||
|
||||
empty_lists(0, []) :- !.
|
||||
empty_lists(N, [[]|T]) :-
|
||||
N2 is N - 1,
|
||||
empty_lists(N2, T).
|
||||
|
||||
heads_and_tails(0, [], [], []).
|
||||
heads_and_tails(N, [[H|T]|L1], [H|L2], [T|L3]) :-
|
||||
N2 is N - 1,
|
||||
heads_and_tails(N2, L1, L2, L3).
|
||||
|
||||
|
||||
%% expand_apply(+GoalIn:callable, -GoalOut) is semidet.
|
||||
%
|
||||
% Macro expansion for `apply' predicates.
|
||||
|
||||
expand_apply(Maplist, Goal) :-
|
||||
functor(Maplist, maplist, N),
|
||||
N >= 2,
|
||||
Maplist =.. [maplist, Callable|Lists],
|
||||
callable(Callable), !,
|
||||
expand_maplist(Callable, Lists, Goal).
|
||||
expand_apply(forall(Cond, Action), \+((Cond, \+(Action)))).
|
||||
expand_apply(once(Goal), (Goal->true;fail)).
|
||||
expand_apply(ignore(Goal), (Goal->true;true)).
|
||||
expand_apply(phrase(NT,Xs), NTXsNil) :-
|
||||
expand_apply(phrase(NT,Xs,[]), NTXsNil).
|
||||
expand_apply(phrase(NT,Xs0,Xs), NewGoal) :-
|
||||
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,
|
||||
\+ contains_illegal_dcgnt(NT), !, % apply translation only if we are safe
|
||||
( var(Xsc), Xsc \== Xs0c
|
||||
-> Xs = Xsc, NewGoal1 = NewGoal0
|
||||
; NewGoal1 = (NewGoal0, Xsc = Xs)
|
||||
),
|
||||
( var(Xs0c)
|
||||
-> Xs0 = Xs0c,
|
||||
NewGoal = NewGoal1
|
||||
; ( Xs0 = Xs0c, NewGoal1 ) = NewGoal
|
||||
).
|
||||
|
||||
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.
|
||||
|
||||
/*******************************
|
||||
* ACTIVATE *
|
||||
*******************************/
|
||||
|
||||
% @tbd Should we only apply if optimization is enabled (-O)?
|
||||
|
||||
user:goal_expansion(GoalIn, M, GoalOut) :-
|
||||
\+ current_prolog_flag(xref, true),
|
||||
expand_apply(M:GoalIn, GoalOut).
|
||||
|
||||
Reference in New Issue