/table-rw.arc

http://github.com/alimoeeny/arc · Unknown · 59 lines · 49 code · 10 blank · 0 comment · 0 complexity · 35df51a7507f01db9b4b57f30ea4d724 MD5 · raw file

  1. ; taken from http://awwx.ws/table-rw3.arc with slight modifications
  2. ; - Mark Huetsch
  3. (load "lib/extend.arc")
  4. (load "lib/scheme.arc")
  5. (load "lib/util.arc")
  6. (load "lib/skipwhite.arc")
  7. (def parse-table-items (port (o acc (table)))
  8. (scheme.skip-whitespace port)
  9. (if (is (peekc port) #\})
  10. (do (readc port) acc)
  11. (with (k (read port)
  12. v (read port))
  13. (= (acc k) v)
  14. (parse-table-items port acc))))
  15. (extend-readtable #\{ parse-table-items)
  16. ; need the errsafe on type tests because (type x) croaks on
  17. ; non-Arc types
  18. (extend ac-literal (x) (errsafe:isa x 'table)
  19. scheme-t)
  20. (def print-table (f x s)
  21. (scheme.display "{" s)
  22. (between (k v) x (scheme.display " " s)
  23. (write k s)
  24. (scheme.display " " s)
  25. (write v s))
  26. (scheme.display "}" s))
  27. (def print-cdr (f x s)
  28. (if (no x)
  29. (scheme.display ")" s)
  30. (errsafe:acons x)
  31. (do (scheme.display " " s)
  32. (print f (car x) s)
  33. (print-cdr f (cdr x) s))
  34. (do (scheme.display " . " s)
  35. (print f x s)
  36. (scheme.display ")" s))))
  37. (def print (f x s)
  38. (if (errsafe:acons x)
  39. (do (scheme.display "(" s)
  40. (print f (car x) s)
  41. (print-cdr f (cdr x) s))
  42. (errsafe:isa x 'table)
  43. (print-table f x s)
  44. (f x s))
  45. (unless (and (bound 'explicit-flush) explicit-flush) (scheme.flush-output s)))
  46. (def disp (x (o s (stdout)))
  47. (print scheme.display x s))
  48. (def write (x (o s (stdout)))
  49. (print scheme.write x s))