From b2f95b60e6c1c211f2bf5ac83dc0a8e8a1342cf3 Mon Sep 17 00:00:00 2001
From: Tom Schrijvers <tom.schrijvers@cs.kuleuven.be>
Date: Thu, 3 Jan 2008 10:11:52 +0100
Subject: [PATCH] Inlined inthash lookups.

---
 ChangeLog           |  1 +
 Tests/dense_int.chr | 26 ++++++++++++++++++++++++++
 chr_translate.chr   | 23 +++++++++++------------
 3 files changed, 38 insertions(+), 12 deletions(-)
 create mode 100644 Tests/dense_int.chr

diff --git a/ChangeLog b/ChangeLog
index 27bdfc0..85b41cc 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -5,6 +5,7 @@ Jan 3, 2008
 	and never stored.
   * TS: write/1, writeln/1 and format/2 are now treated as non-binding
 	builtins.
+  * TS: Properly inline inthash constraint lookup.
 
 Dec 31, 2007
 
diff --git a/Tests/dense_int.chr b/Tests/dense_int.chr
new file mode 100644
index 0000000..6bb042a
--- /dev/null
+++ b/Tests/dense_int.chr
@@ -0,0 +1,26 @@
+:- module(dense_int,[dense_int/0]).
+
+:-use_module(library(chr)).
+
+:-chr_type 'Arity' == dense_int.
+
+:-chr_constraint c1(+'Arity').
+  
+:-chr_option(line_numbers, on).
+:-chr_option(check_guard_bindings, on).
+:-chr_option(debug, off).
+:-chr_option(optimize, full).
+
+dense_int :-
+  c1(1),
+  c1(1).
+
+
+no_duplicates @
+  c1(X)
+  \
+  c1(X)
+  <=>
+  true.
+
+
diff --git a/chr_translate.chr b/chr_translate.chr
index f1fd66c..23802fb 100644
--- a/chr_translate.chr
+++ b/chr_translate.chr
@@ -3512,18 +3512,13 @@ identifier_store_initialization(IndexType,L,T) :-
 multi_inthash_via_lookups([],_,L,L).
 multi_inthash_via_lookups([Index|Indexes],C,L,T) :-
 	multi_hash_via_lookup_head(C,Index,Key,SuspsList,Head),
-	multi_hash_store_name(C,Index,StoreName),
-	Body = 
-	(
-		nb_getval(StoreName,HT),
-		lookup_iht(HT,Key,SuspsList)
-	),
+	multi_hash_via_lookup_goal(C,inthash,Index,Key,SuspsList,Body),
 	L = [(Head :- Body)|L1],
 	multi_inthash_via_lookups(Indexes,C,L1,T).
 multi_hash_via_lookups([],_,L,L).
 multi_hash_via_lookups([Index|Indexes],C,L,T) :-
 	multi_hash_via_lookup_head(C,Index,Key,SuspsList,Head),
-	multi_hash_via_lookup_goal(C,Index,Key,SuspsList,Body),
+	multi_hash_via_lookup_goal(C,hash,Index,Key,SuspsList,Body),
 	L = [(Head :- Body)|L1],
 	multi_hash_via_lookups(Indexes,C,L1,T).
 
@@ -3531,14 +3526,14 @@ multi_hash_via_lookup_head(ConstraintSymbol,Index,Key,SuspsList,Head) :-
 	multi_hash_via_lookup_name(ConstraintSymbol,Index,Name),
 	Head =.. [Name,Key,SuspsList].
 
-%%	multi_hash_via_lookup_goal(+ConstraintSymbol,+Index,+Key,+SuspsList,-Goal) is det.
+%%	multi_hash_via_lookup_goal(+ConstraintSymbol,+HashType,+Index,+Key,+SuspsList,-Goal) is det.
 %
 %	Returns goal that performs hash table lookup.
-multi_hash_via_lookup_goal(ConstraintSymbol,Index,Key,SuspsList,Goal) :-
+multi_hash_via_lookup_goal(ConstraintSymbol,HashType,Index,Key,SuspsList,Goal) :-
 	% INLINED:
 	multi_hash_store_name(ConstraintSymbol,Index,StoreName),
 	make_get_store_goal(StoreName,HT,GetStoreGoal),
-	( specialized_hash_term_call(Key,Hash,HashCall) ->
+	( HashType == hash, specialized_hash_term_call(Key,Hash,HashCall) ->
 		Goal = 
 		(
 			GetStoreGoal, % nb_getval(StoreName,HT),
@@ -3546,14 +3541,18 @@ multi_hash_via_lookup_goal(ConstraintSymbol,Index,Key,SuspsList,Goal) :-
 			lookup_ht1(HT,Hash,Key,SuspsList)
 		)
 	;
+		lookup_hash_call(HashType,HT,Key,SuspsList,Lookup),
 		Goal = 
 		(
 			GetStoreGoal, % nb_getval(StoreName,HT),
 			hash_term(Key,Hash),
-			lookup_ht(HT,Key,SuspsList)
+			Lookup
 		)
 	).
 
+lookup_hash_call(hash,HT,Key,SuspsList,lookup_ht(HT,Key,SuspsList)).
+lookup_hash_call(inthash,HT,Key,SuspsList,lookup_iht(HT,Key,SuspsList)).
+
 specialized_hash_term_call(Key,Hash,Call) :-
 	( ground(Key) ->
 		% This is based on a property of SWI-Prolog's 
@@ -7911,7 +7910,7 @@ hash_lookup_passive_head(HashType,Indexes,Head,VarDict,GroundVars,Goal,AllSusps,
 		KeyCopy =.. [k|KeyArgCopies]
 	),
 	functor(Head,F,A),
-	multi_hash_via_lookup_goal(F/A,Index,KeyCopy,AllSusps,LookupGoal),
+	multi_hash_via_lookup_goal(F/A,HashType,Index,KeyCopy,AllSusps,LookupGoal),
 	
 	check_ground(GroundVars,KeyArgs,OriginalGroundCheck),
 	my_term_copy(OriginalGroundCheck,VarDict,GroundCheck),
-- 
2.11.4.GIT