Changeset 36967 in project


Ignore:
Timestamp:
12/05/18 20:02:20 (5 days ago)
Author:
kon
Message:

tit4tat, enforce pre-condition, reflow

Location:
release/5/synch/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/5/synch/trunk/synch.egg

    r36962 r36967  
    66 (author "[[kon lovett]]")
    77 (license "BSD")
    8  (version "3.1.1")
     8 (version "3.2.0")
    99 (dependencies
    1010  (check-errors "3.1.0")
  • release/5/synch/trunk/synch.scm

    r36962 r36967  
    11;;;; synch.scm
     2;;;; Kon Lovett, Dec '18
    23;;;; Kon Lovett, Jan '18
    34;;;; Kon Lovett, May '17
     
    910;;
    1011;; - dynamic-wind, ...
     12;;
     13;; - lock!/unlock! arguments must NOT invoke an exit continuation
    1114
    1215(module synch
     
    7275
    7376(define-syntax dynwnd-wrap
    74         (syntax-rules ()
    75           ((dynwnd-wrap ?mtx (?lock-arg0 ...) (?unlock-arg0 ...) ?body ...)
    76       (dynamic-wind
    77         (lambda () (mutex-lock! ?mtx ?lock-arg0 ...))
    78         (lambda () ?body ...)
    79         (lambda () (mutex-unlock! ?mtx ?unlock-arg0 ...)) ) ) ) )
     77  (syntax-rules ()
     78    ((dynwnd-wrap ?mtx (?lock-arg0 ...) (?unlock-arg0 ...) ?body ...)
     79      ;Do not continue when cannot get a lock
     80      #; ;just use const(s)
     81      (let (
     82        (lock-args (list ?lock-arg0 ...))
     83        (unlock-args (list ?unlock-arg0 ...)) )
     84        (when (apply mutex-lock! ?mtx lock-args)
     85          (dynamic-wind
     86            void
     87            (lambda () ?body ...)
     88            (lambda () (apply mutex-unlock! ?mtx unlock-args))) ) )
     89      (when (mutex-lock! ?mtx ?lock-arg0 ...)
     90        (dynamic-wind
     91          void
     92          (lambda () ?body ...)
     93          (lambda () (mutex-unlock! ?mtx ?unlock-arg0 ...))) ) ) ) )
    8094
    8195;;
    8296
    8397(define-syntax synch
    84         (syntax-rules ()
    85     ;
    86                 ((_ (?mtx (?lock-arg0 ...) (?unlock-arg0 ...)) ?body ...)
    87         (let ((mtx ?mtx))
     98  (syntax-rules ()
     99    ;
     100    ((synch (?mtx (?lock-arg0 ...) (?unlock-arg0 ...)) ?body ...)
     101      (let ((mtx ?mtx))
    88102        (dynwnd-wrap mtx (?lock-arg0 ...) (?unlock-arg0 ...)
    89103          ?body ...) ) )
    90104    ;
    91                 ((_ (?mtx (?lock-arg0 ...)) ?body ...)
    92         (synch (?mtx (?lock-arg0 ...) ()) ?body ...) )
    93     ;
    94                 ((_ ?mtx ?body ...)
    95         (synch (?mtx () ()) ?body ...) ) ) )
     105    ((synch (?mtx (?lock-arg0 ...)) ?body ...)
     106      (synch (?mtx (?lock-arg0 ...) ()) ?body ...) )
     107    ;
     108    ((synch ?mtx ?body ...)
     109      (synch (?mtx () ()) ?body ...) ) ) )
    96110
    97111;;
     
    105119        (_let (rnm 'let) )
    106120        (_lambda (rnm 'lambda) )
     121        (_when (rnm 'when) )
    107122        (_mutex-unlock! (rnm 'mutex-unlock!) )
    108123        (_mutex-specific (rnm 'mutex-specific) )
     
    124139            (lambda (?mtx ?lock-args ?unlock-args)
    125140              `(,_let ((,mtxvar ,?mtx))
    126                  (,_let ((,?var (,_mutex-specific ,mtxvar)))
     141                (,_when (,_mutex-lock! ,mtxvar ,@?lock-args)
     142                  (,_let ((,?var (,_mutex-specific ,mtxvar)))
    127143                   (,_dynamic-wind
    128                      (,_lambda () (,_mutex-lock! ,mtxvar ,@?lock-args))
     144                     void
    129145                     (,_lambda () ,@?body)
    130                      (,_lambda () (,_mutex-unlock! ,mtxvar ,@?unlock-args)) ) ) ) ) ) ) ) ) ) )
    131 
    132 (define-for-syntax call-synch-transformer
    133         (syntax-rules ()
    134     ;
    135                 ((_ (?mtx (?lock-arg0 ...) (?unlock-arg0 ...)) ?proc ?arg0 ...)
    136                   (let ((mtx ?mtx))
    137                           (dynwnd-wrap mtx (?lock-arg0 ...) (?unlock-arg0 ...)
    138                             (?proc ?arg0 ...)) ) )
    139     ;
    140                 ((_ (?mtx (?lock-arg0 ...)) ?proc ?arg0 ...)
    141                   (call-synch (?mtx (?lock-arg0 ...) ()) ?proc ?arg0 ...) )
    142     ;
    143                 ((_ ?mtx ?proc ?arg0 ...)
    144                   (call-synch (?mtx () ()) ?proc ?arg0 ...) ) ) )
    145 
    146 (define-syntax call-synch call-synch-transformer)
    147 
    148 (define-for-syntax call-synch-with-transformer
    149         (syntax-rules ()
    150     ;
    151                 ((_ (?mtx (?lock-arg0 ...) (?unlock-arg0 ...)) ?proc ?arg0 ...)
    152                   (let ((mtx ?mtx))
    153                           (dynwnd-wrap mtx (?lock-arg0 ...) (?unlock-arg0 ...)
    154                             (?proc (mutex-specific mtx) ?arg0 ...)) ) )
    155     ;
    156                 ((_ (?mtx (?lock-arg0 ...)) ?proc ?arg0 ...)
    157                   (call-synch-with (?mtx (?lock-arg0 ...) ()) ?proc ?arg0 ...) )
    158     ;
    159                 ((_ ?mtx ?proc ?arg0 ...)
    160                   (call-synch-with (?mtx () ()) ?proc ?arg0 ...) ) ) )
    161 
    162 (define-syntax call-synch-with call-synch-with-transformer)
    163 
    164 (define-for-syntax apply-synch-transformer
    165         (syntax-rules ()
    166           ;
    167           ((_ (?mtx (?lock-arg0 ...) (?unlock-arg0 ...)) ?proc ?arg0 ...)
    168                   (let ((mtx ?mtx))
    169                           (dynwnd-wrap mtx (?lock-arg0 ...) (?unlock-arg0 ...)
    170                             (apply ?proc ?arg0 ...)) ) )
    171                 ;
    172           ((_ (?mtx (?lock-arg0 ...)) ?proc ?arg0 ...)
    173                   (apply-synch (?mtx (?lock-arg0 ...) ()) ?proc ?arg0 ...) )
    174     ;
    175                 ((_ ?mtx ?proc ?arg0 ...)
    176                   (apply-synch (?mtx () ()) ?proc ?arg0 ...) ) ) )
    177 
    178 (define-syntax apply-synch apply-synch-transformer)
    179 
    180 (define-for-syntax apply-synch-with-transformer
    181         (syntax-rules ()
    182     ;
    183                 ((_ (?mtx (?lock-arg0 ...) (?unlock-arg0 ...)) ?proc ?arg0 ...)
    184                   (let ((mtx ?mtx))
    185                           (dynwnd-wrap mtx (?lock-arg0 ...) (?unlock-arg0 ...)
    186                             (apply ?proc (mutex-specific mtx) ?arg0 ...)) ) )
    187     ;
    188                 ((_ (?mtx (?lock-arg0 ...)) ?proc ?arg0 ...)
    189                   (apply-synch-with (?mtx (?lock-arg0 ...) ()) ?proc ?arg0 ...) )
    190     ;
    191                 ((_ ?mtx ?proc ?arg0 ...)
    192                   (apply-synch-with (?mtx () ()) ?proc ?arg0 ...) ) ) )
    193 
    194 (define-syntax apply-synch-with apply-synch-with-transformer)
    195 
    196 (define-for-syntax let-synch-with-transformer
     146                     (,_lambda () (,_mutex-unlock! ,mtxvar ,@?unlock-args))) ) ) ) ) ) ) ) ) ) )
     147
     148(define-syntax call-synch
     149  (syntax-rules ()
     150    ;
     151    ((call-synch (?mtx (?lock-arg0 ...) (?unlock-arg0 ...)) ?proc ?arg0 ...)
     152      (let ((mtx ?mtx))
     153        (dynwnd-wrap mtx (?lock-arg0 ...) (?unlock-arg0 ...)
     154          (?proc ?arg0 ...)) ) )
     155    ;
     156    ((call-synch (?mtx (?lock-arg0 ...)) ?proc ?arg0 ...)
     157      (call-synch (?mtx (?lock-arg0 ...) ()) ?proc ?arg0 ...) )
     158    ;
     159    ((call-synch ?mtx ?proc ?arg0 ...)
     160      (call-synch (?mtx () ()) ?proc ?arg0 ...) ) ) )
     161
     162(define-syntax call-synch-with
     163  (syntax-rules ()
     164    ;
     165    ((call-synch-with (?mtx (?lock-arg0 ...) (?unlock-arg0 ...)) ?proc ?arg0 ...)
     166      (let ((mtx ?mtx))
     167        (dynwnd-wrap mtx (?lock-arg0 ...) (?unlock-arg0 ...)
     168          (?proc (mutex-specific mtx) ?arg0 ...)) ) )
     169    ;
     170    ((call-synch-with (?mtx (?lock-arg0 ...)) ?proc ?arg0 ...)
     171      (call-synch-with (?mtx (?lock-arg0 ...) ()) ?proc ?arg0 ...) )
     172    ;
     173    ((call-synch-with ?mtx ?proc ?arg0 ...)
     174      (call-synch-with (?mtx () ()) ?proc ?arg0 ...) ) ) )
     175
     176(define-syntax apply-synch
     177  (syntax-rules ()
     178    ;
     179    ((apply-synch (?mtx (?lock-arg0 ...) (?unlock-arg0 ...)) ?proc ?arg0 ...)
     180      (let ((mtx ?mtx))
     181        (dynwnd-wrap mtx (?lock-arg0 ...) (?unlock-arg0 ...)
     182          (apply ?proc ?arg0 ...)) ) )
     183    ;
     184    ((apply-synch (?mtx (?lock-arg0 ...)) ?proc ?arg0 ...)
     185      (apply-synch (?mtx (?lock-arg0 ...) ()) ?proc ?arg0 ...) )
     186    ;
     187    ((apply-synch ?mtx ?proc ?arg0 ...)
     188      (apply-synch (?mtx () ()) ?proc ?arg0 ...) ) ) )
     189
     190(define-syntax apply-synch-with
     191  (syntax-rules ()
     192    ;
     193    ((apply-synch-with (?mtx (?lock-arg0 ...) (?unlock-arg0 ...)) ?proc ?arg0 ...)
     194      (let ((mtx ?mtx))
     195        (dynwnd-wrap mtx (?lock-arg0 ...) (?unlock-arg0 ...)
     196          (apply ?proc (mutex-specific mtx) ?arg0 ...)) ) )
     197    ;
     198    ((apply-synch-with (?mtx (?lock-arg0 ...)) ?proc ?arg0 ...)
     199      (apply-synch-with (?mtx (?lock-arg0 ...) ()) ?proc ?arg0 ...) )
     200    ;
     201    ((apply-synch-with ?mtx ?proc ?arg0 ...)
     202      (apply-synch-with (?mtx () ()) ?proc ?arg0 ...) ) ) )
     203
     204(define-syntax let-synch-with
    197205  (er-macro-transformer
    198206    (lambda (frm rnm cmp)
     
    211219          (car res) ) ) ) ) )
    212220
    213 (define-syntax let-synch-with let-synch-with-transformer)
    214 
    215221(define-syntax set!-synch-with
    216222  (er-macro-transformer
     
    232238;;
    233239
    234 (define-for-syntax synch-lock-transformer
    235         (syntax-rules ()
    236     ;
    237                 ((_ (?mtx (?lock-arg0 ...)) ?body ...)
    238                   (let ((mtx ?mtx) (ok? #f))
    239                                 (mutex-lock! mtx)
    240                                 (dynamic-wind
    241                                   (lambda () (mutex-lock! mtx ?lock-arg0 ...))
    242                                         (lambda () (let ((res (begin ?body ...))) (set! ok? #t) res))
    243                                         (lambda () (unless ok? (mutex-unlock! mtx)))) ) )
    244     ;
    245                 ((_ ?mtx ?body ...)
    246                   (synch-lock (?mtx ()) ?body ...) ) ) )
    247 
    248 (define-syntax synch-lock synch-lock-transformer)
    249 
    250 (define-for-syntax synch-unlock-transformer
    251         (syntax-rules ()
    252     ;
    253                 ((_ (?mtx (?unlock-arg0 ...)) ?body ...)
    254                   (let ((mtx ?mtx))
    255                           (dynamic-wind
    256                                   (lambda ()
    257                                           (unless (thread? (mutex-state mtx))
    258                                                   (warning 'synch-unlock "mutex is not locked - locking")
    259                                                   (mutex-lock! mtx)))
    260                                   (lambda () ?body ...)
    261                                   (lambda () (mutex-unlock! mtx ?unlock-arg0 ...)) ) ) )
    262     ;
    263                 ((_ ?mtx ?body ...)
    264                   (synch-unlock (?mtx ()) ?body ...) ) ) )
    265 
    266 (define-syntax synch-unlock synch-unlock-transformer)
    267 
    268 ;;
    269 
    270 (define-for-syntax object-synch-cut-with-transformer
     240(define-syntax synch-lock
     241  (syntax-rules ()
     242    ;
     243    ((synch-lock (?mtx (?lock-arg0 ...)) ?body ...)
     244      (let ((mtx ?mtx))
     245        (let ((ok? #f))
     246          (when (mutex-lock! mtx ?lock-arg0 ...)
     247            (dynamic-wind
     248              void
     249              (lambda ()
     250                (let ((res (begin ?body ...)))
     251                  (set! ok? #t)
     252                  res))
     253              (lambda ()
     254                (unless ok?
     255                  (mutex-unlock! mtx)))) ) ) ) )
     256    ;
     257    ((synch-lock ?mtx ?body ...)
     258      (synch-lock (?mtx ()) ?body ...) ) ) )
     259
     260(define-syntax synch-unlock
     261  (syntax-rules ()
     262    ;
     263    ((synch-unlock (?mtx (?unlock-arg0 ...)) ?body ...)
     264      (let ((mtx ?mtx))
     265        (let ((st (mutex-state mtx)))
     266          (if (or (eq 'abandoned st) (eq 'not-abandoned st))
     267            (error 'synch-unlock "mutex unlocked" mtx)
     268            (dynamic-wind
     269              void
     270              (lambda () ?body ...)
     271              (lambda () (mutex-unlock! mtx ?unlock-arg0 ...)) ) ) ) ) )
     272    ;
     273    ((synch-unlock ?mtx ?body ...)
     274      (synch-unlock (?mtx ()) ?body ...) ) ) )
     275
     276;;
     277
     278(define-syntax object-synch-cut-with
    271279  (er-macro-transformer
    272280    (lambda (frm rnm cmp)
     
    301309                    (body-loop next (cons rest parsed))) ) ) ) ) ) ) ) ) )
    302310
    303 (define-syntax object-synch-cut-with object-synch-cut-with-transformer)
    304 
    305311;;
    306312
     
    356362;;; Unprotected
    357363
    358 (define-syntax %*synch
    359         (syntax-rules ()
    360     ;
    361                 ((_ (?mtx (?lock-arg0 ...) (?unlock-arg0 ...)) ?body ...)
    362                   (let ((mtx ?mtx))
    363         (mutex-lock! mtx ?lock-arg0 ...)
    364                                 (call-with-values
    365                                         (lambda () ?body ...)
    366                                         (lambda ret
    367                                                 (mutex-unlock! mtx ?unlock-arg0 ...)
    368                                                 (apply values ret))) ) )
    369     ;
    370                 ((_ ?mtx ?body ...)
    371                   (%*synch (?mtx () ()) ?body ...) ) ) )
    372 
    373 ;;
    374 
    375 (define-syntax %*synch-with
    376   (er-macro-transformer
    377     (lambda (frm rnm cmp)
    378       (##sys#check-syntax '%*synch-with frm '(_ _ variable . _))
     364(define-syntax %synch
     365  (syntax-rules ()
     366    ;
     367    ((%synch (?mtx (?lock-arg0 ...) (?unlock-arg0 ...)) ?body ...)
     368      (let ((mtx ?mtx))
     369        (when (mutex-lock! mtx ?lock-arg0 ...)
     370          (call-with-values
     371            (lambda ()
     372              ?body ...)
     373            (lambda ret
     374              (mutex-unlock! mtx ?unlock-arg0 ...)
     375              (apply values ret))) ) ) )
     376    ;
     377    ((%synch ?mtx ?body ...)
     378      (%synch (?mtx () ()) ?body ...) ) ) )
     379
     380;;
     381
     382(define-syntax %synch-with
     383  (er-macro-transformer
     384    (lambda (frm rnm cmp)
     385      (##sys#check-syntax '%synch-with frm '(_ _ variable . _))
    379386      (let (
    380387        (_call-with-values (rnm 'call-with-values))
     
    386393        (_values (rnm 'values))
    387394        (_lambda (rnm 'lambda))
     395        (_when (rnm 'when))
    388396        (_ret (rnm 'ret))
    389397        (mtxvar (rnm (gensym))))
     
    403411            (lambda (?mtx ?lock-args ?unlock-args)
    404412              `(,_let ((,mtxvar ,?mtx))
    405                  (,_let ((,?var (,_mutex-specific ,mtxvar)))
    406                    (,_mutex-lock! ,mtxvar ,@?lock-args)
    407                    (,_call-with-values
    408                      (,_lambda () ,@?body)
    409                      (,_lambda ,_ret
    410                        (,_mutex-unlock! ,mtxvar ,@?unlock-args)
    411                        (,_apply ,_values ,_ret)) ) ) ) ) ) ) ) ) ) )
    412 
    413 ;;
    414 
    415 (define-syntax %synch
    416         (syntax-rules ()
    417                 ((_ ?mtx ?body ...) (%*synch ?mtx ?body ...) ) ) )
    418 
    419 ;;
    420 
    421 (define-syntax %synch-with
    422         (syntax-rules ()
    423                 ((_ ?mtx ?var ?body ...)
    424                   (%*synch-with ?mtx ?var ?body ...) ) ) )
    425 
    426 (define-for-syntax %call-synch-transformer
    427         (syntax-rules ()
    428                 ((_ ?mtx ?proc ?arg0 ...)
    429                   (%*synch ?mtx (?proc ?arg0 ...)) ) ) )
    430 
    431 (define-syntax %call-synch %call-synch-transformer)
    432 
    433 (define-for-syntax %call-synch-with-transformer
    434         (syntax-rules ()
    435                 ((_ ?mtx ?proc ?arg0 ...)
    436                   (%*synch-with ?mtx var (?proc var ?arg0 ...)) ) ) )
    437 
    438 (define-syntax %call-synch-with %call-synch-with-transformer)
    439 
    440 (define-for-syntax %apply-synch-transformer
    441         (syntax-rules ()
    442                 ((_ ?mtx ?proc ?arg0 ...)
    443                   (%*synch ?mtx (apply ?proc ?arg0 ...)) ) ) )
    444 
    445 (define-syntax %apply-synch %apply-synch-transformer)
    446 
    447 (define-for-syntax %apply-synch-with-transformer
    448         (syntax-rules ()
    449                 ((_ ?mtx ?proc ?arg0 ...)
    450                   (%*synch-with ?mtx var (apply ?proc var ?arg0 ...)) ) ) )
    451 
    452 (define-syntax %apply-synch-with %apply-synch-with-transformer)
    453 
    454 (define-for-syntax %let-synch-with-transformer
     413                (,_let ((,?var (,_mutex-specific ,mtxvar)))
     414                  (,_when (,_mutex-lock! ,mtxvar ,@?lock-args)
     415                    (,_call-with-values
     416                      (,_lambda ()
     417                        ,@?body)
     418                      (,_lambda ,_ret
     419                        (,_mutex-unlock! ,mtxvar ,@?unlock-args)
     420                        (,_apply ,_values ,_ret))) ) ) ) ) ) ) ) ) ) )
     421
     422;;
     423
     424(define-syntax %call-synch
     425  (syntax-rules ()
     426    ((%call-synch ?mtx ?proc ?arg0 ...)
     427      (%synch ?mtx (?proc ?arg0 ...)) ) ) )
     428
     429(define-syntax %call-synch-with
     430  (syntax-rules ()
     431    ((%call-synch-with ?mtx ?proc ?arg0 ...)
     432      (%synch-with ?mtx var (?proc var ?arg0 ...)) ) ) )
     433
     434(define-syntax %apply-synch
     435  (syntax-rules ()
     436    ((%apply-synch ?mtx ?proc ?arg0 ...)
     437      (%synch ?mtx (apply ?proc ?arg0 ...)) ) ) )
     438
     439(define-syntax %apply-synch-with
     440  (syntax-rules ()
     441    ((%apply-synch-with ?mtx ?proc ?arg0 ...)
     442      (%synch-with ?mtx var (apply ?proc var ?arg0 ...)) ) ) )
     443
     444(define-syntax %let-synch-with
    455445  (er-macro-transformer
    456446    (lambda (frm rnm cmp)
     
    466456                  `((,_%synch-with ,(cadr bnd) ,(car bnd) ,@(loop (cdr ?bnds)))) ) ) ) ) ) ) ) ) )
    467457
    468 (define-syntax %let-synch-with %let-synch-with-transformer)
    469 
    470458(define-syntax %set!-synch-with
    471459  (er-macro-transformer
     
    490478;;
    491479
    492 (define-for-syntax %synch-lock-transformer
    493         (syntax-rules ()
    494     ;
    495                 ((_ (?mtx (?lock-arg0 ...)) ?body ...)
    496                   (let ((mtx ?mtx) (ok? #f))
    497                                 (mutex-lock! mtx ?lock-arg0 ...)
    498                                 (call-with-values
    499                                         (lambda () (let ((res (begin ?body ...))) (set! ok? #t) res))
    500                                         (lambda ret
    501                                                 (unless ok? (mutex-unlock! mtx))
    502                                                 (apply values ret))) ) )
    503     ;
    504                 ((_ ?mtx ?body ...)
    505                   (%synch-lock (?mtx ()) ?body ...) ) ) )
    506 
    507 (define-syntax %synch-lock %synch-lock-transformer)
    508 
    509 (define-for-syntax %synch-unlock-transformer
    510         (syntax-rules ()
    511     ;
    512                 ((_ (?mtx (?unlock-arg0 ...)) ?body ...)
    513       (let ((mtx ?mtx))
    514         (unless (thread? (mutex-state mtx))
    515           (warning '%synch-unlock "mutex is not locked - locking")
    516           (mutex-lock! mtx))
    517         (call-with-values
    518           (lambda () ?body ...)
    519           (lambda ret
    520             (mutex-unlock! mtx ?unlock-arg0 ...)
    521             (apply values ret)) ) ) )
    522     ;
    523                 ((_ ?mtx ?body ...)
     480(define-syntax %synch-lock
     481  (syntax-rules ()
     482    ;
     483    ((%synch-lock (?mtx (?lock-arg0 ...)) ?body ...)
     484      (let ((mtx ?mtx) (ok? #f))
     485        (when (mutex-lock! mtx ?lock-arg0 ...)
     486          (call-with-values
     487            (lambda ()
     488              (let ((res (begin ?body ...)))
     489                (set! ok? #t)
     490                res))
     491            (lambda ret
     492              (unless ok? (mutex-unlock! mtx))
     493              (apply values ret))) ) ) )
     494    ;
     495    ((%synch-lock ?mtx ?body ...)
     496      (%synch-lock (?mtx ()) ?body ...) ) ) )
     497
     498(define-syntax %synch-unlock
     499  (syntax-rules ()
     500    ;
     501    ((%synch-unlock (?mtx (?unlock-arg0 ...)) ?body ...)
     502      (let ((mtx ?mtx))
     503        (let ((st (mutex-state mtx)))
     504          (if (or (eq 'abandoned st) (eq 'not-abandoned st))
     505            (error '%synch-unlock "mutex unlocked" mtx)
     506            (call-with-values
     507              (lambda ()
     508                ?body ...)
     509              (lambda ret
     510                (mutex-unlock! mtx ?unlock-arg0 ...)
     511                (apply values ret)) ) ) ) ) )
     512    ;
     513    ((%synch-unlock ?mtx ?body ...)
    524514      (%synch-unlock (?mtx ()) ?body ...) ) ) )
    525515
    526 (define-syntax %synch-unlock %synch-unlock-transformer)
    527 
    528 ;;
    529 
    530 (define-for-syntax %object-synch-cut-with-transformer
     516;;
     517
     518(define-syntax %object-synch-cut-with
    531519  (er-macro-transformer
    532520    (lambda (frm rnm cmp)
     
    561549                    (body-loop next (cons rest parsed))) ) ) ) ) ) ) ) ) )
    562550
    563 (define-syntax %object-synch-cut-with %object-synch-cut-with-transformer)
    564 
    565551;;
    566552
     
    615601
    616602(define (datum-unbound-value? datum)
    617         (or (eq? (void) datum) (not datum)) )
     603  (or (eq? (void) datum) (not datum)) )
    618604
    619605(define (mutex-with-object? obj)
    620         (and
    621           (mutex? obj)
     606  (and
     607    (mutex? obj)
    622608    (not (datum-unbound-value? (mutex-specific obj))) ) )
    623609
     
    706692        (let* (
    707693          (prcnam  (cadr frm))
    708            (newnam (synch-wrapper-name prcnam)) )
     694          (newnam (synch-wrapper-name prcnam)) )
    709695          `(,_define (,newnam ,_mtx+obj . ,_args)
    710696             (,_let ((,_mtx (,_if (,_pair? ,_mtx+obj) (,_car ,_mtx+obj) ,_mtx+obj)))
     
    739725             (,_let ((,_mtx (,_if (,_pair? ,_mtx+obj) (,_car ,_mtx+obj) ,_mtx+obj)))
    740726               (,_check-synch-with-object ',newnam ,_mtx 'object-synch)
    741                                                         (,_%synch-with ,_mtx+obj ,_obj (,_apply ,prcnam ,_obj ,_args)) ) ) ) ) ) ) )
     727              (,_%synch-with ,_mtx+obj ,_obj (,_apply ,prcnam ,_obj ,_args)) ) ) ) ) ) ) )
    742728
    743729) ;module synch
Note: See TracChangeset for help on using the changeset viewer.