From ec02c2f83af9ec3bc9b467d2f93b325c7439a1e1 Mon Sep 17 00:00:00 2001
From: Jon Rafkind <rafkind@racket-lang.org>
Date: Fri, 9 Dec 2011 16:03:45 -0700
Subject: [PATCH] [honu] refactor dot into syntax classes

---
 collects/honu/core/private/honu2.rkt | 54 ++++++++++++++++------------
 1 file changed, 32 insertions(+), 22 deletions(-)

diff --git a/collects/honu/core/private/honu2.rkt b/collects/honu/core/private/honu2.rkt
index a8ff36fd38..7103a032ba 100644
--- a/collects/honu/core/private/honu2.rkt
+++ b/collects/honu/core/private/honu2.rkt
@@ -181,28 +181,38 @@
 (provide honu-dot)
 (define-honu-fixture honu-dot
   (lambda (left rest)
-    (syntax-parse rest #:literal-sets (cruft)
-                       #:literals (honu-assignment)
-      [(_ name:identifier honu-assignment argument:honu-expression . more)
-       (with-syntax ([left left])
-         (values #'(%racket
-                     (let ([left* left])
-                       (cond
-                         [(honu-struct? left*)
-                          (honu-struct-set! left* 'name argument.result)]
-                         [(object? left*) (error 'set "implement set for objects")])))
-                 #'more))]
-      [(_ name:identifier . more)
-       (with-syntax ([left left])
-         (values #'(%racket
-                     (let ([left* left])
-                       (cond
-                         [(honu-struct? left*) (let ([use (honu-struct-get left*)])
-                                                 (use left* 'name))]
-                         [(object? left*) (get-field name left*)]
-                         ;; possibly handle other types of data
-                         [else (error 'dot "don't know how to deal with ~a (~a)" 'left left*)])))
-                 #'more))])))
+
+    ;; v.x = 5
+    (define-syntax-class assign #:literal-sets (cruft)
+                                #:literals (honu-assignment)
+      [pattern (_ name:identifier honu-assignment argument:honu-expression . more)
+               #:with result (with-syntax ([left left])
+                               #'(%racket
+                                   (let ([left* left])
+                                     (cond
+                                       [(honu-struct? left*)
+                                        (honu-struct-set! left* 'name argument.result)]
+                                       [(object? left*) (error 'set "implement set for objects")]))))
+               #:with rest #'more])
+
+    ;; v.x
+    (define-syntax-class plain #:literal-sets (cruft)
+                               #:literals (honu-assignment)
+      [pattern (_ name:identifier . more)
+       #:with result (with-syntax ([left left])
+                       #'(%racket
+                           (let ([left* left])
+                             (cond
+                               [(honu-struct? left*) (let ([use (honu-struct-get left*)])
+                                                       (use left* 'name))]
+                               [(object? left*) (get-field name left*)]
+                               ;; possibly handle other types of data
+                               [else (error 'dot "don't know how to deal with ~a (~a)" 'left left*)]))))
+       #:with rest #'more])
+
+    (syntax-parse rest
+      [stuff:assign (values #'stuff.result #'stuff.rest)]
+      [stuff:plain (values #'stuff.result #'stuff.rest)])))
 #;
 (define-honu-operator/syntax honu-dot 10000 'left
   (lambda (left right)