table-rw2

Table reader / writer

(ac-scheme (begin

  ; recursive table reads don't seem to work unless this code
  ; is in a module; I have no idea why

  (module table-reader mzscheme

    (define ac-niltree (namespace-variable-value 'ac-niltree))
    (define skip-whitespace (namespace-variable-value 'skip-whitespace))

    (define (readnil port)
      (ac-niltree (read port)))

    (define (parse-table-items 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)
               (parse-table-items port a)))))

    (define (parse-table ch port src line col pos)
      (parse-table-items port (make-hash-table 'equal)))

    (current-readtable
     (make-readtable (current-readtable)
                     #\{
                     'non-terminating-macro parse-table)))

  (require 'table-reader)))

; need the errsafe on type tests because (type x) croaks on
; non-Arc types

(extend ac-literal (x) (errsafe:isa x 'table)
  scheme-t)

(= scheme-disp  (ac-scheme display))
(= scheme-write (ac-scheme write))

(def print-table (f x s)
  (scheme-disp "{" s)
  (between (k v) x (scheme-disp " " s)
    (write k s)
    (scheme-disp " " s)
    (write v s))
  (scheme-disp "}" s))
 
(def print-cdr (f x s)
  (if (no x)
       (scheme-disp ")" s)
      (errsafe:acons x)
       (do (scheme-disp " " s)
           (print f (car x) s)
         (print-cdr f (cdr x) s))
       (do (scheme-disp " . " s)
           (print f x s)
         (scheme-disp ")" s))))

(def print (f x s)
  (if (errsafe:acons x)
       (do (scheme-disp "(" s)
           (print f (car x) s)
           (print-cdr f (cdr x) s))
      (errsafe:isa x 'table)
       (print-table f x s)
       (f x s)))

(def disp (x (o s (stdout)))
  (print scheme-disp x s))

(def write (x (o s (stdout)))
  (print scheme-write x s))

Examples

arc> (obj a (list 1 2 (obj b 3) 4))
{a (1 2 {b 3} 4)}

arc> ({a (1 2 {b 3} 4)} 'a)
(1 2 {b 3} 4)

arc> (let x {a 1}
       (= x!a 2)
       x)
{a 2}

arc> (w/outstring s (write {a (1 2 "foo" #\A . 3)} s) (inside s))
"{a (1 2 \"foo\" #\\A . 3)}"

Get this hack

Using the hackinator:

$ hack \
    ycombinator.com/arc/arc3.1.tar \
    awwx.ws/ac0.patch \
    awwx.ws/ac1.arc \
    awwx.ws/defarc0.patch \
    awwx.ws/defarc-literal0.patch \
    awwx.ws/arc-write0.patch \
    awwx.ws/extend0.arc \
    awwx.ws/between0.arc \
    awwx.ws/skipwhite0.arc \
    awwx.ws/table-rw2.arc

unLicense

This code is in the public domain.

Contact me