Racket: add steps0-A. Self-hosting.

- Some additioanl tests.
- Split step9 tests into optional but self-hosting requirements
  (metadata on functions) and other optional (conj, metadata on
  collections).

1 files changed, 85 insertions, 0 deletions

diff --git a/racket/reader.rkt b/racket/reader.rkt
new file mode 100644
index 0000000..6db2e67
--- /dev/null
+++ b/racket/reader.rkt
@@ -0,0 +1,85 @@
+#lang racket
+
+(provide read_str)
+
+(require "types.rkt")
+
+(define Reader%
+  (class object%
+    (init tokens)
+    (super-new)
+    (define toks tokens)
+    (define position 0)
+    (define/public (next)
+      (cond [(>= position (length toks)) null]
+            [else (begin
+                    (set! position (+ 1 position))
+                    (list-ref toks (- position 1)))]))
+    (define/public (peek)
+      (cond [(>= position (length toks)) null]
+            [else (list-ref toks position )]))))
+      
+
+(define (tokenize str)
+  (filter-not (lambda (s) (or (equal? s "") (equal? (substring s 0 1) ";")))
+    (regexp-match* #px"[\\s,]*(~@|[\\[\\]{}()'`~^@]|\"(?:\\\\.|[^\\\\\"])*\"|;[^\n]*|[^\\s\\[\\]{}('\"`,;)]*)"
+                   str #:match-select cadr)))
+
+(define (read_atom rdr)
+  (let ([token (send rdr next)])
+    (cond [(regexp-match #px"^-?[0-9]+$" token)
+           (string->number token)]
+          [(regexp-match #px"^-?[0-9][0-9.]*$" token)
+           (string->number token)]
+          [(regexp-match #px"^\".*\"$" token)
+           (string-replace
+             (string-replace
+               (substring token 1 (- (string-length token) 1))
+               "\\\"" "\"")
+             "\\n" "\n")]
+          [(regexp-match #px"^:" token) (_keyword (substring token 1))]
+          [(equal? "nil" token) nil]
+          [(equal? "true" token) #t]
+          [(equal? "false" token) #f]
+          [else (string->symbol token)])))
+
+(define (read_list_entries rdr end)
+  (let ([tok (send rdr peek)])
+    (cond
+        [(eq? tok '()) (raise (string-append "expected '" end "'"))]
+        [(equal? end tok) '()]
+        [else
+          (cons (read_form rdr) (read_list_entries rdr end))])))
+
+(define (read_list rdr start end)
+  (let ([token (send rdr next)])
+    (if (equal? start token)
+      (let ([lst (read_list_entries rdr end)])
+        (send rdr next)
+        lst)
+      (raise (string-append "expected '" start "'")))))
+
+(define (read_form rdr)
+  (let ([token (send rdr peek)])
+    (if (null? token)
+      (raise (make-blank-exn "blank line" (current-continuation-marks)))
+      (cond
+        [(equal? "'" token) (send rdr next) (list 'quote (read_form rdr))]
+        [(equal? "`" token) (send rdr next) (list 'quasiquote (read_form rdr))]
+        [(equal? "~" token) (send rdr next) (list 'unquote (read_form rdr))]
+        [(equal? "~@" token) (send rdr next) (list 'splice-unquote (read_form rdr))]
+        [(equal? "^" token) (send rdr next)
+                            (let ([meta (read_form rdr)])
+                              (list 'with-meta (read_form rdr) meta))]
+        [(equal? "@" token) (send rdr next) (list 'deref (read_form rdr))]
+
+        [(equal? ")" token) (raise "unexpected ')'")]
+        [(equal? "(" token) (read_list rdr "(" ")")]
+        [(equal? "]" token) (raise "unexpected ']'")]
+        [(equal? "[" token) (list->vector (read_list rdr "[" "]"))]
+        [(equal? "}" token) (raise "unexpected '}'")]
+        [(equal? "{" token) (apply hash (read_list rdr "{" "}"))]
+        [else (read_atom rdr)]))))
+
+(define (read_str str)
+  (read_form (new Reader% [tokens (tokenize str)])))