Clojure: reader/printer instead of monkey patching

Update the Clojure/ClojureScript implementation to have full reader
and printer/pr-str impementation instead of monkey patching Clojure's
reader and print functions.

clojure/Makefile

@@ -1,6 +1,6 @@
 clojure_MODE ?= clj
 SOURCES_UTIL = src/mal/readline.$(clojure_MODE)
-SOURCES_BASE = $(SOURCES_UTIL) src/mal/printer.cljc
+SOURCES_BASE = $(SOURCES_UTIL) src/mal/reader.cljc src/mal/printer.cljc
 SOURCES_LISP = src/mal/env.cljc src/mal/core.cljc src/mal/stepA_mal.cljc
 SRCS = $(SOURCES_BASE) src/mal/env.cljc src/mal/core.cljc
 SOURCES = $(SOURCES_BASE) $(SOURCES_LISP)

clojure/src/mal/core.cljc

@@ -1,7 +1,9 @@
 (ns mal.core
-  (:require [mal.readline :as readline]
+  (:refer-clojure :exclude [pr-str])
+  (:require [clojure.string :refer [join]]
+            [mal.readline :as readline]
             [mal.reader :as reader]
-            [mal.printer :as printer]))
+            [mal.printer :refer [pr-str atom?]]))
 
 ;; Errors/exceptions
 (defn mal_throw [obj]
@@ -14,10 +16,6 @@
 #?(:clj  (defn time-ms [] (System/currentTimeMillis))
    :cljs (defn time-ms [] (.getTime (js/Date.))))
 
-;; Atom functions
-#?(:clj  (defn atom? [atm] (= (type atm) clojure.lang.Atom))
-   :cljs (defn atom? [atm] (satisfies? IAtom atm)))
-
 ;; Metadata functions
 ;; - store metadata at :meta key of the real metadata
 (defn mal_with_meta [obj m]
@@ -43,10 +41,10 @@
    ['fn? (fn [o] (if (and (fn? o) (not (:ismacro (meta o)))) true false))]
    ['macro? (fn [o] (if (and (fn? o) (:ismacro (meta o))) true false))]
 
-   ['pr-str pr-str]
-   ['str printer/_str]
-   ['prn prn]
-   ['println println]
+   ['pr-str (fn [& xs] (join " " (map #(pr-str % true) xs)))]
+   ['str (fn [& xs] (join "" (map #(pr-str % false) xs)))]
+   ['prn (fn [& xs] (println (join " " (map #(pr-str % true) xs))))]
+   ['println (fn [& xs] (println (join " " (map #(pr-str % false) xs))))]
    ['readline readline/readline]
    ['read-string reader/read-string]
    ['slurp slurp]
@@ -59,7 +57,7 @@
    ['* *]
    ['/ /]
    ['time-ms time-ms]
-  
+
    ['list list]
    ['list? seq?]
    ['vector vector]
@@ -72,17 +70,17 @@
    ['contains? contains?]
    ['keys (fn [hm] (let [ks (keys hm)] (if (nil? ks) '() ks)))]
    ['vals (fn [hm] (let [vs (vals hm)] (if (nil? vs) '() vs)))]
-   
+
    ['sequential? sequential?]
    ['cons cons]
-   ['concat concat]
+   ['concat #(apply list (apply concat %&))]
    ['nth nth]
    ['first first]
    ['rest rest]
    ['empty? empty?]
    ['count count]
    ['apply apply]
-   ['map #(doall (map %1 %2))] 
+   ['map #(apply list (map %1 %2))]
 
    ['conj conj]
    ['seq (fn [obj] (seq (if (string? obj) (map str obj) obj)))]

clojure/src/mal/printer.cljc

@@ -1,63 +1,29 @@
-(ns mal.printer)
+(ns mal.printer
+  (:refer-clojure :exclude [pr-str])
+  (:require [clojure.string :as S]))
 
-#?(:clj (import '(java.io Writer)))
+;; atom?
+#?(:clj  (defn atom? [atm] (= (type atm) clojure.lang.Atom))
+   :cljs (defn atom? [atm] (satisfies? IAtom atm)))
 
-;; TODO Better:
-;; (extend-protocol IPrintWithWriter
-;;   Atom
-;;   ...
-;;   PersistentArrayMap
-;;   ...
-;;   PersistentHashMap
-;;   ...)
+(defn escape [s]
+  (-> s (S/replace "\\" "\\\\")
+        (S/replace "\"" "\\\"")
+        (S/replace "\n" "\\n")))
 
-;; Override atom printer
-#?(:clj  (defmethod clojure.core/print-method clojure.lang.Atom [a writer]
-           (.write writer "(atom ")
-           (.write writer (pr-str @a))
-           (.write writer ")"))
-   :cljs (extend-type Atom
-           IPrintWithWriter
-           (-pr-writer [a writer _]
-             (-write writer (str "(atom " (pr-str @a) ")")))))
+(defn pr-str
+  ([obj] (pr-str obj true))
+  ([obj print-readably]
+   (let [_r print-readably]
+     (cond
+       (= nil obj)   "nil"
+       (string? obj) (if _r (str "\"" (escape obj) "\"") obj)
 
+       (list? obj)   (str "(" (S/join " " (map #(pr-str % _r) obj)) ")")
+       (vector? obj) (str "[" (S/join " " (map #(pr-str % _r) obj)) "]")
+       (map? obj)    (str "{" (S/join " " (map (fn [[k v]]
+                                                 (str (pr-str k _r) " "
+                                                      (pr-str v _r))) obj)) "}")
+       (atom? obj)   (str "(atom " (pr-str @obj _r) ")")
+       :else         (str obj)))))
 
-;; Override hash-map printer to remove comma separators
-#?(:clj  (defmethod print-method clojure.lang.IPersistentMap [hm ^Writer w]
-           (.write w "{")
-           (when-let [xs (seq hm)]
-             (loop [[[k v] & xs] xs]
-               (print-method k w)
-               (.write w " ")
-               (print-method v w)
-               (when xs (.write w " ") (recur xs))))
-           (.write w "}"))
-   :cljs (extend-type PersistentHashMap
-           IPrintWithWriter
-           (-pr-writer [hm w _]
-             (-write w "{")
-             (when-let [xs (seq hm)]
-               (loop [[[k v] & xs] xs]
-                 (-write w (pr-str k))
-                 (-write w " ")
-                 (-write w (pr-str v))
-                 (when xs (-write w " ") (recur xs))))
-             (-write w "}"))))
-
-
-;; Add a version of str that is the same all the way down (no
-;; print-readably and nil printing all the way down)
-(defn- pr-
-  ([] nil)
-  ([x]
-     #?(:clj (print-method x *out*)
-        :cljs (pr x)))
-  ([x & more]
-   (pr- x)
-   (if-let [nmore (next more)]
-     (recur (first more) nmore)
-     (apply pr- more))))
-
-(defn _str [& xs]
-  (binding [*print-readably* nil]
-    (with-out-str (apply pr- xs))))

clojure/src/mal/reader.cljc

@@ -1,37 +1,79 @@
 (ns mal.reader
-    (:refer-clojure :exclude [read-string])
-    #?(:clj  (:require [clojure.tools.reader :as r]
-                       [clojure.tools.reader.reader-types :as rt]))
-    #?(:cljs (:require [cljs.tools.reader :as r]
-                       [cljs.tools.reader.reader-types :as rt])))
+  (:refer-clojure :exclude [read-string])
+  (:require [clojure.string :as S]))
 
-;; change tools.reader syntax-quote to quasiquote
-(defn- wrap [sym]
-  (fn [rdr _] (list sym (#'r/read rdr true nil))))
+(defn throw-str [s]
+  (throw #?(:cljs (js/Error. s)
+           :clj (Exception. s))))
 
-(defn- wrap-with [sym]
-  (fn [rdr arg _] (list sym (#'r/read rdr true nil) arg)))
+(defn rdr [tokens]
+  {:tokens (vec tokens) :position (atom 0)})
 
-;; Override some tools.reader reader macros so that we can do our own
-;; metadata and quasiquote handling
-(def new-rmacros
-  (fn [f]
-    (fn [ch]
-      (case ch
-        \` (wrap 'quasiquote)
-        \~ (fn [rdr comma]
-             (if-let [ch (rt/peek-char rdr)]
-               (if (identical? \@ ch)
-                 ((wrap 'splice-unquote) (doto rdr rt/read-char) \@)
-                 ((wrap 'unquote) rdr \~))))
-        \^ (fn [rdr comma]
-             (let [m (#'r/read rdr)]
-               ((wrap-with 'with-meta) rdr m \^)))
-        \@ (wrap 'deref)
-        (f ch)))))
+(defn rdr-peek [rdr]
+  (get (vec (:tokens rdr)) @(:position rdr)))
 
-#?(:clj (alter-var-root #'r/macros new-rmacros)
-   :cljs (set! r/macros (new-rmacros r/macros)))
+(defn rdr-next [rdr]
+  (get (vec (:tokens rdr)) (dec (swap! (:position rdr) inc))))
+
+(def tok-re #"[\s,]*(~@|[\[\]{}()'`~^@]|\"(?:[\\].|[^\\\"])*\"?|;.*|[^\s\[\]{}()'\"`@,;]+)")
+(def int-re #"^-?[0-9]+$")
+(def str-re #"^\"(.*)\"$")
+
+(defn tokenize [s]
+  (filter #(not= \; (first %))
+          (map second (re-seq tok-re s))))
+
+(defn unescape [s]
+  (-> s (S/replace "\\\\" "\u029e")
+        (S/replace "\\\"" "\"")
+        (S/replace "\\n" "\n")
+        (S/replace "\u029e" "\\")))
+
+(defn read-atom [rdr]
+  (let [token (rdr-next rdr)]
+    (cond
+     (re-seq int-re token) #?(:cljs (js/parseInt token)
+                              :clj (Integer/parseInt token))
+     (re-seq str-re token) (unescape (second (re-find str-re token)))
+     (= \: (get token 0))  (keyword (subs token 1))
+     (= "nil" token)       nil
+     (= "true" token)      true
+     (= "false" token)     false
+     :else                 (symbol token))))
+
+(declare read-form)
+
+(defn read-seq [rdr start end]
+  (assert (= start (rdr-next rdr))) ;; pull off start
+  (loop [lst []]
+    (let [token (rdr-peek rdr)]
+      (cond
+        (= token end) (do (rdr-next rdr) lst)
+        (not token) (throw-str (str "expected '" end "', got EOF"))
+        :else (recur (conj lst (read-form rdr)))))))
+
+(defn read-form [rdr]
+  (let [tok (rdr-peek rdr)]
+    (cond
+      (= "'" tok)  (do (rdr-next rdr) (list 'quote (read-form rdr)))
+      (= "`" tok)  (do (rdr-next rdr) (list 'quasiquote (read-form rdr)))
+      (= "~" tok)  (do (rdr-next rdr) (list 'unquote (read-form rdr)))
+      (= "~@" tok) (do (rdr-next rdr) (list 'splice-unquote (read-form rdr)))
+
+      (= "^" tok)  (do (rdr-next rdr) (let [m (read-form rdr)]
+                                          (list 'with-meta (read-form rdr) m)))
+      (= "@" tok)  (do (rdr-next rdr) (list 'deref (read-form rdr)))
+
+      (= ")" tok)  (throw-str "unexpected ')'")
+      (= "(" tok)  (apply list (read-seq rdr "(" ")"))
+
+      (= "]" tok)  (throw-str "unexpected ']'")
+      (= "[" tok)  (vec (read-seq rdr "[" "]"))
+
+      (= "}" tok)  (throw-str "unexpected '}'")
+      (= "{" tok)  (apply hash-map (read-seq rdr "{" "}"))
+
+      :else        (read-atom rdr))))
 
 (defn read-string [s]
-  (r/read-string s))
+  (read-form (rdr (tokenize s))))

clojure/src/mal/step1_read_print.cljc

@@ -14,7 +14,7 @@
   ast)
 
 ;; print
-(defn PRINT [exp] (pr-str exp))
+(defn PRINT [exp] (printer/pr-str exp))
 
 ;; repl
 (defn rep

clojure/src/mal/step2_eval.cljc

@@ -42,7 +42,7 @@
                 (apply f args)))))
 
 ;; print
-(defn PRINT [exp] (pr-str exp))
+(defn PRINT [exp] (printer/pr-str exp))
 
 ;; repl
 (def repl-env {'+ +

clojure/src/mal/step3_env.cljc

@@ -54,7 +54,7 @@
                 (apply f args))))))
 
 ;; print
-(defn PRINT [exp] (pr-str exp))
+(defn PRINT [exp] (printer/pr-str exp))
 
 ;; repl
 (def repl-env (env/env))

clojure/src/mal/step4_if_fn_do.cljc

@@ -70,7 +70,7 @@
                 (apply f args))))))
 
 ;; print
-(defn PRINT [exp] (pr-str exp))
+(defn PRINT [exp] (printer/pr-str exp))
 
 ;; repl
 (def repl-env (env/env))

clojure/src/mal/step5_tco.cljc

@@ -79,7 +79,7 @@
                   (apply f args))))))))
 
 ;; print
-(defn PRINT [exp] (pr-str exp))
+(defn PRINT [exp] (printer/pr-str exp))
 
 ;; repl
 (def repl-env (env/env))

clojure/src/mal/step6_file.cljc

@@ -79,7 +79,7 @@
                   (apply f args))))))))
 
 ;; print
-(defn PRINT [exp] (pr-str exp))
+(defn PRINT [exp] (printer/pr-str exp))
 
 ;; repl
 (def repl-env (env/env))

clojure/src/mal/step7_quote.cljc

@@ -102,7 +102,7 @@
                   (apply f args))))))))
 
 ;; print
-(defn PRINT [exp] (pr-str exp))
+(defn PRINT [exp] (printer/pr-str exp))
 
 ;; repl
 (def repl-env (env/env))

clojure/src/mal/step8_macros.cljc

@@ -127,7 +127,7 @@
                   (apply f args))))))))))
 
 ;; print
-(defn PRINT [exp] (pr-str exp))
+(defn PRINT [exp] (printer/pr-str exp))
 
 ;; repl
 (def repl-env (env/env))

clojure/src/mal/step9_try.cljc

@@ -144,7 +144,7 @@
                   (apply f args))))))))))
 
 ;; print
-(defn PRINT [exp] (pr-str exp))
+(defn PRINT [exp] (printer/pr-str exp))
 
 ;; repl
 (def repl-env (env/env))

clojure/src/mal/stepA_mal.cljc

@@ -152,7 +152,7 @@
                   (apply f args))))))))))
 
 ;; print
-(defn PRINT [exp] (pr-str exp))
+(defn PRINT [exp] (printer/pr-str exp))
 
 ;; repl
 (def repl-env (env/env))