From e838792bb8a58437aa0d21b1e2c4fbf1fef8eea2 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 5 Jan 2017 12:06:25 -0800
Subject: [PATCH] Implement parsing of bytevectors.

---
 src/runtime/parse.scm | 28 ++++++++++++++++++++++++++++
 1 file changed, 28 insertions(+)

diff --git a/src/runtime/parse.scm b/src/runtime/parse.scm
index 018b012a8..084be93e6 100644
--- a/src/runtime/parse.scm
+++ b/src/runtime/parse.scm
@@ -292,6 +292,7 @@ USA.
     (store-char special #\F handler:false)
     (store-char special #\t handler:true)
     (store-char special #\T handler:true)
+    (store-char special #\u handler:unsigned-vector)
     (store-char special #\* handler:bit-string)
     (store-char special #\\ handler:char)
     (store-char special #\! handler:named-constant)
@@ -632,6 +633,27 @@ USA.
 	  (list->vector (reverse! objects))
 	  (loop (cons object objects))))))
 
+(define (handler:unsigned-vector port db ctx char1 char2)
+  ctx
+  (let ((atom (parse-atom/no-quoting port db '())))
+    (if (not (and atom (string=? atom "8")))
+	(error:unsupported-vector (string char1 char2 (or atom "")))))
+  (let ((char (%read-char/no-eof port db)))
+    (if (not (char=? char #\())
+	(error:illegal-char char)))
+  (let loop ((bytes '()))
+    (let ((object (read-in-context port db 'CLOSE-PAREN-OK)))
+      (if (eq? object close-parenthesis)
+	  (let ((bytevector (make-bytevector (length bytes))))
+	    (do ((bytes (reverse! bytes) (cdr bytes))
+		 (index 0 (fix:+ index 1)))
+		((not (pair? bytes)))
+	      (bytevector-u8-set! bytevector index (car bytes)))
+	    bytevector)
+	  (begin
+	    (guarantee-byte object)
+	    (loop (cons object bytes)))))))
+
 (define (handler:close-parenthesis port db ctx char)
   db
   (cond ((eq? ctx 'CLOSE-PAREN-OK)
@@ -1110,6 +1132,7 @@ USA.
 (define condition-type:unbalanced-close)
 (define condition-type:undefined-hash)
 (define condition-type:unexpected-restart)
+(define condition-type:unsupported-vector)
 (define error:illegal-bit-string)
 (define error:illegal-boolean)
 (define error:illegal-char)
@@ -1125,6 +1148,7 @@ USA.
 (define error:unbalanced-close)
 (define error:undefined-hash)
 (define error:unexpected-restart)
+(define error:unsupported-vector)
 
 (define (initialize-condition-types!)
   (set! condition-type:parse-error
@@ -1202,4 +1226,8 @@ USA.
     (lambda (port* port)
       (write-string "Unexpected parse restart on: " port)
       (write port* port)))
+  (define-parse-error (unsupported-vector string)
+    (lambda (string port)
+      (write-string "Unsupported vector prefix: " port)
+      (write-string string port)))
   unspecific)
\ No newline at end of file
-- 
2.25.1