Move pretty printer into boot.dst

lib/pp.dst

@@ -1,52 +0,0 @@
-# Implements a simple pretty printer. Offers similar functionality
-# as the describe function.
-
-(defn- pp-seq [pp seen buf a start end]
- (if (get seen a)
-  (buffer-push-string buf "<cycle>")
-  (do
-   (put seen a true)
-   (def len (length a))
-   (buffer-push-string buf start)
-   (for [i 0 len]
-    (when (not= i 0) (buffer-push-string buf " "))
-    (pp seen buf (get a i)))
-   (buffer-push-string buf end)))
- buf)
-
-(defn- pp-dict [pp seen buf a start end]
- (if (get seen a)
-  (buffer-push-string buf "<cycle>")
-  (do
-   (put seen a true)
-   (var k (next a nil))
-   (buffer-push-string buf start)
-   (while k
-    (def v (get a k))
-    (pp seen buf k)
-    (buffer-push-string buf " ")
-    (pp seen buf v)
-    (varset! k (next a k))
-    (when k (buffer-push-string buf " ")))
-   (buffer-push-string buf end)))
- buf)
-
-(def printers :private {
- :array  (fn [pp seen buf x] (pp-seq pp seen buf x "[" "]"))
- :tuple  (fn [pp seen buf x] (pp-seq pp seen buf x "(" ")"))
- :table  (fn [pp seen buf x] (pp-dict pp seen buf x "@{" "}"))
- :struct (fn [pp seen buf x] (pp-dict pp seen buf x "{" "}"))
-})
-
-(defn- default_printer [pp seen buf x] 
- (buffer-push-string buf (string x)) 
- buf)
-
-(defn- pp1 [seen buf x]
-  (def pmaybe (get printers (type x)))
-  (def p (if pmaybe pmaybe default_printer))
-  (p pp1 seen buf x))
-
-(defn pp 
- "Pretty print a value x."
- [x] (print (pp1 @{} @"" x)))

src/compiler/boot.dst

@@ -252,6 +252,57 @@ If no match is found, returns nil"
   (apply tuple parts))
  (reduce fop x forms))
 
+# Start pretty printer
+(def pp (do
+  (defn- pp-seq [pp seen buf a start end]
+   (if (get seen a)
+    (buffer-push-string buf "<cycle>")
+    (do
+     (put seen a true)
+     (def len (length a))
+     (buffer-push-string buf start)
+     (for [i 0 len]
+      (when (not= i 0) (buffer-push-string buf " "))
+      (pp seen buf (get a i)))
+     (buffer-push-string buf end)))
+   buf)
+
+  (defn- pp-dict [pp seen buf a start end]
+   (if (get seen a)
+    (buffer-push-string buf "<cycle>")
+    (do
+     (put seen a true)
+     (var k (next a nil))
+     (buffer-push-string buf start)
+     (while k
+      (def v (get a k))
+      (pp seen buf k)
+      (buffer-push-string buf " ")
+      (pp seen buf v)
+      (varset! k (next a k))
+      (when k (buffer-push-string buf " ")))
+     (buffer-push-string buf end)))
+   buf)
+
+  (def printers :private {
+   :array  (fn [pp seen buf x] (pp-seq pp seen buf x "[" "]"))
+   :tuple  (fn [pp seen buf x] (pp-seq pp seen buf x "(" ")"))
+   :table  (fn [pp seen buf x] (pp-dict pp seen buf x "@{" "}"))
+   :struct (fn [pp seen buf x] (pp-dict pp seen buf x "{" "}"))
+  })
+
+  (defn- default_printer [pp seen buf x] 
+   (buffer-push-string buf (describe x)) 
+   buf)
+
+  (defn- pp1 [seen buf x]
+    (def pmaybe (get printers (type x)))
+    (def p (if pmaybe pmaybe default_printer))
+    (p pp1 seen buf x))
+
+  (fn [x] (print (pp1 @{} @"" x)))))
+# End pretty printer
+
 (defn make-env [parent]
  (def parent (if parent parent _env))
  (def newenv (setproto @{} parent))
@@ -360,6 +411,6 @@ onvalue."
     (file-read stdin :line buf))
  (defn onvalue [x]
   (put newenv '_ @{'value x})
-  (print (describe x)))
+  (pp x))
  (run-context newenv (if getchunk getchunk chunks) onvalue
   (fn [t x] (print (string t " error: " x)))))