View source with raw comments or as raw
    1/*  $Id$
    2
    3    Part of CLP(Q,R) (Constraint Logic Programming over Rationals and Reals)
    4
    5    Author:        Leslie De Koninck
    6    E-mail:        Leslie.DeKoninck@cs.kuleuven.be
    7    WWW:           http://www.swi-prolog.org
    8		   http://www.ai.univie.ac.at/cgi-bin/tr-online?number+95-09
    9    Copyright (C): 2006, K.U. Leuven and
   10		   1992-1995, Austrian Research Institute for
   11		              Artificial Intelligence (OFAI),
   12			      Vienna, Austria
   13
   14    This software is based on CLP(Q,R) by Christian Holzbaur for SICStus
   15    Prolog and distributed under the license details below with permission from
   16    all mentioned authors.
   17
   18    This program is free software; you can redistribute it and/or
   19    modify it under the terms of the GNU General Public License
   20    as published by the Free Software Foundation; either version 2
   21    of the License, or (at your option) any later version.
   22
   23    This program is distributed in the hope that it will be useful,
   24    but WITHOUT ANY WARRANTY; without even the implied warranty of
   25    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   26    GNU General Public License for more details.
   27
   28    You should have received a copy of the GNU Lesser General Public
   29    License along with this library; if not, write to the Free Software
   30    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
   31
   32    As a special exception, if you link this library with other files,
   33    compiled with a Free Software compiler, to produce an executable, this
   34    library does not by itself cause the resulting executable to be covered
   35    by the GNU General Public License. This exception does not however
   36    invalidate any other reasons why the executable file might be covered by
   37    the GNU General Public License.
   38*/
   39
   40
   41:- module(dump,
   42	[
   43	    dump/3,
   44	    projecting_assert/1
   45	]).   46:- use_module(class,
   47	[
   48	    class_allvars/2
   49	]).   50:- use_module(geler,
   51	[
   52	    collect_nonlin/3
   53	]).   54:- use_module(library(assoc),
   55	[
   56	    empty_assoc/1,
   57	    get_assoc/3,
   58	    put_assoc/4,
   59	    assoc_to_list/2
   60	]).   61:- use_module(itf,
   62	[
   63	    dump_linear/3,
   64	    dump_nonzero/3
   65	]).   66:- use_module(project,
   67	[
   68	    project_attributes/2
   69	]).   70:- use_module(ordering,
   71	[
   72	    ordering/1
   73	]).
 dump(+Target, -NewVars, -Constraints) is det
Returns in <Constraints>, the constraints that currently hold on Target where all variables in <Target> are copied to new variables in <NewVars> and the constraints are given on these new variables. In short, you can safely manipulate <NewVars> and <Constraints> without changing the constraints on <Target>.
   83dump([],[],[]) :- !.
   84dump(Target,NewVars,Constraints) :-
   85	(   (	proper_varlist(Target)
   86	    ->  true
   87	    ;   % Target is not a list of variables
   88		throw(instantiation_error(dump(Target,NewVars,Constraints),1))
   89	    ),
   90	    ordering(Target),
   91	    related_linear_vars(Target,All),	% All contains all variables of the classes of Target variables.
   92	    nonlin_crux(All,Nonlin),
   93	    project_attributes(Target,All),
   94	    related_linear_vars(Target,Again),	% project drops/adds vars
   95	    all_attribute_goals(Again,Gs,Nonlin),
   96	    empty_assoc(D0),
   97	    mapping(Target,NewVars,D0,D1),	% late (AVL suffers from put_atts)
   98	    copy(Gs,Copy,D1,_),			% strip constraints
   99	    nb_setval(clpqr_dump,NewVars/Copy),
  100	    fail				% undo projection
  101	;   catch(nb_getval(clpqr_dump,NewVars/Constraints),_,fail),
  102	    nb_delete(clpqr_dump)
  103	).
  104
  105:- meta_predicate projecting_assert(:).  106
  107projecting_assert(QClause) :-
  108	strip_module(QClause, Module, Clause),  % JW: SWI-Prolog not always qualifies the term!
  109	copy_term_clpq(Clause,Copy,Constraints),
  110	l2c(Constraints,Conj),			% fails for []
  111	(   Sm = clpq
  112	;   Sm = clpr
  113	),			% proper module for {}/1
  114	!,
  115	(   Copy = (H:-B)
  116	->  % former rule
  117	    Module:assert((H:-Sm:{Conj},B))
  118	;   % former fact
  119	    Module:assert((Copy:-Sm:{Conj}))
  120	).
  121projecting_assert(Clause) :-	% not our business
  122	assert(Clause).
  123
  124copy_term_clpq(Term,Copy,Constraints) :-
  125	(   term_variables(Term,Target),	% get all variables in Term
  126	    related_linear_vars(Target,All),	% get all variables of the classes of the variables in Term
  127	    nonlin_crux(All,Nonlin),		% get a list of all the nonlinear goals of these variables
  128	    project_attributes(Target,All),
  129	    related_linear_vars(Target,Again),	% project drops/adds vars
  130	    all_attribute_goals(Again,Gs,Nonlin),
  131	    empty_assoc(D0),
  132	    copy(Term/Gs,TmpCopy,D0,_),	  % strip constraints
  133	    nb_setval(clpqr_dump,TmpCopy),
  134	    fail
  135	;   catch(nb_getval(clpqr_dump,Copy/Constraints),_,fail),
  136	    nb_delete(clpqr_copy_term)
  137	).
  138
  139% l2c(Lst,Conj)
  140%
  141% converts a list to a round list: [a,b,c] -> (a,b,c) and [a] becomes a
  142
  143l2c([X|Xs],Conj) :-
  144	(   Xs = []
  145	->  Conj = X
  146	;   Conj = (X,Xc),
  147	    l2c(Xs,Xc)
  148	).
  149
  150% proper_varlist(List)
  151%
  152% Returns whether Lst is a list of variables.
  153% First clause is to avoid unification of a variable with a list.
  154
  155proper_varlist(X) :-
  156	var(X),
  157	!,
  158	fail.
  159proper_varlist([]).
  160proper_varlist([X|Xs]) :-
  161	var(X),
  162	proper_varlist(Xs).
  163
  164% related_linear_vars(Vs,All)
  165%
  166% Generates a list of all variables that are in the classes of the variables in
  167% Vs.
  168
  169related_linear_vars(Vs,All) :-
  170	empty_assoc(S0),
  171	related_linear_sys(Vs,S0,Sys),
  172	related_linear_vars(Sys,All,[]).
  173
  174% related_linear_sys(Vars,Assoc,List)
  175%
  176% Generates in List, a list of all to classes to which variables in Vars
  177% belong.
  178% Assoc should be an empty association list and is used internally.
  179% List contains elements of the form C-C where C is a class and both C's are
  180% equal.
  181
  182related_linear_sys([],S0,L0) :- assoc_to_list(S0,L0).
  183related_linear_sys([V|Vs],S0,S2) :-
  184	(   get_attr(V,itf,Att),
  185	    arg(6,Att,class(C))
  186	->  put_assoc(C,S0,C,S1)
  187	;   S1 = S0
  188	),
  189	related_linear_sys(Vs,S1,S2).
  190
  191% related_linear_vars(Classes,[Vars|VarsTail],VarsTail)
  192%
  193% Generates a difference list of all variables in the classes in Classes.
  194% Classes contains elements of the form C-C where C is a class and both C's are
  195% equal.
  196
  197related_linear_vars([]) --> [].
  198related_linear_vars([S-_|Ss]) -->
  199	{
  200	    class_allvars(S,Otl)
  201	},
  202	cpvars(Otl),
  203	related_linear_vars(Ss).
  204
  205% cpvars(Vars,Out,OutTail)
  206%
  207% Makes a new difference list of the difference list Vars.
  208% All nonvars are removed.
  209
  210cpvars(Xs) --> {var(Xs)}, !.
  211cpvars([X|Xs]) -->
  212	(   { var(X) }
  213	->  [X]
  214	;   []
  215	),
  216	cpvars(Xs).
  217
  218% nonlin_crux(All,Gss)
  219%
  220% Collects all pending non-linear constraints of variables in All.
  221% This marks all nonlinear goals of the variables as run and cannot
  222% be reversed manually.
  223
  224nonlin_crux(All,Gss) :-
  225	collect_nonlin(All,Gs,[]),	% collect the nonlinear goals of variables All
  226					% this marks the goals as run and cannot be reversed manually
  227	nonlin_strip(Gs,Gss).
  228
  229% nonlin_strip(Gs,Solver,Res)
  230%
  231% Removes the goals from Gs that are not from solver Solver.
  232
  233nonlin_strip([],[]).
  234nonlin_strip([_:What|Gs],Res) :-
  235	(   What = {G}
  236	->  Res = [G|Gss]
  237	;   Res = [What|Gss]
  238	),
  239	nonlin_strip(Gs,Gss).
  240
  241all_attribute_goals([]) --> [].
  242all_attribute_goals([V|Vs]) -->
  243	dump_linear(V),
  244	dump_nonzero(V),
  245	all_attribute_goals(Vs).
  246
  247% mapping(L1,L2,AssocIn,AssocOut)
  248%
  249% Makes an association mapping of lists L1 and L2:
  250% L1 = [L1H|L1T] and L2 = [L2H|L2T] then the association L1H-L2H is formed
  251% and the tails are mapped similarly.
  252
  253mapping([],[],D0,D0).
  254mapping([T|Ts],[N|Ns],D0,D2) :-
  255	put_assoc(T,D0,N,D1),
  256	mapping(Ts,Ns,D1,D2).
  257
  258% copy(Term,Copy,AssocIn,AssocOut)
  259%
  260% Makes a copy of Term by changing all variables in it to new ones and
  261% building an association between original variables and the new ones.
  262% E.g. when Term = test(A,B,C), Copy = test(D,E,F) and an association between
  263% A and D, B and E and C and F is formed in AssocOut. AssocIn is input
  264% association.
  265
  266copy(Term,Copy,D0,D1) :-
  267	var(Term),
  268	(   get_assoc(Term,D0,New)
  269	->  Copy = New,
  270	    D1 = D0
  271	;   put_assoc(Term,D0,Copy,D1)
  272	).
  273copy(Term,Copy,D0,D1) :-
  274	nonvar(Term),	% Term is a functor
  275	functor(Term,N,A),
  276	functor(Copy,N,A),	% Copy is new functor with the same name and arity as Term
  277	copy(A,Term,Copy,D0,D1).
  278
  279% copy(Nb,Term,Copy,AssocIn,AssocOut)
  280%
  281% Makes a copy of the Nb arguments of Term by changing all variables in it to
  282% new ones and building an association between original variables and the new
  283% ones.
  284% See also copy/4
  285
  286copy(0,_,_,D0,D0) :- !.
  287copy(1,T,C,D0,D1) :- !,
  288	arg(1,T,At1),
  289	arg(1,C,Ac1),
  290	copy(At1,Ac1,D0,D1).
  291copy(2,T,C,D0,D2) :- !,
  292	arg(1,T,At1),
  293	arg(1,C,Ac1),
  294	copy(At1,Ac1,D0,D1),
  295	arg(2,T,At2),
  296	arg(2,C,Ac2),
  297	copy(At2,Ac2,D1,D2).
  298copy(N,T,C,D0,D2) :-
  299	arg(N,T,At),
  300	arg(N,C,Ac),
  301	copy(At,Ac,D0,D1),
  302	N1 is N-1,
  303	copy(N1,T,C,D1,D2).
 attribute_goals(@V)// is det
Translate attributes back into goals. This is used by copy_term/3, which also determines the toplevel printing of residual constraints.
  311itf:attribute_goals(V) -->
  312	(   { term_attvars(V, Vs),
  313	      dump(Vs, NVs, List),
  314	      NVs = Vs,
  315	      del_itf(Vs),
  316	      list_to_conj(List, Conj) }
  317	->  [ {}(Conj) ]
  318	;   []
  319	).
  320
  321class:attribute_goals(_) --> [].
  322
  323geler:attribute_goals(V) --> itf:attribute_goals(V).
  324
  325del_itf([]).
  326del_itf([H|T]) :-
  327	del_attr(H, itf),
  328	del_itf(T).
  329
  330
  331list_to_conj([], true) :- !.
  332list_to_conj([X], X) :- !.
  333list_to_conj([H|T0], (H,T)) :-
  334	list_to_conj(T0, T).
  335
  336		 /*******************************
  337		 *	       SANDBOX		*
  338		 *******************************/
  339:- multifile
  340	sandbox:safe_primitive/1.  341
  342sandbox:safe_primitive(dump:dump(_,_,_))