kibi-swipl-linux-x64-gnu 1.0.0

package/lib/swipl/library/ext/chr/chr/chr_hashtable_store.pl

@@ -0,0 +1,425 @@
+/*  Part of CHR (Constraint Handling Rules)
+
+    Author:        Tom Schrijvers
+    E-mail:        Tom.Schrijvers@cs.kuleuven.be
+    WWW:           http://www.swi-prolog.org
+    Copyright (c)  2004-2013, K.U. Leuven
+    All rights reserved.
+
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions
+    are met:
+
+    1. Redistributions of source code must retain the above copyright
+       notice, this list of conditions and the following disclaimer.
+
+    2. Redistributions in binary form must reproduce the above copyright
+       notice, this list of conditions and the following disclaimer in
+       the documentation and/or other materials provided with the
+       distribution.
+
+    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+    POSSIBILITY OF SUCH DAMAGE.
+*/
+
+% author: Tom Schrijvers
+% email:  Tom.Schrijvers@cs.kuleuven.be
+% copyright: K.U.Leuven, 2004
+
+:- module(chr_hashtable_store,
+	[ new_ht/1,
+	  lookup_ht/3,
+	  lookup_ht1/4,
+	  lookup_ht2/4,
+	  insert_ht/3,
+	  insert_ht1/4,
+	  insert_ht/4,
+	  delete_ht/3,
+	  delete_ht1/4,
+	  delete_first_ht/3,
+	  value_ht/2,
+	  stats_ht/1,
+	  stats_ht/1
+	]).
+
+:- use_module(pairlist).
+:- use_module(library(dialect/hprolog)).
+:- use_module(library(lists)).
+
+:- multifile user:goal_expansion/2.
+:- dynamic user:goal_expansion/2.
+
+initial_capacity(89).
+
+new_ht(HT) :-
+	initial_capacity(Capacity),
+	new_ht(Capacity,HT).
+
+new_ht(Capacity,HT) :-
+	functor(T1,t,Capacity),
+	HT = ht(Capacity,0,Table),
+	Table = T1.
+
+lookup_ht(HT,Key,Values) :-
+	term_hash(Key,Hash),
+	lookup_ht1(HT,Hash,Key,Values).
+/*
+	HT = ht(Capacity,_,Table),
+	Index is (Hash mod Capacity) + 1,
+	arg(Index,Table,Bucket),
+	nonvar(Bucket),
+	( Bucket = K-Vs ->
+	    K == Key,
+	    Values = Vs
+	;
+	    lookup(Bucket,Key,Values)
+	).
+*/
+
+% :- load_foreign_library(chr_support).
+
+/*
+lookup_ht1(HT,Hash,Key,Values) :-
+	( lookup_ht1_(HT,Hash,Key,Values) ->
+		true
+	;
+		( lookup_ht1__(HT,Hash,Key,Values) ->
+			writeln(lookup_ht1(HT,Hash,Key,Values)),
+			throw(error)
+		;
+			fail
+		)
+	).
+*/
+
+lookup_ht1(HT,Hash,Key,Values) :-
+	HT = ht(Capacity,_,Table),
+	Index is (Hash mod Capacity) + 1,
+	arg(Index,Table,Bucket),
+	nonvar(Bucket),
+	( Bucket = K-Vs ->
+	    K == Key,
+	    Values = Vs
+	;
+	    lookup(Bucket,Key,Values)
+	).
+
+lookup_ht2(HT,Key,Values,Index) :-
+	term_hash(Key,Hash),
+	HT = ht(Capacity,_,Table),
+	Index is (Hash mod Capacity) + 1,
+	arg(Index,Table,Bucket),
+	nonvar(Bucket),
+	( Bucket = K-Vs ->
+	    K == Key,
+	    Values = Vs
+	;
+	    lookup(Bucket,Key,Values)
+	).
+
+lookup_pair_eq([P | KVs],Key,Pair) :-
+	P = K-_,
+	( K == Key ->
+		P = Pair
+	;
+		lookup_pair_eq(KVs,Key,Pair)
+	).
+
+insert_ht(HT,Key,Value) :-
+	term_hash(Key,Hash),
+	HT = ht(Capacity0,Load,Table0),
+	LookupIndex is (Hash mod Capacity0) + 1,
+	arg(LookupIndex,Table0,LookupBucket),
+	( var(LookupBucket) ->
+		LookupBucket = Key - [Value]
+	; LookupBucket = K-Values ->
+		( K == Key ->
+			setarg(2,LookupBucket,[Value|Values])
+		;
+			setarg(LookupIndex,Table0,[Key-[Value],LookupBucket])
+		)
+	;
+		( lookup_pair_eq(LookupBucket,Key,Pair) ->
+			Pair = _-Values,
+			setarg(2,Pair,[Value|Values])
+		;
+			setarg(LookupIndex,Table0,[Key-[Value]|LookupBucket])
+		)
+	),
+	NLoad is Load + 1,
+	setarg(2,HT,NLoad),
+	( Load == Capacity0 ->
+		expand_ht(HT,_Capacity)
+	;
+		true
+	).
+
+insert_ht1(HT,Key,Hash,Value) :-
+	HT = ht(Capacity0,Load,Table0),
+	LookupIndex is (Hash mod Capacity0) + 1,
+	arg(LookupIndex,Table0,LookupBucket),
+	( var(LookupBucket) ->
+		LookupBucket = Key - [Value]
+	; LookupBucket = K-Values ->
+		( K == Key ->
+			setarg(2,LookupBucket,[Value|Values])
+		;
+			setarg(LookupIndex,Table0,[Key-[Value],LookupBucket])
+		)
+	;
+		( lookup_pair_eq(LookupBucket,Key,Pair) ->
+			Pair = _-Values,
+			setarg(2,Pair,[Value|Values])
+		;
+			setarg(LookupIndex,Table0,[Key-[Value]|LookupBucket])
+		)
+	),
+	NLoad is Load + 1,
+	setarg(2,HT,NLoad),
+	( Load == Capacity0 ->
+		expand_ht(HT,_Capacity)
+	;
+		true
+	).
+
+% LDK: insert version with extra argument denoting result
+
+insert_ht(HT,Key,Value,Result) :-
+	HT = ht(Capacity,Load,Table),
+	term_hash(Key,Hash),
+	LookupIndex is (Hash mod Capacity) + 1,
+	arg(LookupIndex,Table,LookupBucket),
+	(   var(LookupBucket)
+	->  Result = [Value],
+	    LookupBucket = Key - Result,
+	    NewLoad is Load + 1
+	;   LookupBucket = K - V
+	->  (   K = Key
+	    ->  Result = [Value|V],
+		setarg(2,LookupBucket,Result),
+		NewLoad = Load
+	    ;   Result = [Value],
+		setarg(LookupIndex,Table,[Key - Result,LookupBucket]),
+		NewLoad is Load + 1
+	    )
+	;   (   lookup_pair_eq(LookupBucket,Key,Pair)
+	    ->  Pair = _-Values,
+		Result = [Value|Values],
+		setarg(2,Pair,Result),
+		NewLoad = Load
+	    ;   Result = [Value],
+		setarg(LookupIndex,Table,[Key - Result|LookupBucket]),
+		NewLoad is Load + 1
+	    )
+	),
+	setarg(2,HT,NewLoad),
+	(   NewLoad > Capacity
+	->  expand_ht(HT,_)
+	;   true
+	).
+
+% LDK: deletion of the first element of a bucket
+delete_first_ht(HT,Key,Values) :-
+	HT = ht(Capacity,Load,Table),
+	term_hash(Key,Hash),
+	Index is (Hash mod Capacity) + 1,
+	arg(Index,Table,Bucket),
+	(   Bucket = _-[_|Values]
+	->  (   Values = []
+	    ->  setarg(Index,Table,_),
+		NewLoad is Load - 1
+	    ;   setarg(2,Bucket,Values),
+		NewLoad = Load
+	    )
+	;   lookup_pair_eq(Bucket,Key,Pair)
+	->  Pair = _-[_|Values],
+	    (   Values = []
+	    ->  pairlist_delete_eq(Bucket,Key,NewBucket),
+		(   NewBucket = []
+		->  setarg(Index,Table,_)
+		;   NewBucket = [OtherPair]
+		->  setarg(Index,Table,OtherPair)
+		;   setarg(Index,Table,NewBucket)
+		),
+		NewLoad is Load - 1
+	    ;   setarg(2,Pair,Values),
+		NewLoad = Load
+	    )
+	),
+	setarg(2,HT,NewLoad).
+
+delete_ht(HT,Key,Value) :-
+	HT = ht(Capacity,Load,Table),
+	NLoad is Load - 1,
+	term_hash(Key,Hash),
+	Index is (Hash mod Capacity) + 1,
+	arg(Index,Table,Bucket),
+	( /* var(Bucket) ->
+		true
+	; */ Bucket = _K-Vs ->
+		( /* _K == Key, */
+		  delete_first_fail(Vs,Value,NVs) ->
+			setarg(2,HT,NLoad),
+			( NVs == [] ->
+				setarg(Index,Table,_)
+			;
+				setarg(2,Bucket,NVs)
+			)
+		;
+			true
+		)
+	;
+		( lookup_pair_eq(Bucket,Key,Pair),
+		  Pair = _-Vs,
+		  delete_first_fail(Vs,Value,NVs) ->
+			setarg(2,HT,NLoad),
+			( NVs == [] ->
+				pairlist_delete_eq(Bucket,Key,NBucket),
+				( NBucket = [Singleton] ->
+					setarg(Index,Table,Singleton)
+				;
+					setarg(Index,Table,NBucket)
+				)
+			;
+				setarg(2,Pair,NVs)
+			)
+		;
+			true
+		)
+	).
+
+delete_first_fail([X | Xs], Y, Zs) :-
+	( X == Y ->
+		Zs = Xs
+	;
+		Zs = [X | Zs1],
+		delete_first_fail(Xs, Y, Zs1)
+	).
+
+delete_ht1(HT,Key,Value,Index) :-
+	HT = ht(_Capacity,Load,Table),
+	NLoad is Load - 1,
+	% term_hash(Key,Hash),
+	% Index is (Hash mod _Capacity) + 1,
+	arg(Index,Table,Bucket),
+	( /* var(Bucket) ->
+		true
+	; */ Bucket = _K-Vs ->
+		( /* _K == Key, */
+		  delete_first_fail(Vs,Value,NVs) ->
+			setarg(2,HT,NLoad),
+			( NVs == [] ->
+				setarg(Index,Table,_)
+			;
+				setarg(2,Bucket,NVs)
+			)
+		;
+			true
+		)
+	;
+		( lookup_pair_eq(Bucket,Key,Pair),
+		  Pair = _-Vs,
+		  delete_first_fail(Vs,Value,NVs) ->
+			setarg(2,HT,NLoad),
+			( NVs == [] ->
+				pairlist_delete_eq(Bucket,Key,NBucket),
+				( NBucket = [Singleton] ->
+					setarg(Index,Table,Singleton)
+				;
+					setarg(Index,Table,NBucket)
+				)
+			;
+				setarg(2,Pair,NVs)
+			)
+		;
+			true
+		)
+	).
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+value_ht(HT,Value) :-
+	HT = ht(Capacity,_,Table),
+	value_ht(1,Capacity,Table,Value).
+
+value_ht(I,N,Table,Value) :-
+	I =< N,
+	arg(I,Table,Bucket),
+	(
+		nonvar(Bucket),
+		( Bucket = _-Vs ->
+			true
+		;
+			member(_-Vs,Bucket)
+		),
+		member(Value,Vs)
+	;
+		J is I + 1,
+		value_ht(J,N,Table,Value)
+	).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+expand_ht(HT,NewCapacity) :-
+	HT = ht(Capacity,_,Table),
+	NewCapacity is Capacity * 2 + 1,
+	functor(NewTable,t,NewCapacity),
+	setarg(1,HT,NewCapacity),
+	setarg(3,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
+		; Bucket = Key - Value ->
+			expand_insert(NewTable,NewCapacity,Key,Value)
+		;
+			expand_inserts(Bucket,NewTable,NewCapacity)
+		),
+		J is I + 1,
+		expand_copy(Table,J,N,NewTable,NewCapacity)
+	).
+
+expand_inserts([],_,_).
+expand_inserts([K-V|R],Table,Capacity) :-
+	expand_insert(Table,Capacity,K,V),
+	expand_inserts(R,Table,Capacity).
+
+expand_insert(Table,Capacity,K,V) :-
+	term_hash(K,Hash),
+	Index is (Hash mod Capacity) + 1,
+	arg(Index,Table,Bucket),
+	( var(Bucket) ->
+		Bucket = K - V
+	; Bucket = _-_ ->
+		setarg(Index,Table,[K-V,Bucket])
+	;
+		setarg(Index,Table,[K-V|Bucket])
+	).
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+stats_ht(HT) :-
+	HT = ht(Capacity,Load,Table),
+	format('HT load = ~w / ~w\n',[Load,Capacity]),
+	( between(1,Capacity,Index),
+		arg(Index,Table,Entry),
+		( var(Entry)  -> Size = 0
+		; Entry = _-_ -> Size = 1
+		; length(Entry,Size)
+		),
+		format('~w : ~w\n',[Index,Size]),
+		fail
+	;
+		true
+	).

package/lib/swipl/library/ext/chr/chr/chr_integertable_store.pl

@@ -0,0 +1,139 @@
+/*  Part of CHR (Constraint Handling Rules)
+
+    Author:        Jon Sneyers
+    E-mail:        Jon.Sneyers@cs.kuleuven.be
+    WWW:           http://www.swi-prolog.org
+    Copyright (c)  2006-2011, K.U. Leuven
+    All rights reserved.
+
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions
+    are met:
+
+    1. Redistributions of source code must retain the above copyright
+       notice, this list of conditions and the following disclaimer.
+
+    2. Redistributions in binary form must reproduce the above copyright
+       notice, this list of conditions and the following disclaimer in
+       the documentation and/or other materials provided with the
+       distribution.
+
+    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+    POSSIBILITY OF SUCH DAMAGE.
+*/
+
+% based on chr_hashtable_store (by Tom Schrijvers)
+% 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(library(dialect/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<<ceil(log(Index)/log(2)),
+		expand_iht(HT,Capacity),
+		insert_iht(HT,Int,Value)
+	).
+
+delete_iht(ht(_,Table),Int,Value) :-
+%	arg(2,HT,Table),
+	Index is Int + 1,
+	arg(Index,Table,Bucket),
+	( Bucket = [_Value] ->
+		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)
+	).