Changeset 35358 in project


Ignore:
Timestamp:
03/27/18 18:20:32 (4 weeks ago)
Author:
kon
Message:

add types, use proper test groups, not a critical region

Location:
release/4/lookup-table/trunk
Files:
7 edited

Legend:

Unmodified
Added
Removed
  • release/4/lookup-table/trunk/lookup-table-body.scm

    r24157 r35358  
    22;;;; Kon Lovett, Sep '09
    33
    4 (import
     4(use
    55  #;scheme  ;imported by including module
    66  #;chicken ;imported by including module
     
    1919  type-checks
    2020  type-errors
    21   record-variants)
    22 
    23 (require-library
    24   srfi-1 srfi-69
    25   ports data-structures extras
    26   miscmacros
    27   type-checks type-errors
    28   record-variants)
     21  record-variants
     22  typed-define)
    2923
    3024;;;
     
    3327  (syntax-rules ()
    3428    ((_ body ...)
    35       (cond-expand (unsafe) (else body ... )) ) ) )
     29      (cond-expand
     30        (unsafe)
     31        (else
     32          body ... )) ) ) )
    3633
    3734;;;
     
    3936(cond-expand
    4037  (unsafe
     38
    4139    (include "chicken-primitive-object-inlines")
     40
    4241    (define-record-type-variant dict (unsafe unchecked inline)
    4342      (make-dictbase data)
     
    5655      (values dict-values-ref dict-values-set!)
    5756      (exists dict-exists-ref dict-exists-set!) )
    58     (define-inline (dict::undefined-value? a) (%undefined-value? a))
    59     (define-inline (dict::undefined-value) (%undefined-value))
    60     (define-inline (dict::list-map/1 a b) (%list-map/1 a b))
    61     (define-inline (dict::list-for-each/1 a b) (%list-for-each/1 a b))
    62     (define-inline (dict::list-length a) (%list-length a))
    63     (define-inline (dict::list-find a b) (%list-find a b))
    64     (define-inline (dict::eq? a b) (%eq? a b))
    65     (define-inline (dict::alist-delete! a b c) (%alist-delete! a b c))
    66     (define-inline (dict::alist-update! a b c d) (%alist-update! a b c d))
    67     (define-inline (dict::alist-ref a b c d) (%alist-ref a b c d))
    68     (define-inline (dict::list-copy a) (%list-copy a))
    69     (define-inline (dict::set-cdr! a b) (%set-cdr! a b))
    70     (define-inline (dict::cons a b) (%cons a b))
    71     (define-inline (dict::cdr a) (%cdr a))
    72     (define-inline (dict::car a) (%car a)) )
     57
     58    (define-inline (dict::undefined-value? a)
     59      (%undefined-value? a))
     60
     61    (define-inline (dict::undefined-value)
     62      (%undefined-value))
     63
     64    (define-inline (dict::list-map/1 a b)
     65      (%list-map/1 a b))
     66
     67    (define-inline (dict::list-for-each/1 a b)
     68      (%list-for-each/1 a b))
     69
     70    (define-inline (dict::list-length a)
     71      (%list-length a))
     72
     73    (define-inline (dict::list-find a b)
     74      (%list-find a b))
     75
     76    (define-inline (dict::eq? a b)
     77      (%eq? a b))
     78
     79    (define-inline (dict::alist-delete! a b c)
     80      (%alist-delete! a b c))
     81
     82    (define-inline (dict::alist-update! a b c d)
     83      (%alist-update! a b c d))
     84
     85    (define-inline (dict::alist-ref a b c d)
     86      (%alist-ref a b c d))
     87
     88    (define-inline (dict::list-copy a)
     89      (%list-copy a))
     90
     91    (define-inline (dict::set-cdr! a b)
     92      (%set-cdr! a b))
     93
     94    (define-inline (dict::cons a b)
     95      (%cons a b))
     96
     97    (define-inline (dict::cdr a)
     98      (%cdr a))
     99
     100    (define-inline (dict::car a)
     101      (%car a)))
     102
    73103  (else
     104
    74105    (define-record-type-variant dict (unchecked inline)
    75106      (make-dictbase data)
     
    88119      (values dict-values-ref dict-values-set!)
    89120      (exists dict-exists-ref dict-exists-set!) )
    90     (define-inline (dict::undefined-value? obj) (eq? (void) obj))
    91     (define-inline (dict::undefined-value) (void))
     121
     122    (define-inline (dict::undefined-value? obj)
     123      (eq? (void) obj) )
     124
     125    (define-inline (dict::undefined-value)
     126      (void) )
     127
    92128    (define dict::list-map/1 map)
     129
    93130    (define dict::list-for-each/1 for-each)
     131
    94132    (define dict::list-length length)
     133
    95134    (define dict::list-find find)
     135
    96136    (define dict::eq? eq?)
     137
    97138    (define dict::alist-delete! alist-delete!)
     139
    98140    (define dict::alist-update! alist-update!)
     141
    99142    (define dict::alist-ref alist-ref)
     143
    100144    (define dict::list-copy list-copy)
     145
    101146    (define dict::set-cdr! set-cdr!)
     147
    102148    (define dict::cons cons)
     149
    103150    (define dict::cdr cdr)
     151
    104152    (define dict::car car) ) )
    105153
    106154;;; Argument Checks
     155
     156;;
     157
     158(define-type dict (struct dict))
     159
     160(define-type dict-for-eacher (* * -> void))
     161
     162(define-type dict-searcher (* * --> boolean))
     163
     164(define-type dict-equaler (* * --> boolean))
     165
     166(define-type dict-updater (* -> *))
     167
     168(define-type dict-refer (-> *))
     169
     170;;
    107171
    108172(define-check+error-type dict dict::dict?)
     
    127191; Representation independent primitive calls
    128192
    129 (define (dictbase-test dict) ((dict-test-ref dict) (dict-data-ref dict)))
    130 (define (dictbase->alist dict) ((dict->alist-ref dict) (dict-data-ref dict)))
    131 (define (dictbase-ref dict key def) ((dict-ref-ref dict) (dict-data-ref dict) key def))
    132 (define (dictbase-set! dict key val) ((dict-set-ref dict) (dict-data-ref dict) key val))
    133 (define (dictbase-delete! dict key) ((dict-delete-ref dict) (dict-data-ref dict) key))
    134 (define (dictbase-for-each dict proc) ((dict-for-each-ref dict) (dict-data-ref dict) proc))
    135 (define (dictbase-merge! dict1 dict2) ((dict-merge-ref dict1) (dict-data-ref dict1) (dict-data-ref dict2)))
    136 (define (dictbase-search dict proc def) ((dict-search-ref dict) (dict-data-ref dict) proc def))
    137 (define (dictbase-count dict) ((dict-count-ref dict) (dict-data-ref dict)))
    138 (define (dictbase-keys dict) ((dict-keys-ref dict) (dict-data-ref dict)))
    139 (define (dictbase-values dict) ((dict-values-ref dict) (dict-data-ref dict)))
    140 (define (dictbase-exists? dict key) ((dict-exists-ref dict) (dict-data-ref dict) key))
     193(define: (dictbase-test (dict dict)) --> dict-equaler
     194  ((dict-test-ref dict) (dict-data-ref dict)))
     195
     196(define: (dictbase->alist (dict dict)) --> *
     197  ((dict->alist-ref dict) (dict-data-ref dict)))
     198
     199(define: (dictbase-ref (dict dict) (key *) (def *)) --> *
     200  ((dict-ref-ref dict) (dict-data-ref dict) key def))
     201
     202(define: (dictbase-set! (dict dict) (key *) (val *))
     203  ((dict-set-ref dict) (dict-data-ref dict) key val))
     204
     205(define: (dictbase-delete! (dict dict) (key *))
     206  ((dict-delete-ref dict) (dict-data-ref dict) key))
     207
     208(define: (dictbase-for-each (dict dict) (proc dict-for-eacher))
     209  ((dict-for-each-ref dict) (dict-data-ref dict) proc))
     210
     211(define: (dictbase-merge! (dict1 dict) (dict2 dict))
     212  ((dict-merge-ref dict1) (dict-data-ref dict1) (dict-data-ref dict2)))
     213
     214(define: (dictbase-search (dict dict) (proc dict-searcher) (def *)) --> *
     215  ((dict-search-ref dict) (dict-data-ref dict) proc def))
     216
     217(define: (dictbase-count (dict dict)) --> fixnum
     218  ((dict-count-ref dict) (dict-data-ref dict)))
     219
     220(define: (dictbase-keys (dict dict)) --> list
     221  ((dict-keys-ref dict) (dict-data-ref dict)))
     222
     223(define: (dictbase-values (dict dict)) --> list
     224  ((dict-values-ref dict) (dict-data-ref dict)))
     225
     226(define: (dictbase-exists? (dict dict) (key *)) --> boolean
     227  ((dict-exists-ref dict) (dict-data-ref dict) key))
    141228
    142229;; Association List
    143230
    144231(define (alist-search al proc #!optional def)
    145   (let ((p (dict::list-find (lambda (p) (proc (dict::car p) (dict::cdr p))) al)))
    146     (if p (dict::cdr p)
    147         def ) ) )
    148 
    149 (define (make-alist-data test al) (dict::cons test al))
    150 (define (alist-dict-test data) (dict::car data))
    151 (define (alist-dict-alist data) (dict::cdr data))
    152 (define (alist-dict-alist-set! data al) (dict::set-cdr! data al))
     232  (let (
     233    (p
     234      (dict::list-find
     235        (lambda (p)
     236          (proc (dict::car p) (dict::cdr p))) al)) )
     237    (if p
     238      (dict::cdr p)
     239      def ) ) )
     240
     241(define (make-alist-data test al)
     242  (dict::cons test al))
     243
     244(define (alist-dict-test data)
     245  (dict::car data))
     246
     247(define (alist-dict-alist data)
     248  (dict::cdr data))
     249
     250(define (alist-dict-alist-set! data al)
     251  (dict::set-cdr! data al))
    153252
    154253(define (set-alist-dict-procs! dict)
     
    169268;; Hash Table
    170269
    171 (define (make-htable-data test ht) (dict::cons test ht))
    172 (define (htable-dict-test data) (dict::car data))
    173 (define (htable-dict-htable data) (dict::cdr data))
    174 (define (htable-dict-htable-set! data ht) (dict::set-cdr! data ht))
     270(define (make-htable-data test ht)
     271  (dict::cons test ht))
     272
     273(define (htable-dict-test data)
     274  (dict::car data))
     275
     276(define (htable-dict-htable data)
     277  (dict::cdr data))
     278
     279(define (htable-dict-htable-set! data ht)
     280  (dict::set-cdr! data ht))
    175281
    176282(define (set-htable-dict-procs! dict)
     
    193299;;; Alist Dictionary
    194300
    195 (define (alist-dict-test-ref data) (alist-dict-test data))
     301(define (alist-dict-test-ref data)
     302  (alist-dict-test data))
    196303
    197304(define (alist-dict->alist data)
    198   (cond-expand (unsafe (alist-dict-alist data)) (else (dict::list-copy (alist-dict-alist data)))) )
     305  (cond-expand
     306    (unsafe
     307      (alist-dict-alist data))
     308    (else
     309      (dict::list-copy (alist-dict-alist data)))) )
    199310
    200311(define (alist-dict-ref data key def)
     
    213324(define (alist-dict-for-each data proc)
    214325        (dict::list-for-each/1
    215           (lambda (p) (proc (dict::car p) (dict::cdr p)))
     326          (lambda (p)
     327            (proc (dict::car p) (dict::cdr p)))
    216328    (alist-dict-alist data)) )
    217329
    218330(define (alist-dict-merge! data1 data2)
    219         (let ((test (alist-dict-test data1))
    220               (al (alist-dict-alist data1)))
     331        (let (
     332          (test (alist-dict-test data1))
     333    (al (alist-dict-alist data1)) )
    221334                (dict::list-for-each/1
    222                   (lambda (p) (set! al (dict::alist-update! (dict::car p) (dict::cdr p) al test)))
     335      (lambda (p)
     336        (set! al (dict::alist-update! (dict::car p) (dict::cdr p) al test)))
    223337      (alist-dict-alist data2))
    224338                (alist-dict-alist-set! data1 al) ) )
     
    251365;;; Hash-table Dictionary
    252366
    253 (define (htable-dict-test-ref data) (htable-dict-test data))
    254 
    255 (define (htable-dict->alist data) (hash-table->alist (htable-dict-htable data)))
     367(define (htable-dict-test-ref data)
     368  (htable-dict-test data))
     369
     370(define (htable-dict->alist data)
     371  (hash-table->alist (htable-dict-htable data)))
    256372
    257373(define (htable-dict-ref data key def)
     
    273389
    274390(define (htable-dict-search data proc def)
    275         (let ((ht (htable-dict-htable data))
    276                                 (ret #f))
    277                 (let ((res (let/cc return
    278                  (hash-table-walk ht
    279                    (lambda (key val) (when (proc key val) (set! ret #t) (return val)))))))
    280                         (if ret res def) ) ) )
    281 
    282 (define (htable-dict-count data) (hash-table-size (htable-dict-htable data)))
    283 
    284 (define (htable-dict-keys data) (hash-table-keys (htable-dict-htable data)))
    285 
    286 (define (htable-dict-values data) (hash-table-values (htable-dict-htable data)))
    287 
    288 (define (htable-dict-exists? data key) (hash-table-exists? (htable-dict-htable data) key))
     391        (let* (
     392          (ht (htable-dict-htable data))
     393    (ret #f)
     394    (res
     395      (let/cc return
     396        (hash-table-walk ht
     397          (lambda (key val)
     398            (when (proc key val)
     399              (set! ret #t)
     400              (return val)))))) )
     401    (if ret res def) ) )
     402
     403(define (htable-dict-count data)
     404  (hash-table-size (htable-dict-htable data)))
     405
     406(define (htable-dict-keys data)
     407  (hash-table-keys (htable-dict-htable data)))
     408
     409(define (htable-dict-values data)
     410  (hash-table-values (htable-dict-htable data)))
     411
     412(define (htable-dict-exists? data key)
     413  (hash-table-exists? (htable-dict-htable data) key))
    289414
    290415(define (make-htable-dict test ht)
    291416  (set-htable-dict-procs! (make-dictbase (make-htable-data test ht))) )
    292417
    293 (define (htable-dict? dict) (dict::eq? htable-dict-test-ref (dictbase-test dict)))
    294 
    295 (define (become-htable-dict! dict)
    296         (let ((test (dictbase-test dict)))
    297                 (dict-data-set! dict (make-htable-data test (alist->hash-table (dictbase->alist dict) test))))
     418(define (htable-dict? dict)
     419  (dict::eq? htable-dict-test-ref (dictbase-test dict)))
     420
     421(define: (become-htable-dict! (dict dict))
     422        (let (
     423          (test (dictbase-test dict)) )
     424                (dict-data-set! dict
     425                  (make-htable-data test
     426                    (alist->hash-table (dictbase->alist dict) test))))
    298427        (set-htable-dict-procs! dict) )
    299428
    300429;; Dictionary Type
    301430
    302 (define (dict-same-kind? dict1 dict2) (dict::eq? (dict-test-ref dict1) (dict-test-ref dict2)))
     431(define: (dict-same-kind? (dict1 dict) (dict2 dict)) --> boolean
     432  (dict::eq? (dict-test-ref dict1) (dict-test-ref dict2)))
    303433(safety
    304   (define (dict-same-test? dict1 dict2) (dict::eq? (dictbase-test dict1) (dictbase-test dict2))) )
     434  (define: (dict-same-test? (dict1 dict) (dict2 dict)) --> boolean
     435    (dict::eq? (dictbase-test dict1) (dictbase-test dict2))) )
    305436
    306437;; Optimal form
    307438
    308 (define-inline (magic-count? count) (<= count MAGIC-LIMIT))
    309 
    310 (define (dict-bestfit dict)
     439(define-inline (magic-count? count)
     440  (fx<= count MAGIC-LIMIT))
     441
     442(define: (dict-bestfit (dict dict))
    311443        (if (magic-count? (dictbase-count dict))
    312           (unless (alist-dict? dict) (become-alist-dict! dict))
    313     (unless (htable-dict? dict) (become-htable-dict! dict)) )
     444          (unless (alist-dict? dict)
     445      (become-alist-dict! dict))
     446    (unless (htable-dict? dict)
     447      (become-htable-dict! dict)) )
    314448  ;enforce unspecified return
    315449  (void) )
     
    317451;; Print worker
    318452
    319 (define (*dict-print dict)
    320   (define (print-node-table dict spcr)
    321     (dictbase-for-each dict
    322       (lambda (key val)
    323         (dict::list-for-each/1 display spcr)
    324         (cond
    325           ((dict::dict? val)
    326             (write key) (display " :") (newline)
    327             (print-node-table val (dict::cons "  " spcr)) )
    328           (else
    329             (write key) (display " : ") (pretty-print val)) ) ) ) )
    330     (print-node-table dict '()) )
     453(define: (*dict-print (dict dict))
     454  (letrec (
     455    (print-node-table
     456      (lambda (dict spcr)
     457        (dictbase-for-each dict
     458          (lambda (key val)
     459            (dict::list-for-each/1 display spcr)
     460            (cond
     461              ((dict::dict? val)
     462                (write key) (display " :") (newline)
     463                (print-node-table val (dict::cons "  " spcr)) )
     464              (else
     465                (write key) (display " : ") (pretty-print val)) ) ) ) ) ) )
     466    (print-node-table dict '()) ) )
    331467
    332468;; Update workers
    333469
    334 (define (*dict-update! loc dict key valu-func updt-func)
    335 
    336   (define (do-dict-update! curr)
    337     (let* ((val (if (not (dict::undefined-value? curr)) curr
    338                   (let ((val (valu-func))) (safety (check-defined-value loc val)) val)))
    339            (updval (updt-func val)) )
    340       (dictbase-set! dict key updval)
    341       (dict-bestfit dict)
    342       updval ) )
    343 
     470(define: (*dict-update! (loc symbol) (dict dict) (key *) (valu-func dict-refer) (updt-func dict-updater)) -> *
     471  (letrec (
     472    (do-dict-update!
     473      (lambda (curr)
     474        (let* (
     475          (val
     476            (if (not (dict::undefined-value? curr))
     477              curr
     478              (let (
     479                (val (valu-func)) )
     480                (safety (check-defined-value loc val)) val)))
     481          (updval
     482            (updt-func val)) )
     483          (dictbase-set! dict key updval)
     484          (dict-bestfit dict)
     485          updval ) ) ) )
    344486  (safety
    345487    (check-dict loc dict)
    346488    (check-procedure loc valu-func)
    347489    (check-procedure loc updt-func) )
    348   (do-dict-update! (dictbase-ref dict key (dict::undefined-value))) )
     490  (do-dict-update! (dictbase-ref dict key (dict::undefined-value))) ) )
    349491
    350492;;; Globals
    351493
    352494; Cannot set but can still get
    353 (define (dict-safe-mode . args) (cond-expand (unsafe #f) (else #t)))
    354 
    355 (define (make-dict #!optional (test eq?) (size 0))
    356   (safety
    357     (check-cardinal-fixnum 'make-dict size "size")
    358     (check-procedure 'make-dict test) )
    359         (if (magic-count? size) (make-alist-dict test '())
    360     (make-htable-dict test (make-hash-table test)) ) )
    361 
    362 (define (alist->dict al #!optional (test eq?) (size 0))
    363   (safety
    364     (check-alist 'alist->dict al "alist")
    365     (check-cardinal-fixnum 'alist->dict size "size")
    366     (check-procedure 'alist->dict test) )
    367         (if (magic-count? (fxmax (dict::list-length al) size)) (make-alist-dict test al)
    368     (make-htable-dict test (alist->hash-table al test)) ) )
    369 
    370 (define (dict? obj) (dict::dict? obj))
    371 
    372 (define (dict->alist dict)
     495(define: (dict-safe-mode . (args list)) --> boolean
     496  (cond-expand (unsafe #f) (else #t)) )
     497
     498(define: (make-dict . (opts list)) --> dict
     499  (let-optionals* opts (
     500    (test eq?)
     501    (size 0) )
     502    (safety
     503      (check-cardinal-fixnum 'make-dict size "size")
     504      (check-procedure 'make-dict test) )
     505    (if (magic-count? size)
     506      (make-alist-dict test '())
     507      (make-htable-dict test (make-hash-table test)) ) ) )
     508
     509(define: (alist->dict (al list) . (opts list)) --> dict
     510  (let-optionals* opts (
     511    (test eq?)
     512    (size 0) )
     513    (safety
     514      (check-alist 'alist->dict al "alist")
     515      (check-cardinal-fixnum 'alist->dict size "size")
     516      (check-procedure 'alist->dict test) )
     517    (if (magic-count? (fxmax (dict::list-length al) size))
     518      (make-alist-dict test al)
     519      (make-htable-dict test (alist->hash-table al test)) ) ) )
     520
     521(: dict? (* -> boolean : dict))
     522;
     523(define (dict? obj)
     524  (dict::dict? obj) )
     525
     526(define: (dict->alist (dict dict)) --> list
    373527  (safety (check-dict 'dict->alist dict))
    374528        (dictbase->alist dict) )
    375529
    376 (define (dict-equivalence-function dict)
     530(define: (dict-equivalence-function (dict dict)) --> dict-equaler
    377531  (safety (check-dict 'dict-equivalence-function dict))
    378532        (dictbase-test dict) )
    379533
    380 (define (dict-count dict)
     534(define: (dict-count (dict dict)) --> fixnum
    381535  (safety (check-dict 'dict-count dict))
    382536        (dictbase-count dict) )
    383537
    384 (define (dict-keys dict)
     538(define: (dict-keys (dict dict)) --> list
    385539  (safety (check-dict 'dict-keys dict))
    386540        (dictbase-keys dict) )
    387541
    388 (define (dict-values dict)
     542(define: (dict-values (dict dict)) --> list
    389543  (safety (check-dict 'dict-values dict))
    390544        (dictbase-values dict) )
    391545
    392 (define (dict-ref dict key #!optional def)
    393   (safety (check-dict 'dict-ref dict))
    394         (dictbase-ref dict key def) )
    395 
    396 (define (dict-indempotent-ref! dict key func #!optional def)
    397   (safety
    398     (check-dict 'dict-indempotent-ref! dict)
    399     (check-procedure 'dict-indempotent-ref! func) )
    400   (let ((val (dictbase-ref dict key def)))
    401     (if (not (eq? def val)) val
    402       (let ((val (func def)))
    403         (if (eq? def val) def
    404           (begin
    405             (dictbase-set! dict key val)
    406             (dict-bestfit dict)
    407             val ) ) ) ) ) )
    408 
    409 (define (dict-set! dict key obj)
     546(define: (dict-ref (dict dict) (key *) . (opts list)) --> *
     547  (let* (
     548    (def (optional opts #f)) )
     549    (safety (check-dict 'dict-ref dict))
     550    (dictbase-ref dict key def) ) )
     551
     552(define: (dict-indempotent-ref! (dict dict) (key *) (func procedure) . (opts list)) --> *
     553  (let (
     554    (def (optional opts #f)) )
     555    (safety
     556      (check-dict 'dict-indempotent-ref! dict)
     557      (check-procedure 'dict-indempotent-ref! func) )
     558    (let ((val (dictbase-ref dict key def)))
     559      (if (not (eq? def val))
     560        val
     561        (let (
     562          (val (func def)) )
     563          (if (eq? def val)
     564            def
     565            (begin
     566              (dictbase-set! dict key val)
     567              (dict-bestfit dict)
     568              val ) ) ) ) ) ) )
     569
     570(define: (dict-set! (dict dict) (key *) (obj *))
    410571  (safety
    411572    (check-defined-value 'dict-set! obj)
     
    414575        (dict-bestfit dict) )
    415576
    416 (define (dict-exists? dict key)
     577(define: (dict-exists? (dict dict) (key *)) --> boolean
    417578  (safety (check-dict 'dict-exists? dict))
    418579  (dictbase-exists? dict key) )
    419580
    420 (define (dict-update! dict key valu-func #!optional (updt-func identity))
    421         (*dict-update! 'dict-update! dict key valu-func updt-func) )
    422 
    423 (define (dict-update-list! dict key . vals)
     581(define: (dict-update! (dict dict) (key *) (valu-func dict-refer) . (opts (list dict-updater)))
     582  (let (
     583    (updt-func (optional opts identity)) )
     584    (*dict-update! 'dict-update! dict key valu-func updt-func) ) )
     585
     586(define: (dict-update-list! (dict dict) (key *) . (vals list))
    424587  (*dict-update! 'dict-update-list!
    425     dict key (lambda () '()) (cut fold cons <> (reverse! vals))) )
    426 
    427 (define (dict-update-dict! dict key #!optional (test eq?) (size 0))
    428   (*dict-update! 'dict-update-dict!
    429     dict key (lambda () (make-dict test size)) identity) )
    430 
    431 (define (dict-delete! dict key)
     588    dict key
     589    (lambda () '())
     590    (cut fold cons <> (reverse! vals))) )
     591
     592(define: (dict-update-dict! (dict dict) (key *) . (opts list))
     593  (let-optionals* opts (
     594    (test eq?)
     595    (size 0) )
     596    (*dict-update! 'dict-update-dict!
     597      dict key
     598      (lambda () (make-dict test size))
     599      identity) ) )
     600
     601(define: (dict-delete! (dict dict) (key *))
    432602  (safety (check-dict 'dict-delete! dict))
    433603        (dictbase-delete! dict key)
    434604        (dict-bestfit dict) )
    435605
    436 (define (dict-for-each dict proc)
     606(define: (dict-for-each (dict dict) (proc dict-for-eacher))
    437607  (safety
    438608    (check-dict 'dict-for-each dict)
     
    440610        (dictbase-for-each dict proc) )
    441611
    442 (define (dict-search dict proc #!optional def)
    443   (safety
    444     (check-dict 'dict-search dict)
    445     (check-procedure 'dict-search proc) )
    446         (dictbase-search dict proc def) )
    447 
    448 (define (dict-merge! dict . dicts)
     612(define: (dict-search (dict dict) (proc dict-searcher) . (opts list)) --> *
     613  (let (
     614    (def (optional opts #f)) )
     615    (safety
     616      (check-dict 'dict-search dict)
     617      (check-procedure 'dict-search proc) )
     618    (dictbase-search dict proc def) ) )
     619
     620(define: (dict-merge! (dict dict) . (dicts (list-of dict)))
    449621  (safety (check-dict 'dict-merge! dict))
    450622        (dict::list-for-each/1
     
    454626        (unless (dict-same-test? dict dictx)
    455627          (error "cannot merge lookup-tables; incompatible test") ) )
    456                         (if (dict-same-kind? dict dictx) (dictbase-merge! dict dictx)
     628                        (if (dict-same-kind? dict dictx)
     629                          (dictbase-merge! dict dictx)
    457630        (dictbase-for-each dictx (cut dict-set! dict <> <>)) ) )
    458631                dicts)
    459632        (dict-bestfit dict) )
    460633
    461 (define (dict-print dict #!optional port)
    462   (if (not port) (*dict-print dict)
    463     (with-output-to-port port (lambda () (*dict-print dict)) ) ) )
     634(define: (dict-print (dict dict) . (opts (list output-port)))
     635  (let (
     636    (port (optional opts #f)) )
     637    (if (not port)
     638      (*dict-print dict)
     639      (with-output-to-port port
     640      (lambda ()
     641        (*dict-print dict)) ) ) ) )
  • release/4/lookup-table/trunk/lookup-table.setup

    r27572 r35358  
    99  '(-scrutinize
    1010    -prelude "\"(define-constant MAGIC-LIMIT 12)\""
    11     -disable-interrupts
    1211    -fixnum-arithmetic
    1312    -local
     
    1716    -optimize-level 3))
    1817
    19 (setup-shared-extension-module 'lookup-table (extension-version "1.13.5")
     18(setup-shared-extension-module 'lookup-table (extension-version "1.14.0")
    2019  #:inline? #t
    2120  #:types? #t
    2221  #:compile-options (append opts '(-debug-level 1)))
    2322
    24 (setup-shared-extension-module 'lookup-table-unsafe (extension-version "1.13.5")
     23(setup-shared-extension-module 'lookup-table-unsafe (extension-version "1.14.0")
    2524  #:inline? #t
    2625  #:types? #t
    2726  #:compile-options (append opts '(-feature unsafe -debug-level 0 -no-bound-checks -no-argc-checks)))
    2827
    29 (setup-shared-extension-module 'lookup-table-synch (extension-version "1.13.5")
     28(setup-shared-extension-module 'lookup-table-synch (extension-version "1.14.0")
    3029  #:inline? #t
    3130  #:types? #t
    3231  #:compile-options (append opts '(-debug-level 1)))
    3332
    34 (setup-shared-extension-module 'lookup-table-unsafe-synch (extension-version "1.13.5")
     33(setup-shared-extension-module 'lookup-table-unsafe-synch (extension-version "1.14.0")
    3534  #:inline? #t
    3635  #:types? #t
  • release/4/lookup-table/trunk/tests/safe-synch.scm

    r35097 r35358  
    22(use lookup-table-synch)
    33
    4 ;;;
     4(use test srfi-1 srfi-18)
    55
    6 (newline) (print "*** Lookup Table Safe Synch ***")
    7 
    8 (use test srfi-1 srfi-18)
    96;;;
    107
     
    5249        ([> i 54])
    5350      (if (odd? i)
    54           (dict-set!-synch tbl1 i (->string i))
    55           (dict-set!-synch tbl1 (->string i) i)))
     51        (dict-set!-synch tbl1 i (->string i))
     52        (dict-set!-synch tbl1 (->string i) i)))
    5653
    5754    (test 20 (dict-ref-synch tbl1 "20"))
     
    7067;;;
    7168
    72 (newline) (print "** Alist Test (eq?) **") (newline)
    73 (dict-alist-test '((foo . bar) (baz . bop)) eq?)
    74 (newline) (print "** Alist Test (equal?) **") (newline)
    75 (dict-alist-test '((foo . bar) (baz . bop) (2 . 3)) equal?)
    76 (newline) (print "** HT Test () **") (newline)
    77 (dict-ht-test)
     69(test-begin "Lookup Table Safe Synch")
     70
     71(test-group "Alist Test (eq?)"
     72  (dict-alist-test '((foo . bar) (baz . bop)) eq?) )
     73
     74(test-group "Alist Test (equal?)"
     75  (dict-alist-test '((foo . bar) (baz . bop) (2 . 3)) equal?) )
     76
     77(test-group "HT Test ()"
     78  (dict-ht-test) )
     79
     80(test-end)
     81
     82(test-exit)
  • release/4/lookup-table/trunk/tests/safe.scm

    r22485 r35358  
    44;;;
    55
    6 (newline) (print "*** Lookup Table Safe ***")
     6(define LOOKUP-TEST-NAME "Lookup Table Safe")
    77(include "test-body")
  • release/4/lookup-table/trunk/tests/test-body.scm

    r34956 r35358  
    6767;;;
    6868
    69 (newline) (print "** Alist Test (eq?) **") (newline)
    70 (dict-alist-test '((foo . bar) (baz . bop)) eq?)
    71 (newline) (print "** Alist Test (equal?) **") (newline)
    72 (dict-alist-test '((foo . bar) (baz . bop) (2 . 3)) equal?)
    73 (newline) (print "** HT Test () **") (newline)
    74 (dict-ht-test)
     69(test-begin LOOKUP-TEST-NAME)
     70
     71(test-group "Alist Test (eq?)"
     72  (dict-alist-test '((foo . bar) (baz . bop)) eq?) )
     73
     74(test-group "Alist Test (equal?)"
     75  (dict-alist-test '((foo . bar) (baz . bop) (2 . 3)) equal?) )
     76
     77(test-group "HT Test ()"
     78  (dict-ht-test) )
     79
     80(test-end)
    7581
    7682(test-exit)
  • release/4/lookup-table/trunk/tests/unsafe-synch.scm

    r35097 r35358  
    22(use lookup-table-unsafe-synch)
    33
    4 ;;;
     4(use test srfi-1 srfi-18)
    55
    6 (newline) (print "*** Lookup Table UnSafe Synch ***")
    7 
    8 (use test srfi-1 srfi-18)
    96;;;
    107
     
    5249        ([> i 54])
    5350      (if (odd? i)
    54           (dict-set!-%synch tbl1 i (->string i))
    55           (dict-set!-%synch tbl1 (->string i) i)))
     51        (dict-set!-%synch tbl1 i (->string i))
     52        (dict-set!-%synch tbl1 (->string i) i)))
    5653
    5754    (test 20 (dict-ref-%synch tbl1 "20"))
     
    7067;;;
    7168
    72 (newline) (print "** Alist Test (eq?) **") (newline)
    73 (dict-alist-test '((foo . bar) (baz . bop)) eq?)
    74 (newline) (print "** Alist Test (equal?) **") (newline)
    75 (dict-alist-test '((foo . bar) (baz . bop) (2 . 3)) equal?)
    76 (newline) (print "** HT Test () **") (newline)
    77 (dict-ht-test)
     69(test-begin "Lookup Table UnSafe Synch")
     70
     71(test-group "Alist Test (eq?)"
     72  (dict-alist-test '((foo . bar) (baz . bop)) eq?) )
     73
     74(test-group "Alist Test (equal?)"
     75  (dict-alist-test '((foo . bar) (baz . bop) (2 . 3)) equal?) )
     76
     77(test-group "HT Test ()"
     78  (dict-ht-test) )
     79
     80(test-end)
     81
     82(test-exit)
  • release/4/lookup-table/trunk/tests/unsafe.scm

    r22485 r35358  
    44;;;
    55
    6 (newline) (print "*** Lookup Table UnSafe ***")
     6(define LOOKUP-TEST-NAME "Lookup Table UnSafe")
    77(include "test-body")
Note: See TracChangeset for help on using the changeset viewer.