arbitrary-null.scm (8155B)
1 (define-library (rsv arbitrary-null) 2 (import (scheme base) 3 (scheme file) 4 (scheme write)) 5 (export write-rsv 6 write-rsv-row 7 read-rsv 8 read-rsv-row 9 legal-rsv?) 10 11 (begin 12 (define row-terminator-byte #xFD) ;; 253 13 (define value-terminator-byte #xFF) ;; 255 14 (define null-value-byte #xFE) ;; 254 15 16 (define (row-terminator-byte? byte) (= row-terminator-byte byte)) 17 (define (value-terminator-byte? byte) (= value-terminator-byte byte)) 18 (define (null-value-byte? byte) (= null-value-byte byte)) 19 20 (define (write-rsv-field field port) 21 (cond 22 ((not field) 23 (write-u8 null-value-byte 24 port)) 25 (else 26 (write-bytevector (string->utf8 field) 27 port)))) 28 29 (define (write-rsv-row row port) 30 (unless (binary-port? port) 31 (error "Provided port should be a binary port." 32 port)) 33 34 (let loop ((row row)) 35 (cond 36 ((null? row) 37 (write-u8 row-terminator-byte 38 port)) 39 (else 40 (let ((field (car row)) 41 (rest-of-fields (cdr row))) 42 (write-rsv-field field port) 43 (write-u8 value-terminator-byte port) 44 (loop rest-of-fields)))))) 45 46 (define (write-rsv scm port) 47 "Convert provided SCM, which is a list of lists of strings or null values, into RSV and write it into PORT. 48 49 The SCM, the sexp representation of RSV, is defined as: 50 51 RSV := ( ROW* ) 52 ROW := ( STRING-or-NULL-VALUE* ) 53 STRING-or-NULL-VALUE := String | Null-Value 54 Null-Value := #f" 55 (unless (binary-port? port) 56 (error "Expected binary port." port)) 57 58 (let loop ((scm scm)) 59 (cond 60 ((null? scm) '()) 61 (else 62 (let ((row (car scm)) 63 (rest-of-rows (cdr scm))) 64 (write-rsv-row row port) 65 (loop rest-of-rows)))))) 66 67 (define (legal-utf8? byte) 68 ;; XXX: Replace with a better predicate. 69 (and (integer? byte) 70 (< -1 byte #xF8))) 71 72 (define (legal-rsv? byte) 73 ;; XXX: Same as for legal-utf8? 74 (and (integer? byte) 75 (< -1 byte #x100))) 76 77 (define (read-rsv-string row-count column-count port) 78 "Read a string from PORT. 79 80 Return the string just read, and the number of bytes just 81 read." 82 (unless (binary-port? port) 83 (error "Expected binary port." port)) 84 85 (let ((output-field-port (open-output-bytevector))) 86 (let loop ((column-count column-count)) 87 (let ((byte (read-u8 port))) 88 (cond 89 ((eof-object? byte) 90 (error "Prematurely terminated RSV at: (row, column)" 91 row-count 92 column-count)) 93 ((not (legal-rsv? byte)) 94 (error "Illegal value returned by RSV string reader: (illegal value, row, column)" 95 byte 96 row-count 97 column-count)) 98 ((value-terminator-byte? byte) 99 (values (utf8->string (get-output-bytevector output-field-port)) 100 row-count 101 column-count)) 102 ((legal-utf8? byte) 103 (write-u8 byte 104 output-field-port) 105 (loop (+ column-count 1)))))))) 106 107 (define (read-null-value row-count column-count port) 108 ;; `row->scm` had already `peek-u8`-ed and knows that the next 109 ;; `read-u8` will be the Null-Value-Byte, a.k.a. #xFE, so we can 110 ;; remove it without looking at it. 111 (unless (binary-port? port) 112 (error "Expected binary port." port)) 113 114 ;; Remove Null-Value-Byte. XXX: Already checked in the 115 ;; procedure calling read-null-value, so it should be okay not 116 ;; to check it, no? Can a time-of-check-time-of-use result when not checking? 117 (let ((byte (read-u8 port))) 118 (cond 119 ((eof-object? byte) 120 (error "Prematurely terminated RSV: (row, column)" 121 row-count 122 column-count)) 123 ((not (legal-rsv? byte)) 124 (error "Illegal value returned by RSV string reader: (illegal value, row, column)" 125 byte 126 row-count 127 column-count)) 128 ((not (null-value-byte? byte)) 129 (error "Expected a Null Byte (#xFE), instead got: (unexpected byte, row, column)" 130 byte 131 row-count 132 column-count)))) 133 134 (let ((byte (read-u8 port))) ;; Remove value terminator byte. 135 (cond 136 ((eof-object? byte) 137 (error "Prematurely terminated RSV: (row, column)" 138 row-count 139 column-count)) 140 ((not (legal-rsv? byte)) 141 (error "Expected a Value-Terminator-Byte (#xFF) after a Null Byte (#xFE), instead got illegal value: (illegal value, row, column)" 142 byte 143 row-count 144 column-count)) 145 ((value-terminator-byte? byte) 146 ;; Return successfully. 147 (values row-count 148 (+ column-count 2))) 149 (else 150 (error "Expected a Value-Terminator-Byte (#xFF) after a Null Byte (#xFE), instead got illegal value: (illegal value, row, column)" 151 byte 152 row-count 153 column-count))))) 154 155 (define (read-rsv-row row-count column-count port) 156 (unless (binary-port? port) 157 (error "Provided port should be a binary port." 158 port)) 159 (let loop ((row '()) 160 (row-count row-count) 161 (column-count column-count)) 162 (let ((byte (peek-u8 port))) 163 (cond ((eof-object? byte) 164 (error "Prematurely terminated RSV: (row, column)" 165 row-count 166 column-count)) 167 ((row-terminator-byte? byte) ;; End of row. 168 (read-u8 port) ;; Remove row terminator. 169 (values (reverse row) 170 (+ row-count 1) 171 0)) 172 173 ((null-value-byte? byte) ;; Field is null. 174 (let-values (((new-row-count new-column-count) 175 (read-null-value row-count column-count port))) 176 (loop (cons #f row) 177 new-row-count 178 new-column-count))) 179 180 ((value-terminator-byte? byte) 181 (read-u8 port) 182 (loop (cons "" 183 row) 184 row-count 185 (+ column-count 1))) 186 187 ((legal-utf8? byte) ;; Field is a string. 188 (let-values (((new-field-value new-row-count new-column-count) 189 (read-rsv-string row-count 190 column-count 191 port))) 192 (loop (cons new-field-value 193 row) 194 new-row-count 195 new-column-count))) 196 197 (else 198 (error "Illegal value returned in read-rsv-row: (illegal value, row, column)" 199 byte 200 row-count 201 column-count)))))) 202 203 (define (read-rsv port) 204 (unless (binary-port? port) 205 (error "Provided port should be a binary port." 206 port)) 207 (let loop ((rows '()) 208 (row-count 0) 209 (column-count 0)) 210 (let ((byte (peek-u8 port))) 211 (cond 212 ((eof-object? byte) 213 (reverse rows)) 214 215 ((legal-rsv? byte) 216 (let-values (((new-row new-row-count new-column-count) 217 (read-rsv-row row-count column-count port))) 218 (loop (cons new-row rows) 219 new-row-count 220 new-column-count))) 221 222 (else 223 (error "Illegal value returned when reading RSV row: (illegal value, row)" 224 byte 225 row-count))))))))