table-reader-writer1.patch
diff --git a/ac.scm b/ac.scm index bf60ead..fa674ce 100644 --- a/ac.scm +++ b/ac.scm @@ -39,7 +39,8 @@ (char? x) (string? x) (number? x) - (eq? x '()))) + (eq? x '()) + (hash-table? x))) (define (ssyntax? x) (and (symbol? x) @@ -866,6 +867,18 @@ (current-output-port))) b)) +(define (print-table f port x) + (display "{" port) + (let ((first #t)) + (hash-table-for-each x + (lambda (k v) + (if (not first) (display " " port)) + (print* f port k) + (display " " port) + (print* f port v) + (set! first #f)))) + (display "}" port)) + (define (print* f port x) (define (print x) @@ -873,6 +886,8 @@ (display "(" port) (print (car x)) (print-cdr (cdr x))) + ((hash-table? x) + (print-table f port x)) (#t (f x port)))) diff --git a/as.scm b/as.scm index 409a9fa..4619e92 100644 --- a/as.scm +++ b/as.scm @@ -8,6 +8,8 @@ (require "ac.scm") (require "brackets.scm") (use-bracket-readtable) +(require "readtable.scm") +(use-table-readtable) (aload "arc.arc") (aload "libs.arc") diff --git a/readtable.scm b/readtable.scm new file mode 100644 index 0000000..d52d793 --- /dev/null +++ b/readtable.scm @@ -0,0 +1,41 @@ +; By catdancer, cat@catdancer.ws +; This code is in the public domain, except for +; the copy of ac-niltree, which is a part of Arc. + +(module readtable mzscheme + +(require "skipwhite.scm") + +; need a copy of ac-niltree as long as the reader reads +; MzScheme lists instead of Arc lists + +(define (ac-niltree x) + (cond ((pair? x) (cons (ac-niltree (car x)) (ac-niltree (cdr x)))) + ((or (eq? x #f) (eq? x '())) 'nil) + (#t x))) + +(define (readnil port) + (ac-niltree (read port))) + +(define (slurp port a) + (skip-whitespace port) + (if (eq? (peek-char port) #\}) + (begin (read-char port) + a) + (let ((k (readnil port))) + (let ((v (readnil port))) + (hash-table-put! a k v) + (slurp port a))))) + +(define (parse-table ch port src line col pos) + (slurp port (make-hash-table 'equal))) + +(define (table-readtable) + (make-readtable (current-readtable) #\{ 'non-terminating-macro parse-table)) + +(provide use-table-readtable) + +(define (use-table-readtable) + (current-readtable (table-readtable))) + +) diff --git a/skipwhite.scm b/skipwhite.scm new file mode 100644 index 0000000..dac91f3 --- /dev/null +++ b/skipwhite.scm @@ -0,0 +1,31 @@ +; place in own library to abide by the LGPL +; +; skip-whitespace is copied from +; http://download.plt-scheme.org/doc/352/html/mzscheme/mzscheme-Z-H-11.html#node_sec_11.2.8 +; which has the following licence: +; +; Copyright ©1995-2006 Matthew Flatt +; +; Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Library General Public License, Version 2 published by the Free Software Foundation. +; +; [ ] in source changed to ( ) to avoid conflict with brackets.scm + +(module skipwhite mzscheme + +(provide skip-whitespace) + +(define (skip-whitespace port) + ;; Skips whitespace characters, sensitive to the current + ;; readtable's definition of whitespace + (let ((ch (peek-char port))) + (unless (eof-object? ch) + ;; Consult current readtable: + (let-values (((like-ch/sym proc dispatch-proc) + (readtable-mapping (current-readtable) ch))) + ;; If like-ch/sym is whitespace, then ch is whitespace + (when (and (char? like-ch/sym) + (char-whitespace? like-ch/sym)) + (read-char port) + (skip-whitespace port)))))) + +)
This patch to Arc adds a reader and writer for Arc tables so that they are printed out in a way that they can be read back in.
The syntax is an unstructured list of keys and values within curly braces:
arc> (obj "Boston" 'bos "San Francisco" 'sfo "Paris" 'cdg)
{"San Francisco" sfo "Paris" cdg "Boston" bos}
arc> {"San Francisco" sfo "Paris" cdg "Boston" bos}
{"San Francisco" sfo "Paris" cdg "Boston" bos}Unlike tables read using MzScheme’s #hash((...)) syntax, tables read in by this reader can be modified.
wget http://ycombinator.com/arc/arc3.tar tar xf arc3.tar cd arc3 wget -O - http://hacks.catdancer.ws/list-writer1.patch | patch wget -O - http://hacks.catdancer.ws/table-reader-writer1.patch | patch