Anonymous user
Enumerations: Difference between revisions
Scheme syntax extension
(Scheme syntax extension) |
|||
Line 1,796:
(equal? 'cherry atom)))</lang>
(This section needs attention from someone familiar with Scheme idioms.)
===Using syntax extension===
{{works with|Chez Scheme}}
'''The Implementation'''
<lang scheme>; Syntax that implements a C-like enum; items without assignment take next value.
; Form: (enum <name> <item>...)
; Where <name> is a symbol that will be the name of the enum; <item> are one or
; more expressions that are either symbols or lists of symbol and integer value.
; The symbols are bound to the values. If a value is not given, then the next
; integer after the one bound to the previous symbol is used (starting at 0).
; The <name> itself is bound to an a-list of the item symbols and their values.
(define-syntax enum
(lambda (x)
(syntax-case x ()
((_ name itm1 itm2 ...)
(identifier? (syntax name))
(syntax
(begin
(define name '())
(enum-help name 0 itm1 itm2 ...)))))))
; Helper for (enum) syntax, above. Do not call directly!
(define-syntax enum-help
(lambda (x)
(syntax-case x ()
((_ name nxint (sym val))
(and (identifier? (syntax sym))
(integer? (syntax-object->datum (syntax val))))
(syntax
(begin
(define sym val)
(set! name (cons (cons 'sym val) name)))))
((_ name nxint sym)
(identifier? (syntax sym))
(syntax
(begin
(define sym nxint)
(set! name (cons (cons 'sym nxint) name)))))
((_ name nxint (sym val) rest ...)
(and (identifier? (syntax sym))
(integer? (syntax-object->datum (syntax val))))
(syntax
(begin
(define sym val)
(set! name (cons (cons 'sym val) name))
(enum-help name (1+ val) rest ...))))
((_ name nxint sym rest ...)
(identifier? (syntax sym))
(syntax
(begin
(define sym nxint)
(set! name (cons (cons 'sym nxint) name))
(enum-help name (1+ nxint) rest ...)))))))</lang>
'''Example Use'''
<lang scheme>(define-syntax test
(syntax-rules ()
((_ e)
(printf "~a --> ~s~%" 'e e))))
(printf "~%The 'foo' enum:~%")
(enum foo a (b 10) c (d 20) e (f 30) g)
(test a)
(test b)
(test c)
(test d)
(test e)
(test f)
(test g)
(test foo)
(test (assq 'd foo))
(test (assq 'm foo))
(printf "~%The 'bar' enum:~%")
(enum bar x y (z 99))
(test x)
(test y)
(test z)
(test bar)</lang>
{{out}}
<pre>The 'foo' enum:
a --> 0
b --> 10
c --> 11
d --> 20
e --> 21
f --> 30
g --> 31
foo --> ((g . 31) (f . 30) (e . 21) (d . 20) (c . 11) (b . 10) (a . 0))
(assq 'd foo) --> (d . 20)
(assq 'm foo) --> #f
The 'bar' enum:
x --> 0
y --> 1
z --> 99
bar --> ((z . 99) (y . 1) (x . 0))</pre>
=={{header|Seed7}}==
| |||