Changeset 37032 in project


Ignore:
Timestamp:
12/26/18 00:02:30 (3 months ago)
Author:
kon
Message:

fix lock result condition, fix syntax var refs, bump point

Location:
release/4/synch/trunk
Files:
1 deleted
3 edited

Legend:

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

    r35162 r37032  
    1313(files
    1414  "synch.meta" "synch.setup"
    15   "synch.scm" "critical-region.scm"
     15  "synch.scm"
    1616  "tests/synch-test.scm" "tests/run.scm") )
  • release/4/synch/trunk/synch.scm

    r37027 r37032  
    11;;;; synch.scm
     2;;;; Kon Lovett, Dec '18
    23;;;; Kon Lovett, Jan '18
    34;;;; Kon Lovett, May '17
     
    5051  ;
    5152  synchronized-procedure
    52 #|
    5353  ;;
    5454  ;DEPRECATED
     
    8282  define-predicate/synch
    8383  (define-operation/synch check-synch-with-object)
    84   define-operation/%synch
    85 |#
    86   )
     84  define-operation/%synch)
    8785
    8886(import
     
    171169                  (,_synch (,_mtx ,?lock-args ,?unlock-args) ,@?body) ) ) ) ) ) ) ) ) )
    172170
    173 (define-syntax call-synch
     171(define-for-syntax call-synch-transformer
    174172  (syntax-rules ()
    175173    ;
    176174    ((call-synch (?mtx (?lock-arg0 ...) (?unlock-arg0 ...)) ?proc ?arg0 ...)
    177       (synch (mtx (?lock-arg0 ...) (?unlock-arg0 ...)) (?proc ?arg0 ...)) )
     175      (synch (?mtx (?lock-arg0 ...) (?unlock-arg0 ...)) (?proc ?arg0 ...)) )
    178176    ;
    179177    ((call-synch (?mtx (?lock-arg0 ...)) ?proc ?arg0 ...)
     
    183181      (call-synch (?mtx () ()) ?proc ?arg0 ...) ) ) )
    184182
    185 (define-syntax call-synch-with
     183(define-syntax call-synch call-synch-transformer)
     184
     185(define-for-syntax call-synch-with-transformer
    186186  (syntax-rules ()
    187187    ;
    188188    ((call-synch-with (?mtx (?lock-arg0 ...) (?unlock-arg0 ...)) ?proc ?arg0 ...)
    189       (synch (mtx (?lock-arg0 ...) (?unlock-arg0 ...)) (?proc (mutex-specific mtx) ?arg0 ...)) )
     189      (synch (?mtx (?lock-arg0 ...) (?unlock-arg0 ...)) (?proc (mutex-specific ?mtx) ?arg0 ...)) )
    190190    ;
    191191    ((call-synch-with (?mtx (?lock-arg0 ...)) ?proc ?arg0 ...)
     
    195195      (call-synch-with (?mtx () ()) ?proc ?arg0 ...) ) ) )
    196196
    197 (define-syntax apply-synch
     197(define-syntax call-synch-with call-synch-with-transformer)
     198
     199(define-for-syntax apply-synch-transformer
    198200  (syntax-rules ()
    199201    ;
    200202    ((apply-synch (?mtx (?lock-arg0 ...) (?unlock-arg0 ...)) ?proc ?arg0 ...)
    201       (synch (mtx (?lock-arg0 ...) (?unlock-arg0 ...)) (apply ?proc ?arg0 ...)) )
     203      (synch (?mtx (?lock-arg0 ...) (?unlock-arg0 ...)) (apply ?proc ?arg0 ...)) )
    202204    ;
    203205    ((apply-synch (?mtx (?lock-arg0 ...)) ?proc ?arg0 ...)
     
    207209      (apply-synch (?mtx () ()) ?proc ?arg0 ...) ) ) )
    208210
    209 (define-syntax apply-synch-with
     211(define-syntax apply-synch apply-synch-transformer)
     212
     213(define-for-syntax apply-synch-with-transformer
    210214  (syntax-rules ()
    211215    ;
    212216    ((apply-synch-with (?mtx (?lock-arg0 ...) (?unlock-arg0 ...)) ?proc ?arg0 ...)
    213       (synch (mtx (?lock-arg0 ...) (?unlock-arg0 ...)) (apply ?proc (mutex-specific mtx) ?arg0 ...)) )
     217      (synch (?mtx (?lock-arg0 ...) (?unlock-arg0 ...)) (apply ?proc (mutex-specific ?mtx) ?arg0 ...)) )
    214218    ;
    215219    ((apply-synch-with (?mtx (?lock-arg0 ...)) ?proc ?arg0 ...)
     
    219223      (apply-synch-with (?mtx () ()) ?proc ?arg0 ...) ) ) )
    220224
    221 (define-syntax let-synch-with
     225(define-syntax apply-synch-with apply-synch-with-transformer)
     226
     227(define-for-syntax let-synch-with-transformer
    222228  (er-macro-transformer
    223229    (lambda (frm rnm cmp)
     
    237243          (car res) ) ) ) ) )
    238244
     245(define-syntax let-synch-with let-synch-with-transformer)
     246
    239247(define-syntax set!-synch-with
    240248  (er-macro-transformer
     
    256264;;
    257265
    258 (define-syntax synch-lock
     266(define-for-syntax synch-lock-transformer
    259267  (syntax-rules ()
    260268    ;
     
    276284      (synch-lock (?mtx ()) ?body ...) ) ) )
    277285
    278 (define-syntax synch-unlock
     286(define-syntax synch-lock synch-lock-transformer)
     287
     288(define-for-syntax synch-unlock-transformer
    279289  (syntax-rules ()
    280290    ;
     
    292302      (synch-unlock (?mtx ()) ?body ...) ) ) )
    293303
    294 ;;
    295 
    296 (define-syntax object-synch-cut-with
     304(define-syntax synch-unlock synch-unlock-transformer)
     305
     306;;
     307
     308(define-for-syntax object-synch-cut-with-transformer
    297309  (er-macro-transformer
    298310    (lambda (frm rnm cmp)
     
    327339                    (body-loop next (cons rest parsed))) ) ) ) ) ) ) ) ) )
    328340
     341(define-syntax object-synch-cut-with object-synch-cut-with-transformer)
     342
    329343;;
    330344
     
    440454;;
    441455
    442 (define-syntax %call-synch
     456(define-for-syntax %call-synch-transformer
    443457  (syntax-rules ()
    444458    ((%call-synch ?mtx ?proc ?arg0 ...)
    445459      (%synch ?mtx (?proc ?arg0 ...)) ) ) )
    446460
    447 (define-syntax %call-synch-with
     461(define-syntax %call-synch %call-synch-transformer)
     462
     463(define-for-syntax %call-synch-with-transformer
    448464  (syntax-rules ()
    449465    ((%call-synch-with ?mtx ?proc ?arg0 ...)
    450466      (%synch-with ?mtx var (?proc var ?arg0 ...)) ) ) )
    451467
    452 (define-syntax %apply-synch
     468(define-syntax %call-synch-with %call-synch-with-transformer)
     469
     470(define-for-syntax %apply-synch-transformer
    453471  (syntax-rules ()
    454472    ((%apply-synch ?mtx ?proc ?arg0 ...)
    455473      (%synch ?mtx (apply ?proc ?arg0 ...)) ) ) )
    456474
    457 (define-syntax %apply-synch-with
     475(define-syntax %apply-synch %apply-synch-transformer)
     476
     477(define-for-syntax %apply-synch-with-transformer
    458478  (syntax-rules ()
    459479    ((%apply-synch-with ?mtx ?proc ?arg0 ...)
    460480      (%synch-with ?mtx var (apply ?proc var ?arg0 ...)) ) ) )
    461481
    462 (define-syntax %let-synch-with
     482(define-syntax %apply-synch-with %apply-synch-with-transformer)
     483
     484(define-for-syntax %let-synch-with-transformer
    463485  (er-macro-transformer
    464486    (lambda (frm rnm cmp)
     
    474496                  `((,_%synch-with ,(cadr bnd) ,(car bnd) ,@(loop (cdr ?bnds)))) ) ) ) ) ) ) ) ) )
    475497
     498(define-syntax %let-synch-with %let-synch-with-transformer)
     499
    476500(define-syntax %set!-synch-with
    477501  (er-macro-transformer
     
    496520;;
    497521
    498 (define-syntax %synch-lock
     522(define-for-syntax %synch-lock-transformer
    499523  (syntax-rules ()
    500524    ;
     
    514538      (%synch-lock (?mtx ()) ?body ...) ) ) )
    515539
    516 (define-syntax %synch-unlock
     540(define-syntax %synch-lock %synch-lock-transformer)
     541
     542(define-for-syntax %synch-unlock-transformer
    517543  (syntax-rules ()
    518544    ;
     
    532558      (%synch-unlock (?mtx ()) ?body ...) ) ) )
    533559
    534 ;;
    535 
    536 (define-syntax %object-synch-cut-with
     560(define-syntax %synch-unlock %synch-unlock-transformer)
     561
     562;;
     563
     564(define-for-syntax %object-synch-cut-with-transformer
    537565  (er-macro-transformer
    538566    (lambda (frm rnm cmp)
     
    567595                    (body-loop next (cons rest parsed))) ) ) ) ) ) ) ) ) )
    568596
     597(define-syntax %object-synch-cut-with %object-synch-cut-with-transformer)
     598
    569599;;
    570600
     
    741771            (,_%synch-with ,_mtx-w-obj ,_obj (,_apply ,prcnam ,_obj ,_args)) ) ) ) ) ) )
    742772
    743 #|
    744773;; ;DEPRECATED
    745774
     
    9791008               (,_check-synch-with-object ',newnam ,_mtx 'object/synch)
    9801009                                                         (,_%synch-with ,_mtx+obj ,_obj (,_apply ,prcnam ,_obj ,_args)) ) ) ) ) ) ) )
    981 |#
    9821010
    9831011) ;module synch
  • release/4/synch/trunk/synch.setup

    r37027 r37032  
    88  #:inline? #t
    99  #:types? #t
    10   #:compile-options '(-optimize-level 3 -debug-level 2))
    11 
    12 #;
    13 (setup-shared-extension-module 'critical-region (extension-version "2.4.1")
    14   #:inline? #t
    15   #:types? #t
    16   #:compile-options '(-optimize-level 3 -debug-level 2))
     10  #:compile-options '(-optimize-level 3 -debug-level 2 -no-procedure-checks-for-toplevel-bindings))
Note: See TracChangeset for help on using the changeset viewer.