commit d56ee9e4728763cbcb5b5386c19aa06648375e97
parent b5ae50565dd1cd431ce0108436a08390d4966229
Author: Yuval Langer <yuval.langer@gmail.com>
Date: Sat, 13 Jan 2024 08:33:02 +0200
Rename main RSV library.
Diffstat:
| M | TODO.org | | | 2 | +- |
| M | rsv.scm | | | 226 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-- |
| D | rsv/arbitrary-null.scm | | | 225 | ------------------------------------------------------------------------------- |
3 files changed, 224 insertions(+), 229 deletions(-)
diff --git a/TODO.org b/TODO.org
@@ -1,7 +1,7 @@
- [X] Use a single object to track RSV position.
- [X] Tried it and it results in GC churn. Use rows and columns
instead.
-- [ ] I don't like the naming of the libraries. Rename things into
+- [X] I don't like the naming of the libraries. Rename things into
something proper.
Zipheir's points:
diff --git a/rsv.scm b/rsv.scm
@@ -1,5 +1,225 @@
(define-library (rsv)
(import (scheme base)
- (rsv arbitrary-null))
- (export scm->rsv
- rsv->scm))
+ (scheme file)
+ (scheme write))
+ (export write-rsv
+ write-rsv-row
+ read-rsv
+ read-rsv-row
+ legal-rsv?)
+
+ (begin
+ (define row-terminator-byte #xFD) ;; 253
+ (define value-terminator-byte #xFF) ;; 255
+ (define null-value-byte #xFE) ;; 254
+
+ (define (row-terminator-byte? byte) (= row-terminator-byte byte))
+ (define (value-terminator-byte? byte) (= value-terminator-byte byte))
+ (define (null-value-byte? byte) (= null-value-byte byte))
+
+ (define (write-rsv-field field port)
+ (cond
+ ((not field)
+ (write-u8 null-value-byte
+ port))
+ (else
+ (write-bytevector (string->utf8 field)
+ port))))
+
+ (define (write-rsv-row row port)
+ (unless (binary-port? port)
+ (error "Provided port should be a binary port."
+ port))
+
+ (let loop ((row row))
+ (cond
+ ((null? row)
+ (write-u8 row-terminator-byte
+ port))
+ (else
+ (let ((field (car row))
+ (rest-of-fields (cdr row)))
+ (write-rsv-field field port)
+ (write-u8 value-terminator-byte port)
+ (loop rest-of-fields))))))
+
+ (define (write-rsv scm port)
+ "Convert provided SCM, which is a list of lists of strings or null values, into RSV and write it into PORT.
+
+The SCM, the sexp representation of RSV, is defined as:
+
+RSV := ( ROW* )
+ROW := ( STRING-or-NULL-VALUE* )
+STRING-or-NULL-VALUE := String | Null-Value
+Null-Value := #f"
+ (unless (binary-port? port)
+ (error "Expected binary port." port))
+
+ (let loop ((scm scm))
+ (cond
+ ((null? scm) '())
+ (else
+ (let ((row (car scm))
+ (rest-of-rows (cdr scm)))
+ (write-rsv-row row port)
+ (loop rest-of-rows))))))
+
+ (define (legal-utf8? byte)
+ ;; XXX: Replace with a better predicate.
+ (and (integer? byte)
+ (< -1 byte #xF8)))
+
+ (define (legal-rsv? byte)
+ ;; XXX: Same as for legal-utf8?
+ (and (integer? byte)
+ (< -1 byte #x100)))
+
+ (define (read-rsv-string row-count column-count port)
+ "Read a string from PORT.
+
+Return the string just read, and the number of bytes just
+read."
+ (unless (binary-port? port)
+ (error "Expected binary port." port))
+
+ (let ((output-field-port (open-output-bytevector)))
+ (let loop ((column-count column-count))
+ (let ((byte (read-u8 port)))
+ (cond
+ ((eof-object? byte)
+ (error "Prematurely terminated RSV at: (row, column)"
+ row-count
+ column-count))
+ ((not (legal-rsv? byte))
+ (error "Illegal value returned by RSV string reader: (illegal value, row, column)"
+ byte
+ row-count
+ column-count))
+ ((value-terminator-byte? byte)
+ (values (utf8->string (get-output-bytevector output-field-port))
+ row-count
+ column-count))
+ ((legal-utf8? byte)
+ (write-u8 byte
+ output-field-port)
+ (loop (+ column-count 1))))))))
+
+ (define (read-null-value row-count column-count port)
+ ;; `row->scm` had already `peek-u8`-ed and knows that the next
+ ;; `read-u8` will be the Null-Value-Byte, a.k.a. #xFE, so we can
+ ;; remove it without looking at it.
+ (unless (binary-port? port)
+ (error "Expected binary port." port))
+
+ ;; Remove Null-Value-Byte. XXX: Already checked in the
+ ;; procedure calling read-null-value, so it should be okay not
+ ;; to check it, no? Can a time-of-check-time-of-use result when not checking?
+ (let ((byte (read-u8 port)))
+ (cond
+ ((eof-object? byte)
+ (error "Prematurely terminated RSV: (row, column)"
+ row-count
+ column-count))
+ ((not (legal-rsv? byte))
+ (error "Illegal value returned by RSV string reader: (illegal value, row, column)"
+ byte
+ row-count
+ column-count))
+ ((not (null-value-byte? byte))
+ (error "Expected a Null Byte (#xFE), instead got: (unexpected byte, row, column)"
+ byte
+ row-count
+ column-count))))
+
+ (let ((byte (read-u8 port))) ;; Remove value terminator byte.
+ (cond
+ ((eof-object? byte)
+ (error "Prematurely terminated RSV: (row, column)"
+ row-count
+ column-count))
+ ((not (legal-rsv? byte))
+ (error "Expected a Value-Terminator-Byte (#xFF) after a Null Byte (#xFE), instead got illegal value: (illegal value, row, column)"
+ byte
+ row-count
+ column-count))
+ ((value-terminator-byte? byte)
+ ;; Return successfully.
+ (values row-count
+ (+ column-count 2)))
+ (else
+ (error "Expected a Value-Terminator-Byte (#xFF) after a Null Byte (#xFE), instead got illegal value: (illegal value, row, column)"
+ byte
+ row-count
+ column-count)))))
+
+ (define (read-rsv-row row-count column-count port)
+ (unless (binary-port? port)
+ (error "Provided port should be a binary port."
+ port))
+ (let loop ((row '())
+ (row-count row-count)
+ (column-count column-count))
+ (let ((byte (peek-u8 port)))
+ (cond ((eof-object? byte)
+ (error "Prematurely terminated RSV: (row, column)"
+ row-count
+ column-count))
+ ((row-terminator-byte? byte) ;; End of row.
+ (read-u8 port) ;; Remove row terminator.
+ (values (reverse row)
+ (+ row-count 1)
+ 0))
+
+ ((null-value-byte? byte) ;; Field is null.
+ (let-values (((new-row-count new-column-count)
+ (read-null-value row-count column-count port)))
+ (loop (cons #f row)
+ new-row-count
+ new-column-count)))
+
+ ((value-terminator-byte? byte)
+ (read-u8 port)
+ (loop (cons ""
+ row)
+ row-count
+ (+ column-count 1)))
+
+ ((legal-utf8? byte) ;; Field is a string.
+ (let-values (((new-field-value new-row-count new-column-count)
+ (read-rsv-string row-count
+ column-count
+ port)))
+ (loop (cons new-field-value
+ row)
+ new-row-count
+ new-column-count)))
+
+ (else
+ (error "Illegal value returned in read-rsv-row: (illegal value, row, column)"
+ byte
+ row-count
+ column-count))))))
+
+ (define (read-rsv port)
+ (unless (binary-port? port)
+ (error "Provided port should be a binary port."
+ port))
+ (let loop ((rows '())
+ (row-count 0)
+ (column-count 0))
+ (let ((byte (peek-u8 port)))
+ (cond
+ ((eof-object? byte)
+ (reverse rows))
+
+ ((legal-rsv? byte)
+ (let-values (((new-row new-row-count new-column-count)
+ (read-rsv-row row-count column-count port)))
+ (loop (cons new-row rows)
+ new-row-count
+ new-column-count)))
+
+ (else
+ (error "Illegal value returned when reading RSV row: (illegal value, row)"
+ byte
+ row-count))))))))
diff --git a/rsv/arbitrary-null.scm b/rsv/arbitrary-null.scm
@@ -1,225 +0,0 @@
-(define-library (rsv arbitrary-null)
- (import (scheme base)
- (scheme file)
- (scheme write))
- (export write-rsv
- write-rsv-row
- read-rsv
- read-rsv-row
- legal-rsv?)
-
- (begin
- (define row-terminator-byte #xFD) ;; 253
- (define value-terminator-byte #xFF) ;; 255
- (define null-value-byte #xFE) ;; 254
-
- (define (row-terminator-byte? byte) (= row-terminator-byte byte))
- (define (value-terminator-byte? byte) (= value-terminator-byte byte))
- (define (null-value-byte? byte) (= null-value-byte byte))
-
- (define (write-rsv-field field port)
- (cond
- ((not field)
- (write-u8 null-value-byte
- port))
- (else
- (write-bytevector (string->utf8 field)
- port))))
-
- (define (write-rsv-row row port)
- (unless (binary-port? port)
- (error "Provided port should be a binary port."
- port))
-
- (let loop ((row row))
- (cond
- ((null? row)
- (write-u8 row-terminator-byte
- port))
- (else
- (let ((field (car row))
- (rest-of-fields (cdr row)))
- (write-rsv-field field port)
- (write-u8 value-terminator-byte port)
- (loop rest-of-fields))))))
-
- (define (write-rsv scm port)
- "Convert provided SCM, which is a list of lists of strings or null values, into RSV and write it into PORT.
-
-The SCM, the sexp representation of RSV, is defined as:
-
-RSV := ( ROW* )
-ROW := ( STRING-or-NULL-VALUE* )
-STRING-or-NULL-VALUE := String | Null-Value
-Null-Value := #f"
- (unless (binary-port? port)
- (error "Expected binary port." port))
-
- (let loop ((scm scm))
- (cond
- ((null? scm) '())
- (else
- (let ((row (car scm))
- (rest-of-rows (cdr scm)))
- (write-rsv-row row port)
- (loop rest-of-rows))))))
-
- (define (legal-utf8? byte)
- ;; XXX: Replace with a better predicate.
- (and (integer? byte)
- (< -1 byte #xF8)))
-
- (define (legal-rsv? byte)
- ;; XXX: Same as for legal-utf8?
- (and (integer? byte)
- (< -1 byte #x100)))
-
- (define (read-rsv-string row-count column-count port)
- "Read a string from PORT.
-
-Return the string just read, and the number of bytes just
-read."
- (unless (binary-port? port)
- (error "Expected binary port." port))
-
- (let ((output-field-port (open-output-bytevector)))
- (let loop ((column-count column-count))
- (let ((byte (read-u8 port)))
- (cond
- ((eof-object? byte)
- (error "Prematurely terminated RSV at: (row, column)"
- row-count
- column-count))
- ((not (legal-rsv? byte))
- (error "Illegal value returned by RSV string reader: (illegal value, row, column)"
- byte
- row-count
- column-count))
- ((value-terminator-byte? byte)
- (values (utf8->string (get-output-bytevector output-field-port))
- row-count
- column-count))
- ((legal-utf8? byte)
- (write-u8 byte
- output-field-port)
- (loop (+ column-count 1))))))))
-
- (define (read-null-value row-count column-count port)
- ;; `row->scm` had already `peek-u8`-ed and knows that the next
- ;; `read-u8` will be the Null-Value-Byte, a.k.a. #xFE, so we can
- ;; remove it without looking at it.
- (unless (binary-port? port)
- (error "Expected binary port." port))
-
- ;; Remove Null-Value-Byte. XXX: Already checked in the
- ;; procedure calling read-null-value, so it should be okay not
- ;; to check it, no? Can a time-of-check-time-of-use result when not checking?
- (let ((byte (read-u8 port)))
- (cond
- ((eof-object? byte)
- (error "Prematurely terminated RSV: (row, column)"
- row-count
- column-count))
- ((not (legal-rsv? byte))
- (error "Illegal value returned by RSV string reader: (illegal value, row, column)"
- byte
- row-count
- column-count))
- ((not (null-value-byte? byte))
- (error "Expected a Null Byte (#xFE), instead got: (unexpected byte, row, column)"
- byte
- row-count
- column-count))))
-
- (let ((byte (read-u8 port))) ;; Remove value terminator byte.
- (cond
- ((eof-object? byte)
- (error "Prematurely terminated RSV: (row, column)"
- row-count
- column-count))
- ((not (legal-rsv? byte))
- (error "Expected a Value-Terminator-Byte (#xFF) after a Null Byte (#xFE), instead got illegal value: (illegal value, row, column)"
- byte
- row-count
- column-count))
- ((value-terminator-byte? byte)
- ;; Return successfully.
- (values row-count
- (+ column-count 2)))
- (else
- (error "Expected a Value-Terminator-Byte (#xFF) after a Null Byte (#xFE), instead got illegal value: (illegal value, row, column)"
- byte
- row-count
- column-count)))))
-
- (define (read-rsv-row row-count column-count port)
- (unless (binary-port? port)
- (error "Provided port should be a binary port."
- port))
- (let loop ((row '())
- (row-count row-count)
- (column-count column-count))
- (let ((byte (peek-u8 port)))
- (cond ((eof-object? byte)
- (error "Prematurely terminated RSV: (row, column)"
- row-count
- column-count))
- ((row-terminator-byte? byte) ;; End of row.
- (read-u8 port) ;; Remove row terminator.
- (values (reverse row)
- (+ row-count 1)
- 0))
-
- ((null-value-byte? byte) ;; Field is null.
- (let-values (((new-row-count new-column-count)
- (read-null-value row-count column-count port)))
- (loop (cons #f row)
- new-row-count
- new-column-count)))
-
- ((value-terminator-byte? byte)
- (read-u8 port)
- (loop (cons ""
- row)
- row-count
- (+ column-count 1)))
-
- ((legal-utf8? byte) ;; Field is a string.
- (let-values (((new-field-value new-row-count new-column-count)
- (read-rsv-string row-count
- column-count
- port)))
- (loop (cons new-field-value
- row)
- new-row-count
- new-column-count)))
-
- (else
- (error "Illegal value returned in read-rsv-row: (illegal value, row, column)"
- byte
- row-count
- column-count))))))
-
- (define (read-rsv port)
- (unless (binary-port? port)
- (error "Provided port should be a binary port."
- port))
- (let loop ((rows '())
- (row-count 0)
- (column-count 0))
- (let ((byte (peek-u8 port)))
- (cond
- ((eof-object? byte)
- (reverse rows))
-
- ((legal-rsv? byte)
- (let-values (((new-row new-row-count new-column-count)
- (read-rsv-row row-count column-count port)))
- (loop (cons new-row rows)
- new-row-count
- new-column-count)))
-
- (else
- (error "Illegal value returned when reading RSV row: (illegal value, row)"
- byte
- row-count))))))))
