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:
Eli Barzilay 2010-11-16 14:59:48 -05:00
parent d2b1bf73e0
commit b8bbed6eb4
2 changed files with 34 additions and 34 deletions

View File

@ -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))
(let-values ([(i rest) (if (and (pair? (cdr symbols))
(eq? '= (cadr symbols))
(pair? (cddr symbols)))
(values (caddr symbols)
(cdddr symbols))
(values i
(cdr 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

View File

@ -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?]{