Changeset 12262 in project


Ignore:
Timestamp:
10/25/08 06:49:10 (12 years ago)
Author:
Kon Lovett
Message:

Rmvd lolevel make-hash-table from imports (no existing refs that I found). Internal renames for canonical-ish style (sorry Felix). Rmvd dup unused code.

Location:
chicken/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • chicken/trunk/srfi-69.import.scm

    r10788 r12262  
    2727(##sys#register-primitive-module
    2828 'srfi-69
    29  '(%make-hash-table
    30    alist->hash-table
     29 '(alist->hash-table
    3130   eq?-hash
    3231   equal?-hash
  • chicken/trunk/srfi-69.scm

    r12117 r12262  
    3636  (declare
    3737    (no-bound-checks)
    38     (no-procedure-checks-for-usual-bindings)
    39     (bound-to-procedure
    40       ##sys#check-string ##sys#check-symbol ##sys#check-exact ##sys#check-closure
    41       ##sys#check-inexact ##sys#check-structure
    42       ##sys#signal-hook
    43       ##sys#peek-fixnum
    44       ##sys#make-structure
    45       ##sys#size
    46       ##sys#slot ##sys#setslot ) ) ] )
     38    (no-procedure-checks-for-usual-bindings) ) ] )
    4739
    4840(declare
     41  (bound-to-procedure
     42    ##sys#signal-hook
     43    ##sys#peek-fixnum
     44    ##sys#make-structure
     45    ##sys#size
     46    ##sys#slot ##sys#setslot
     47    *equal?-hash )
    4948  (hide
    50     %object-uid-hash %eq?-hash %eqv?-hash %equal?-hash
    51     %hash-table-copy %hash-table-merge!
    52     %hash-table-for-each %hash-table-fold
    53     hash-table-canonical-length
    54     %hash-table-rehash! %hash-table-check-resize!
    55     %hash-table-update!/default) )
     49    *eq?-hash *eqv?-hash *equal?-hash
     50    *make-hash-table
     51    *hash-table-copy *hash-table-merge! *hash-table-update!/default
     52    *hash-table-for-each *hash-table-fold
     53    hash-table-canonical-length hash-table-rehash! hash-table-check-resize! ) )
     54
     55(cond-expand
     56 [unsafe]
     57 [else
     58   (declare
     59     (bound-to-procedure
     60       ##sys#check-string ##sys#check-symbol
     61       ##sys#check-exact ##sy#check-inexact
     62       ##sys#check-closure ##sys#check-structure ) ) ] )
    5663
    5764(include "unsafe-declarations.scm")
     
    6067
    6168
    62 ;;; Core Inlines:
    63 
    64 (define-inline ($fix wrd)
    65   (##core#inline "C_fix" wrd) )
    66 
    67 (define-inline ($block? obj)
    68   (##core#inline "C_blockp" obj) )
    69 
    70 (define-inline ($special? obj)
    71   (##core#inline "C_specialp" obj) )
    72 
    73 (define-inline ($port? obj)
    74   (##core#inline "C_portp" obj) )
    75 
    76 (define-inline ($byte-block? obj)
    77   (##core#inline "C_byteblockp" obj) )
    78 
    79 (define-inline ($string-hash str)
    80   (##core#inline "C_hash_string" str) )
    81 
    82 (define-inline ($string-ci-hash str)
    83   (##core#inline "C_hash_string_ci" str) )
    84 
    85 
    86 ;;;
    87 
    88 (define-inline ($immediate? obj)
    89   (not ($block? obj)) )
    90 
    91 
    92 ;;; Generation of hash-values:
    93 
    94 ;; Naming Conventions:
    95 ;; $foo - inline primitive
    96 ;; $*foo - local inline (no such thing but at least it looks different)
    97 ;; %foo - private, usually unchecked, procedure
     69;;; Naming Conventions:
     70
     71;; %foo - inline primitive
     72;; %%foo - local inline (no such thing but at least it looks different)
     73;; $foo - local macro
     74;; *foo - local unchecked variant of a checked procedure
    9875;; ##sys#foo - public, but undocumented, un-checked procedure
    9976;; foo - public checked procedure
    10077;;
     78
     79
     80;;; Core Inlines:
     81
     82(define-inline (%fix wrd)
     83  (##core#inline "C_fix" wrd) )
     84
     85(define-inline (%block? obj)
     86  (##core#inline "C_blockp" obj) )
     87
     88(define-inline (%immediate? obj)
     89  (not (##core#inline "C_blockp" obj)) )
     90
     91(define-inline (%special? obj)
     92  (##core#inline "C_specialp" obj) )
     93
     94(define-inline (%port? obj)
     95  (##core#inline "C_portp" obj) )
     96
     97(define-inline (%byte-block? obj)
     98  (##core#inline "C_byteblockp" obj) )
     99
     100(define-inline (%string-hash str)
     101  (##core#inline "C_hash_string" str) )
     102
     103(define-inline (%string-ci-hash str)
     104  (##core#inline "C_hash_string_ci" str) )
     105
     106(define-inline (%subbyte bytvec i)
     107  (##core#inline "C_subbyte" bytvec i) )
     108
     109
     110;;; Generation of hash-values:
     111
    101112;; All '%foo-hash' return a fixnum, not necessarily positive. The "overflow" of
    102113;; a, supposedly, unsigned hash value into negative is not checked during
    103114;; intermediate computation.
    104115;;
    105 ;; The body of '%eq?-hash' is duplicated in 'eqv?-hash' and the body of '%eqv?-hash'
    106 ;; is duplicated in '%equal?-hash' to save on procedure calls.
     116;; The body of '*eq?-hash' is duplicated in '*eqv?-hash' and the body of '*eqv?-hash'
     117;; is duplicated in '*equal?-hash' to save on procedure calls.
    107118
    108119;; Fixed hash-values:
     
    121132;; Force Hash to Bounded Fixnum:
    122133
    123 (define-inline ($fxabs fxn)
    124   (let ([_fxn fxn]) (if (fx< _fxn 0) (fxneg _fxn) _fxn ) ) )
    125 
    126 (define-inline ($hash/limit hsh lim)
     134(define-inline (%fxabs fxn)
     135  (if (fx< fxn 0) (fxneg fxn) fxn ) )
     136
     137(define-inline (%hash/limit hsh lim)
    127138  (fxmod (fxand (foreign-value "C_MOST_POSITIVE_FIXNUM" int)
    128                 ($fxabs hsh))
     139                (%fxabs hsh))
    129140         lim) )
    130141
     
    132143
    133144(define-constant flonum-magic 331804471)
    134 
    135 (define-inline ($subbyte bytvec i)
    136   (##core#inline "C_subbyte" bytvec i) )
    137145
    138146(define-syntax $flonum-hash
    139147  (lambda (form r c)
    140148    (let ( (flo (cadr form))
    141            (%$subbyte (r '$subbyte))
     149           (%%subbyte (r '%subbyte))
    142150           (%flonum-magic (r 'flonum-magic))
    143151           (%fx+ (r 'fx+))
     
    147155            ,(let loop ( (idx (fx- (##sys#size 1.0) 1)) )
    148156               (if (fx= 0 idx)
    149                    `(,%$subbyte ,flo 0)
    150                    `(,%fx+ (,%$subbyte ,flo ,idx)
     157                   `(,%%subbyte ,flo 0)
     158                   `(,%fx+ (,%%subbyte ,flo ,idx)
    151159                           (,%fxshl ,(loop (fx- idx 1)) 1)) ) ) ) ) ) )
    152160
    153161(define (##sys#number-hash-hook obj)
    154   (%equal?-hash obj) )
    155 
    156 (define-inline ($non-fixnum-number-hash obj)
     162  (*equal?-hash obj) )
     163
     164(define-inline (%non-fixnum-number-hash obj)
    157165  (cond [(flonum? obj)  ($flonum-hash obj)]
    158         [else           ($fix (##sys#number-hash-hook obj))] ) )
    159 
    160 (define-inline ($number-hash obj)
     166        [else           (%fix (##sys#number-hash-hook obj))] ) )
     167
     168(define-inline (%number-hash obj)
    161169  (cond [(fixnum? obj)  ?obj]
    162         [else           ($non-fixnum-number-hash obj)] ) )
     170        [else           (%non-fixnum-number-hash obj)] ) )
    163171
    164172(define (number-hash obj #!optional (bound hash-default-bound))
     
    166174    (##sys#signal-hook #:type 'number-hash "invalid number" obj) )
    167175  (##sys#check-exact bound 'number-hash)
    168   ($hash/limit ($number-hash obj) bound) )
     176  (%hash/limit (%number-hash obj) bound) )
    169177
    170178;; Object UID Hash:
    171179
    172180#; ;NOT YET (no weak-reference)
    173 (define (%object-uid-hash obj)
     181(define-inline (%object-uid-hash obj)
    174182  (%uid-hash (##sys#object->uid obj)) )
    175183
    176 (define (%object-uid-hash obj)
    177   (%equal?-hash obj) )
     184(define-inline (%object-uid-hash obj)
     185  (*equal?-hash obj) )
    178186
    179187(define (object-uid-hash obj #!optional (bound hash-default-bound))
    180188  (##sys#check-exact bound 'object-uid-hash)
    181   ($hash/limit (%object-uid-hash obj) bound) )
     189  (%hash/limit (%object-uid-hash obj) bound) )
    182190
    183191;; Symbol Hash:
    184192
    185193#; ;NOT YET (no unique-symbol-hash)
    186 (define-inline ($symbol-hash obj)
     194(define-inline (%symbol-hash obj)
    187195  (##sys#slot obj INDEX-OF-UNIQUE-HASH-VALUE-COMPUTED-DURING-SYMBOL-CREATION) )
    188196
    189 (define-inline ($symbol-hash obj)
    190   ($string-hash (##sys#slot obj 1)) )
     197(define-inline (%symbol-hash obj)
     198  (%string-hash (##sys#slot obj 1)) )
    191199
    192200(define (symbol-hash obj #!optional (bound hash-default-bound))
    193201  (##sys#check-symbol obj 'symbol-hash)
    194202  (##sys#check-exact bound 'symbol-hash)
    195   ($hash/limit ($symbol-hash obj) bound) )
     203  (%hash/limit (%symbol-hash obj) bound) )
    196204
    197205;; Keyword Hash:
     
    204212
    205213#; ;NOT YET (no unique-keyword-hash)
    206 (define-inline ($keyword-hash obj)
     214(define-inline (%keyword-hash obj)
    207215  (##sys#slot obj INDEX-OF-UNIQUE-HASH-VALUE-COMPUTED-DURING-KEYWORD-CREATION) )
    208216
    209 (define-inline ($keyword-hash obj)
    210   ($string-hash (##sys#slot obj 1)) )
     217(define-inline (%keyword-hash obj)
     218  (%string-hash (##sys#slot obj 1)) )
    211219
    212220(define (keyword-hash obj #!optional (bound hash-default-bound))
    213221  (##sys#check-keyword obj 'keyword-hash)
    214222  (##sys#check-exact bound 'keyword-hash)
    215   ($hash/limit ($keyword-hash obj) bound) )
     223  (%hash/limit (%keyword-hash obj) bound) )
    216224
    217225;; Eq Hash:
    218226
    219 (define-inline ($eq?-hash-object? obj)
    220   (or ($immediate? obj)
     227(define-inline (%eq?-hash-object? obj)
     228  (or (%immediate? obj)
    221229       (symbol? obj)
    222230       #; ;NOT YET (no keyword vs. symbol issue)
    223231       (keyword? obj) ) )
    224232
    225 (define (%eq?-hash obj)
     233(define (*eq?-hash obj)
    226234  (cond [(fixnum? obj)          obj]
    227235        [(char? obj)            (char->integer obj)]
     
    230238        [(null? obj)            null-hash-value]
    231239        [(eof-object? obj)      eof-hash-value]
    232         [(symbol? obj)          ($symbol-hash obj)]
     240        [(symbol? obj)          (%symbol-hash obj)]
    233241        #; ;NOT YET (no keyword vs. symbol issue)
    234         [(keyword? obj)         ($keyword-hash obj)]
    235         [($immediate? obj)      unknown-immediate-hash-value]
     242        [(keyword? obj)         (%keyword-hash obj)]
     243        [(%immediate? obj)      unknown-immediate-hash-value]
    236244        [else                   (%object-uid-hash obj) ] ) )
    237245
    238246(define (eq?-hash obj #!optional (bound hash-default-bound))
    239247  (##sys#check-exact bound 'eq?-hash)
    240   ($hash/limit (%eq?-hash obj) bound) )
     248  (%hash/limit (*eq?-hash obj) bound) )
    241249
    242250(define hash-by-identity eq?-hash)
     
    244252;; Eqv Hash:
    245253
    246 (define-inline ($eqv?-hash-object? obj)
    247   (or ($eq?-hash-object? obj)
    248        (number? obj)) )
    249 
    250 (define (%eqv?-hash obj)
     254(define-inline (%eqv?-hash-object? obj)
     255  (or (%eq?-hash-object? obj)
     256      (number? obj) ) )
     257
     258(define (*eqv?-hash obj)
    251259  (cond [(fixnum? obj)          obj]
    252260        [(char? obj)            (char->integer obj)]
     
    255263        [(null? obj)            null-hash-value]
    256264        [(eof-object? obj)      eof-hash-value]
    257         [(symbol? obj)          ($symbol-hash obj)]
     265        [(symbol? obj)          (%symbol-hash obj)]
    258266        #; ;NOT YET (no keyword vs. symbol issue)
    259         [(keyword? obj)         ($keyword-hash obj)]
    260         [(number? obj)          ($non-fixnum-number-hash obj)]
    261         [($immediate? obj)      unknown-immediate-hash-value]
     267        [(keyword? obj)         (%keyword-hash obj)]
     268        [(number? obj)          (%non-fixnum-number-hash obj)]
     269        [(%immediate? obj)      unknown-immediate-hash-value]
    262270        [else                   (%object-uid-hash obj) ] ) )
    263271
    264272(define (eqv?-hash obj #!optional (bound hash-default-bound))
    265273  (##sys#check-exact bound 'eqv?-hash)
    266   ($hash/limit (%eqv?-hash obj) bound) )
     274  (%hash/limit (*eqv?-hash obj) bound) )
    267275
    268276;; Equal Hash:
     
    272280(define-constant recursive-hash-max-length 4)
    273281
    274 (define-inline ($*list-hash obj)
     282;; NOTE - These refer to identifiers available only within the body of '*equal?-hash'.
     283
     284(define-inline (%%list-hash obj)
    275285  (fx+ (length obj)
    276286       (recursive-atomic-hash (##sys#slot obj 0) depth)) )
    277287
    278 (define-inline ($*pair-hash obj)
     288(define-inline (%%pair-hash obj)
    279289  (fx+ (fxshl (recursive-atomic-hash (##sys#slot obj 0) depth) 16)
    280290        (recursive-atomic-hash (##sys#slot obj 1) depth)) )
    281291
    282 (define-inline ($*port-hash obj)
     292(define-inline (%%port-hash obj)
    283293  (fx+ (fxshl (##sys#peek-fixnum obj 0) 4) ; Little extra "identity"
    284294        (if (input-port? obj)
     
    286296            output-port-hash-value)) )
    287297
    288 (define-inline ($*special-vector-hash obj)
     298(define-inline (%%special-vector-hash obj)
    289299  (vector-hash obj (##sys#peek-fixnum obj 0) depth 1) )
    290300
    291 (define-inline ($*regular-vector-hash obj)
     301(define-inline (%%regular-vector-hash obj)
    292302  (vector-hash obj 0 depth 0) )
    293303
    294 (define (%equal?-hash obj)
     304(define (*equal?-hash obj)
    295305
    296306  ; Recurse into some portion of the vector's slots
     
    310320  ; Don't recurse into structured objects
    311321  (define (recursive-atomic-hash obj depth)
    312     (if (or ($eqv?-hash-object? obj)
    313             ($byte-block? obj))
     322    (if (or (%eqv?-hash-object? obj)
     323            (%byte-block? obj))
    314324        (recursive-hash obj (fx+ depth 1))
    315325        other-hash-value ) )
     
    325335          [(null? obj)            null-hash-value]
    326336          [(eof-object? obj)      eof-hash-value]
    327           [(symbol? obj)          ($symbol-hash obj)]
     337          [(symbol? obj)          (%symbol-hash obj)]
    328338          #; ;NOT YET (no keyword vs. symbol issue)
    329           [(keyword? obj)         ($keyword-hash obj)]
    330           [(number? obj)          ($non-fixnum-number-hash obj)]
    331           [($immediate? obj)      unknown-immediate-hash-value]
    332           [($byte-block? obj)     ($string-hash obj)]
    333           [(list? obj)            ($*list-hash obj)]
    334           [(pair? obj)            ($*pair-hash obj)]
    335           [($port? obj)           ($*port-hash obj)]
    336           [($special? obj)        ($*special-vector-hash obj)]
    337           [else                   ($*regular-vector-hash obj)] ) )
     339          [(keyword? obj)         (%keyword-hash obj)]
     340          [(number? obj)          (%non-fixnum-number-hash obj)]
     341          [(%immediate? obj)      unknown-immediate-hash-value]
     342          [(%byte-block? obj)     (%string-hash obj)]
     343          [(list? obj)            (%%list-hash obj)]
     344          [(pair? obj)            (%%pair-hash obj)]
     345          [(%port? obj)           (%%port-hash obj)]
     346          [(%special? obj)        (%%special-vector-hash obj)]
     347          [else                   (%%regular-vector-hash obj)] ) )
    338348
    339349  ;
     
    342352(define (equal?-hash obj #!optional (bound hash-default-bound))
    343353  (##sys#check-exact bound 'hash)
    344   ($hash/limit (%equal?-hash obj) bound) )
     354  (%hash/limit (*equal?-hash obj) bound) )
    345355
    346356(define hash equal?-hash)
     
    351361  (##sys#check-string str 'string-hash)
    352362  (##sys#check-exact bound 'string-hash)
    353   ($hash/limit ($string-hash str) bound) )
     363  (%hash/limit (%string-hash str) bound) )
    354364
    355365(define (string-ci-hash str #!optional (bound hash-default-bound))
    356366  (##sys#check-string str 'string-ci-hash)
    357367  (##sys#check-exact bound 'string-ci-hash)
    358   ($hash/limit ($string-ci-hash str) bound) )
     368  (%hash/limit (%string-ci-hash str) bound) )
    359369
    360370
     
    399409;; "Raw" make-hash-table:
    400410
    401 (define %make-hash-table
     411(define *make-hash-table
    402412  (let ([make-vector make-vector])
    403413    (lambda (test hash len min-load max-load weak-keys weak-values initial
     
    530540                    (set! hash equal?-hash) ) ) ) )
    531541          ; Done
    532           (%make-hash-table test hash size min-load max-load weak-keys weak-values initial) ) ) ) ) )
     542          (*make-hash-table test hash size min-load max-load weak-keys weak-values initial) ) ) ) ) )
    533543
    534544;; Hash-Table Predicate:
     
    577587    (thunk) ) )
    578588
    579 ;; %hash-table-rehash!:
    580 
    581 (define (%hash-table-rehash! vec1 vec2 hash)
     589;; hash-table-rehash!:
     590
     591(define (hash-table-rehash! vec1 vec2 hash)
    582592  (let ([len1 (##sys#size vec1)]
    583593        [len2 (##sys#size vec2)] )
     
    593603            (loop (##sys#slot bucket 1)) ) ) ) ) ) )
    594604
    595 ;; %hash-table-resize!:
    596 
    597 (define (%hash-table-resize! ht vec len)
     605;; hash-table-resize!:
     606
     607(define (hash-table-resize! ht vec len)
    598608  (let* ([deslen (fxmin hash-table-max-length (fx* len hash-table-new-length-factor))]
    599609         [newlen (hash-table-canonical-length hash-table-prime-lengths deslen)]
    600610         [vec2 (make-vector newlen '())] )
    601     (%hash-table-rehash! vec vec2 (##sys#slot ht 4))
     611    (hash-table-rehash! vec vec2 (##sys#slot ht 4))
    602612    (##sys#setslot ht 1 vec2) ) )
    603613
    604 ;; %hash-table-check-resize!:
    605 
    606 #; ;UNUSED
    607 (define %hash-table-check-resize!
    608        ; Note that these are standard integrations!
    609   (let ([floor floor]
    610         [inexact->exact inexact->exact]
    611         [* *] )
    612     (lambda (ht newsiz)
    613       (let ([vec (##sys#slot ht 1)]
    614             [min-load (##sys#slot ht 5)]
    615             [max-load (##sys#slot ht 6)] )
    616         (let ([len (##sys#size vec)] )
    617           (let ([min-load-len (inexact->exact (floor (* len min-load)))]
    618                 [max-load-len (inexact->exact (floor (* len max-load)))] )
    619             (if (and (fx< len hash-table-max-length)
    620                      (fx<= min-load-len newsiz) (fx<= newsiz max-load-len))
    621                 (%hash-table-resize! ht vec len) ) ) ) ) ) ) )
    622 
    623 (define-inline (%hash-table-check-resize! ht newsiz)
     614;; hash-table-check-resize!:
     615
     616(define-inline (hash-table-check-resize! ht newsiz)
    624617  (let ([vec (##sys#slot ht 1)]
    625618        [min-load (##sys#slot ht 5)]
     
    630623        (if (and (fx< len hash-table-max-length)
    631624                 (fx<= min-load-len newsiz) (fx<= newsiz max-load-len))
    632           (%hash-table-resize! ht vec len) ) ) ) ) )
     625          (hash-table-resize! ht vec len) ) ) ) ) )
    633626
    634627;; hash-table-copy:
    635628
    636 (define %hash-table-copy
     629(define *hash-table-copy
    637630  (let ([make-vector make-vector])
    638631    (lambda (ht)
     
    642635        (do ([i 0 (fx+ i 1)])
    643636            [(fx>= i len)
    644              (%make-hash-table
     637             (*make-hash-table
    645638              (##sys#slot ht 3) (##sys#slot ht 4)
    646639              (##sys#slot ht 2)
     
    659652(define (hash-table-copy ht)
    660653  (##sys#check-structure ht 'hash-table 'hash-table-copy)
    661   (%hash-table-copy ht) )
     654  (*hash-table-copy ht) )
    662655
    663656;; hash-table-update!:
     
    681674      (##sys#check-closure thunk 'hash-table-update!)
    682675      (let ([newsiz (fx+ (##sys#slot ht 2) 1)] )
    683         (%hash-table-check-resize! ht newsiz)
     676        (hash-table-check-resize! ht newsiz)
    684677        (let ([hash (##sys#slot ht 4)]
    685678              [test (##sys#slot ht 3)]
     
    716709                             (loop (##sys#slot bucket 1)) ) ) ) ) ) ) ) ) ) ) )
    717710
    718 (define %hash-table-update!/default
     711(define *hash-table-update!/default
    719712  (let ([core-eq? eq?] )
    720713    (lambda (ht key func def)
    721714      (let ([newsiz (fx+ (##sys#slot ht 2) 1)] )
    722         (%hash-table-check-resize! ht newsiz)
     715        (hash-table-check-resize! ht newsiz)
    723716        (let ([hash (##sys#slot ht 4)]
    724717              [test (##sys#slot ht 3)]
     
    758751  (##sys#check-structure ht 'hash-table 'hash-table-update!/default)
    759752  (##sys#check-closure func 'hash-table-update!/default)
    760   (%hash-table-update!/default ht key func def) )
     753  (*hash-table-update!/default ht key func def) )
    761754
    762755(define hash-table-set!
     
    765758      (##sys#check-structure ht 'hash-table 'hash-table-set!)
    766759      (let ([newsiz (fx+ (##sys#slot ht 2) 1)] )
    767         (%hash-table-check-resize! ht newsiz)
     760        (hash-table-check-resize! ht newsiz)
    768761        (let ([hash (##sys#slot ht 4)]
    769762              [test (##sys#slot ht 3)]
     
    950943;; Hash Table Merge:
    951944
    952 (define (%hash-table-merge! ht1 ht2)
     945(define (*hash-table-merge! ht1 ht2)
    953946  (let* ([vec (##sys#slot ht2 1)]
    954947         [len (##sys#size vec)] )
     
    958951          [(null? lst)]
    959952        (let ([b (##sys#slot lst 0)])
    960           (%hash-table-update!/default ht1 (##sys#slot b 0) identity (##sys#slot b 1)) ) ) ) ) )
     953          (*hash-table-update!/default ht1 (##sys#slot b 0) identity (##sys#slot b 1)) ) ) ) ) )
    961954
    962955(define (hash-table-merge! ht1 ht2)
    963956  (##sys#check-structure ht1 'hash-table 'hash-table-merge!)
    964957  (##sys#check-structure ht2 'hash-table 'hash-table-merge!)
    965   (%hash-table-merge! ht1 ht2) )
     958  (*hash-table-merge! ht1 ht2) )
    966959
    967960(define (hash-table-merge ht1 ht2)
    968961  (##sys#check-structure ht1 'hash-table 'hash-table-merge)
    969962  (##sys#check-structure ht2 'hash-table 'hash-table-merge)
    970   (%hash-table-merge! (%hash-table-copy ht1) ht2) )
     963  (*hash-table-merge! (*hash-table-copy ht1) ht2) )
    971964
    972965;; Hash-Table <-> Association-List:
     
    993986      (let ([ht (apply make-hash-table rest)])
    994987        (for-each (lambda (x)
    995                     (%hash-table-update!/default  ht (##sys#slot x 0) identity (##sys#slot x 1)) )
     988                    (*hash-table-update!/default  ht (##sys#slot x 0) identity (##sys#slot x 1)) )
    996989                  alist)
    997990        ht ) ) ) )
     
    10361029;; hash-table-map:
    10371030
    1038 (define (%hash-table-for-each ht proc)
     1031(define (*hash-table-for-each ht proc)
    10391032  (let* ([vec (##sys#slot ht 1)]
    10401033         [len (##sys#size vec)] )
     
    10451038                      (##sys#slot vec i)) ) ) )
    10461039
    1047 (define (%hash-table-fold ht func init)
     1040(define (*hash-table-fold ht func init)
    10481041  (let* ([vec (##sys#slot ht 1)]
    10491042         [len (##sys#size vec)] )
     
    10621055  (##sys#check-structure ht 'hash-table 'hash-table-fold)
    10631056  (##sys#check-closure func 'hash-table-fold)
    1064   (%hash-table-fold ht func init) )
     1057  (*hash-table-fold ht func init) )
    10651058
    10661059(define (hash-table-for-each ht proc)
    10671060  (##sys#check-structure ht 'hash-table 'hash-table-for-each)
    10681061  (##sys#check-closure proc 'hash-table-for-each)
    1069   (%hash-table-for-each ht proc) )
     1062  (*hash-table-for-each ht proc) )
    10701063
    10711064(define (hash-table-walk ht proc)
    10721065  (##sys#check-structure ht 'hash-table 'hash-table-walk)
    10731066  (##sys#check-closure proc 'hash-table-walk)
    1074   (%hash-table-for-each ht proc) )
     1067  (*hash-table-for-each ht proc) )
    10751068
    10761069(define (hash-table-map ht func)
    10771070  (##sys#check-structure ht 'hash-table 'hash-table-map)
    10781071  (##sys#check-closure func 'hash-table-map)
    1079   (%hash-table-fold ht (lambda (k v a) (cons (func k v) a)) '()) )
     1072  (*hash-table-fold ht (lambda (k v a) (cons (func k v) a)) '()) )
Note: See TracChangeset for help on using the changeset viewer.