;*=====================================================================*/
;*    serrano/prgm/project/bigloo/runtime/Llib/hash.scm                */
;*    -------------------------------------------------------------    */
;*    Author      :  Manuel Serrano                                    */
;*    Creation    :  Thu Sep  1 08:51:06 1994                          */
;*    Last change :  Tue May 13 11:05:26 2003 (serrano)                */
;*    -------------------------------------------------------------    */
;*    The hash tables.                                                 */
;*    -------------------------------------------------------------    */
;*    Source documentation:                                            */
;*       @path ../../manuals/body.texi@                                */
;*       @node Hash Tables@                                            */
;*    -------------------------------------------------------------    */
;*    This implementation is cumbersome because the keys are inside    */
;*    the objects. Unfortunately I can't change this because these     */
;*    hash table are extensively used by the compiler. This approach   */
;*    has the advantage to be space and time efficient.                */
;*=====================================================================*/

;*---------------------------------------------------------------------*/
;*    The module                                                       */
;*---------------------------------------------------------------------*/
(module __hash

   (import  __error
	    __r4_symbols_6_4)

   (use     __type
	    __bigloo
	    __structure
	    __bit
	    __tvector
	    __object
	    __r4_numbers_6_5_fixnum
	    __r4_numbers_6_5_flonum
	    __r4_equivalence_6_2
	    __r4_control_features_6_9
	    __r4_characters_6_6
	    __r4_booleans_6_1
	    __r4_vectors_6_8
	    __r4_pairs_and_lists_6_3
	    __r4_strings_6_7
	    __foreign
	    __evenv)

   ;; the new interface
   (extern  (string-hash-number::int (::string) "bgl_string_hash_number")
	    (symbol-hash-number::int (::symbol) "bgl_symbol_hash_number")
	    (keyword-hash-number::int (::keyword) "bgl_keyword_hash_number")
	    (obj-hash-number::int (::obj) "bgl_obj_hash_number")
	    (foreign-hash-number::int (::foreign) "bgl_foreign_hash_number"))
   
   ;; the old interface
   (extern  (get_hash_number::long (::string)
		   "get_hash_number")
	    (get_hash_power_number::long (::string ::long)
                   "get_hash_power_number")

	    (get_hash_number_from_int::long (::long)
		   "get_hash_number_from_int")
	    (get_hash_power_number_from_int::long (::long ::long)
		   "get_hash_power_number_from_int")

	    (get_hash_number_from_pointer::long (::obj)
		   "get_hash_number_from_pointer")
	    (get_hash_power_number_from_pointer::long (::obj ::long)
		   "get_hash_power_number_from_pointer"))

   ;; the new interface
   (java    (class foreign
	       (method static string-hash-number::int (::string)
		       "bgl_string_hash_number")
	       (method static symbol-hash-number::int (::symbol)
		       "bgl_symbol_hash_number")
	       (method static keyword-hash-number::int (::keyword)
		       "bgl_keyword_hash_number")
	       (method static obj-hash-number::int (::obj)
		       "bgl_obj_hash_number")
	       (method static foreign-hash-number::int (::obj)
		       "bgl_foreign_hash_number")))

   ;; the old interface
   (java    (class foreign
	       (method static get_hash_number::long (::string)
		       "get_hash_number")
	       (method static get_hash_power_number::long (::string ::long)
		       "get_hash_power_number")
	       
	       (method static get_hash_number_from_int::long (::long)
		       "get_hash_number_from_int")
	       (method static get_hash_power_number_from_int::long (::long ::long)
		       "get_hash_power_number_from_int")
	       
	       (method static get_hash_number_from_pointer::long (::obj)
		       "get_hash_number_from_int")
	       (method static get_hash_power_number_from_pointer::long (::obj ::long)
		       "get_hash_power_number_from_int")))


   ;; the new interface
   (export  (make-hashtable . args)
	    (get-hashnumber::int ::obj)
	    (hashtable?::bool ::obj)
	    (hashtable-size::int ::struct)
	    (hashtable-get::obj ::struct ::obj)
	    (hashtable-put! ::struct ::obj ::obj)
	    (hashtable-update! ::struct ::obj ::procedure ::obj)
	    (hashtable-remove!::bool ::struct ::obj)
	    (hashtable->vector::vector ::struct)
	    (hashtable->list::pair-nil ::struct)
	    (hashtable-key-list::pair-nil ::struct)
	    (hashtable-for-each ::struct ::procedure))

   ;; the old interface
   (export  (make-hash-table  ::long ::procedure ::procedure
				::procedure . <size>)
	    (hash-table?::bool         <obj>)
	    (hash-table-nb-entry       <table>)
	    (hash-table->vector        <table>)

	    (get-hash                  <key> <table>)
	    (put-hash!                 <obj> <table>)
	    (rem-obj-hash!             <obj> <table>)

	    (rem-key-hash!             <obj> <table>)
	    (for-each-hash             ::procedure <table>)

	    (inline string->0..255::long   ::string)
	    (inline string->0..2^x-1::long ::string ::long)
	    (inline int->0..255::long      ::long)
	    (inline int->0..2^x-1::long    ::long ::long)
	    (obj->0..255::long             ::obj)
	    (obj->0..2^x-1::long           ::obj ::long))

   (pragma  (hashtable-get side-effect-free))

   (pragma  (get-hash side-effect-free)
	    (get_hash_number_from_int nesting)
	    (get_hash_power_number_from_int nesting)
	    (get_hash_number_from_pointer nesting)
	    (get_hash_power_number_from_pointer nesting)))

;*---------------------------------------------------------------------*/
;*    Default hashtable configuration                                  */
;*---------------------------------------------------------------------*/
(define default-hashtable-bucket-length 128)
(define default-max-bucket-length 10)

;*---------------------------------------------------------------------*/
;*    %hashtable                                                       */
;*---------------------------------------------------------------------*/
(define-struct %hashtable size max-bucket-len buckets)

;*---------------------------------------------------------------------*/
;*    make-hashtable ...                                               */
;*---------------------------------------------------------------------*/
(define (make-hashtable . args)
   (let ((size (if (pair? args)
		   (if (and (fixnum? (car args))
			    (>=fx (car args) 1))
		       (car args)
		       (error "make-hashtable"
			      "Illegal default bucket length"
			      args))
		   default-hashtable-bucket-length))
	 (mblen (if (and (pair? args) (pair? (cdr args)))
		    (if (and (fixnum? (cadr args))
			     (>=fx (cadr args) 1))
			(cadr args)
			(error "make-hashtable"
			       "Illegal max bucket length"
			       args))
		    default-max-bucket-length)))
      (%hashtable 0 mblen (make-vector size '()))))

;*---------------------------------------------------------------------*/
;*    hashtable? ...                                                   */
;*---------------------------------------------------------------------*/
(define (hashtable?::bool obj::obj)
   (%hashtable? obj))

;*---------------------------------------------------------------------*/
;*    hashtable-size ...                                               */
;*---------------------------------------------------------------------*/
(define (hashtable-size::int table::struct)
   (%hashtable-size table))

;*---------------------------------------------------------------------*/
;*    hashtable->vector ...                                            */
;*---------------------------------------------------------------------*/
(define (hashtable->vector table::struct)
   (let* ((vec (make-vector (hashtable-size table)))
	  (buckets (%hashtable-buckets table))
	  (buckets-len (vector-length buckets)))
      (let loop ((i 0)
		 (w 0))
	 (if (=fx i buckets-len)
	     vec
	     (let liip ((bucket (vector-ref buckets i))
			(w w))
		(if (null? bucket)
		    (loop (+fx i 1) w)
		    (begin
		       (vector-set! vec w (cdar bucket))
		       (liip (cdr bucket) (+fx w 1)))))))))

;*---------------------------------------------------------------------*/
;*    hashtable->list ...                                              */
;*---------------------------------------------------------------------*/
(define (hashtable->list table::struct)
   (let* ((vec (make-vector (hashtable-size table)))
	  (buckets (%hashtable-buckets table))
	  (buckets-len (vector-length buckets)))
      (let loop ((i 0)
		 (res '()))
	 (if (=fx i buckets-len)
	     res
	     (let liip ((bucket (vector-ref buckets i))
			(res res))
		(if (null? bucket)
		    (loop (+fx i 1) res)
		    (liip (cdr bucket) (cons (cdar bucket) res))))))))

;*---------------------------------------------------------------------*/
;*    hashtable-key-list ...                                           */
;*---------------------------------------------------------------------*/
(define (hashtable-key-list table::struct)
   (let* ((vec (make-vector (hashtable-size table)))
	  (buckets (%hashtable-buckets table))
	  (buckets-len (vector-length buckets)))
      (let loop ((i 0)
		 (res '()))
	 (if (=fx i buckets-len)
	     res
	     (let liip ((bucket (vector-ref buckets i))
			(res res))
		(if (null? bucket)
		    (loop (+fx i 1) res)
		    (liip (cdr bucket) (cons (caar bucket) res))))))))

;*---------------------------------------------------------------------*/
;*    hashtable-for-each ...                                           */
;*---------------------------------------------------------------------*/
(define (hashtable-for-each table::struct fun::procedure)
   (let* ((buckets (%hashtable-buckets table))
	  (buckets-len (vector-length buckets)))
      (let loop ((i 0))
	 (if (<fx i buckets-len)
	     (begin
		(for-each (lambda (cell)
			     (fun (car cell) (cdr cell)))
			  (vector-ref buckets i))
		(loop (+fx i 1)))))))

;*---------------------------------------------------------------------*/
;*    hashtable-get ...                                                */
;*---------------------------------------------------------------------*/
(define (hashtable-get table::struct key::obj)
   (let* ((buckets (%hashtable-buckets table))
	  (bucket-len (vector-length buckets))
	  (bucket-num (remainder (get-hashnumber key) bucket-len))
	  (bucket (vector-ref buckets bucket-num)))
      (let loop ((bucket bucket))
	 (cond
	    ((null? bucket)
	     #f)
	    ((hashtable-equal? (caar bucket) key)
	     (cdar bucket))
	    (else
	     (loop (cdr bucket)))))))

;*---------------------------------------------------------------------*/
;*    hashtable-put! ...                                               */
;*---------------------------------------------------------------------*/
(define (hashtable-put! table::struct key::obj obj::obj)
   (let* ((buckets (%hashtable-buckets table))
	  (bucket-len (vector-length buckets))
	  (bucket-num (remainder (get-hashnumber key) bucket-len))
	  (bucket (vector-ref buckets bucket-num))
	  (max-bucket-len (%hashtable-max-bucket-len table)))
      (if (null? bucket)
	  (begin
	     (%hashtable-size-set! table (+fx (%hashtable-size table) 1))
	     (vector-set! buckets bucket-num (list (cons key obj)))
	     obj)
	  (let loop ((buck bucket)
		     (count 0))
	     (cond
		((null? buck)
		 (%hashtable-size-set! table (+fx (%hashtable-size table) 1))
		 (vector-set! buckets bucket-num (cons (cons key obj) bucket))
		 (if (>fx count max-bucket-len)
		     (hashtable-expand! table))
		 obj)
		((hashtable-equal? (caar buck) key)
		 (set-cdr! (car buck) obj))
		(else
		 (loop (cdr buck) (+fx count 1))))))))

;*---------------------------------------------------------------------*/
;*    hashtable-update! ...                                            */
;*---------------------------------------------------------------------*/
(define (hashtable-update! table::struct key::obj proc::procedure obj)
   (let* ((buckets (%hashtable-buckets table))
	  (bucket-len (vector-length buckets))
	  (bucket-num (remainder (get-hashnumber key) bucket-len))
	  (bucket (vector-ref buckets bucket-num))
	  (max-bucket-len (%hashtable-max-bucket-len table)))
      (if (null? bucket)
	  (begin
	     (%hashtable-size-set! table (+fx (%hashtable-size table) 1))
	     (vector-set! buckets bucket-num (list (cons key obj)))
	     obj)
	  (let loop ((buck bucket)
		     (count 0))
	     (cond
		((null? buck)
		 (%hashtable-size-set! table (+fx (%hashtable-size table) 1))
		 (vector-set! buckets bucket-num (cons (cons key obj) bucket))
		 (if (>fx count max-bucket-len)
		     (hashtable-expand! table))
		 obj)
		((hashtable-equal? (caar buck) key)
		 (set-cdr! (car buck) (proc (cdar buck))))
		(else
		 (loop (cdr buck) (+fx count 1))))))))
   
;*---------------------------------------------------------------------*/
;*    hashtable-remove! ...                                            */
;*---------------------------------------------------------------------*/
(define (hashtable-remove! table::struct key::obj)
   (let* ((buckets (%hashtable-buckets table))
	  (bucket-len (vector-length buckets))
	  (bucket-num (remainder (get-hashnumber key) bucket-len))
	  (bucket (vector-ref buckets bucket-num)))
      (cond
	 ((null? bucket)
	  #f)
	 ((hashtable-equal? (caar bucket) key)
	  (vector-set! buckets bucket-num (cdr bucket))
	  (%hashtable-size-set! table (-fx (%hashtable-size table) 1))
	  #t)
	 (else
	  (let loop ((bucket (cdr bucket))
		     (prev bucket))
	     (if (pair? bucket)
		 (if (hashtable-equal? (caar bucket) key)
		     (begin
			(set-cdr! prev (cdr bucket))
			(%hashtable-size-set! table
					      (-fx (%hashtable-size table) 1))
			#t)
		     (loop (cdr bucket)
			   bucket))
		 #f))))))
   
;*---------------------------------------------------------------------*/
;*    hashtable-expand! ...                                            */
;*---------------------------------------------------------------------*/
(define (hashtable-expand! table)
   (let* ((old-bucks (%hashtable-buckets table))
	  (old-bucks-len (vector-length old-bucks))
	  (new-bucks-len (*fx 2 old-bucks-len))
	  (new-bucks (make-vector new-bucks-len '())))
      (%hashtable-buckets-set! table new-bucks)
      (let loop ((i 0))
	 (if (<fx i old-bucks-len)
	     (begin
		(for-each (lambda (cell)
			     (let* ((key (car cell))
				    (h   (remainder (get-hashnumber key)
						    new-bucks-len)))
				(vector-set! new-bucks
					     h
					     (cons cell
						   (vector-ref new-bucks h)))))
			  (vector-ref old-bucks i))
		(loop (+fx i 1)))))))

;*---------------------------------------------------------------------*/
;*    hashtable-equal? ...                                             */
;*---------------------------------------------------------------------*/
(define-inline (hashtable-equal? obj1 obj2)
   (if (string? obj1)
       (if (string? obj2)
	   (string=? obj1 obj2)
	   #f)
       (equal? obj1 obj2)))

;*---------------------------------------------------------------------*/
;*    get-hashnumber ...                                               */
;*---------------------------------------------------------------------*/
(define (get-hashnumber::int key)
   (cond
      ((string? key)
       (absfx (string-hash-number key)))
      ((symbol? key)
       (absfx (symbol-hash-number key)))
      ((fixnum? key)
       (absfx key))
      ((object? key)
       (absfx (object-hashnumber key)))
      ((foreign? key)
       (absfx (foreign-hash-number key)))
      (else
       (absfx (obj-hash-number key)))))

;*---------------------------------------------------------------------*/
;*    hash-table                                                       */
;*---------------------------------------------------------------------*/
(define-struct hashtbl
   max-size           ;; integer   : la taille maximum de la table
   size               ;; integer   : la taille courante de la table
   get-hash-number    ;; integer   : la fonction de hashage
   get-key            ;; obj->key  : la fonction cherchant la cle des objets
   nb-entry           ;; integer   : le nombre d'entrees de la table
   predicate          ;; oxo->bool : le predicat d'equivalence
   table)             ;; vecteur   : la table elle meme.

;*---------------------------------------------------------------------*/
;*    make-hash-table ...                                              */
;*    -------------------------------------------------------------    */
;*    max-size       : int           : la taille max de la table       */
;*    get-hash-number: key -> int    : la fonction de hashage          */
;*    get-key        : obj -> key    : la cle des objets               */
;*    eq             : obj x obj -> b: le test d'egalite.              */
;*    init-size      : int           : la taille initiale de la table  */
;*---------------------------------------------------------------------*/
(define (make-hash-table max-size get-hash-number get-key eq . init-size)
   (let ((size     (if (null? init-size)
		       max-size
		       (car init-size)))
	 (2^power? (lambda (size)
		      (and (>fx size 1)
			   (=fx 0 (bit-and size (-fx size 1)))))))
      (cond
	 ((not (2^power? size))
	  (error "make-hash-table"
		 "Illegal init-size (not a 2 power)"
		 size))
	 ((not (2^power? max-size))
	  (error "make-hash-table"
		 "Illegal max-size (not a 2 power)"
		 max-size))
	 ((>fx size max-size)
	  (error "make-hash-table"
		 "init-size greater than max-size !"
		 size))
	 (else
	  (let ((table (make-vector size '())))
	     (hashtbl max-size size get-hash-number get-key 0 eq table))))))

;*---------------------------------------------------------------------*/
;*    hash-table? ...                                                  */
;*---------------------------------------------------------------------*/
(define (hash-table? obj)
   (hashtbl? obj))

;*---------------------------------------------------------------------*/
;*    hash-table-nb-entry ...                                          */
;*---------------------------------------------------------------------*/
(define (hash-table-nb-entry table)
   (hashtbl-nb-entry table))

;*---------------------------------------------------------------------*/
;*    hash-table->vector ...                                           */
;*---------------------------------------------------------------------*/
(define (hash-table->vector table)
   (hashtbl-table table))

;*---------------------------------------------------------------------*/
;*    get-hash-number ...                                              */
;*---------------------------------------------------------------------*/
(define (get-hash-number table key)
   (let* ((hash-function (hashtbl-get-hash-number table))
	  (max-size      (hashtbl-max-size table))
	  (size          (hashtbl-size table))
	  (num           (hash-function key))
	  (res           (if (<fx size max-size)
			     (modulo num size)
			     num)))
      (if (>=fx res max-size)
	  (let ((res (error "get-hash-number"
			    "Illegal get-hash-function"
			    table)))
	     (if (fixnum? res)
		 res
		 -1))
	  res)))

;*---------------------------------------------------------------------*/
;*    get-hash ...                                                     */
;*---------------------------------------------------------------------*/
(define (get-hash key table)
   (let* ((hash-num  (get-hash-number table key))
	  (hash-eq?  (hashtbl-predicate table))
	  (bucket    (vector-ref (hashtbl-table table) hash-num))
	  (get-key   (hashtbl-get-key table)))
      (let loop ((bucket bucket))
	 (cond
	    ((null? bucket)
	     #f)
	    ((hash-eq? (get-key (car bucket)) key)
	     (car bucket))
	    (else
	     (loop (cdr bucket)))))))

;*---------------------------------------------------------------------*/
;*    put-hash! ...                                                    */
;*---------------------------------------------------------------------*/
(define (put-hash! obj table)
   (if (and (<fx (hashtbl-size table) (hashtbl-max-size table))
	    (>fx (hash-table-nb-entry table)
		 (/fx (hashtbl-size table) 2)))
       ;; quand le nombre d'entree est egal a la taille de la table
       ;; divisee par deux, a augemte la table
       (hash-table-grows! table))
   (let* ((get-key    (hashtbl-get-key table))
	  (key        (get-key obj))
	  (hash-eq?   (hashtbl-predicate table))
	  (hash-num   (get-hash-number table key))
	  (vec        (hashtbl-table table))
	  (bucket     (vector-ref vec hash-num)))
      (if (null? bucket)
	  (begin
	     (hashtbl-nb-entry-set! table (+fx 1 (hashtbl-nb-entry table)))
	     (vector-set! vec hash-num (list obj))
	     obj)
	  (let loop ((bucket bucket))
	     (cond
		((hash-eq? (get-key (car bucket)) key)
		 (car bucket))
		((null? (cdr bucket))
		 (hashtbl-nb-entry-set! table (+fx 1 (hashtbl-nb-entry table)))
		 (set-cdr! bucket (list obj))
		 obj)
		(else
		 (loop (cdr bucket))))))))

;*---------------------------------------------------------------------*/
;*    rem-obj-hash! ...                                                */
;*---------------------------------------------------------------------*/
(define (rem-obj-hash! obj table)
   (let* ((get-key    (hashtbl-get-key table))
	  (key        (get-key obj))
	  (hash-eq?   (hashtbl-predicate table))
	  (hash-num   (get-hash-number table key))
	  (vec        (hashtbl-table table))
	  (bucket     (vector-ref vec hash-num)))
      (cond
	 ((null? bucket)
	  #f)
	 ((eq? (car bucket) obj)
	  (hashtbl-nb-entry-set! table (-fx (hashtbl-nb-entry table) 1))
	  (vector-set! vec hash-num (cdr bucket))
	  #t)
	 (else
	  (let loop ((bucket bucket))
	     (cond
		((eq? (cadr bucket) obj)
		 (hashtbl-nb-entry-set! table (-fx (hashtbl-nb-entry table) 1))
		 (set-cdr! bucket (cddr bucket))
		 #t)
		((null? (cdr bucket))
		 #f)
		(else
		 (loop (cdr bucket)))))))))

;*---------------------------------------------------------------------*/
;*    rem-key-hash! ...                                                */
;*---------------------------------------------------------------------*/
(define (rem-key-hash! key table)
   (let* ((get-key    (hashtbl-get-key table))
	  (hash-eq?   (hashtbl-predicate table))
	  (hash-num   (get-hash-number table key))
	  (vec        (hashtbl-table table))
	  (bucket     (vector-ref vec hash-num)))
      (cond
	 ((null? bucket)
	  #f)
	 ((hash-eq? (get-key (car bucket)) key)
	  (hashtbl-nb-entry-set! table (-fx (hashtbl-nb-entry table) 1))
	  (vector-set! vec hash-num (cdr bucket))
	  #t)
	 (else
	  (let loop ((bucket bucket))
	     (cond
		((hash-eq? (get-key (cadr bucket)) key)
		 (hashtbl-nb-entry-set! table (-fx (hashtbl-nb-entry table) 1))
		 (set-cdr! bucket (cddr bucket))
		 #t)
		((null? (cdr bucket))
		 #f)
		(else
		 (loop (cdr bucket)))))))))

;*---------------------------------------------------------------------*/
;*    for-each-hash ...                                                */
;*---------------------------------------------------------------------*/
(define (for-each-hash fun table)
   (let ((vec (hashtbl-table table)))
      (let loop ((i (-fx (hashtbl-size table) 1)))
	 (if (=fx i -1)
	     #unspecified
	     (begin
		(for-each fun (vector-ref vec i))
		(loop (-fx i 1)))))))

;*---------------------------------------------------------------------*/
;*    hash-table-grows! ...                                            */
;*---------------------------------------------------------------------*/
(define (hash-table-grows! table)
   (let* ((max-size   (hashtbl-max-size table))
	  (size       (hashtbl-size table))
	  (new-size   (*fx size 2))
	  (new-table  (make-vector new-size '()))
	  (old-table  (hash-table->vector table)))
      ;; on reajuste la table de hash
      (hashtbl-size-set!  table new-size)
      (hashtbl-table-set! table new-table)
      ;; remettre a zero le nombre d'elements
      ;; a cause des appels a put-hash! juste apres
      (hashtbl-nb-entry-set! table 0)
      ;; on rehash tous les elements du vector dans la nouvelle table.
      (let loop ((i 0))
	 (if (=fx i size)
	     'done
	     (let ((bucket (vector-ref old-table i)))
		(for-each (lambda (obj)
			     (put-hash! obj table))
			  bucket)
		(loop (+fx i 1)))))))

;*---------------------------------------------------------------------*/
;*    string->0..255 ...                                               */
;*---------------------------------------------------------------------*/
(define-inline (string->0..255 string)
   (get_hash_number string))

;*---------------------------------------------------------------------*/
;*    string->0..2^x-1 ...                                             */
;*---------------------------------------------------------------------*/
(define-inline (string->0..2^x-1 string power)
   (get_hash_power_number string power))

;*---------------------------------------------------------------------*/
;*    int->0..255 ...                                                  */
;*---------------------------------------------------------------------*/
(define-inline (int->0..255 int)
   (get_hash_number_from_int int))

;*---------------------------------------------------------------------*/
;*    int->0..2^x-1 ...                                                */
;*---------------------------------------------------------------------*/
(define-inline (int->0..2^x-1 int power)
   (get_hash_power_number_from_int int power))

;*---------------------------------------------------------------------*/
;*    obj->0..255 ...                                                  */
;*---------------------------------------------------------------------*/
(define (obj->0..255 obj)
   (cond
      ((string? obj)
       (string->0..255 obj))
      ((symbol? obj)
       (string->0..255 (symbol->string obj)))
      ((fixnum? obj)
       (int->0..255 obj))
      ((char? obj)
       (char->integer obj))
      ((foreign? obj)
       (int->0..255 (foreign-hash-number obj)))
      (else
       (get_hash_number_from_pointer obj))))

;*---------------------------------------------------------------------*/
;*    obj->0..2^x-1 ...                                                */
;*---------------------------------------------------------------------*/
(define (obj->0..2^x-1 obj power)
   (cond
      ((string? obj)
       (string->0..2^x-1 obj power))
      ((symbol? obj)
       (string->0..2^x-1 (symbol->string obj) power))
      ((fixnum? obj)
       (int->0..2^x-1 obj power))
      ((char? obj)
       (char->integer obj))
      ((foreign? obj)
       (int->0..2^x-1 (foreign-hash-number obj) power))
      (else
       (get_hash_power_number_from_pointer obj power))))



