commit be30bc942bdeb6c04bb81abeddd9b03524b40b8c
parent b7c2142e00d1999edb20778e18d60ae487978f47
Author: Yuval Langer <yuval.langer@gmail.com>
Date: Tue, 9 Jan 2024 23:46:05 +0200
Add rsv2scm and scm2rsv commands. Use the (rsv) library to import the (rsv arbitrary-null) library. I do not know if it is an okay directory layout.
Diffstat:
4 files changed, 36 insertions(+), 91 deletions(-)
diff --git a/rsv.scm b/rsv.scm
@@ -1,91 +1,5 @@
(define-library (rsv)
(import (scheme base)
- (scheme file)
- (scheme write)
- (ice-9 match))
+ (rsv arbitrary-null))
(export scm->rsv
- rsv->scm
- main)
-
- (begin
- (define ROW-TERMINATOR-BYTE 253)
- (define VALUE-TERMINATOR-BYTE 255)
- (define NULL-VALUE-BYTE 254)
-
- (define (scm->rsv scm port)
- (match scm
- (()
- (write-u8 ROW-TERMINATOR-BYTE
- port))
- ((() rows ...)
- (write-u8 ROW-TERMINATOR-BYTE
- port)
- (scm->rsv rows
- port))
- (((#f fields ...) rows ...)
- (write-u8 NULL-VALUE-BYTE
- port)
- (write-u8 VALUE-TERMINATOR-BYTE
- port)
- (scm->rsv (cons fields rows)
- port))
- (((field fields ...) rows ...)
- (write-bytevector (string->utf8 field)
- port)
- (write-u8 VALUE-TERMINATOR-BYTE
- port)
- (scm->rsv (cons fields rows)
- port))))
-
- (define (rsv->scm port)
- (let loop ((rows '())
- (current-row '())
- (current-field #u8()))
- (match (read-u8 port)
- ;; End of file:
- ((? eof-object?)
- (reverse rows))
-
- ;; Value Terminator Byte:
- (255
- (if current-field
- (loop rows
- (cons (utf8->string current-field)
- current-row)
- #u8())
- (loop rows
- (cons #f
- current-row)
- #u8())))
-
- ;; Null Value Byte:
- (254
- (loop rows
- current-row
- #f))
-
- ;; Row Terminator Byte:
- (253
- (loop (cons (reverse current-row)
- rows)
- '()
- #u8()))
-
- ;; Any byte:
- (some-byte
- (loop rows
- current-row
- (bytevector-append current-field
- (make-bytevector 1 some-byte)))))))
-
- (define (main args)
- (let ((our-scm '(("blah" "blah" #f "moo")
- ("asdf" "fdsaa" #f "asdfsd" "asdf")
- ()
- (#f #f))))
- (call-with-output-file "poop.rsv"
- (lambda (port)
- (scm->rsv our-scm port)))
- (call-with-input-file "poop.rsv"
- (lambda (port)
- (display (rsv->scm port))))))))
+ rsv->scm))
diff --git a/rsv/arbitrary-null.scm b/rsv/arbitrary-null.scm
@@ -8,9 +8,9 @@
main)
(begin
- (define ROW-TERMINATOR-BYTE 253)
- (define VALUE-TERMINATOR-BYTE 255)
- (define NULL-VALUE-BYTE 254)
+ (define ROW-TERMINATOR-BYTE 253) ;; 0xFD
+ (define VALUE-TERMINATOR-BYTE 255) ;; 0xFF
+ (define NULL-VALUE-BYTE 254) ;; 0xFE
(define (row-terminator-byte? byte) (= ROW-TERMINATOR-BYTE byte))
(define (value-terminator-byte? byte) (= VALUE-TERMINATOR-BYTE byte))
diff --git a/rsv2scm b/rsv2scm
@@ -0,0 +1,14 @@
+#!/usr/bin/guile \
+--r7rs -e main -L . -s
+!#
+(import (scheme base)
+ (scheme file)
+ (scheme write)
+ (ice-9 match)
+ (rsv))
+
+(define (main args)
+ (match args
+ ((arg0)
+ (write (rsv->scm #f (current-input-port)))
+ (newline))))
diff --git a/scm2rsv b/scm2rsv
@@ -0,0 +1,17 @@
+#!/usr/bin/guile \
+--r7rs -e main -L . -s
+!#
+(import (scheme base)
+ (scheme file)
+ (scheme write)
+ (ice-9 match)
+ (ice-9 pretty-print)
+ (rsv))
+
+(define (main args)
+ (match args
+ ((arg0)
+ (let ((scm (read (current-input-port))))
+ (scm->rsv scm
+ not
+ (current-output-port))))))
