Changeset 13877 in project


Ignore:
Timestamp:
03/23/09 16:04:43 (11 years ago)
Author:
Kon Lovett
Message:

Rmvd unused extn.

File:
1 edited

Legend:

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

    r12011 r13877  
    22;;;; Kon Lovett, May '06
    33
    4 (eval-when (compile)
    5   (declare
    6     (usual-integrations)
    7     (fixnum)
    8     (inline)
    9     (no-procedure-checks)
    10     (no-bound-checks)
    11     (export
    12       dict-safe-mode
    13       make-dict
    14       alist->dict
    15       dict->alist
    16       dict?
    17       dict-equivalence-function
    18       dict-count
    19       dict-keys
    20       dict-values
    21       dict-ref
    22       dict-set!
    23       dict-exists?
    24       dict-update!
    25       dict-update-list!
    26       dict-update-dict!
    27       dict-delete!
    28       dict-for-each
    29       dict-search
    30       dict-merge!
    31       dict-print ) ) )
    32 
    33 (use srfi-1 extras srfi-69
    34      miscmacros misc-extn-record misc-extn-control)
     4(declare
     5  (usual-integrations)
     6  (fixnum)
     7  (inline)
     8  (no-procedure-checks)
     9  (export
     10    dict-safe-mode
     11    make-dict
     12    alist->dict
     13    dict->alist
     14    dict?
     15    dict-equivalence-function
     16    dict-count
     17    dict-keys
     18    dict-values
     19    dict-ref
     20    dict-set!
     21    dict-exists?
     22    dict-update!
     23    dict-update-list!
     24    dict-update-dict!
     25    dict-delete!
     26    dict-for-each
     27    dict-search
     28    dict-merge!
     29    dict-print ) )
     30
     31(use srfi-1 srfi-69 extras miscmacros misc-extn-record)
    3532
    3633;;;
     
    131128
    132129(define (alist-dict->alist data)
    133   (if *dict-safe-mode*
    134       (list-copy (%alist-dict-alist data))
     130  (if *dict-safe-mode* (list-copy (%alist-dict-alist data))
    135131      (%alist-dict-alist data) ) )
    136132
     
    145141
    146142(define (alist-dict-for-each data proc)
    147         (for-each
    148                 (lambda (pair)
    149                         (proc (car pair) (cdr pair)))
    150                 (%alist-dict-alist data)) )
     143        (for-each (lambda (pair) (proc (car pair) (cdr pair))) (%alist-dict-alist data)) )
    151144
    152145(define (alist-dict-merge data1 data2)
    153         (let ([test (%alist-dict-test data1)] [al (%alist-dict-alist data1)])
     146        (let ((test (%alist-dict-test data1)) (al (%alist-dict-alist data1)))
    154147                (for-each
    155                         (lambda (pair)
    156                                 (set! al (alist-update! (car pair) (cdr pair) al test)))
     148                        (lambda (pair) (set! al (alist-update! (car pair) (cdr pair) al test)))
    157149                        (%alist-dict-alist data2))
    158150                (set-cdr! data1 al) ) )
    159151
    160152(define (alist-dict-search data proc def)
    161         (let loop ([al (%alist-dict-alist data)])
    162                 (if (null? al)
    163         def
    164         (let* ([pair (car al)]
    165                [val (cdr pair)])
    166             (if (proc (car pair) val)
    167                 val
     153        (let loop ((al (%alist-dict-alist data)))
     154                (if (null? al) def
     155        (let* ((pair (car al))
     156               (val (cdr pair)))
     157            (if (proc (car pair) val) val
    168158                (loop (cdr al)) ) ) ) ) )
    169159
     
    178168
    179169(define (alist-dict-exists? data key)
    180         (not (eq? *unspecified*
    181                   (alist-dict-ref data key *unspecified*))) )
     170        (not (eq? *unspecified* (alist-dict-ref data key *unspecified*))) )
    182171
    183172(define (set-alist-dict-procs! dict)
     
    203192
    204193(define (become-alist-dict dict)
    205         (let ([test (%dict-test dict)])
     194        (let ((test (%dict-test dict)))
    206195                (%dict-data-set! dict (cons test (%dict->alist dict))))
    207196        (set-alist-dict-procs! dict) )
     
    235224(define (hash-table-dict-merge data1 data2)
    236225        (set-cdr! data1
    237                 (hash-table-merge!
    238                         (%hash-table-dict-hash-table data1)
    239                         (%hash-table-dict-hash-table data2))) )
     226                (hash-table-merge! (%hash-table-dict-hash-table data1) (%hash-table-dict-hash-table data2))) )
    240227
    241228(define (hash-table-dict-search data proc def)
    242         (let ([ht (%hash-table-dict-hash-table data)]
    243                                 [ret #f])
    244                 (let ([res
     229        (let ((ht (%hash-table-dict-hash-table data))
     230                                (ret #f))
     231                (let ((res
    245232            (let/cc return
    246233              (hash-table-walk ht
     
    248235                  (when (proc key val)
    249236                    (set! ret #t)
    250                     (return val)))) ) ] )
     237                    (return val)))) ) ) )
    251238                        (if ret res def) ) ) )
    252239
     
    285272
    286273(define (become-hash-table-dict dict)
    287         (let ([test (%dict-test dict)])
     274        (let ((test (%dict-test dict)))
    288275                (%dict-data-set! dict (cons test (alist->hash-table (%dict->alist dict) test))))
    289276        (set-hash-table-dict-procs! dict) )
     
    327314      (lambda (key val)
    328315        (for-each display spcr)
    329         (cond [(dict? val)
     316        (cond ((dict? val)
    330317                (write key) (display " :") (newline)
    331                 (print-node-table val (cons "  " spcr))]
    332               [else
    333                 (write key) (display " : ") (pretty-print val)]))))
     318                (print-node-table val (cons "  " spcr)))
     319              (else
     320                (write key) (display " : ") (pretty-print val))))))
    334321    dict '()) )
    335322
    336323(define (%dict-update! dict key valu-func updt-func curr loc)
    337   (let ([val (updt-func
    338               (if (not (eq? *unspecified* curr))
    339                   curr
    340                   (let ([val (valu-func)])
     324  (let ((val (updt-func
     325              (if (not (eq? *unspecified* curr)) curr
     326                  (let ((val (valu-func)))
    341327                    (when *dict-safe-mode*
    342328                      (check-value val loc) )
    343                     val ) ) ) ] )
     329                    val ) ) ) ) )
    344330    (%dict-set! dict key val)
    345331    val ) )
     
    352338    (check-procedure valu-func loc)
    353339    (check-procedure updt-func loc) )
    354   (let* ([curr (%dict-ref dict key *unspecified*)]
    355          [updt (%dict-update! dict key valu-func updt-func curr loc)])
     340  (let* ((curr (%dict-ref dict key *unspecified*))
     341         (updt (%dict-update! dict key valu-func updt-func curr loc)))
    356342    (unless (eq? *unspecified* curr)
    357343      (dict-bestfit dict) )
     
    387373        (%dict->alist dict) )
    388374
    389 (define dict? %dict?)
     375(define (dict? obj) (%dict? obj))
    390376
    391377(define (dict-equivalence-function dict)
     
    412398  (when *dict-safe-mode*
    413399    (check-dict dict 'dict-ref) )
    414         (%dict-ref dict key (:optional def #f)) )
     400        (%dict-ref dict key (optional def #f)) )
    415401
    416402(define (dict-set! dict key obj)
     
    430416
    431417(define (dict-update-list! dict key . vals)
    432   (*dict-update!
    433     dict key
    434     (lambda () '())
    435     (cut fold cons <> (reverse! vals))
    436     'dict-update-list!) )
     418  (*dict-update! dict key (lambda () '()) (cut fold cons <> (reverse! vals)) 'dict-update-list!) )
    437419
    438420(define (dict-update-dict! dict key)
    439   (*dict-update!
    440     dict key
    441     (cut make-dict)
    442     identity
    443     'dict-update-dict!) )
     421  (*dict-update! dict key (cut make-dict) identity 'dict-update-dict!) )
    444422
    445423(define (dict-delete! dict key)
     
    459437    (check-dict dict 'dict-search)
    460438    (check-procedure proc 'dict-search) )
    461         (%dict-search dict proc (:optional def #f)) )
     439        (%dict-search dict proc (optional def #f)) )
    462440
    463441(define (dict-merge! dict . dicts)
     
    470448        (unless (dict-same-test? dict dictx)
    471449          (error "cannot merge lookup-tables; incompatible test") ) )
    472                         (if (dict-same-kind? dict dictx)
    473           (%dict-merge dict dictx)
     450                        (if (dict-same-kind? dict dictx) (%dict-merge dict dictx)
    474451          (%dict-for-each dictx (cut %dict-set! dict <> <>)) ) )
    475452                dicts)
     
    477454
    478455(define (dict-print dict #!optional port)
    479   (if port
     456  (if (not port) (%dict-print dict)
    480457      (begin
    481458        (when *dict-safe-mode*
    482459          (check-output-port port 'dict-print) )
    483         (with-output-to-port port (lambda () (%dict-print dict))))
    484       (%dict-print dict) ) )
     460        (with-output-to-port port (lambda () (%dict-print dict)) ) ) ) )
Note: See TracChangeset for help on using the changeset viewer.