Enumerations: Difference between revisions
Content added Content deleted
(Scheme syntax extension) |
|||
Line 1,796: | Line 1,796: | ||
(equal? 'cherry atom)))</lang> |
(equal? 'cherry atom)))</lang> |
||
(This section needs attention from someone familiar with Scheme idioms.) |
(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}}== |
=={{header|Seed7}}== |