Changeset 13474 in project


Ignore:
Timestamp:
03/03/09 21:03:41 (11 years ago)
Author:
Kon Lovett
Message:

Save

File:
1 edited

Legend:

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

    r13472 r13474  
    168168
    169169(define-syntax set!/synch
    170         (syntax-rules ()
    171                 [(_ ?binding . ?body) ] ) )
    172         (if (pair? ?binding)
    173                         (let ([?var (car ?binding)]
    174                                                 [?mutex (cadr ?binding)])
    175                                 `(synch-with ,?mutex ,?var
    176                                          (mutex-specific-set! ,?mutex (begin ,@?body))
    177                                          (mutex-specific ,?mutex) ) )
    178                         (syntax-error 'set!/synch "invalid binding form" ?binding) ) )
     170  (lambda (form r c)
     171    (##sys#check-syntax 'set!/synch form '(_ pair . _))
     172    (let ([$synch-with (r 'synch-with)]
     173          [$mutex-specific (r 'mutex-specific)]
     174          [$mutex-specific-set! (r 'mutex-specific-set!)]
     175          [$begin (r 'begin)])
     176      (let ([?bnd (cadr form)] [?body (cddr form)])
     177        (let ([?var (car ?bnd)]
     178              [?mtx (cadr ?bnd)])
     179          `(,$synch-with ,?mtx ,?var
     180             (,$mutex-specific-set! ,?mtx (,$begin ,@?body))
     181             (,$mutex-specific ,?mtx) ) ) ) ) ) )
    179182
    180183(define-syntax synch/lock
     
    200203
    201204(define-syntax object/synch
     205  (lambda (form r c)
     206    (##sys#check-syntax 'object/synch form '(_ _ . _))
     207
    202208        (syntax-rules ()
    203209                [(_ ?mtx ?body ...) ] ) )
     
    226232
    227233(define-syntax record/synch
    228         (syntax-rules ()
    229                 [(_ ?sym ?rec ?body ...) ] ) )
    230         `(synch (,(string->symbol (conc ?sym #\- 'mutex)) ,?rec)
    231                 ?body ...) )
     234  (lambda (form r c)
     235    (##sys#check-syntax 'record/synch form '(_ variable _ . _))
     236    (let ([$synch (r 'synch)])
     237      (let ([?sym (cadr form)] [?rec (caddr form)] [?body (cdddr form)])
     238        `(,$synch (,(string->symbol (conc ?sym #\- 'mutex)) ,?rec) ,@?body) ) ) ) )
    232239
    233240(define-syntax record-synch/lock
    234         (syntax-rules ()
    235                 [(_ ?sym ?rec ?body ...) ] ) )
    236         `(synch/lock (,(string->symbol (conc ?sym #\- 'mutex)) ,?rec)
    237                 ?body ...) )
     241  (lambda (form r c)
     242    (##sys#check-syntax 'record-synch/lock form '(_ variable _ . _))
     243    (let ([$synch/lock (r 'synch/lock)])
     244      (let ([?sym (cadr form)] [?rec (caddr form)] [?body (cdddr form)])
     245        `(,$synch/lock (,(string->symbol (conc ?sym #\- 'mutex)) ,?rec) ,@?body) ) ) ) )
    238246
    239247(define-syntax record-synch/unlock
    240         (syntax-rules ()
    241                 [(_ ?sym ?rec ?body ...) ] ) )
    242         `(synch/unlock (,(string->symbol (conc ?sym #\- 'mutex)) ,?rec)
    243                 ?body ...) )
     248  (lambda (form r c)
     249    (##sys#check-syntax 'record-synch/unlock form '(_ variable _ . _))
     250    (let ([$synch/unlock (r 'synch/unlock)])
     251      (let ([?sym (cadr form)] [?rec (caddr form)] [?body (cdddr form)])
     252        `(,$synch/unlock (,(string->symbol (conc ?sym #\- 'mutex)) ,?rec) ,@?body) ) ) ) )
    244253
    245254;;; Unprotected
     
    257266
    258267(define-syntax %synch-mutex-with*
     268
    259269        (syntax-rules ()
    260270                [(_ ?mtx ?var ?body ...) ] ) )
     
    295305
    296306(define-syntax %let/synch
     307
    297308        (syntax-rules ()
    298309                [(_ BINDINGS ?body ...) ] ) )
     
    309320
    310321(define-syntax %set!/synch
     322
    311323        (syntax-rules ()
    312324                [(_ ?binding . ?body) ] ) )
     
    320332
    321333(define-syntax %synch/lock
     334
    322335        (syntax-rules ()
    323336                [(_ ?mtx ?body ...) ] ) )
     
    333346
    334347(define-syntax %synch/unlock
     348
    335349        (syntax-rules ()
    336350                [(_ ?mtx ?body ...) ] ) )
     
    348362
    349363(define-syntax %object/synch
     364
    350365        (syntax-rules ()
    351366                [(_ ?mtx ?body ...) ] ) )
     
    374389
    375390(define-syntax %record/synch
     391  (lambda (form r c)
     392    (##sys#check-syntax 'object/synch form '(_ _ . _))
     393
    376394        (syntax-rules ()
    377395                [(_ ?sym ?rec ?body ...) ] ) )
     
    380398
    381399(define-syntax %record-synch/lock
     400  (lambda (form r c)
     401    (##sys#check-syntax 'object/synch form '(_ _ . _))
     402
    382403        (syntax-rules ()
    383404                [(_ ?sym ?rec ?body ...) ] ) )
     
    386407
    387408(define-syntax %record-synch/unlock
     409  (lambda (form r c)
     410    (##sys#check-syntax 'object/synch form '(_ _ . _))
     411
    388412        (syntax-rules ()
    389413                [(_ ?sym ?rec ?body ...)
Note: See TracChangeset for help on using the changeset viewer.