
;;; Implementation of S48's DEFINE-ENUMERATION macro using R6RS-style
;;; SYNTAX-CASE macros.
;;;
;;; So far, tested only using Larceny 0.97 in ERR5RS mode, with the
;;; jumbo library (rnrs) imported.  This may not run on a strict R6RS
;;; implementation (or even on Larceny in ‘spanky mode’).



(define-syntax define-enumeration
  (syntax-rules ()
    ((define-enumeration enum-name (element ...))
     (define-syntax enum-name
       (let ((component-vec '#(element ...)))

	 (define (vector-index/1 pred v0)
	   (let ((v0-len (vector-length v0)))
	     (let ((len v0-len))                       ;(MIN V0-LEN V1-LEN ...)
	       (let loop ((i 0))
		 (cond
		  ((= i len)
		   #f)
		  ((pred (vector-ref v0 i))
		   i)
		  (else
		   (loop (+ i 1))))))))
	 ;; alternate definition if SRFI 43 is available and efficient:
	 ;; (define vector-index/1 vector-index)

	 (lambda (expr)
	   (syntax-case expr (components enum)
	     ((enum-name components)
	      (list #'quote
		    (datum->syntax (car (generate-temporaries '(bogon)))
				   component-vec)))
	     ((enum-name enum lookup-name)
	      (or (vector-index/1 (lambda (x) (eq? x (syntax->datum #'lookup-name)))
				  component-vec)
		  (syntax-violation 'enum               ;!!!
				    "unknown enumerand name"
				    expr
				    #'lookup-name))))))))))



(define-syntax components
  (syntax-rules ()
    ((components enum-name)
     (enum-name components))))

(define-syntax enum
  (syntax-rules ()
    ((enum enum-name lookup-name)
     (enum-name enum lookup-name))))


