;;;;
;;;; hash-table.stk        -- Implementation of (srfi hash-table), aka SRFI-125
;;;;
;;;; Copyright © 2022 Jeronimo Pellegrini - <j_p@aleph0.info>
;;;;
;;;;
;;;; 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 3 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 General Public License
;;;; along with this program; if not, write to the Free Software
;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;;;; USA.
;;;;
;;;; This file is a derivative work from the  implementation of
;;;; this SRFI by John Cowan, it is copyrighted as:
;;;;
;;;;;;;; Copyright (C) John Cowan (2015).

;;;;;;;; Permission is hereby granted, free of charge, to any person obtaining
;;;;;;;; a copy of this software and associated documentation
;;;;;;;; files (the "Software"), to deal in the Software without restriction,
;;;;;;;; including without limitation the rights to use, copy, modify, merge,
;;;;;;;; publish, distribute, sublicense, and/or sell copies of the Software,
;;;;;;;; and to permit persons to whom the Software is furnished to do so,
;;;;;;;; subject to the following conditions:

;;;;;;;; The above copyright notice and this permission notice shall be
;;;;;;;; included in all copies or substantial portions of the Software.

;;;;;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;;;;;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;;;;;;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;;;;;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
;;;;;;;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
;;;;;;;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
;;;;;;;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
;;;;
;;;;           Author: Jeronimo Pellegrini [j_p@aleph0.info]
;;;;    Creation date: 23-Jun-2022 10:11 (jpellegrini)
;;;;



(define-module scheme/hash-table
  (import (scheme comparator))

  (export

   (rename s125:make-hash-table make-hash-table)
   (rename s125:hash-table hash-table)
   (rename s125:hash-table-unfold hash-table-unfold)
   (rename s125:alist->hash-table alist->hash-table)
   
   (rename s125:hash-table? hash-table?)
   (rename s125:hash-table-contains? hash-table-contains?)
   (rename s125:hash-table-empty? hash-table-empty?)
   (rename s125:hash-table=? hash-table=?)
   (rename s125:hash-table-mutable? hash-table-mutable?)

   (rename s125:hash-table-ref hash-table-ref)
   (rename s125:hash-table-ref/default hash-table-ref/default)

   (rename s125:hash-table-set! hash-table-set!)
   (rename s125:hash-table-delete! hash-table-delete!)
   (rename s125:hash-table-intern! hash-table-intern!)
   (rename s125:hash-table-update! hash-table-update!)
   (rename s125:hash-table-update!/default hash-table-update!/default)
   (rename s125:hash-table-pop! hash-table-pop!)
   (rename s125:hash-table-clear! hash-table-clear!)

   (rename s125:hash-table-size hash-table-size)
   (rename s125:hash-table-keys hash-table-keys)
   (rename s125:hash-table-values hash-table-values)
   (rename s125:hash-table-entries hash-table-entries)
   (rename s125:hash-table-find hash-table-find)
   (rename s125:hash-table-count hash-table-count)

   (rename s125:hash-table-map hash-table-map)
   (rename s125:hash-table-for-each hash-table-for-each)
   (rename s125:hash-table-map! hash-table-map!)
   (rename s125:hash-table-map->list hash-table-map->list)
   (rename s125:hash-table-fold hash-table-fold)
   (rename s125:hash-table-prune! hash-table-prune!)

   (rename s125:hash-table-copy hash-table-copy)
   (rename s125:hash-table-empty-copy hash-table-empty-copy)
   (rename s125:hash-table->alist hash-table->alist)

   (rename s125:hash-table-union! hash-table-union!)
   (rename s125:hash-table-intersection! hash-table-intersection!)
   (rename s125:hash-table-difference! hash-table-difference!)
   (rename s125:hash-table-xor! hash-table-xor!)

   ;; The following procedures are deprecated by SRFI 125:

   (rename deprecated:hash                     hash)
   (rename deprecated:string-hash              string-hash)
   (rename deprecated:string-ci-hash           string-ci-hash)
   (rename deprecated:hash-by-identity         hash-by-identity)

   (rename deprecated:hash-table-equivalence-function
                                               hash-table-equivalence-function)
   (rename deprecated:hash-table-hash-function hash-table-hash-function)
   (rename deprecated:hash-table-exists?       hash-table-exists?)
   (rename deprecated:hash-table-walk          hash-table-walk)
   (rename deprecated:hash-table-merge!        hash-table-merge!)

   )

(define scheme (find-module 'SCHEME))

(define s:make-hash-table        (symbol-value 'make-hash-table        scheme))
(define s:hash-table?            (symbol-value 'hash-table?            scheme))
(define s:hash-table-size        (symbol-value 'hash-table-size        scheme))
(define s:hash-table-exists?     (symbol-value 'hash-table-exists?     scheme))
(define s:hash-table-set!        (symbol-value 'hash-table-set!        scheme))
(define s:hash-table-delete!     (symbol-value 'hash-table-delete!     scheme))
(define s:hash-table-clear!      (symbol-value 'hash-table-clear!      scheme))
(define s:hash-table-ref         (symbol-value 'hash-table-ref         scheme))
(define s:hash-table-ref/default (symbol-value 'hash-table-ref/default scheme))
(define s:hash-table-fold        (symbol-value 'hash-table-fold        scheme))
(define s:hash-table-for-each    (symbol-value 'hash-table-for-each    scheme))
(define s:hash-table-copy        (symbol-value 'hash-table-copy        scheme))
(define s:hash-table->alist      (symbol-value 'hash-table->alist      scheme))
(define s:hash-table-keys        (symbol-value 'hash-table-keys        scheme))
(define s:hash-table-values      (symbol-value 'hash-table-values      scheme))
(define s:hash-table-size        (symbol-value 'hash-table-size        scheme))
(define s:hash-table-hash        (symbol-value 'hash-table-hash        scheme))

(define s125:hash-table-mutable? (symbol-value 'hash-table-mutable?    scheme))

(define s128:default-hash        (symbol-value 'default-hash    (find-module 'scheme/comparator)))
(define s128:string-hash         (symbol-value 'string-hash     (find-module 'scheme/comparator)))
(define s128:string-ci-hash      (symbol-value 'string-ci-hash  (find-module 'scheme/comparator)))

(define s:hash-table-equivalence-function
  (symbol-value 'hash-table-equivalence-function scheme))
(define s:hash-table-hash-function
  (symbol-value 'hash-table-hash-function scheme))

;;; Comparators contain a type test predicate, which implementations
;;; of the hash-table-set! procedure can use to reject invalid keys.
;;; That's hard to do without sacrificing interoperability with R6RS
;;; and/or SRFI 69 and/or SRFI 126 hash tables.
;;;
;;; Full interoperability means the hash tables implemented here are
;;; interchangeable with the SRFI 126 hashtables used to implement them.
;;; SRFI 69 and R6RS and SRFI 126 hashtables don't contain comparators,
;;; so any association between a hash table and its comparator would have
;;; to be maintained outside the representation of hash tables themselves,
;;; which is problematic unless weak pointers are available.
;;;
;;; Not all of the hash tables implemented here will have comparators
;;; associated with them anyway, because an equivalence procedure
;;; and hash function can be used to create a hash table instead of
;;; a comparator (although that usage is deprecated by SRFI 125).
;;;
;;; One way to preserve interoperability while enforcing a comparator's
;;; type test is to incorporate that test into a hash table's hash
;;; function.  The advantage of doing that should be weighed against
;;; these disadvantages:
;;;
;;;     If the type test is slow, then hashing would also be slower.
;;;
;;;     The R6RS, SRFI 69, and SRFI 126 APIs allow extraction of
;;;     a hash function from some hash tables.
;;;     Some programmers might expect that hash function to be the
;;;     hash function encapsulated by the comparator (in the sense
;;;     of eq?, perhaps) even though this API makes no such guarantee
;;;     (and extraction of that hash function from an existing hash
;;;     table can only be done by calling a deprecated procedure).

;;; If %enforce-comparator-type-tests is true, then make-hash-table,
;;; when passed a comparator, will use a hash function that enforces
;;; the comparator's type test.

(define %enforce-comparator-type-tests #t)

;;; Given a comparator, return its hash function, possibly augmented
;;; by the comparator's type test.

(define (%comparator-hash-function comparator)
  (let ((okay? (comparator-type-test-predicate comparator))
        (hash-function (comparator-hash-function comparator)))
    (if %enforce-comparator-type-tests
        (lambda (x . rest)
          (cond ((not (okay? x))
                 (error "key rejected by hash-table comparator"
                        x
                        comparator))
                ((null? rest)
                 (hash-function x))
                (else
                 (apply hash-function x rest))))
        hash-function)))

;;; A unique (in the sense of eq?) value that will never be found
;;; within a hash-table.

(define %not-found (gensym "srfi-125:not-found"))

;;; A unique (in the sense of eq?) value that escapes only as an irritant
;;; when a hash-table key is not found.

(define %not-found-irritant (list 'not-found))

;;; The error message used when a hash-table key is not found.

(define %not-found-message "hash-table key not found")

;;; FIXME: thread-safe, weak-keys, ephemeral-keys, weak-values,
;;; and ephemeral-values are not supported by this portable
;;; reference implementation.

(define (%check-optional-arguments procname args)
  (if (or (memq 'thread-safe args)
          (memq 'weak-keys args)
          (memq 'weak-values args)
          (memq 'ephemeral-keys args)
          (memq 'ephemeral-values args))
      (error (string-append (symbol->string procname)
                            ": unsupported optional argument(s)")
             args)))

;;; This was exported by an earlier draft of SRFI 125,
;;; and is still used by hash-table=?

(define (s125:hash-table-every proc ht)
  (call-with-values
   (lambda () (s125:hash-table-entries ht))
   (lambda (keys vals)
     (let loop ((keys keys)
                (vals vals))
       (if (null? keys)
           #t
           (let* ((key (car keys))
                  (val (car vals))
                  (x   (proc key val)))
             (and x
                  (loop (cdr keys)
                        (cdr vals)))))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Exported procedures
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; Constructors.

;;; The first argument can be a comparator or an equality predicate.
;;;
;;; If the first argument is a comparator, any remaining arguments
;;; are implementation-dependent, but a non-negative exact integer
;;; should be interpreted as an initial capacity and the symbols
;;; thread-safe, weak-keys, ephemeral-keys, weak-values, and
;;; emphemeral-values should be interpreted specially.  (These
;;; special symbols are distinct from the analogous special symbols
;;; in SRFI 126.)
;;;
;;; If the first argument is not a comparator, then it had better
;;; be an equality predicate (which is deprecated by SRFI 125).
;;; If a second argument is present and is a procedure, then it's
;;; a hash function (which is allowed only for the deprecated case
;;; in which the first argument is an equality predicate).  If a
;;; second argument is not a procedure, then it's some kind of
;;; implementation-dependent optional argument, as are all arguments
;;; beyond the second.
;;;
;;; SRFI 128 defines make-eq-comparator, make-eqv-comparator, and
;;; make-equal-comparator procedures whose hash function is the
;;; default-hash procedure of SRFI 128, which is inappropriate
;;; for use with eq? and eqv? unless the object being hashed is
;;; never mutated.  Neither SRFI 125 nor 128 provide any way to
;;; define a comparator whose hash function is truly compatible
;;; with the use of eq? or eqv? as an equality predicate.
;;;
;;; That would make SRFI 125 almost as bad as SRFI 69 if not for
;;; the following paragraph of SRFI 125:
;;;
;;;     Implementations are permitted to ignore user-specified
;;;     hash functions in certain circumstances. Specifically,
;;;     if the equality predicate, whether passed as part of a
;;;     comparator or explicitly, is more fine-grained (in the
;;;     sense of R7RS-small section 6.1) than equal?, the
;;;     implementation is free — indeed, is encouraged — to
;;;     ignore the user-specified hash function and use something
;;;     implementation-dependent. This allows the use of addresses
;;;     as hashes, in which case the keys must be rehashed if
;;;     they are moved by the garbage collector. Such a hash
;;;     function is unsafe to use outside the context of
;;;     implementation-provided hash tables. It can of course be
;;;     exposed by an implementation as an extension, with
;;;     suitable warnings against inappropriate uses.
;;;
;;; That gives implementations permission to do something more
;;; useful, but when should implementations take advantage of
;;; that permission?  This implementation uses the superior
;;; solution provided by SRFI 126 whenever:
;;;
;;;     A comparator is passed as first argument and its equality
;;;     predicate is eq? or eqv?.
;;;
;;;     The eq? or eqv? procedure is passed as first argument
;;;     (which is a deprecated usage).

(define (s125:make-hash-table comparator/equiv . rest)
  (if (comparator? comparator/equiv)
      (let ((equiv (comparator-equality-predicate comparator/equiv))
            (hash-function (%comparator-hash-function comparator/equiv)))
        (%%make-hash-table equiv hash-function rest))
      (let* ((equiv comparator/equiv)
             (hash-function (if (and (not (null? rest))
                                     (procedure? (car rest)))
                                (car rest)
                                #f))
             (rest (if hash-function (cdr rest) rest)))
        (%%make-hash-table equiv hash-function rest))))

;; We'll trust STklos' hash-table-hash to do the right thing, and define
;; equal-hash and symbol-hash as synonyms to it.
;;
;; Maybe string-hash and string-ci-hash should also be treated the same way?
(define equal-hash  s:hash-table-hash)
(define symbol-hash s:hash-table-hash)

;; there's already a primitive called %make-hash-table, so we include
;; an extra '%' here...
(define (%%make-hash-table equiv hash-function opts)
  (%check-optional-arguments 'make-hash-table opts)
  (cond ((eq? equiv eq?)
         (s:make-hash-table eq?))
        ((eq? equiv eqv?)
         (s:make-hash-table eqv?))
        (hash-function
         (s:make-hash-table equiv hash-function))
        ((eq? equiv equal?)
         (s:make-hash-table equiv equal-hash))
        ((eq? equiv string=?)
         (s:make-hash-table equiv s128:string-hash))
        ((eq? equiv string-ci=?)
         (s:make-hash-table equiv s128:string-ci-hash))
        ((eq? equiv symbol=?)
         (s:make-hash-table equiv symbol-hash))
        (else
         (error "make-hash-table: unable to infer hash function"
                equiv))))

(define (s125:hash-table comparator . rest)
  (let ((ht (apply s125:make-hash-table comparator rest)))
    (let loop ((kvs rest))
      (cond
       ((null? kvs) #f)
       ((null? (cdr kvs)) (error "hash-table: wrong number of arguments"))
       ((s:hash-table-exists? ht (car kvs))
        (error "hash-table: two equivalent keys were provided"
               (car kvs)))
       (else (s:hash-table-set! ht (car kvs) (cadr kvs))
             (loop (cddr kvs)))))
    (hash-table-immutable! ht)
    ht))

(define (s125:hash-table-unfold stop? mapper successor seed comparator . rest)
  (let ((ht (apply s125:make-hash-table comparator rest)))
    (let loop ((seed seed))
      (if (stop? seed)
          ht
          (call-with-values
           (lambda () (mapper seed))
           (lambda (key val)
             (s:hash-table-set! ht key val)
             (loop (successor seed))))))))

(define (s125:alist->hash-table alist comparator/equiv . rest)
  (let ((ht (apply s125:make-hash-table comparator/equiv rest))
        (entries (reverse alist)))
    (for-each (lambda (entry)
                (s:hash-table-set! ht (car entry) (cdr entry)))
              entries)
    ht))

;;; Predicates.

(define s125:hash-table?  s:hash-table?)

(define s125:hash-table-contains? s:hash-table-exists?)

(define (s125:hash-table-empty? ht)
  (= 0 (s:hash-table-size ht)))

;;; FIXME: walks both hash tables because their key comparators
;;; might be different

(define (s125:hash-table=? value-comparator ht1 ht2)
  (let ((val=? (comparator-equality-predicate value-comparator))
        (n1 (s125:hash-table-size ht1))
        (n2 (s125:hash-table-size ht2)))
    (and (= n1 n2)
         (s125:hash-table-every (lambda (key val1)
                                  (and (s:hash-table-exists? ht2 key)
                                       (val=? val1
                                              (s:hash-table-ref ht2 key 'ignored))))
                                ht1)
         (s125:hash-table-every (lambda (key val2)
                                  (and (s:hash-table-exists? ht1 key)
                                       (val=? val2
                                              (s:hash-table-ref ht1 key 'ignored))))
                                ht2))))


;;; Accessors.

(define (s125:hash-table-ref ht key . rest)
  (let ((failure (if (null? rest) #f (car rest)))
        (success (if (or (null? rest) (null? (cdr rest))) #f (cadr rest)))
        (val (s:hash-table-ref ht key (lambda () %not-found))))
    (cond ((eq? val %not-found)
           (if (and failure (procedure? failure))
               (failure)
               (error %not-found-message ht key %not-found-irritant)))
          (success
           (success val))
          (else
           val))))

(define (s125:hash-table-ref/default ht key default)
  (s:hash-table-ref/default ht key default))

;;; Mutators.

(define s125:hash-table-clear!  s:hash-table-clear!)

(define (s125:hash-table-set! ht . rest)
  (if (= 2 (length rest))
      (s:hash-table-set! ht (car rest) (cadr rest))
      (let loop ((kvs rest))
        (cond ((and (not (null? kvs))
                    (not (null? (cdr kvs))))
               (s:hash-table-set! ht (car kvs) (cadr kvs))
               (loop (cddr kvs)))
              ((not (null? kvs))
               (error "hash-table-set!: wrong number of arguments"
                      (cons ht rest)))))))

(define (s125:hash-table-delete! ht . keys)
  (let loop ((keys keys) (cnt 0))
    (cond ((null? keys) cnt)
	  ((s:hash-table-exists? ht (car keys))
	   (s:hash-table-delete! ht (car keys))
	   (loop (cdr keys) (+ cnt 1)))
	  (else
	   (loop (cdr keys) cnt)))))

(define (s125:hash-table-intern! ht key failure)
  (if (s:hash-table-exists? ht key)
      (s125:hash-table-ref ht key)
      (let ((val (failure)))
        (s125:hash-table-set! ht key val)
        val)))

(define (s125:hash-table-update! ht key updater . rest)
  (s125:hash-table-set! ht
                   key
                   (updater (apply s125:hash-table-ref ht key rest))))

(define (s125:hash-table-update!/default ht key updater default)
  (s125:hash-table-set! ht key (updater (s:hash-table-ref/default ht key default))))

(define (s125:hash-table-pop! ht)
  (call/cc
    (lambda (return)
      (s125:hash-table-for-each
        (lambda (key value)
          (s125:hash-table-delete! ht key)
          (return key value))
        ht)
      (error "hash-table-pop!: hash table is empty" ht))))

;;; The whole hash table.

(define s125:hash-table-size s:hash-table-size)

(define s125:hash-table-keys s:hash-table-keys)

(define s125:hash-table-values s:hash-table-values)

(define (s125:hash-table-entries ht)
    (values (s:hash-table-keys ht)
            (s:hash-table-values ht)))

(define (s125:hash-table-find proc ht failure)
  (call-with-values
   (lambda () (s125:hash-table-entries ht))
   (lambda (keys vals)
     (let loop ((keys keys)
                (vals vals))
       (if (null? keys)
           (failure)
           (let* ((key (car keys))
                  (val (car vals))
                  (x   (proc key val)))
             (or x
                 (loop (cdr keys)
                       (cdr vals)))))))))

(define (s125:hash-table-count pred ht)
  (call-with-values
      (lambda () (s125:hash-table-entries ht))
    (lambda (keys vals)
      (let loop ((keys keys)
                 (vals vals)
                 (n 0))
        (if (null? keys)
            n
            (let* ((key (car keys))
                   (val (car vals))
                   (x   (pred key val)))
              (loop (cdr keys)
                    (cdr vals)
                    (if x (+ n 1) n))))))))

;;; Mapping and folding.

(define (s125:hash-table-map proc comparator ht)
  (let ((result (s125:make-hash-table comparator)))
    (s125:hash-table-for-each
     (lambda (key val)
       (s125:hash-table-set! result key (proc val)))
     ht)
    result))

(define (s125:hash-table-map->list proc ht)
  (call-with-values
      (lambda () (s125:hash-table-entries ht))
    (lambda (keys vals)
      (map proc keys vals))))

;;; With this particular implementation, the proc can safely mutate ht.
;;; That property is not guaranteed by the specification, but can be
;;; relied upon by procedures defined in this file.


(define (s125:hash-table-for-each proc h)
  (s:hash-table-for-each h proc))

(define (s125:hash-table-map! proc ht)
  (s125:hash-table-for-each (lambda (key val)
                              (s:hash-table-set! ht key (proc key val)))
                            ht))

(define (s125:hash-table-fold proc init ht)
  (if (s:hash-table? proc)
      (deprecated:hash-table-fold proc init ht)
      (s:hash-table-fold ht proc init)))


(define (s125:hash-table-prune! proc ht)
  (s125:hash-table-for-each (lambda (key val)
                              (if (proc key val)
                                  (s:hash-table-delete! ht key)))
                            ht))

;;; Copying and conversion.

(define (s125:hash-table-copy ht :optional (mutable? #f))
  (let ((ht (s:hash-table-copy ht)))
    (unless mutable?
      (hash-table-immutable! ht))
    ht))

;; FIXME: This copies the entire hashtable! It'd be better to create a
;; primitive for this
(define (s125:hash-table-empty-copy ht)
  (let* ((ht2 (s:hash-table-copy ht)))
    (s:hash-table-clear! ht2)
    ht2))

(define s125:hash-table->alist s:hash-table->alist)

;;; Hash tables as sets.

(define (s125:hash-table-union! ht1 ht2)
  (s125:hash-table-for-each
   (lambda (key2 val2)
     (if (not (s:hash-table-exists? ht1 key2))
         (s:hash-table-set! ht1 key2 val2)))
   ht2)
  ht1)

(define (s125:hash-table-intersection! ht1 ht2)
  (s125:hash-table-for-each
   (lambda (key1 val1)
     (if (not (s:hash-table-exists? ht2 key1))
         (s:hash-table-delete! ht1 key1)))
   ht1)
  ht1)

(define (s125:hash-table-difference! ht1 ht2)
  (s125:hash-table-for-each
   (lambda (key1 val1)
     (if (s:hash-table-exists? ht2 key1)
         (s:hash-table-delete! ht1 key1)))
   ht1)
  ht1)

(define (s125:hash-table-xor! ht1 ht2)
  (s125:hash-table-for-each
   (lambda (key2 val2)
     (if (s:hash-table-exists? ht1 key2)
         (s:hash-table-delete! ht1 key2)
         (s:hash-table-set! ht1 key2 val2)))
   ht2)
  ht1)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; The following procedures are deprecated by SRFI 125, but must
;;; be exported nonetheless.
;;;
;;; Programs that import the (srfi 125) library must rename the
;;; deprecated string-hash and string-ci-hash procedures to avoid
;;; conflict with the string-hash and string-ci-hash procedures
;;; exported by SRFI 126 and SRFI 128.
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; We use STklos' default hash instead of the one available in
;; SRFI 128 reference implementation, except for the string-ci-hash,
;; which must be different.

(define (deprecated:hash obj . rest)
  (s:hash-table-hash obj))
  ;;(s128:default-hash obj))

(define (deprecated:string-hash obj . rest)
  (s:hash-table-hash obj))
  ;;(s128:string-hash obj))

(define (deprecated:string-ci-hash obj . rest)
  (s128:string-ci-hash obj))

(define (deprecated:hash-by-identity obj . rest)
  (s:hash-table-hash obj))
  ;;(s128:default-hash obj))

(define deprecated:hash-table-equivalence-function s:hash-table-equivalence-function)
(define deprecated:hash-table-hash-function s:hash-table-hash-function)
(define deprecated:hash-table-exists? s:hash-table-exists?)

;; must change argument order!
(define (deprecated:hash-table-walk ht proc)
  (s125:hash-table-for-each proc ht))

;; must change argument order!
(define (deprecated:hash-table-fold ht proc seed)
  (s125:hash-table-fold proc seed ht))

(define deprecated:hash-table-merge! s125:hash-table-union!)

) ;; END of module srfi/125


(provide "scheme/hash-table")
