Throw an error when translating an unknown enum integer to a symbol.
Also, add a keyword argument that can be used to get the old behavior back. Also, improve the way the `_enum' and `_bitmask' functions are wrapped.
This commit is contained in:
parent
d2b1bf73e0
commit
b8bbed6eb4
|
@ -759,22 +759,20 @@
|
|||
|
||||
;; Call this with a name (symbol) and a list of symbols, where a symbol can be
|
||||
;; followed by a '= and an integer to have a similar effect of C's enum.
|
||||
(define (_enum* name symbols . base?)
|
||||
(define basetype (if (pair? base?) (car base?) _ufixint))
|
||||
(define (_enum name symbols [basetype _ufixint] #:unknown [unknown _enum])
|
||||
(define sym->int '())
|
||||
(define int->sym '())
|
||||
(define s->c
|
||||
(if name (string->symbol (format "enum:~a->int" name)) 'enum->int))
|
||||
(define c->s
|
||||
(if name (string->symbol (format "enum:int->~a" name)) 'int->enum))
|
||||
(let loop ([i 0] [symbols symbols])
|
||||
(unless (null? symbols)
|
||||
(let-values ([(i rest)
|
||||
(if (and (pair? (cdr symbols))
|
||||
(eq? '= (cadr symbols))
|
||||
(pair? (cddr symbols)))
|
||||
(values (caddr symbols)
|
||||
(cdddr symbols))
|
||||
(values i
|
||||
(cdr symbols)))])
|
||||
(let-values ([(i rest) (if (and (pair? (cdr symbols))
|
||||
(eq? '= (cadr symbols))
|
||||
(pair? (cddr symbols)))
|
||||
(values (caddr symbols) (cdddr symbols))
|
||||
(values i (cdr symbols)))])
|
||||
(set! sym->int (cons (cons (car symbols) i) sym->int))
|
||||
(set! int->sym (cons (cons i (car symbols)) int->sym))
|
||||
(loop (add1 i) rest))))
|
||||
|
@ -784,26 +782,26 @@
|
|||
(if a
|
||||
(cdr a)
|
||||
(raise-type-error s->c (format "~a" (or name "enum")) x))))
|
||||
(lambda (x) (cond [(assq x int->sym) => cdr] [else #f]))))
|
||||
(lambda (x)
|
||||
(cond [(assq x int->sym) => cdr]
|
||||
[(eq? unknown _enum)
|
||||
(error c->s "expected a known ~a, got: ~s" basetype x)]
|
||||
[(procedure? unknown) (unknown x)]
|
||||
[else unknown]))))
|
||||
|
||||
;; Macro wrapper -- no need for a name
|
||||
(provide _enum)
|
||||
(define-syntax (_enum stx)
|
||||
(provide (rename-out [_enum* _enum]))
|
||||
(define-syntax (_enum* stx)
|
||||
(syntax-case stx ()
|
||||
[(_ syms)
|
||||
(with-syntax ([name (syntax-local-name)])
|
||||
#'(_enum* 'name syms))]
|
||||
[(_ syms basetype)
|
||||
(with-syntax ([name (syntax-local-name)])
|
||||
#'(_enum* 'name syms basetype))]
|
||||
[id (identifier? #'id)
|
||||
#'(lambda (syms . base?) (apply _enum* #f syms base?))]))
|
||||
[(_ x ...)
|
||||
(with-syntax ([name (syntax-local-name)]) #'(_enum 'name x ...))]
|
||||
[id (identifier? #'id) #'_enum]))
|
||||
|
||||
;; Call this with a name (symbol) and a list of (symbol int) or symbols like
|
||||
;; the above with '= -- but the numbers have to be specified in some way. The
|
||||
;; generated type will convert a list of these symbols into the logical-or of
|
||||
;; their values and back.
|
||||
(define (_bitmask* name orig-symbols->integers . base?)
|
||||
(define (_bitmask name orig-symbols->integers . base?)
|
||||
(define basetype (if (pair? base?) (car base?) _uint))
|
||||
(define s->c
|
||||
(if name (string->symbol (format "bitmask:~a->int" name)) 'bitmask->int))
|
||||
|
@ -843,17 +841,12 @@
|
|||
l)))))))))
|
||||
|
||||
;; Macro wrapper -- no need for a name
|
||||
(provide _bitmask)
|
||||
(define-syntax (_bitmask stx)
|
||||
(provide (rename-out [_bitmask* _bitmask]))
|
||||
(define-syntax (_bitmask* stx)
|
||||
(syntax-case stx ()
|
||||
[(_ syms)
|
||||
(with-syntax ([name (syntax-local-name)])
|
||||
#'(_bitmask* 'name syms))]
|
||||
[(_ syms basetype)
|
||||
(with-syntax ([name (syntax-local-name)])
|
||||
#'(_bitmask* 'name syms basetype))]
|
||||
[id (identifier? #'id)
|
||||
#'(lambda (syms . base?) (apply _bitmask* #f syms base?))]))
|
||||
[(_ x ...)
|
||||
(with-syntax ([name (syntax-local-name)]) #'(_bitmask 'name x ...))]
|
||||
[id (identifier? #'id) #'_bitmask]))
|
||||
|
||||
;; ----------------------------------------------------------------------------
|
||||
;; Custom function type macros
|
||||
|
|
|
@ -989,7 +989,9 @@ Although the constructors below are describes as procedures, they are
|
|||
implemented as syntax, so that error messages can report a type name
|
||||
where the syntactic context implies one.
|
||||
|
||||
@defproc[(_enum [symbols list?] [basetype ctype? _ufixint])
|
||||
@defproc[(_enum [symbols list?]
|
||||
[basetype ctype? _ufixint]
|
||||
[#:unknown unknown any/c (lambda (x) (error ....))])
|
||||
ctype?]{
|
||||
|
||||
Takes a list of symbols and generates an enumeration type. The
|
||||
|
@ -1002,7 +1004,12 @@ example, the list @scheme['(x y = 10 z)] maps @scheme['x] to
|
|||
@scheme[0], @scheme['y] to @scheme[10], and @scheme['z] to
|
||||
@scheme[11].
|
||||
|
||||
The @scheme[basetype] argument specifies the base type to use.}
|
||||
The @scheme[basetype] argument specifies the base type to use.
|
||||
|
||||
The @scheme[unknown] argument specifies the result of converting an
|
||||
unknown integer from the foreign side: it can be a one-argument function
|
||||
to be applied on the integer, or a value to return instead. The default
|
||||
is to throw an exception.}
|
||||
|
||||
@defproc[(_bitmask [symbols (or symbol? list?)] [basetype ctype? _uint])
|
||||
ctype?]{
|
||||
|
|
Loading…
Reference in New Issue
Block a user