From b993d6617ff88065a6ad4d507aacecc81c4ab5de Mon Sep 17 00:00:00 2001
From: Jesse McDonald <nybble41@gmail.com>
Date: Sat, 5 Jun 2010 22:56:08 -0500
Subject: [PATCH] Add support for reading symbols.

Also remove | and \ from the list of valid symbol characters.
---
 src/reader.rls | 38 +++++++++++++++++++++++++++++++++++---
 1 file changed, 35 insertions(+), 3 deletions(-)

diff --git a/src/reader.rls b/src/reader.rls
index 8025b03..be730df 100644
--- a/src/reader.rls
+++ b/src/reader.rls
@@ -68,6 +68,9 @@
              (read-number)]
           [(eq? current-char #\")
              (read-string)]
+          [(eq? current-char #\|)
+             (next-char)
+             (read-symbol #t)]
           [(symbol-char? current-char)
              (read-symbol)]
           [else
@@ -325,8 +328,37 @@
           (iter 0 (cdr items))
           struct))
 
-      (define (read-symbol)
-        undefined)
+      (define (read-symbol [quoted? #f])
+        (define (read-chars)
+          (cond
+            [eof?
+               (if quoted?
+                   (unexpected-eof)
+                   '())]
+            [(and quoted? (eq? current-char #\|))
+               (next-char)
+               '()]
+            [(eq? current-char #\\)
+               (next-char)
+               (when eof? (unexpected-eof))
+               (let ([ch current-char])
+                 (next-char)
+                 (cons ch (read-chars)))]
+            [(or quoted? (symbol-char? current-char))
+               (let ([ch current-char])
+                 (next-char)
+                 (cons ch (read-chars)))]
+            [else '()]))
+
+        (let* ([chars (read-chars)]
+               [len (list-length chars)]
+               [str (make-byte-string len #\Null)])
+          (define (iter n rst)
+            (when (fix< n len)
+              (byte-string-set! str n (car rst))
+              (iter (fix+ n 1) (cdr rst))))
+          (iter 0 chars)
+          (intern str)))
 
       (define (skip-whitespace)
         (unless eof?
@@ -402,7 +434,7 @@
   (or (alphanumeric-char? ch)
       (memq? ch '(#\! #\$ #\% #\& #\* #\+
                   #\- #\/ #\< #\= #\> #\?
-                  #\@ #\\ #\^ #\_ #\| #\~))))
+                  #\@ #\^ #\_ #\~))))
 
 (define (reverse lst [newcdr '()])
   (if (pair? lst)