From 93897e4ef450b2166a2d004bab22676609ad6cbb Mon Sep 17 00:00:00 2001 From: vsc Date: Tue, 16 Oct 2007 23:40:07 +0000 Subject: [PATCH] fix new files git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1960 b08c6af1-5177-4d33-ba66-4b1c6b8b522a --- LGPL/chr/chr_compiler_errors.pl | 166 +++++++++++++++++++++++++++++ LGPL/chr/chr_integertable_store.pl | 136 +++++++++++++++++++++++ 2 files changed, 302 insertions(+) diff --git a/LGPL/chr/chr_compiler_errors.pl b/LGPL/chr/chr_compiler_errors.pl index e69de29bb..63797838c 100644 --- a/LGPL/chr/chr_compiler_errors.pl +++ b/LGPL/chr/chr_compiler_errors.pl @@ -0,0 +1,166 @@ +/* $Id: chr_compiler_errors.pl,v 1.2 2007-10-16 23:40:07 vsc Exp $ + + Part of CHR (Constraint Handling Rules) + + Author: Tom Schrijvers + E-mail: Tom.Schrijvers@cs.kuleuven.be + WWW: http://www.swi-prolog.org + Copyright (C): 2005, K.U. Leuven + + 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 Lesser 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(chr_compiler_errors, + [ + chr_info/3, + chr_warning/3, + chr_error/3, + print_chr_error/1 + ]). + +:- use_module(chr_compiler_options). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% chr_info(+Type,+FormattedMessage,+MessageParameters) + +chr_info(_,Message,Params) :- + ( \+verbosity_on -> + true + ; + long_line_with_equality_signs, + format(user_error,'CHR compiler:\n',[]), + format(user_error,Message,Params), + long_line_with_equality_signs + ). + + +%% SWI begin +verbosity_on :- + current_prolog_flag(verbose,V), V \== silent, + current_prolog_flag(verbose_load,true). +%% SWI end + +%% SICStus begin +%% verbosity_on. % at the moment +%% SICStus end + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% chr_warning(+Type,+FormattedMessage,+MessageParameters) + +chr_warning(deprecated(Term),Message,Params) :- !, + long_line_with_equality_signs, + format(user_error,'CHR compiler WARNING: deprecated syntax ~w.\n',[Term]), + format(user_error,' `--> ',[]), + format(user_error,Message,Params), + format(user_error,' Support for deprecated syntax will be discontinued in the near future!\n',[]), + long_line_with_equality_signs. + +chr_warning(internal,Message,Params) :- !, + long_line_with_equality_signs, + format(user_error,'CHR compiler WARNING: something unexpected happened in the CHR compiler.\n',[]), + format(user_error,' `--> ',[]), + format(user_error,Message,Params), + format(user_error,' Your program may not have been compiled correctly!\n',[]), + format(user_error,' Please contact tom.schrijvers@cs.kuleuven.be.\n',[]), + long_line_with_equality_signs. + +chr_warning(unsupported_pragma(Pragma,Rule),Message,Params) :- !, + long_line_with_equality_signs, + format(user_error,'CHR compiler WARNING: unsupported pragma ~w in ~@.\n',[Pragma,format_rule(Rule)]), + format(user_error,' `--> ',[]), + format(user_error,Message,Params), + format(user_error,' Pragma is ignored!\n',[]), + long_line_with_equality_signs. +chr_warning(problem_pragma(Pragma,Rule),Message,Params) :- !, + long_line_with_equality_signs, + format(user_error,'CHR compiler WARNING: unsupported pragma ~w in ~@.\n',[Pragma,format_rule(Rule)]), + format(user_error,' `--> ',[]), + format(user_error,Message,Params), + long_line_with_equality_signs. + +chr_warning(_,Message,Params) :- + ( chr_pp_flag(verbosity,on) -> + long_line_with_equality_signs, + format(user_error,'CHR compiler WARNING:\n',[]), + format(user_error,' `--> ',[]), + format(user_error,Message,Params), + long_line_with_equality_signs + ; + true + ). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% chr_error(+Type,+FormattedMessage,+MessageParameters) + +chr_error(Type,Message,Params) :- + throw(chr_error(error(Type,Message,Params))). + +print_chr_error(error(Type,Message,Params)) :- + print_chr_error(Type,Message,Params). + +print_chr_error(syntax(Term),Message,Params) :- !, + long_line_with_equality_signs, + format(user_error,'CHR compiler ERROR: invalid syntax "~w".\n',[Term]), + format(user_error,' `--> ',[]), + format(user_error,Message,Params), + long_line_with_equality_signs. + +print_chr_error(internal,Message,Params) :- !, + long_line_with_equality_signs, + format(user_error,'CHR compiler ERROR: something unexpected happened in the CHR compiler.\n',[]), + format(user_error,' `--> ',[]), + format(user_error,Message,Params), + format(user_error,' Please contact tom.schrijvers@cs.kuleuven.be.\n',[]), + long_line_with_equality_signs. + +print_chr_error(cyclic_alias(Alias),_Message,_Params) :- !, + long_line_with_equality_signs, + format(user_error,'CHR compiler ERROR: cyclic alias "~w".\n',[Alias]), + format(user_error,' `--> Aborting compilation.\n',[]), + long_line_with_equality_signs. + +print_chr_error(_,Message,Params) :- + long_line_with_equality_signs, + format(user_error,'CHR compiler ERROR:\n',[]), + format(user_error,' `--> ',[]), + format(user_error,Message,Params), + long_line_with_equality_signs. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + +format_rule(PragmaRule) :- + PragmaRule = pragma(_,_,Pragmas,MaybeName,N), + ( MaybeName = yes(Name) -> + write('rule '), write(Name) + ; + write('rule number '), write(N) + ), + ( memberchk(line_number(LineNumber),Pragmas) -> + write(' (line '), + write(LineNumber), + write(')') + ; + true + ). + +long_line_with_equality_signs :- + format(user_error,'================================================================================\n',[]). diff --git a/LGPL/chr/chr_integertable_store.pl b/LGPL/chr/chr_integertable_store.pl index e69de29bb..e6a24b6f6 100644 --- a/LGPL/chr/chr_integertable_store.pl +++ b/LGPL/chr/chr_integertable_store.pl @@ -0,0 +1,136 @@ +/* $Id: chr_integertable_store.pl,v 1.2 2007-10-16 23:40:07 vsc Exp $ + + Part of CHR (Constraint Handling Rules) + + based on chr_hashtable_store (by Tom Schrijvers) + Author: Jon Sneyers + E-mail: Jon.Sneyers@cs.kuleuven.be + WWW: http://www.swi-prolog.org + Copyright (C): 2005, K.U. Leuven + + 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 Lesser 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. +*/ + +% is it safe to use nb_setarg here? + +:- module(chr_integertable_store, + [ new_iht/1, + lookup_iht/3, + insert_iht/3, + delete_iht/3, + value_iht/2 + ]). +:- use_module(library(lists)). +:- use_module(hprolog). + +%initial_capacity(65536). +%initial_capacity(1024). +initial_capacity(8). +%initial_capacity(2). +%initial_capacity(1). + + +new_iht(HT) :- + initial_capacity(Capacity), + new_iht(Capacity,HT). + +new_iht(Capacity,HT) :- + functor(T1,t,Capacity), + HT = ht(Capacity,Table), + Table = T1. + +lookup_iht(ht(_,Table),Int,Values) :- + Index is Int + 1, + arg(Index,Table,Values), + Values \= []. +% nonvar(Values). + +insert_iht(HT,Int,Value) :- + Index is Int + 1, + arg(2,HT,Table), + (arg(Index,Table,Bucket) -> + ( var(Bucket) -> + Bucket = [Value] + ; + setarg(Index,Table,[Value|Bucket]) + ) + ; % index > capacity + Capacity is 1< + setarg(Index,Table,[]) + ; + delete_first_fail(Bucket,Value,NBucket), + setarg(Index,Table,NBucket) + ). +%delete_first_fail([], Y, []). +%delete_first_fail([_], _, []) :- !. +delete_first_fail([X | Xs], Y, Xs) :- + X == Y, !. +delete_first_fail([X | Xs], Y, [X | Zs]) :- + delete_first_fail(Xs, Y, Zs). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +value_iht(HT,Value) :- + HT = ht(Capacity,Table), + value_iht(1,Capacity,Table,Value). + +value_iht(I,N,Table,Value) :- + I =< N, + arg(I,Table,Bucket), + ( + nonvar(Bucket), + member(Value,Bucket) + ; + J is I + 1, + value_iht(J,N,Table,Value) + ). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +expand_iht(HT,NewCapacity) :- + HT = ht(Capacity,Table), + functor(NewTable,t,NewCapacity), + setarg(1,HT,NewCapacity), + setarg(2,HT,NewTable), + expand_copy(Table,1,Capacity,NewTable,NewCapacity). + +expand_copy(Table,I,N,NewTable,NewCapacity) :- + ( I > N -> + true + ; + arg(I,Table,Bucket), + ( var(Bucket) -> + true + ; + arg(I,NewTable,Bucket) + ), + J is I + 1, + expand_copy(Table,J,N,NewTable,NewCapacity) + ).