From 3581bcf92879a3ef1b06d84d74ea57ffd8725f24 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Fri, 26 Oct 2001 22:35:43 +0000
Subject: [PATCH] .

original commit: b58dd97194b162bce69d7ae13d1b750e0e6f3615
---
 collects/mzlib/class.ss | 49 +++++++++++++++++++++++++----------------
 1 file changed, 30 insertions(+), 19 deletions(-)

diff --git a/collects/mzlib/class.ss b/collects/mzlib/class.ss
index b4c1a62..0660a61 100644
--- a/collects/mzlib/class.ss
+++ b/collects/mzlib/class.ss
@@ -1660,24 +1660,35 @@
   ;;  methods and fields
   ;;--------------------------------------------------------------------
   
-  (define-syntax send
-    (lambda (stx)
-      (syntax-case stx ()
-	[(_ obj name . args)
-	 (begin
-	   (unless (identifier? (syntax name))
-	     (raise-syntax-error
-	      #f
-	      "method name is not an identifier"
-	      stx
-	      (syntax name)))
-	   (if (stx-list? (syntax args))
-	       (syntax (let ([this obj])
-			 ((find-method this 'name) this . args)))
-	       (with-syntax ([args (flatten-args (syntax args))])
-		 (syntax (let ([this obj])
-			   (apply (find-method this 'name) this . args))))))])))
-
+  (define-syntaxes (send send/apply)
+    (let ([mk
+	   (lambda (flatten?)
+	     (lambda (stx)
+	       (syntax-case stx ()
+		 [(_ obj name . args)
+		  (begin
+		    (unless (identifier? (syntax name))
+		      (raise-syntax-error
+		       #f
+		       "method name is not an identifier"
+		       stx
+		       (syntax name)))
+		    (if flatten?
+			(if (stx-list? (syntax args))
+			    (syntax (let ([this obj])
+				      (apply (find-method this 'name) this . args)))
+			    (raise-syntax-error
+			     #f
+			     "bad syntax (illegal use of `.')"
+			     stx))
+			(if (stx-list? (syntax args))
+			    (syntax (let ([this obj])
+				      ((find-method this 'name) this . args)))
+			    (with-syntax ([args (flatten-args (syntax args))])
+			      (syntax (let ([this obj])
+					(apply (find-method this 'name) this . args)))))))])))])
+      (values (mk #f) (mk #t))))
+  
   (define-syntax send*
     (lambda (stx)
       (syntax-case stx ()
@@ -2004,7 +2015,7 @@
 	   (rename :interface interface) interface?	   
 	   object% object?
 	   make-object instantiate
-	   send send* make-class-field-accessor make-class-field-mutator with-method
+	   send send/apply send* make-class-field-accessor make-class-field-mutator with-method
 	   private* public* override*
 	   define/private define/public define/override
 	   (rename make-generic/proc make-generic) send-generic