summaryrefslogtreecommitdiff
path: root/bstruct.scm
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2024-11-23 18:51:28 -0500
committerDavid Thompson <dthompson2@worcester.edu>2024-11-23 18:51:28 -0500
commitf6596f32468ed21ea539fc2943210f559668d958 (patch)
tree3f6296255ba9622603e34a88919202b20ea4295f /bstruct.scm
parent94c82c7fb1ef4533d0e749ea4d9796e26604275b (diff)
Improve error messages a bit.
Diffstat (limited to 'bstruct.scm')
-rw-r--r--bstruct.scm15
1 files changed, 9 insertions, 6 deletions
diff --git a/bstruct.scm b/bstruct.scm
index 191f2b5..9377a62 100644
--- a/bstruct.scm
+++ b/bstruct.scm
@@ -755,7 +755,7 @@
(_
(bstruct-descriptor-identifier? type)
(bstruct-descriptor-identifier-align type))))
-(define (expand-accessor proc stx id op type)
+(define (expand-accessor proc who stx id op type)
(syntax-case stx ()
(() (proc id 0)) ; self reference
((elem ...)
@@ -781,6 +781,7 @@
(let ((name (syntax->datum #'e)))
(let field-lp ((fields #'(field ...)))
(syntax-case fields ()
+ (() (syntax-violation who "no such bit field" #'e))
(((name* offset* len signed?) . rest)
(if (identifier-eq? #'name* name)
(proc #`(bit-field size offset* len signed? native?) offset)
@@ -793,6 +794,7 @@
(let ((name (syntax->datum #'e)))
(let field-lp ((fields #'(field ...)))
(syntax-case fields ()
+ (() (syntax-violation who "no such struct field" #'e))
(((name* offset* type*) . rest)
(if (identifier-eq? #'name* name)
(loop #'(elem ...) #'type* #`(+ #,offset offset*))
@@ -805,6 +807,7 @@
(let ((name (syntax->datum #'e)))
(let field-lp ((fields #'(field ...)))
(syntax-case fields ()
+ (() (syntax-violation who "no such union field" #'e))
(((name* type) . rest)
(if (identifier-eq? #'name* name)
(loop #'(elem ...) #'type offset)
@@ -892,11 +895,11 @@
((bit-field size start len signed? native?)
(symbolic-match? bit-field)
(syntax-violation 'bstruct->pointer
- "cannot create pointer to bit field"
- id elems))
+ "cannot take address of bit field"
+ elems))
(sub-offset
#'(sub-offset bv (+ i offset))))))
- elems id 'offset type)))
+ 'bstruct->pointer elems id 'offset type)))
;; Primitive getter/setter helpers
(define (ref/endianness proc endianness)
#`(lambda (bv i)
@@ -996,7 +999,7 @@
x)))))
(sub-get
#'(sub-get bv (+ i offset))))))
- elems id 'getter type)))
+ 'bstruct-unpack elems id 'getter type)))
(define (set!/endianness proc endianness)
#`(lambda (bv i x)
(#,proc bv i x #,endianness)))
@@ -1104,7 +1107,7 @@
(fail)))))))
(sub-set!
#'(sub-set! bv (+ i offset) x)))))
- elems id 'setter type)))
+ 'bstruct-pack! elems id 'setter type)))
(define-syntax define-bstruct-macro
(lambda (stx)