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
|
; Part of Scheme 48 1.9. See file COPYING for notices and license.
; Authors: Mike Sperber
(define-syntax define-external-enum-type-with-unknowns
(syntax-rules ()
((define-external-enum-type-with-unknowns
?type-name
(?enumerand ...) ; The C code knows about the order
?unknown-type-name ?:unknown-type-name
?make-unknown ?unknown-predicate? ?unknown-accessor
?offset ; C code knows this
?predicate? ?->raw ?raw->)
(begin
(define-record-type ?unknown-type-name ?:unknown-type-name
(?make-unknown number)
?unknown-predicate?
(number ?unknown-accessor))
(define-record-discloser ?:unknown-type-name
(lambda (r)
(list '?unknown-type-name
(?unknown-accessor r))))
(define-enumeration ?type-name
(?enumerand ...)
set)
(define all (enum-set-complement (set)))
(define index (enum-set-indexer all))
(define set-type (enum-set-type all))
(define (?predicate? thing)
(or (and (symbol? thing)
(enum-set-member? thing all))
(?unknown-predicate? thing)))
(define (?->raw val)
(if (?unknown-predicate? val)
(+ (?unknown-accessor val) ?offset)
(index val)))
(define (?raw-> raw)
(if (>= raw ?offset)
(?make-unknown (- raw ?offset))
(vector-ref (enum-set-type-values set-type) raw)))
))))
|
