All pastes #1462551 Raw Edit

Helper for define-record-type

public text v1 · immutable
#1462551 ·published 2009-06-16 20:26 UTC
rendered paste body
(define-syntax easy-record
  (lambda (e r c)
    (let* ((symbol+ (lambda syms
		      (string->symbol (apply string-append (map symbol->string syms)))))
	   (name (cadr e))		      ; 'sframe
	   (fields (cddr e))		      ; '(type val state)
	   (tag (symbol+ ': name))	      ; ':sframe
	   (pred (symbol+ name '?))	      ; 'sframe?
	   (make (symbol+ 'make- name))	      ; 'make-sframe
	 
	   (%lambda (r 'lambda))
	   (%define-record-type (r 'define-record-type))
	   (%define-record-discloser (r 'define-record-discloser))
	   (%begin (r 'begin))
	   (%cons (r 'cons))
	   (%list (r 'list))
	 
	   (constructor (cons make fields)) ; '(make-sframe type val state)
	   (accessors (map (lambda (field)
			     (list field
				   (symbol+ name '- field)))
			   fields)) ; '((type sframe-type) (val sframe-val) (state sframe-state))
	   (disclosers (map (lambda (acc)
			      `(,(cadr acc) o))
			    accessors)) ; '((sframe-type o) (sframe-val o) (sframe-state o))
	   (definer (append (list %define-record-type name tag
				  constructor
				  pred)
			    accessors))
	   (discloser `(,%define-record-discloser
			,tag
			(,%lambda (o)
				  ,(cons 'list (cons `(quote ,make) disclosers))))))
      `(,%begin ,definer ,discloser))))