Added a match expander for objects in unstable.

collects/unstable/match.rkt

@@ -1,8 +1,11 @@
 #lang racket/base
 
-(require racket/match (for-syntax racket/base))
+(require racket/class
+         racket/match
+         (for-syntax racket/base)
+         (for-syntax syntax/parse))
 
-(provide == match? as)
+(provide == match? as object)
 
 (define-match-expander
   ==
@@ -18,3 +21,25 @@
 (define-match-expander as
   (syntax-rules ()
     [(as ([x e] ...) p ...) (and (app (lambda (y) e) x) ... p ...)]))
+
+;; Added by asumu
+;; Match expander for objects from racket/class
+(define-match-expander object
+  (λ (stx)
+    (define-syntax-class field
+      #:attributes (name pat)
+      (pattern
+        ((~datum field)
+         name
+         (~optional pat #:defaults ([pat #'name])))))
+
+    (syntax-parse stx
+      [(object f:field ...)
+       #'(and (? object?)
+              (and (? (λ (o) (field-bound? f.name o)))
+                   (app (λ (o) (get-field f.name o))
+                        f.pat))
+              ...)]
+      [(object class f:field ...)
+       #'(and (? (λ (o) (is-a? o class)))
+              (object f ...))])))

collects/unstable/scribblings/match.scrbl

@@ -3,7 +3,7 @@
           (for-label unstable/match racket/match racket/contract racket/base))
 
 @(define the-eval (make-base-eval))
-@(the-eval '(require racket/match unstable/match))
+@(the-eval '(require racket/class racket/match unstable/match))
 
 @title[#:tag "match"]{Match}
 
@@ -66,4 +66,51 @@ result value of @racket[rhs-expr], and continues matching each subsequent
 
 }
 
+@addition[@author+email["Asumu Takikawa" "asumu@racket-lang.org"]]
+
+@defform/subs[
+  #:literals (field)
+  (object maybe-class field-clause ...)
+  ([maybe-class
+    code:blank
+    class-expr]
+   [field-clause (field field-id maybe-pat)]
+   [maybe-pat
+    code:blank
+    pat])]{
+
+A match expander that checks if the matched value is an object
+and contains the fields named by the @racket[field-id]s. If
+@racket[pat]s are provided, the value in each field is matched to
+its corresponding @racket[pat]. If a @racket[pat] is not provided,
+it defaults to the name of the field.
+
+If @racket[class-expr] is provided, the match expander will also
+check that the supplied object is an instance of the class
+that the given expression evaluates to.
+
+@defexamples[
+#:eval the-eval
+(define point%
+  (class object%
+    (super-new)
+    (init-field x y)))
+
+(match (make-object point% 3 5)
+  [(object point% (field x) (field y))
+   (sqrt (+ (* x x) (* y y)))])
+
+(match (make-object point% 0 0)
+  [(object (field x (? zero?))
+           (field y (? zero?)))
+   'origin])
+
+(match (make-object object%)
+  [(object (field x) (field y))
+   'ok]
+  [_ 'fail])
+]
+
+}
+
 @close-eval[the-eval]