Changeset 13474 in project for release/4/synch

Timestamp:

03/03/09 21:03:41 (12 years ago)

Author:

Kon Lovett

Message:

Save

File:

• release/4/synch/trunk/synch.scm (modified) (12 diffs)

release/4/synch/trunk/synch.scm

@@ -168 +168 @@
 
 (define-syntax set!/synch
-        (syntax-rules ()
-                [(_ ?binding . ?body) ] ) )
-        (if (pair? ?binding)
-                        (let ([?var (car ?binding)]
-                                                [?mutex (cadr ?binding)])
-                                `(synch-with ,?mutex ,?var
-                                         (mutex-specific-set! ,?mutex (begin ,@?body))
-                                         (mutex-specific ,?mutex) ) )
-                        (syntax-error 'set!/synch "invalid binding form" ?binding) ) )
+  (lambda (form r c)
+    (##sys#check-syntax 'set!/synch form '(_ pair . _))
+    (let ([$synch-with (r 'synch-with)]
+          [$mutex-specific (r 'mutex-specific)]
+          [$mutex-specific-set! (r 'mutex-specific-set!)]
+          [$begin (r 'begin)])
+      (let ([?bnd (cadr form)] [?body (cddr form)])
+        (let ([?var (car ?bnd)]
+              [?mtx (cadr ?bnd)])
+          `(,$synch-with ,?mtx ,?var
+             (,$mutex-specific-set! ,?mtx (,$begin ,@?body))
+             (,$mutex-specific ,?mtx) ) ) ) ) ) )
 
 (define-syntax synch/lock
@@ -200 +203 @@
 
 (define-syntax object/synch
+  (lambda (form r c)
+    (##sys#check-syntax 'object/synch form '(_ _ . _))
+
         (syntax-rules ()
                 [(_ ?mtx ?body ...) ] ) )
@@ -226 +232 @@
 
 (define-syntax record/synch
-        (syntax-rules ()
-                [(_ ?sym ?rec ?body ...) ] ) )
-        `(synch (,(string->symbol (conc ?sym #\- 'mutex)) ,?rec)
-                ?body ...) )
+  (lambda (form r c)
+    (##sys#check-syntax 'record/synch form '(_ variable _ . _))
+    (let ([$synch (r 'synch)])
+      (let ([?sym (cadr form)] [?rec (caddr form)] [?body (cdddr form)])
+        `(,$synch (,(string->symbol (conc ?sym #\- 'mutex)) ,?rec) ,@?body) ) ) ) )
 
 (define-syntax record-synch/lock
-        (syntax-rules ()
-                [(_ ?sym ?rec ?body ...) ] ) )
-        `(synch/lock (,(string->symbol (conc ?sym #\- 'mutex)) ,?rec)
-                ?body ...) )
+  (lambda (form r c)
+    (##sys#check-syntax 'record-synch/lock form '(_ variable _ . _))
+    (let ([$synch/lock (r 'synch/lock)])
+      (let ([?sym (cadr form)] [?rec (caddr form)] [?body (cdddr form)])
+        `(,$synch/lock (,(string->symbol (conc ?sym #\- 'mutex)) ,?rec) ,@?body) ) ) ) )
 
 (define-syntax record-synch/unlock
-        (syntax-rules ()
-                [(_ ?sym ?rec ?body ...) ] ) )
-        `(synch/unlock (,(string->symbol (conc ?sym #\- 'mutex)) ,?rec)
-                ?body ...) )
+  (lambda (form r c)
+    (##sys#check-syntax 'record-synch/unlock form '(_ variable _ . _))
+    (let ([$synch/unlock (r 'synch/unlock)])
+      (let ([?sym (cadr form)] [?rec (caddr form)] [?body (cdddr form)])
+        `(,$synch/unlock (,(string->symbol (conc ?sym #\- 'mutex)) ,?rec) ,@?body) ) ) ) )
 
 ;;; Unprotected
@@ -257 +266 @@
 
 (define-syntax %synch-mutex-with*
+
         (syntax-rules ()
                 [(_ ?mtx ?var ?body ...) ] ) )
@@ -295 +305 @@
 
 (define-syntax %let/synch
+
         (syntax-rules ()
                 [(_ BINDINGS ?body ...) ] ) )
@@ -309 +320 @@
 
 (define-syntax %set!/synch
+
         (syntax-rules ()
                 [(_ ?binding . ?body) ] ) )
@@ -320 +332 @@
 
 (define-syntax %synch/lock
+
         (syntax-rules ()
                 [(_ ?mtx ?body ...) ] ) )
@@ -333 +346 @@
 
 (define-syntax %synch/unlock
+
         (syntax-rules ()
                 [(_ ?mtx ?body ...) ] ) )
@@ -348 +362 @@
 
 (define-syntax %object/synch
+
         (syntax-rules ()
                 [(_ ?mtx ?body ...) ] ) )
@@ -374 +389 @@
 
 (define-syntax %record/synch
+  (lambda (form r c)
+    (##sys#check-syntax 'object/synch form '(_ _ . _))
+
         (syntax-rules ()
                 [(_ ?sym ?rec ?body ...) ] ) )
@@ -380 +398 @@
 
 (define-syntax %record-synch/lock
+  (lambda (form r c)
+    (##sys#check-syntax 'object/synch form '(_ _ . _))
+
         (syntax-rules ()
                 [(_ ?sym ?rec ?body ...) ] ) )
@@ -386 +407 @@
 
 (define-syntax %record-synch/unlock
+  (lambda (form r c)
+    (##sys#check-syntax 'object/synch form '(_ _ . _))
+
         (syntax-rules ()
                 [(_ ?sym ?rec ?body ...)