Changeset 15948 in project


Ignore:
Timestamp:
09/18/09 20:42:09 (10 years ago)
Author:
Kon Lovett
Message:

Added indempotent-ref & synch versions.

Location:
release/4/lookup-table/trunk
Files:
2 added
5 edited

Legend:

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

    r15809 r15948  
    213213(define (check-value loc obj #!optional nam)
    214214  (when (%undefined-value? obj)
    215     (error-argument-type loc obj "non-undefined value" nam)) )
     215    (error-argument-type loc obj "defined value" nam)) )
    216216
    217217(define (check-alist loc obj #!optional nam)
     
    246246;; Update workers
    247247
    248 (define (*dict-update! dict key valu-func updt-func curr loc)
    249   (let ((val (updt-func
    250                (if (not (%undefined-value? curr)) curr
    251                    (let ((val (valu-func)))
    252                      (safety (check-value loc val))
    253                      val ) ) ) ) )
    254     (dictbase-set! dict key val)
    255     val ) )
    256 
    257 (define (+dict-update! dict key valu-func updt-func loc)
     248(define (+dict-update! loc dict key valu-func updt-func)
     249
     250  (define (*dict-update! curr)
     251    (let* ((val (if (not (%undefined-value? curr)) curr
     252                    (let ((val (valu-func))) (safety (check-value loc val)) val)))
     253           (updval (updt-func val)) )
     254      (dictbase-set! dict key updval)
     255      (dict-bestfit dict)
     256      updval ) )
     257
    258258  (safety
    259259    (check-dict loc dict)
    260260    (check-procedure loc valu-func)
    261261    (check-procedure loc updt-func) )
    262   (let* ((curr (dictbase-ref dict key (%undefined-value)))
    263          (updt (*dict-update! dict key valu-func updt-func curr loc)))
    264     (unless (%undefined-value? curr) (dict-bestfit dict))
    265     updt ) )
     262  (*dict-update! (dictbase-ref dict key (%undefined-value))) )
    266263
    267264;; Dictionary Type
     
    320317        (dictbase-ref dict key def) )
    321318
     319(define (dict-Idempotent-ref! dict key func #!optional def)
     320  (safety
     321    (check-dict 'dict-Idempotent-ref! dict)
     322    (check-procedure 'dict-Idempotent-ref! func) )
     323  (let ((val (dictbase-ref dict key def)))
     324    (if (not (eq? def val)) val
     325        (let ((val (func def)))
     326          (if (eq? def val) def
     327              (begin
     328                (dictbase-set! dict key obj)
     329                (dict-bestfit dict)
     330                val ) ) ) ) ) )
     331
    322332(define (dict-set! dict key obj)
    323333  (safety
     
    332342
    333343(define (dict-update! dict key valu-func #!optional (updt-func identity))
    334         (+dict-update! dict key valu-func updt-func 'dict-update!) )
     344        (+dict-update! 'dict-update! dict key valu-func updt-func) )
    335345
    336346(define (dict-update-list! dict key . vals)
    337   (+dict-update! dict key (lambda () '()) (cut fold cons <> (reverse! vals)) 'dict-update-list!) )
     347  (+dict-update! 'dict-update-list! dict key (lambda () '()) (cut fold cons <> (reverse! vals))) )
    338348
    339349(define (dict-update-dict! dict key)
    340   (+dict-update! dict key (cut make-dict) identity 'dict-update-dict!) )
     350  (+dict-update! 'dict-update-dict! dict key (cut make-dict) identity) )
    341351
    342352(define (dict-delete! dict key)
  • release/4/lookup-table/trunk/lookup-table-unsafe.scm

    r15809 r15948  
    2020  dict-set!
    2121  dict-exists?
     22  dict-Idempotent-ref!
    2223  dict-update!
    2324  dict-update-list!
     
    2930  dict-print )
    3031
    31   (import
    32     scheme chicken
    33     srfi-1 srfi-69 ports data-structures extras
    34     miscmacros type-checks type-errors srfi-9-ext)
     32  (import scheme chicken
     33          srfi-1 srfi-69 ports data-structures extras
     34          miscmacros type-checks type-errors srfi-9-ext)
    3535
    3636  (require-library srfi-1 srfi-69 extras miscmacros type-checks type-errors srfi-9-ext)
    3737
    38 (include "lookup-table-body")
     38  (include "lookup-table-body")
    3939
    4040) ;module lookup-table-unsafe
  • release/4/lookup-table/trunk/lookup-table.meta

    r15809 r15948  
    77 (doc-from-wiki)
    88 (synopsis "Simple Lookup Table")
    9  (needs check-errors miscmacros setup-helper srfi-9-ext)
     9 (needs check-errors miscmacros setup-helper srfi-9-ext synch)
    1010 (files
    1111  "tests"
     
    1515  "lookup-table.scm"
    1616  "lookup-table-unsafe.scm"
     17  "lookup-table-synch.scm"
     18  "lookup-table-unsafe-synch.scm"
    1719  "lookup-table.setup") )
  • release/4/lookup-table/trunk/lookup-table.scm

    r15809 r15948  
    2020  dict-set!
    2121  dict-exists?
     22  dict-Idempotent-ref!
    2223  dict-update!
    2324  dict-update-list!
     
    3637  (require-library srfi-1 srfi-69 extras miscmacros type-checks type-errors srfi-9-ext)
    3738
    38 (include "lookup-table-body")
     39  (include "lookup-table-body")
    3940
    4041) ;module lookup-table
  • release/4/lookup-table/trunk/lookup-table.setup

    r15809 r15948  
    1212    -inline-limit 50))
    1313
    14 (setup-shared-extension-module 'lookup-table (extension-version "1.10.0")
     14(setup-shared-extension-module 'lookup-table (extension-version "1.11.0")
    1515  #:compile-options (append opts '(-optimize-level 3 -debug-level 1)))
    1616
    17 (setup-shared-extension-module 'lookup-table-unsafe (extension-version "1.10.0")
     17(setup-shared-extension-module 'lookup-table-unsafe (extension-version "1.11.0")
    1818  #:compile-options (append opts '(-optimize-level 4 -debug-level 0)))
     19
     20(setup-shared-extension-module 'lookup-table-synch (extension-version "1.11.0")
     21  #:compile-options (append opts '(-optimize-level 3 -debug-level 1)))
     22
     23(setup-shared-extension-module 'lookup-table-unsafe-synch (extension-version "1.11.0")
     24  #:compile-options (append opts '(-optimize-level 4 -debug-level 0)))
Note: See TracChangeset for help on using the changeset viewer.