commit bd35a5c9e3e4d0666e645bd3a8026f46c9663496
parent ed35cf9e0003fe63eedae10821a579914f10a3c7
Author: Yuval Langer <yuval.langer@gmail.com>
Date: Fri, 12 Jan 2024 05:37:58 +0200
Switch from using match forms to cond forms, and from immutable records (srfi srfi-9 gnu) to regular records (srfi srfi-9).
Diffstat:
3 files changed, 148 insertions(+), 136 deletions(-)
diff --git a/rsv/arbitrary-null.scm b/rsv/arbitrary-null.scm
@@ -3,8 +3,6 @@
(scheme file)
(scheme write)
- (ice-9 match)
-
(rsv read-position))
(export scm->rsv
rsv->scm
@@ -20,24 +18,26 @@
(define (null-value-byte? byte) (= null-value-byte byte))
(define (field->rsv field null-value port)
- (match field
- ((? (lambda (field) (equal? null-value field)))
- (write-u8 null-value-byte
- port))
- (field
- (write-bytevector (string->utf8 field)
- port))))
+ (cond
+ ((equal? null-value field)
+ (write-u8 null-value-byte
+ port))
+ (else
+ (write-bytevector (string->utf8 field)
+ port))))
(define (row->rsv row null-value port)
(let loop ((row row))
- (match row
- (()
- (write-u8 row-terminator-byte
- port))
- ((field fields ...)
- (field->rsv field null-value port)
- (write-u8 value-terminator-byte port)
- (loop fields)))))
+ (cond
+ ((null? row)
+ (write-u8 row-terminator-byte
+ port))
+ (else
+ (let ((field (car row))
+ (rest-of-fields (cdr row)))
+ (field->rsv field null-value port)
+ (write-u8 value-terminator-byte port)
+ (loop rest-of-fields))))))
(define (scm->rsv scm null-value port)
"Convert provided SCM, which is a list of lists of strings or null values, into RSV and write it into PORT.
@@ -49,11 +49,13 @@ ROW := ( STRING-or-NULL-VALUE* )
STRING-or-NULL-VALUE := String | Null-Value
Null-Value := The value provided as NULL-VALUE"
(let loop ((scm scm))
- (match scm
- (() '())
- ((row rows ...)
- (row->rsv row null-value port)
- (loop rows)))))
+ (cond
+ ((null? scm) '())
+ (else
+ (let ((row (car scm))
+ (rest-of-rows (cdr scm)))
+ (row->rsv row null-value port)
+ (loop rest-of-rows))))))
(define (legal-utf8? byte)
;; XXX: Replace with a better predicate.
@@ -72,113 +74,116 @@ Return the string just read, and the number of bytes just
read."
(let ((output-field-port (open-output-bytevector)))
(let loop ((position position))
- (match (read-u8 port)
- ((? eof-object?)
- (error (string-append "Prematurely terminated RSV at row "
- (number->string (position-row position))
- " at an offset of "
- (number->string (position-column position))
- " from the beginning of the last RSV row.")))
- ((? value-terminator-byte?)
- (values (utf8->string (get-output-bytevector output-field-port))
- (add-position-column position 1)))
- ((? legal-utf8? byte)
- (write-u8 byte
- output-field-port)
- (loop (add-position-column position 1)))
- (illegal-value
- (error "Illegal value returned by RSV string reader:"
- illegal-value))))))
+ (let ((byte (read-u8 port)))
+ (cond
+ ((eof-object? byte)
+ (error (string-append "Prematurely terminated RSV at row "
+ (number->string (position-row position))
+ " at an offset of "
+ (number->string (position-column position))
+ " from the beginning of the last RSV row.")))
+ ((value-terminator-byte? byte)
+ (values (utf8->string (get-output-bytevector output-field-port))
+ (add-position-column position 1)))
+ ((legal-utf8? byte)
+ (write-u8 byte
+ output-field-port)
+ (loop (add-position-column position 1)))
+ (else
+ (error "Illegal value returned by RSV string reader:"
+ byte)))))))
(define (read-null-value position null-value 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.
(read-u8 port)
- (match (read-u8 port) ;; remove value terminator byte.
- ((? value-terminator-byte?)
- ;; Return successfully.
- (values null-value
- (add-position-column position 2)))
- ((? number? byte)
- ;; If we've read any other byte following a null byte, we
- ;; raise an error.
- (error (string-append "Expected a Value-Terminator-Byte (#xFF) after"
- " a Null Byte (#xFE) at row "
- (number->string (position-row position))
- " at an offset of "
- (number->string (position-column position))
- " from the beggining of the last RSV row, instead got: "
- (number->string byte))))
- (illegal-value
- (error (string-append "Expected a Value-Terminator-Byte (#xFF) after"
- " a Null Byte (#xFE) at row "
- (number->string (position-row position))
- " at an offset of "
- (number->string (position-column position))
- " from the beggining of the last RSV row, instead got illegal value:")
- illegal-value))))
+ (let ((byte (read-u8 port))) ;; remove value terminator byte.
+ (cond
+ ((value-terminator-byte? byte)
+ ;; Return successfully.
+ (values null-value
+ (add-position-column position 2)))
+ ((number? byte)
+ ;; If we've read any other byte following a null byte, we
+ ;; raise an error.
+ (error (string-append "Expected a Value-Terminator-Byte (#xFF) after"
+ " a Null Byte (#xFE) at row "
+ (number->string (position-row position))
+ " at an offset of "
+ (number->string (position-column position))
+ " from the beggining of the last RSV row, instead got: "
+ (number->string byte))))
+ (else
+ (error (string-append "Expected a Value-Terminator-Byte (#xFF) after"
+ " a Null Byte (#xFE) at row "
+ (number->string (position-row position))
+ " at an offset of "
+ (number->string (position-column position))
+ " from the beggining of the last RSV row, instead got illegal value:")
+ byte)))))
(define (row->scm null-value position port)
(let loop ((row '())
(position position))
- (match (peek-u8 port)
- ((? eof-object?)
- (error (string-append "Prematurely terminated RSV at row "
- (number->string (position-row position))
- " at an offset of "
- (number->string (position-column position))
- " from the beginning of the last RSV row.")))
- ((? row-terminator-byte?) ;; End of row.
- (read-u8 port) ;; Remove row terminator.
- (values (reverse row)
- (add-position-row (set-position-column position 0)
- 1)))
-
- ((? null-value-byte?) ;; Field is null.
- (let-values (((new-field-value new-position)
- (read-null-value position null-value port)))
- (loop (cons new-field-value
- row)
- new-position)))
-
- ((? value-terminator-byte?)
- (read-u8 port)
- (loop (cons ""
- row)
- (add-position-column position 1)))
-
- ((? legal-utf8? byte) ;; Field is a string.
- (let-values (((new-field-value new-position)
- (string->scm position
- port)))
- (loop (cons new-field-value
- row)
- new-position)))
-
- (illegal-value
- (error (string-append "Illegal value returned in row->scm when reading RSV row "
- (number->string (position-row position))
- " at offset of "
- (number->string (position-column position))
- " bytes by row reader:")
- illegal-value)))))
+ (let ((byte (peek-u8 port)))
+ (cond ((eof-object? byte)
+ (error (string-append "Prematurely terminated RSV at row "
+ (number->string (position-row position))
+ " at an offset of "
+ (number->string (position-column position))
+ " from the beginning of the last RSV row.")))
+ ((row-terminator-byte? byte) ;; End of row.
+ (read-u8 port) ;; Remove row terminator.
+ (values (reverse row)
+ (add-position-row (set-position-column position 0)
+ 1)))
+
+ ((null-value-byte? byte) ;; Field is null.
+ (let-values (((new-field-value new-position)
+ (read-null-value position null-value port)))
+ (loop (cons new-field-value
+ row)
+ new-position)))
+
+ ((value-terminator-byte? byte)
+ (read-u8 port)
+ (loop (cons ""
+ row)
+ (add-position-column position 1)))
+
+ ((legal-utf8? byte) ;; Field is a string.
+ (let-values (((new-field-value new-position)
+ (string->scm position
+ port)))
+ (loop (cons new-field-value
+ row)
+ new-position)))
+
+ (else
+ (error (string-append "Illegal value returned in row->scm when reading RSV row "
+ (number->string (position-row position))
+ " at offset of "
+ (number->string (position-column position))
+ " bytes by row reader:")
+ byte))))))
(define (rsv->scm null-value port)
(let loop ((rows '())
(position (make-position 0 0)))
- (match (peek-u8 port)
- ((? eof-object?)
- (reverse rows))
-
- ((? legal-rsv?)
- (let-values (((new-row new-position)
- (row->scm null-value position port)))
- (loop (cons new-row rows)
- new-position)))
-
- (illegal-value
- (error (string-append "Illegal value returned when reading RSV row "
- (number->string (position-row position))
- ":")
- illegal-value)))))))
+ (let ((byte (peek-u8 port)))
+ (cond
+ ((eof-object? byte)
+ (reverse rows))
+
+ ((legal-rsv? byte)
+ (let-values (((new-row new-position)
+ (row->scm null-value position port)))
+ (loop (cons new-row rows)
+ new-position)))
+
+ (else
+ (error (string-append "Illegal value returned when reading RSV row "
+ (number->string (position-row position))
+ ":")
+ byte))))))))
diff --git a/rsv/read-position.scm b/rsv/read-position.scm
@@ -1,6 +1,6 @@
(define-library (rsv read-position)
(import (scheme base)
- (srfi srfi-9 gnu))
+ (srfi srfi-9))
(export make-position
position-row
position-column
@@ -10,11 +10,21 @@
set-position-column)
(begin
- (define-immutable-record-type <position>
+ (define-record-type <position>
(make-position row column)
position?
- (row position-row set-position-row)
- (column position-column set-position-column))
+ (row position-row)
+ (column position-column))
+
+ (define (set-position-row position n)
+ (make-position (+ (position-row position)
+ n)
+ (position-column position)))
+
+ (define (set-position-column position n)
+ (make-position (position-row position)
+ (+ (position-column position)
+ n)))
(define (add-position-row position n)
"Add N to POSITION's row count."
@@ -30,6 +40,5 @@
(define (add-position-row-column position n m)
"Add N to POSITION's row count and M to its column count."
- (set-fields position
- ((position-row) (add-position-row position n))
- ((position-column) (add-position-column position m))))))
+ (make-position (add-position-row position n)
+ (add-position-column position m)))))
diff --git a/tests.scm b/tests.scm
@@ -6,8 +6,6 @@
(srfi srfi-1)
(srfi srfi-64)
- (ice-9 match)
-
(rsv arbitrary-null))
(begin
@@ -23,7 +21,6 @@
".rsv"))
(iota 70 10))))
- #;
(define invalid-filenames
(append (map (lambda (n)
(string-append "TestFiles/Invalid_00"
@@ -39,14 +36,15 @@
(define (get-bytevector-all port)
(let ((output-bytevector-port (open-output-bytevector)))
(let loop ()
- (match (read-u8 port)
- ((? eof-object?)
- (get-output-bytevector output-bytevector-port))
- ((? number? byte)
- (write-u8 byte output-bytevector-port)
- (loop))
- (illegal-value
- (error "Illegal value while reading file:" illegal-value))))))
+ (let ((byte (read-u8 port)))
+ (cond
+ ((eof-object? byte)
+ (get-output-bytevector output-bytevector-port))
+ ((number? byte)
+ (write-u8 byte output-bytevector-port)
+ (loop))
+ (else
+ (error "Illegal value while reading file:" byte)))))))
(define (run-back-and-forth-test)
(let* ((file-contents (get-bytevector-all (current-input-port)))
