mirror of
https://github.com/janet-lang/janet
synced 2024-12-25 07:50:27 +00:00
Move pretty printer into boot.dst
This commit is contained in:
parent
c0ac44a650
commit
8ec29d9326
52
lib/pp.dst
52
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)))
|
@ -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)))))
|
||||
|
Loading…
Reference in New Issue
Block a user