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:- module(clpcd_class, 41 [ 42 class_allvars/2, 43 class_new/5, 44 class_drop/2, 45 class_basis/2, 46 class_basis_add/3, 47 class_basis_drop/2, 48 class_basis_pivot/3, 49 class_get_clp/2, 50 class_get_prio/2, 51 class_put_prio/2 52 ]). 53 54:- use_module(library(clpcd/combine)). 55:- use_module(library(lists)). 56 57% called when two classes are unified: the allvars lists are appended to eachother, as well as the basis 58% lists. 59% 60% note: La=[A,B,...,C|Lat], Lb=[D,E,...,F|Lbt], so new La = [A,B,...,C,D,E,...,F|Lbt] 61 62attr_unify_hook(class(CLP,La,Lat,ABasis,PrioA),Y) :- 63 !, 64 var(Y), 65 get_attr(Y,clpcd_class,class(CLP,Lb,Lbt,BBasis,PrioB)), 66 Lat = Lb, 67 append(ABasis,BBasis,CBasis), 68 combine(PrioA,PrioB,PrioC), 69 put_attr(Y,clpcd_class,class(CLP,La,Lbt,CBasis,PrioC)). 70attr_unify_hook(_,_). 71 72class_new(Class,CLP,All,AllT,Basis) :- 73 put_attr(Su,clpcd_class,class(CLP,All,AllT,Basis,[])), 74 Su = Class. 75 76class_get_prio(Class,Priority) :- 77 get_attr(Class,clpcd_class,class(_,_,_,_,Priority)). 78 79class_get_clp(Class,CLP) :- 80 get_attr(Class,clpcd_class,class(CLP,_,_,_,_)). 81 82class_put_prio(Class,Priority) :- 83 get_attr(Class,clpcd_class,class(CLP,All,AllT,Basis,_)), 84 put_attr(Class,clpcd_class,class(CLP,All,AllT,Basis,Priority)). 85 86class_drop(Class,X) :- 87 get_attr(Class,clpcd_class,class(CLP,Allvars,Tail,Basis,Priority)), 88 delete_first(Allvars,X,NewAllvars), 89 delete_first(Basis,X,NewBasis), 90 put_attr(Class,clpcd_class,class(CLP,NewAllvars,Tail,NewBasis,Priority)). 91 92class_allvars(Class,All) :- get_attr(Class,clpcd_class,class(_,All,_,_,_)). 93 94% class_basis(Class,Basis) 95% 96% Returns the basis of class Class. 97 98class_basis(Class,Basis) :- get_attr(Class,clpcd_class,class(_,_,_,Basis,_)). 99 100% class_basis_add(Class,X,NewBasis) 101% 102% adds X in front of the basis and returns the new basis 103 104class_basis_add(Class,X,NewBasis) :- 105 NewBasis = [X|Basis], 106 get_attr(Class,clpcd_class,class(CLP,All,AllT,Basis,Priority)), 107 put_attr(Class,clpcd_class,class(CLP,All,AllT,NewBasis,Priority)). 108 109% class_basis_drop(Class,X) 110% 111% removes the first occurrence of X from the basis (if exists) 112 113class_basis_drop(Class,X) :- 114 get_attr(Class,clpcd_class,class(CLP,All,AllT,Basis0,Priority)), 115 delete_first(Basis0,X,Basis), 116 Basis0 \== Basis, % anything deleted ? 117 !, 118 put_attr(Class,clpcd_class,class(CLP,All,AllT,Basis,Priority)). 119class_basis_drop(_,_). 120 121% class_basis_pivot(Class,Enter,Leave) 122% 123% removes first occurrence of Leave from the basis and adds Enter in front of the basis 124 125class_basis_pivot(Class,Enter,Leave) :- 126 get_attr(Class,clpcd_class,class(CLP,All,AllT,Basis0,Priority)), 127 delete_first(Basis0,Leave,Basis1), 128 put_attr(Class,clpcd_class,class(CLP,All,AllT,[Enter|Basis1],Priority)). 129 130% delete_first(Old,Element,New) 131% 132% removes the first occurrence of Element from Old and returns the result in New 133% 134% note: test via syntactic equality, not unifiability 135 136delete_first(L,_,Res) :- 137 var(L), 138 !, 139 Res = L. 140delete_first([],_,[]). 141delete_first([Y|Ys],X,Res) :- 142 ( X==Y 143 -> Res = Ys 144 ; Res = [Y|Tail], 145 delete_first(Ys,X,Tail) 146 )