[plt-scheme] Using the struct type identifier as a macro [PATCH]

The struct type identifier contains the expansion time information,
but is otherwise sitting unused as a macro. This is a waste of a
perfectly good identifier; the macro can be used as a
constructor. Similarly, the match syntax can be adapted for symmetry,
avoiding the current (overly verbose) struct form.

The attached patch (against svn 12407) does this: The
(checked-)struct-info info macro acts as a constructor when the
constructor identifier is available.  Similarly, match is adjusted to
symmetrically deconstruct structs by using the type name directly.

Example:
(define-struct test (x y))
(test 1 2) => #<test>
(match (test 1 2) ((test x y) (list x y))) => '(1 2)


-- vyzo
-------------- next part --------------
Index: collects/scheme/match/parse.ss
===================================================================
--- collects/scheme/match/parse.ss	(revision 12407)
+++ collects/scheme/match/parse.ss	(working copy)
@@ -152,6 +152,10 @@
     [(mcons e1 e2) (make-MPair (parse #'e1) (parse #'e2))]
     [(struct s pats)
      (parse-struct stx cert parse #'s #'pats)]
+    [(type pat ...)
+     (and (identifier? #'type) 
+          (struct-info? (syntax-local-value (cert #'type) (lambda () #f))))
+     (parse-struct stx cert parse #'type #'(pat ...))]
     [(? p q1 qs ...)
      (make-And (cons (make-Pred (cert #'p))
                      (map parse (syntax->list #'(q1 qs ...)))))]
Index: collects/scheme/private/define-struct.ss
===================================================================
--- collects/scheme/private/define-struct.ss	(revision 12407)
+++ collects/scheme/private/define-struct.ss	(working copy)
@@ -26,10 +26,18 @@
                       0 0 #f
                       null (current-inspector)
                       (lambda (v stx)
-                        (raise-syntax-error
-                         #f
-                         "identifier for static struct-type information cannot be used as an expression"
-                         stx))
+                        (let-values (((kons) (cadr (extract-struct-info v))))
+                          (if kons
+                            (if (list? (syntax-e stx))
+                              (datum->syntax stx (cons kons (cdr (syntax-e stx))) stx)
+                              (raise-syntax-error
+                               #f
+                               "illegal use of struct-type identifier"
+                               stx))
+                            (raise-syntax-error
+                                #f
+                              "identifier for static struct-type information cannot be used as an expression"
+                              stx))))
                       null
                       (lambda (proc info)
                         (if (and (procedure? proc)
Index: collects/scheme/private/struct-info.ss
===================================================================
--- collects/scheme/private/struct-info.ss	(revision 12407)
+++ collects/scheme/private/struct-info.ss	(working copy)
@@ -16,10 +16,18 @@
                       1 0 #f
                       null (current-inspector)
                       (lambda (v stx)
-                        (raise-syntax-error
-                         #f
-                         "identifier for static struct-type information cannot be used as an expression"
-                         stx))
+                        (let-values (((kons) (cadr (extract-struct-info v))))
+                          (if kons
+                            (if (list? (syntax-e stx))
+                              (datum->syntax stx (cons kons (cdr (syntax-e stx))) stx)
+                              (raise-syntax-error
+                               #f
+                               "illegal use of struct-type identifier"
+                               stx))
+                            (raise-syntax-error
+                                #f
+                              "identifier for static struct-type information cannot be used as an expression"
+                              stx))))
                       null
                       (lambda (proc info)
                         (if (and (procedure? proc)