-(define-syntax fold-class-slots
- (lambda (x)
- (define slots
- '((layout <protected-read-only-slot>)
- (flags <hidden-slot>)
- (self <self-slot>)
- (instance-finalizer <hidden-slot>)
- (print)
- (name <protected-hidden-slot>)
- (nfields <hidden-slot>)
- (%reserved <hidden-slot>)
- (redefined)
- (direct-supers)
- (direct-slots)
- (direct-subclasses)
- (direct-methods)
- (cpl)
- (slots)
- (getters-n-setters)))
- (syntax-case x ()
- ((_ fold visit seed)
- ;; The datum->syntax makes it as if the identifiers in `slots'
- ;; were present in the initial form, which allows them to be used
- ;; as (components of) introduced identifiers.
- #`(fold visit seed #,(datum->syntax #'visit slots))))))
+(define-syntax-rule (define-macro-folder macro-folder value ...)
+ (define-syntax macro-folder
+ (lambda (x)
+ (syntax-case x ()
+ ((_ fold visit seed)
+ ;; The datum->syntax makes it as if each `value' were present
+ ;; in the initial form, which allows them to be used as
+ ;; (components of) introduced identifiers.
+ #`(fold visit seed #,(datum->syntax #'visit '(value ...))))))))
+
+(define-macro-folder fold-class-slots
+ (layout <protected-read-only-slot>)
+ (flags <hidden-slot>)
+ (self <self-slot>)
+ (instance-finalizer <hidden-slot>)
+ (print)
+ (name <protected-hidden-slot>)
+ (nfields <hidden-slot>)
+ (%reserved <hidden-slot>)
+ (redefined)
+ (direct-supers)
+ (direct-slots)
+ (direct-subclasses)
+ (direct-methods)
+ (cpl)
+ (slots)
+ (getters-n-setters))
+
+(define-macro-folder fold-slot-slots
+ (name #:init-keyword #:name)
+ (allocation #:init-keyword #:allocation #:init-value #:instance)
+ (init-form #:init-keyword #:init-form)
+ (init-thunk #:init-keyword #:init-thunk #:init-value #f)
+ (options)
+ (getter #:init-keyword #:getter)
+ (setter #:init-keyword #:setter)
+ (index #:init-keyword #:index)
+ (size #:init-keyword #:size))