Index: tinyclos.scm
===================================================================
--- tinyclos.scm	(revision 14791)
+++ tinyclos.scm	(working copy)
@@ -137,63 +137,68 @@
     [(_ n class) (define n (make class 'name 'n))]
     [(_ n) (define n (make-generic 'n))] ) )
 
-(define-syntax (define-method x r c)
-  (let ((head (cadr x))
-	(body (cddr x))
-	(%add-global-method (r 'add-global-method))
-	(%make-method (r 'make-method))
-	(%lambda (r 'lambda))
-	(%list (r 'list))
-	(%<top> (r '<top>)))
-    (##sys#check-syntax 'define-method head '(symbol . _))
-    (##sys#check-syntax 'define-method body '#(_ 1))
-    (let gather ([args (##sys#slot head 1)]
-		 [specs '()]
-		 [vars '()] )
-      (if (or (not (pair? args))
-	      (memq (car args) '(#!optional #!key #!rest)) )
-	  (let ([name (##sys#slot head 0)])
-	    `(set! ,name
-	       (,%add-global-method
-		(##core#global-ref ,name)
-		',name
-		(,%list ,@(reverse specs))
-		;; `call-next-method' not renamed:
-		(,%lambda (call-next-method ,@(reverse vars) ,@args) ,@body) ) ) )
-	  (let ([arg (##sys#slot args 0)])
-	    (gather (##sys#slot args 1)
-		    (cons (if (pair? arg) (cadr arg) %<top>) specs)
-		    (cons (if (pair? arg) (car arg) arg) vars) ) ) ) ) ) )
+(define-syntax define-method
+  (lambda (x r c)
+    (let ((head (cadr x))
+          (body (cddr x))
+          (%add-global-method (r 'add-global-method))
+          (%make-method (r 'make-method))
+          (%lambda (r 'lambda))
+          (%list (r 'list))
+          (%<top> (r '<top>)))
+      (##sys#check-syntax 'define-method head '(symbol . _))
+      (##sys#check-syntax 'define-method body '#(_ 1))
+      (let gather ([args (##sys#slot head 1)]
+                   [specs '()]
+                   [vars '()] )
+        (if (or (not (pair? args))
+                (memq (car args) '(#!optional #!key #!rest)) )
+            (let ([name (##sys#slot head 0)])
+              `(set! ,name
+                     (,%add-global-method
+                      (##core#global-ref ,name)
+                      ',name
+                      (,%list ,@(reverse specs))
+                      ;; `call-next-method' not renamed:
+                      (,%lambda (call-next-method ,@(reverse vars) ,@args) ,@body) ) ) )
+            (let ([arg (##sys#slot args 0)])
+              (gather (##sys#slot args 1)
+                      (cons (if (pair? arg) (cadr arg) %<top>) specs)
+                      (cons (if (pair? arg) (car arg) arg) vars) ) ) ) ) )) )
 
 ;; For system use in extending the set of "builtin" classes.
 
 (define-for-syntax (##tinyclos#make-classname-symbol str)
   (string->symbol (string-append "<" (##sys#strip-syntax str) ">")) )
 
-(define-syntax (define-primitive-class x r c)
-  (let ((name (cadr x))
-	(pred (caddr x))
-	(sclasses (cdddr x)))
-    `(,(r 'define) ,(##tinyclos#make-classname-symbol name)
-      (,(r 'new-primitive-class) ,name ,pred ,@sclasses)) ))
+(define-syntax define-primitive-class
+  (lambda (x r c)
+    (let ((name (cadr x))
+          (pred (caddr x))
+          (sclasses (cdddr x)))
+      `(,(r 'define) ,(##tinyclos#make-classname-symbol name)
+        (,(r 'new-primitive-class) ,name ,pred ,@sclasses)) )))
 
-(define-syntax (define-structure-class x r c)
-  (let ((name (cadr x))
-	(tag (caddr x)))
-    `(,(r 'define) ,(##tinyclos#make-classname-symbol name)
-      (,(r 'new-structure-class) name (,(r 'quote) ,tag)) )))
+(define-syntax define-structure-class
+  (lambda (x r c)
+    (let ((name (cadr x))
+          (tag (caddr x)))
+      `(,(r 'define) ,(##tinyclos#make-classname-symbol name)
+        (,(r 'new-structure-class) name (,(r 'quote) ,tag)) ))))
 
-(define-syntax (define-tagged-pointer-class x r c)
-  (let ((name (cadr x))
-	(pred (caddr x)))
-    `(,(r 'define) ,(##tinyclos#make-classname-symbol name)
-      (,(r 'new-tagged-pointer-class) name (,(r 'quote) ,pred)) )))
+(define-syntax define-tagged-pointer-class
+  (lambda (x r c)
+   (let ((name (cadr x))
+         (pred (caddr x)))
+     `(,(r 'define) ,(##tinyclos#make-classname-symbol name)
+       (,(r 'new-tagged-pointer-class) name (,(r 'quote) ,pred)) ))))
 
-(define-syntax (define-extended-procedure-class x r c)
-  (let ((name (cadr x))
-	(pred (caddr x)))
-    `(,(r 'define) ,(##tinyclos#make-classname-symbol name)
-      (,(r 'new-extended-procedure-class) name (,(r 'quote) ,pred)) )))
+(define-syntax define-extended-procedure-class
+  (lambda (x r c)
+    (let ((name (cadr x))
+          (pred (caddr x)))
+      `(,(r 'define) ,(##tinyclos#make-classname-symbol name)
+        (,(r 'new-extended-procedure-class) name (,(r 'quote) ,pred)) ))))
 
 ;
 ; A very simple CLOS-like language, embedded in Scheme, with a simple
@@ -300,12 +305,13 @@
 (define-inline (%vector-set! v i x) (##sys#setslot v i x))
 (define-inline (%vector-length v) (##sys#size v))
 
-(define-syntax (%structure? x r c)
-  (let ((?x (cadr x))
-	(?t (cddr x)))
-    (if (null? ?t)
-	`(##sys#generic-structure? ,?x)
-	`(##sys#structure? ,?x ,(car ?t)))))
+(define-syntax %structure?
+  (lambda (x r c)
+   (let ((?x (cadr x))
+         (?t (cddr x)))
+     (if (null? ?t)
+         `(##sys#generic-structure? ,?x)
+         `(##sys#structure? ,?x ,(car ?t))))))
 
 (define-inline (%structure-ref r i) (##sys#slot r i))
 (define-inline (%structure-set! r i x) (##sys#setslot r i x))
@@ -339,8 +345,9 @@
 
 ;;; Support code
 
-(define-syntax (define-unique-object x r c)
-  `(,(r 'define) ,(cadr x) (,(r 'gensym)) ))
+(define-syntax define-unique-object
+  (lambda (x r c)
+   `(,(r 'define) ,(cadr x) (,(r 'gensym)) )))
 
 (define (filter-in f l)
   (let loop ([l l])