Changeset 13472 in project


Ignore:
Timestamp:
03/03/09 20:48:57 (11 years ago)
Author:
Kon Lovett
Message:

Save.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/synch/trunk/synch.scm

    r13471 r13472  
    101101
    102102(define-syntax synch-with
    103         (syntax-rules ()
    104                 [(_ ?mtx ?var ?body ...)
    105 
    106                   (let ([mtx ?mtx])
    107         (let ([,?var (mutex-specific mtx)])
    108           (dynamic-wind
    109             (lambda () (mutex-lock! mtx))
    110                                           (lambda () ?body ...)
    111                                           (lambda () (mutex-unlock! mtx)) ) ) ) ] ) )
     103  (lambda (form r c)
     104    (##sys#check-syntax 'synch-with form '(_ _ variable . #(_ 0)))
     105    (let ([$dynamic-wind (r 'dynamic-wind)]
     106          [$let (r 'let)]
     107          [$lambda (r 'lambda)]
     108          [$mutex-unlock! (r 'mutex-unlock!)]
     109          [$mutex-specific (r 'mutex-specific)]
     110          [$mutex-lock! (r 'mutex-lock!)])
     111      (let ([mtxvar (gensym)]
     112            [?mtx (cadr form)] [?var (caddr form)] [?body (cdddr form)])
     113                    `(,$let ([,mtxvar ,?mtx])
     114           (,$let ([,?var (,$mutex-specific ,mtxvar)])
     115             (,$dynamic-wind
     116               (,$lambda () (,$mutex-lock! ,mtxvar))
     117                                             (,$lambda () ,@?body)
     118                                             (,$lambda () (,$mutex-unlock! ,mtxvar)) ) ) ) ) ) ) )
    112119
    113120(define-syntax call/synch
     
    148155
    149156(define-syntax let/synch
    150         (syntax-rules ()
    151                 [(_ BINDINGS ?body ...) ] ) )
    152         (car (let loop ([bnds BINDINGS])
    153          (cond [(null? bnds)
    154                ?body ...]
    155                [(pair? (car bnds))
    156                  (let ([bnd (car bnds)])
    157                    (if (pair? bnd)
    158                      `((synch-with ,(cadr bnd) ,(car bnd) ,@(loop (cdr bnds))))
    159                      (syntax-error 'let/synch "invalid binding form" bnd) ) )]
    160                [else
    161                  (syntax-error 'let/synch "invalid binding form" bnds)] ) ) ) )
     157  (lambda (form r c)
     158    (##sys#check-syntax 'let/synch form '(_ list . _))
     159    (let ([$synch-with (r 'synch-with)])
     160      (let ([?body (cddr form)])
     161        (car
     162          (let loop ([?bnds (cadr form)])
     163            (if (not (null? ?bnds))
     164                (let ([bnd (car ?bnds)])
     165                  (##sys#check-syntax 'let/synch bnd '(variable _))
     166                  `((,$synch-with ,(cadr bnd) ,(car bnd) ,@(loop (cdr ?bnds)))) )
     167                ?body ) ) ) ) ) ) )
    162168
    163169(define-syntax set!/synch
Note: See TracChangeset for help on using the changeset viewer.