~ chicken-core (master) 72483b2401a1a691be8f3c7c314740d79cdaa8d0

commit 72483b2401a1a691be8f3c7c314740d79cdaa8d0
Author:     Kristian Lein-Mathisen <kristianlein@gmail.com>
AuthorDate: Mon Aug 31 15:22:12 2026 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Mon Aug 31 20:32:38 2026 +0200

    reader: introduce hex bytevector literals
    
    bringing a CHICKEN 5 blob look-alike syntax back. see the added tests
    for syntax. blob literals need special care because leading zeros
    affect the result, and hence we can't re-use the existing reader for
    numbers.
    
    read-bytevector-literal is similar to CHICKEN 5's ##sys#read-bytevector-literal
    but differs in that it:
    
    - returns a list of fixnums / bytes in order
    - only allows 2-digit hex entries or multiples of 2-digit hex entries
      for clarity
    
    from ddf6d90e1a9e29246084cfff4a8544f2c25089e7 in C5 we have these
    tests:
    
        (assert (equal? '#${a} '#${0a}))
        (assert (equal? '#${ab cd} '#${abcd}))
        (assert (equal? '#${ab c} '#${ab0c}))
        (assert (equal? '#${abc} '#${ab0c}))
        (assert (equal? '#${a b c} '#${0a0b0c}))
    
        ;; self-evaluating
        (assert (equal? '#${a} #${a}))
        (assert (equal? '#${abcd} #${abcd}))
        (assert (equal? '#${abc} #${abc}))
    
    this test covers some of those cases. it adds error checking against
    single-nibbles, but does not test for self-evaluating (do we need that?)

diff --git a/library.scm b/library.scm
index 31f12cac..a1db238f 100644
--- a/library.scm
+++ b/library.scm
@@ -5379,10 +5379,42 @@ EOF
              (else (fail sym))))))
     (else (fail char))))
 
+;; returns a (potentially large) list of numbers (bytes) in
+;; order. ignores whitespace.
+(define (##sys#read-hex-literal port) ;; { 00ff11 ff } => #u8(0 255 17 255)
+  (define (hex c)
+    (cond ((and (char>=? c #\a) (char<=? c #\f)) (fx- (char->integer c) 87)) ;; (- (char->integer #\a) 10)
+          ((and (char>=? c #\A) (char<=? c #\F)) (fx- (char->integer c) 55)) ;; (- (char->integer #\A) 10)
+	  ((and (char>=? c #\0) (char<=? c #\9)) (fx- (char->integer c) 48)) ;; (char->integer #\0)
+	  (else (##sys#read-error port "invalid hex-code in bytecode literal" c))))
+
+  (unless (eq? #\{ (##sys#read-char-0 port)) (##sys#read-error port "internal error"))
+  (let ((first #f))
+    (let loop ((h #f) (last #f))
+      (let ((c (##sys#read-char-0 port)))
+        (cond ((eof-object? c)
+	       (##sys#read-error port "unexpected end of hex bytevector literal"))
+	      ((char=? #\} c)
+	       (if h
+		   (##sys#read-error port "odd-numbered hex bytevector literal")
+		   (or first '())))
+	      ((char-whitespace? c)
+	       (if h
+		   (##sys#read-error port "odd-numbered hex bytevector literal")
+		   (loop #f last)))
+	      (h
+               (let ((node (cons (fxior (fxshl h 4) (hex c)) '())))
+                 (if first
+                     (##sys#setslot last 1 node)
+                     (set! first node))
+                 (loop #f node)))
+	      (else (loop (hex c) last)))))))
+
 (define (##sys#read-numvector-data port)
   (let ((c (##sys#peek-char-0 port)))
     (case c
       ((#\( #\") (##sys#read port ##sys#default-read-info-hook))
+      ((#\{) (##sys#read-hex-literal port))
       (else (##sys#read-error port "invalid numeric vector syntax" c)))))
 
 (define (##sys#canonicalize-number-list! lst1)
diff --git a/tests/library-tests.scm b/tests/library-tests.scm
index 38ab88dd..e63aeb6a 100644
--- a/tests/library-tests.scm
+++ b/tests/library-tests.scm
@@ -617,7 +617,8 @@
 (assert-fail (with-input-from-string "\"" read))
 (assert-fail (with-input-from-string "#|" read))
 (assert-fail (with-input-from-string "#(" read))
-(assert-fail (with-input-from-string "#${" read))
+(assert-fail (with-input-from-string "#u8(" read))
+(assert-fail (with-input-from-string "#u8{" read))
 (assert-fail (with-input-from-string "\\" read))
 (assert-fail (with-input-from-string "|\\" read))
 (assert-fail (with-input-from-string "\"\\" read))
@@ -677,6 +678,22 @@ A
 (assert (string-ci<? "foo\x00;a" "foo\x00;B"))
 (assert (string-ci>? "foo\x00;b" "foo\x00;A"))
 
+;; hex bytevector literals
+(assert-fail (with-input-from-string "#u8{f}" read))
+(assert-fail (with-input-from-string "#u8{ff0}" read))
+(assert-fail (with-input-from-string "#u8{1}" read))
+(assert-fail (with-input-from-string "#u8{-1}" read))
+(assert-fail (with-input-from-string "#u8{ -01 }" read))
+(assert-fail (with-input-from-string "#u8{F11223344556677889900}" read))
+
+(assert (equal? '#u8{}   '#u8()))
+(assert (equal? '#u8{01} '#u8(1)))
+(assert (equal? '#u8{00 01 10 11} '#u8(0 1 16 17)))
+(assert (equal? '#u8{af fa FA AF} '#u8(175 250 250 175)))
+(assert (equal? '#u8{0001   0203  0aff} '#u8(0 1 2 3 10 255)))
+(assert (equal? '#u8{0001   0203  0aff} '#u8(0 1 2 3 10 255)))
+(assert (equal? '#u8{000102030aff}      '#u8(0 1 2 3 10 255)))
+
 ;; reported by Nils Holm (#1534)
 ;; https://groups.google.com/group/comp.lang.scheme/t/6b8be06b84b39a7
 (assert (not (string-ci<=? "test" "tes")))