1/* Part of CLP(Q,R) (Constraint Logic Programming over Rationals and Reals) 2 3 Author: Leslie De Koninck 4 E-mail: Leslie.DeKoninck@cs.kuleuven.be 5 WWW: http://www.swi-prolog.org 6 http://www.ai.univie.ac.at/cgi-bin/tr-online?number+95-09 7 Copyright (C): 2006, K.U. Leuven and 8 1992-1995, Austrian Research Institute for 9 Artificial Intelligence (OFAI), 10 Vienna, Austria 11 12 This software is based on CLP(Q,R) by Christian Holzbaur for SICStus 13 Prolog and distributed under the license details below with permission from 14 all mentioned authors. 15 16 This program is free software; you can redistribute it and/or 17 modify it under the terms of the GNU General Public License 18 as published by the Free Software Foundation; either version 2 19 of the License, or (at your option) any later version. 20 21 This program is distributed in the hope that it will be useful, 22 but WITHOUT ANY WARRANTY; without even the implied warranty of 23 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 24 GNU General Public License for more details. 25 26 You should have received a copy of the GNU Lesser General Public 27 License along with this library; if not, write to the Free Software 28 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 29 30 As a special exception, if you link this library with other files, 31 compiled with a Free Software compiler, to produce an executable, this 32 library does not by itself cause the resulting executable to be covered 33 by the GNU General Public License. This exception does not however 34 invalidate any other reasons why the executable file might be covered by 35 the GNU General Public License. 36*/ 37 38 39:- module(clpqr_dump, 40 [ dump/3, 41 projecting_assert/1 42 ]). 43:- use_module(class, [class_allvars/2]). 44:- use_module(geler, [collect_nonlin/3]). 45:- use_module(library(assoc), [empty_assoc/1, put_assoc/4, assoc_to_list/2]). 46:- use_module(itf, [dump_linear/3, dump_nonzero/3]). 47:- use_module(project, [project_attributes/2]). 48:- use_module(ordering, [ordering/1]). 49:- use_module(library(error), [must_be/2]).
59dump([],[],[]) :- !. 60dump(Target,NewVars,Constraints) :- 61 must_be(list(var), Target), 62 copy_term_clpq(Target, NewVars, Constraints). 63 64:- meta_predicate projecting_assert(). 65 66projecting_assert(Module:Clause) :- 67 copy_term_clpq(Clause,Copy,Constraints), 68 l2c(Constraints,Conj), % fails for [] 69 ( Sm = clpq 70 ; Sm = clpr 71 ), % proper module for {}/1 72 !, 73 ( Copy = (H:-B) 74 -> % former rule 75 assert(Module:(H:-Sm:{Conj},B)) 76 ; % former fact 77 assert(Module:(Copy:-Sm:{Conj})) 78 ). 79projecting_assert(Clause) :- % not our business 80 assert(Clause). 81 82copy_term_clpq(Term,Copy,Constraints) :- 83 State = state(-), 84 ( copy_term_clpq_(Term, NV, Cs), 85 nb_setarg(1, State, NV/Cs), 86 fail 87 ; arg(1, State, Copy/Constraints) 88 ). 89 90copy_term_clpq_(Term, Copy, Constraints) :- 91 term_variables(Term,Target), % get all variables in Term 92 ordering(Target), 93 related_linear_vars(Target,All), % get all variables of the classes of the variables in Term 94 nonlin_crux(All,Nonlin), % get a list of all the nonlinear goals of these variables 95 project_attributes(Target,All), 96 related_linear_vars(Target,Again), % project drops/adds vars 97 all_attribute_goals(Again,Gs,Nonlin), 98 copy_term_nat(Term/Gs,Copy/Constraints). % strip constraints 99 100% l2c(Lst,Conj) 101% 102% converts a list to a round list: [a,b,c] -> (a,b,c) and [a] becomes a 103 104l2c([X|Xs],Conj) :- 105 ( Xs = [] 106 -> Conj = X 107 ; Conj = (X,Xc), 108 l2c(Xs,Xc) 109 ). 110 111% related_linear_vars(Vs,All) 112% 113% Generates a list of all variables that are in the classes of the variables in 114% Vs. 115 (Vs,All) :- 117 empty_assoc(S0), 118 related_linear_sys(Vs,S0,Sys), 119 related_linear_vars(Sys,All,[]). 120 121% related_linear_sys(Vars,Assoc,List) 122% 123% Generates in List, a list of all to classes to which variables in Vars 124% belong. 125% Assoc should be an empty association list and is used internally. 126% List contains elements of the form C-C where C is a class and both C's are 127% equal. 128 ([],S0,L0) :- assoc_to_list(S0,L0). 130related_linear_sys([V|Vs],S0,S2) :- 131 ( get_attr(V,clpqr_itf,Att), 132 arg(6,Att,class(C)) 133 -> put_assoc(C,S0,C,S1) 134 ; S1 = S0 135 ), 136 related_linear_sys(Vs,S1,S2). 137 138% related_linear_vars(Classes,[Vars|VarsTail],VarsTail) 139% 140% Generates a difference list of all variables in the classes in Classes. 141% Classes contains elements of the form C-C where C is a class and both C's are 142% equal. 143 ([]) --> []. 145related_linear_vars([S-_|Ss]) --> 146 { 147 class_allvars(S,Otl) 148 }, 149 cpvars(Otl), 150 related_linear_vars(Ss). 151 152% cpvars(Vars,Out,OutTail) 153% 154% Makes a new difference list of the difference list Vars. 155% All nonvars are removed. 156 157cpvars(Xs) --> {var(Xs)}, !. 158cpvars([X|Xs]) --> 159 ( { var(X) } 160 -> [X] 161 ; [] 162 ), 163 cpvars(Xs). 164 165% nonlin_crux(All,Gss) 166% 167% Collects all pending non-linear constraints of variables in All. 168% This marks all nonlinear goals of the variables as run and cannot 169% be reversed manually. 170 171nonlin_crux(All,Gss) :- 172 collect_nonlin(All,Gs,[]), % collect the nonlinear goals of variables All 173 % this marks the goals as run and cannot be reversed manually 174 nonlin_strip(Gs,Gss). 175 176% nonlin_strip(Gs,Solver,Res) 177% 178% Removes the goals from Gs that are not from solver Solver. 179 180nonlin_strip([],[]). 181nonlin_strip([_:What|Gs],Res) :- 182 ( What = {G} 183 -> Res = [G|Gss] 184 ; Res = [What|Gss] 185 ), 186 nonlin_strip(Gs,Gss). 187 188all_attribute_goals([]) --> []. 189all_attribute_goals([V|Vs]) --> 190 dump_linear(V), 191 dump_nonzero(V), 192 all_attribute_goals(Vs).
200clpqr_itfattribute_goals(V) --> 201 ( { term_attvars(V, Vs), 202 dump(Vs, NVs, List), 203 List \== [], 204 NVs = Vs, 205 del_itf(Vs), 206 list_to_conj(List, Conj) 207 } 208 -> [ {}(Conj) ] 209 ; [] 210 ). 211 212clpqr_classattribute_goals(_) --> []. 213 214clpqr_gelerattribute_goals(V) --> clpqr_itf:attribute_goals(V). 215 216del_itf([]). 217del_itf([H|T]) :- 218 del_attr(H, clpqr_itf), 219 del_itf(T). 220 221 222list_to_conj([], true) :- !. 223list_to_conj([X], X) :- !. 224list_to_conj([H|T0], (H,T)) :- 225 list_to_conj(T0, T). 226 227 /******************************* 228 * SANDBOX * 229 *******************************/ 230:- multifile 231 sandbox:safe_primitive/1. 232 233sandbox:safe_primitive(clpqr_dump:dump(_,_,_))