/usr/share/scsh-0.6/rts/defenum.scm is in scsh-common-0.6 0.6.7-8.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 | ; Copyright (c) 1993-1999 by Richard Kelsey and Jonathan Rees. See file COPYING.
; define-enumeration macro
(define-syntax define-enumeration
(lambda (form rename compare)
(let ((name (cadr form))
(components (list->vector (caddr form)))
(conc (lambda things
(string->symbol (apply string-append
(map (lambda (thing)
(if (symbol? thing)
(symbol->string thing)
thing))
things)))))
(%define (rename 'define))
(%define-syntax (rename 'define-syntax))
(%begin (rename 'begin))
(%quote (rename 'quote)))
(let ((e-name (conc name '- 'enumeration))
(count (vector-length components)))
`(,%begin (,%define-syntax ,name
(cons (let ((components ',components))
(lambda (e r c)
(let ((key (cadr e)))
(cond ((c key 'components)
(r ',e-name))
((c key 'enum)
(let ((which (caddr e)))
(let loop ((i 0)) ;vector-posq
(if (< i ,count)
(if (c which (vector-ref components i))
i
(loop (+ i 1)))
;; (syntax-error "unknown enumerand name"
;; `(,(cadr e) ,(car e) ,(caddr e)))
e))))
(else e)))))
'(,e-name))) ;Auxiliary binding
(,%define ,e-name ',components)
(,%define ,(conc name '- 'count) ,count)))))
(begin define define-syntax quote))
(define-syntax components
(cons (lambda (e r c) `(,(cadr e) components))
'()))
(define-syntax enum
(cons (lambda (e r c) `(,(cadr e) enum ,(caddr e)))
'()))
(define-syntax enumerand->name
(syntax-rules ()
((enumerand->name ?enumerand ?type)
(vector-ref (components ?type) ?enumerand))))
(define-syntax name->enumerand
(syntax-rules ()
((name->enumerand ?name ?type)
(lookup-enumerand (components ?type) ?name))))
(define (lookup-enumerand components name)
(let ((len (vector-length components)))
(let loop ((i 0)) ;vector-posq
(if (>= i len)
#f
(if (eq? name (vector-ref components i))
i
(loop (+ i 1)))))))
|