This file is indexed.

/usr/share/gauche-0.9/0.9.5/lib/srfi-69.scm is in gauche 0.9.5-1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
;;;
;;; srfi-69  Basic Hash Tables
;;;

;; This is a thin wrapper to the Gauche's native hashtable support.

(define-module srfi-69
  (use srfi-13 :prefix srfi-13:) ; string-hash
  (export make-hash-table hash-table? alist->hash-table
          hash-table-equivalence-function hash-table-hash-function
          hash-table-ref hash-table-ref/default
          hash-table-set! hash-table-delete!
          hash-table-exists? hash-table-update!
          hash-table-update!/default
          hash-table-size hash-table-keys hash-table-values
          hash-table-walk hash-table-fold hash-table->alist
          hash-table-copy hash-table-merge!
          hash string-hash string-ci-hash hash-by-identity))
(select-module srfi-69)

;; These procedures are the same as Gauche's built-in:
;; hash-table?       hash-table-delete!   hash-table-exists?
;; hash-table-keys   hash-table-values    hash-table-fold
;;hash-table->alist hash-table-copy 

(define-constant *hasher-range* (+ (greatest-fixnum) 1))

(define (%choose-comparator equal hasher) ; equal never be #f.
  (if hasher
    (make-comparator #t equal #f (^[obj] (hasher obj *hasher-range*)))
    (cond [(eq? equal equal?)      equal-comparator]
          [(eq? equal eqv?)        eqv-comparator]
          [(eq? equal eq?)         eq-comparator]
          [(eq? equal string=?)    string-comparator]
          [(eq? equal string-ci=?) string-ci-comparator]
          [else (make-comparator #t equal #f (with-module gauche hash))])))

(define (make-hash-table :optional (equal equal?) (hasher #f) :rest opts)
  ((with-module gauche make-hash-table)
   (%choose-comparator equal hasher)))

(define (alist->hash-table alist :optional (equal equal?) (hasher #f) :rest opts)
  ((with-module gauche alist->hash-table)
   alist (%choose-comparator equal hasher)))

(define (hash-table-equivalence-function ht)
  (comparator-equality-predicate (hash-table-comparator ht)))

;; NB: srfi-69's hash function must take second argument.
(define (hash-table-hash-function ht)
  (let1 h (comparator-hash-function (hash-table-comparator ht))
    (^[obj bound] (modulo (h obj) bound))))

(define *unique* (list #f))

(define (no-key-thunk)
  (error "Hashtable has no key"))  ; maybe custom condition?

(define (hash-table-ref ht key :optional (thunk no-key-thunk))
  (let1 r (hash-table-get ht key *unique*)
    (if (eq? r *unique*)
      (thunk)
      r)))

(define (hash-table-ref/default ht key default)
  (hash-table-get ht key default))

(define (hash-table-set! ht key val)
  (hash-table-put! ht key val))

(define (hash-table-update! ht key proc :optional (thunk no-key-thunk))
  ((with-module gauche hash-table-update!)
   ht key
   (^[v] (if (eq? v *unique*)
           (thunk)
           (proc v)))
   *unique*))

(define (hash-table-update!/default ht key proc default)
  ((with-module gauche hash-table-update!) ht key proc default))

(define hash-table-size hash-table-num-entries)

(define (hash-table-walk ht proc) (hash-table-for-each ht proc))

(define (hash-table-merge! ht1 ht2)
  (hash-table-for-each ht2 (^[k v] (hash-table-put! ht1 k v)))
  ht1)

(define (%maybe-bounded proc obj bound)
  (let1 h (proc obj)
    (if bound (modulo h bound) h)))

(define (hash obj :optional (bound #f))
  (%maybe-bounded (with-module gauche hash) obj bound))

(define (string-hash obj :optional (bound #f))
  (if bound (srfi-13:string-hash obj bound) (srfi-13:string-hash obj)))

(define (string-ci-hash obj :optional (bound #f))
  (if bound (srfi-13:string-hash-ci obj bound) (srfi-13:string-hash-ci obj)))

(define (hash-by-identity obj :optional (bound #f))
  (%maybe-bounded eq-hash obj bound))