private/check-syntax.ss
;; PLTv4
;; #lang scheme/base

;; PLTv3
(module check-syntax mzscheme

(provide <record-case> <clause>)
     
;; Returns iff stx represents a well-formed record-case expression.
(define (<record-case> stx) ; Syntax -> Void
  (syntax-case stx (else)
    [(_ e0 c0 c1 ...) 
     (for-each (lambda (c) (<clause> stx c)) (syntax->list #'(c0 c1 ...)))]
    [(_ e0 c0 c1 ... (else e1))
     (for-each (lambda (c) (<clause> stx c)) (syntax->list #'(c0 c1 ...)))]
    [_ (raise-syntax-error 'record-case "bad syntax" stx)]))

;; Returns iff stx represents a well-formed clause form (within the context
;; of "pre-" record-case expression ctxt; used for better error reporting).
(define (<clause> ctxt stx) ; Syntax -> Void
  (syntax-case stx (else)
    [(else e0 e1 ...) (void)]
    [(n (x ...) e0 e1 ...)     ;; [*]
     (begin
       (for-each (lambda (e) (<identifier> ctxt e)) (syntax->list #'(n x ...)))
       (when (check-duplicate-identifier (syntax->list #'(x ...)))
         (raise-syntax-error 'record-case "duplicate identifier"
                             ctxt #'(x ...))))]
    [(n (x ... . y) e0 e1 ...)
     (with-syntax ([y (syntax-case #'y ()
                        [() #'()]
                        [y  #'(y)])])
       (for-each (lambda (e) (<identifier> ctxt e)) (syntax->list #'(n x ... . y)))
       (when (check-duplicate-identifier (syntax->list #'(x ... . y)))
         (raise-syntax-error 'record-case "duplicate identifier"
                             ctxt #'(x ... . y))))]
    
    [_ (raise-syntax-error 'record-case "bad clause" ctxt stx)]))

;; Returns iff stx is an identifier.
(define (<identifier> ctxt stx)
  (unless (identifier? stx)
    (raise-syntax-error 'record-case "expected identifier" ctxt stx)))

;; [*] This clause can go away in PLT v4, since the next pattern will
;;     subsume it.  This is do to the following change in MzScheme:
#|
Welcome to MzScheme v372 [3m], Copyright (c) 2004-2007 PLT Scheme Inc.
> (syntax-case #'(a b c) ()
    [(x ... . y) 'yes]
    [_ 'no])
no

Welcome to MzScheme v3.99.0.13 [3m], Copyright (c) 2004-2008 PLT Scheme Inc.
> (syntax-case #'(a b c) ()
    [(x ... . y) 'yes]
    [_ 'no])
yes
|#

) ; end of module check-syntax