dualshock 3 -> zsnes button converter

[clinton/scratch.git] / define-record.scm

(define-syntax define-record
  (lambda (e)
    (syntax-case e ()
      ((_ name field0 field1 ...)
       (with-syntax ((%fields
		      (map (lambda (f)
			     (syntax-case f ()
			       ((fname) (syntax (field fname #f)))
			       ((fname default) (syntax (field fname default)))
			       (fname (syntax (field fname #f)))))
			   (syntax (field0 field1 ...)))))
	 (syntax
	  (define-record* name
	    %fields)))))))

(define-syntax define-record*
  (lambda (e)
    (letrec ((make-name (lambda args
			  (datum->syntax e
			   (string->symbol
			    (apply string-append
				   (map (lambda (a)
					  (if (string? a)
					      a
					      (symbol->string
					       (syntax->datum a))))
					args)))))))
      (syntax-case e (field)
	((_ name ((field field-name default) ...))
	 #`(begin (define* (#,(make-name "make-" (syntax name))
			    #:optional (field-name default) ...)
		    (vector 'name field-name ...))
		  #,@(let ((idx 0))
		       (map (lambda (fname)
			      (set! idx (1+ idx))
			      #`(begin (define (#,(make-name (syntax name)
							     ":"
							     fname)
						rec)
					 (vector-ref rec #,idx))
				       (define (#,(make-name "set-"
							     (syntax name)
							     ":"
							     fname)
						rec val)
					 (vector-set! rec #,idx val))))
			    (syntax (field-name ...))))))))))