fix some error-message reporting for mzscheme define-struct

svn: r8953

original commit: 9ecf9dfe4aedc729a71fc525399e89caae066e2f
This commit is contained in:
Matthew Flatt 2008-03-11 21:14:40 +00:00
parent 8dc8589a9a
commit db1a358d81

View File

@ -1,16 +1,25 @@
(module old-ds '#%kernel (module old-ds '#%kernel
(#%require "define-struct.ss" (#%require "define-struct.ss"
(for-syntax "stxcase-scheme.ss")) (for-syntax '#%kernel
"stxcase-scheme.ss"))
(#%provide define-struct let-struct datum) (#%provide define-struct let-struct datum)
(define-syntaxes (define-struct) (define-syntaxes (define-struct)
(syntax-rules () (lambda (stx)
(with-syntax ([orig stx])
(syntax-case stx ()
[(_ base (field ...)) [(_ base (field ...))
(define-struct* base (field ...) #:mutable)] #'(define-struct/derived orig base (field ...) #:mutable)]
[(_ base (field ...) insp) [(_ base (field ...) insp)
(define-struct* base (field ...) #:mutable #:inspector insp)])) (with-syntax ([insp
(if (keyword? (syntax-e #'insp))
(datum->syntax #'insp
(cons '#%datum #'insp)
#'insp)
#'insp)])
#'(define-struct/derived orig base (field ...) #:mutable #:inspector insp))]))))
(define-syntaxes (let-struct) (define-syntaxes (let-struct)
(syntax-rules () (syntax-rules ()