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
|
;; 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.
|
;; followed by a '= and an integer to have a similar effect of C's enum.
|
||||||
(define (_enum* name symbols . base?)
|
(define (_enum name symbols [basetype _ufixint] #:unknown [unknown _enum])
|
||||||
(define basetype (if (pair? base?) (car base?) _ufixint))
|
|
||||||
(define sym->int '())
|
(define sym->int '())
|
||||||
(define int->sym '())
|
(define int->sym '())
|
||||||
(define s->c
|
(define s->c
|
||||||
(if name (string->symbol (format "enum:~a->int" name)) 'enum->int))
|
(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])
|
(let loop ([i 0] [symbols symbols])
|
||||||
(unless (null? symbols)
|
(unless (null? symbols)
|
||||||
(let-values ([(i rest)
|
(let-values ([(i rest) (if (and (pair? (cdr symbols))
|
||||||
(if (and (pair? (cdr symbols))
|
(eq? '= (cadr symbols))
|
||||||
(eq? '= (cadr symbols))
|
(pair? (cddr symbols)))
|
||||||
(pair? (cddr symbols)))
|
(values (caddr symbols) (cdddr symbols))
|
||||||
(values (caddr symbols)
|
(values i (cdr symbols)))])
|
||||||
(cdddr symbols))
|
|
||||||
(values i
|
|
||||||
(cdr symbols)))])
|
|
||||||
(set! sym->int (cons (cons (car symbols) i) sym->int))
|
(set! sym->int (cons (cons (car symbols) i) sym->int))
|
||||||
(set! int->sym (cons (cons i (car symbols)) int->sym))
|
(set! int->sym (cons (cons i (car symbols)) int->sym))
|
||||||
(loop (add1 i) rest))))
|
(loop (add1 i) rest))))
|
||||||
|
@ -784,26 +782,26 @@
|
||||||
(if a
|
(if a
|
||||||
(cdr a)
|
(cdr a)
|
||||||
(raise-type-error s->c (format "~a" (or name "enum")) x))))
|
(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
|
;; Macro wrapper -- no need for a name
|
||||||
(provide _enum)
|
(provide (rename-out [_enum* _enum]))
|
||||||
(define-syntax (_enum stx)
|
(define-syntax (_enum* stx)
|
||||||
(syntax-case stx ()
|
(syntax-case stx ()
|
||||||
[(_ syms)
|
[(_ x ...)
|
||||||
(with-syntax ([name (syntax-local-name)])
|
(with-syntax ([name (syntax-local-name)]) #'(_enum 'name x ...))]
|
||||||
#'(_enum* 'name syms))]
|
[id (identifier? #'id) #'_enum]))
|
||||||
[(_ syms basetype)
|
|
||||||
(with-syntax ([name (syntax-local-name)])
|
|
||||||
#'(_enum* 'name syms basetype))]
|
|
||||||
[id (identifier? #'id)
|
|
||||||
#'(lambda (syms . base?) (apply _enum* #f syms base?))]))
|
|
||||||
|
|
||||||
;; Call this with a name (symbol) and a list of (symbol int) or symbols like
|
;; 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
|
;; 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
|
;; generated type will convert a list of these symbols into the logical-or of
|
||||||
;; their values and back.
|
;; 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 basetype (if (pair? base?) (car base?) _uint))
|
||||||
(define s->c
|
(define s->c
|
||||||
(if name (string->symbol (format "bitmask:~a->int" name)) 'bitmask->int))
|
(if name (string->symbol (format "bitmask:~a->int" name)) 'bitmask->int))
|
||||||
|
@ -843,17 +841,12 @@
|
||||||
l)))))))))
|
l)))))))))
|
||||||
|
|
||||||
;; Macro wrapper -- no need for a name
|
;; Macro wrapper -- no need for a name
|
||||||
(provide _bitmask)
|
(provide (rename-out [_bitmask* _bitmask]))
|
||||||
(define-syntax (_bitmask stx)
|
(define-syntax (_bitmask* stx)
|
||||||
(syntax-case stx ()
|
(syntax-case stx ()
|
||||||
[(_ syms)
|
[(_ x ...)
|
||||||
(with-syntax ([name (syntax-local-name)])
|
(with-syntax ([name (syntax-local-name)]) #'(_bitmask 'name x ...))]
|
||||||
#'(_bitmask* 'name syms))]
|
[id (identifier? #'id) #'_bitmask]))
|
||||||
[(_ syms basetype)
|
|
||||||
(with-syntax ([name (syntax-local-name)])
|
|
||||||
#'(_bitmask* 'name syms basetype))]
|
|
||||||
[id (identifier? #'id)
|
|
||||||
#'(lambda (syms . base?) (apply _bitmask* #f syms base?))]))
|
|
||||||
|
|
||||||
;; ----------------------------------------------------------------------------
|
;; ----------------------------------------------------------------------------
|
||||||
;; Custom function type macros
|
;; 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
|
implemented as syntax, so that error messages can report a type name
|
||||||
where the syntactic context implies one.
|
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?]{
|
ctype?]{
|
||||||
|
|
||||||
Takes a list of symbols and generates an enumeration type. The
|
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[0], @scheme['y] to @scheme[10], and @scheme['z] to
|
||||||
@scheme[11].
|
@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])
|
@defproc[(_bitmask [symbols (or symbol? list?)] [basetype ctype? _uint])
|
||||||
ctype?]{
|
ctype?]{
|
||||||
|
|
Loading…
Reference in New Issue
Block a user