Make pretty printer prettier.

src/compiler/boot.dst

@@ -294,6 +294,17 @@ If no match is found, returns nil"
      (tuple-prepend body 'do)
      (tuple ':= sym (tuple '+ sym inc)))))
 
+(defn every? [pred seq]
+ (var res true)
+ (var i 0)
+ (def len (length seq))
+ (while (< i len)
+  (def item (get seq i))
+  (if (pred item)
+   (++ i)
+   (do (:= res false) (:= i len))))
+ res)
+
 (defn juxt*
   [& funs]
   (def len (length funs))
@@ -443,54 +454,89 @@ If no match is found, returns nil"
   (if (table? (get colls 0)) container (table-to-struct container)))
 
 # Start pretty printer
-(def pp (do
+(defn pp [x]
-  (defn- pp-seq [pp seen buf a start end checkcycle]
+
-   (if (and checkcycle (get seen a))
+  (def buf @"")
-    (buffer-push-string buf "<cycle>")
+  (def indent @"\n")
+  (def seen @{})
+  (var nextid 0)
+
+  # Forward declaration
+  (var recur nil)
+
+  (defn do-ds
+   [y start end checkcycle dispatch]
+   (def id (get seen y))
+   (if (and checkcycle id)
     (do
-     (put seen a true)
+     (buffer-push-string buf "<cycle ")
-     (def len (length a))
+     (buffer-push-string buf (string id))
+     (buffer-push-string buf ">"))
+    (do
+     (put seen y (++ nextid))
      (buffer-push-string buf start)
+     (dispatch y)
+     (buffer-push-string buf end))))
+
+  (defn pp-seq [y]
+   (def len (length y))
+   (if (< len 5)
+    (do
      (for [i 0 len]
       (when (not= i 0) (buffer-push-string buf " "))
-      (pp seen buf (get a i)))
+      (recur (get y i))))
-     (buffer-push-string buf end)))
-   buf)
-
-  (defn- pp-dict [pp seen buf a start end checkcycle]
-   (if (and checkcycle (get seen a))
-    (buffer-push-string buf "<cycle>")
     (do
-     (put seen a true)
+      (buffer-push-string indent "  ")
-     (var k (next a nil))
+      (for [i 0 len]
-     (buffer-push-string buf start)
+       (when (not= i len) (buffer-push-string buf indent))
-     (while k
+       (recur (get y i)))
-      (def v (get a k))
+      (buffer-popn indent 2)
-      (pp seen buf k)
+      (buffer-push-string buf indent))))
-      (buffer-push-string buf " ")
-      (pp seen buf v)
-      (:= k (next a k))
-      (when k (buffer-push-string buf " ")))
-     (buffer-push-string buf end)))
-   buf)
 
-  (def printers :private {
+  (defn pp-dict-nested [y]
-   :array  (fn [pp seen buf x] (pp-seq pp seen buf x "@[" "]" true))
+   (var k (next y nil))
-   :tuple  (fn [pp seen buf x] (pp-seq pp seen buf x "(" ")"))
+   (buffer-push-string indent "  ")
-   :table  (fn [pp seen buf x] (pp-dict pp seen buf x "@{" "}" true))
+   (buffer-push-string buf indent)
-   :struct (fn [pp seen buf x] (pp-dict pp seen buf x "{" "}"))
+   (while k
+    (def v (get y k))
+    (recur k)
+    (buffer-push-string buf " ")
+    (recur v)
+    (:= k (next y k))
+    (when k (buffer-push-string buf indent)))
+   (buffer-popn indent 2)
+   (buffer-push-string buf indent))
+
+  (defn pp-dict-simple [y]
+   (var k (next y nil))
+   (while k
+    (def v (get y k))
+    (recur k)
+    (buffer-push-string buf " ")
+    (recur v)
+    (:= k (next y k))
+    (when k (buffer-push-string buf " "))))
+
+  (defn pp-dict [y]
+   ((if (> 4 (length y)) pp-dict-simple pp-dict-nested) y))
+
+  (def printers {
+   :array  (fn [y] (do-ds y "@[" "]" true pp-seq))
+   :tuple  (fn [y] (do-ds y "(" ")" false pp-seq))
+   :table  (fn [y] (do-ds y "@{" "}" true pp-dict))
+   :struct  (fn [y] (do-ds y "{" "}" false pp-dict))
   })
   
-  (defn- default_printer [pp seen buf x]
+  (:= recur (fn [y]
-   (buffer-push-string buf (describe x))
+    (def p (get printers (type y)))
-   buf)
+    (if p
+     (p y)
+     (buffer-push-string buf (describe y)))))
 
-  (defn- pp1 [seen buf x]
+  (recur x)
-    (def pmaybe (get printers (type x)))
+  (buffer-push-string buf "\n")
-    (def p (if pmaybe pmaybe default_printer))
-    (p pp1 seen buf x))
 
-  (fn [x] (print (pp1 @{} @"" x)))))
+  (file-write stdout buf))
 # End pretty printer
 
 (defn unique [s]

src/core/buffer.c

@@ -187,6 +187,23 @@ static int cfun_clear(DstArgs args) {
     return dst_return(args, args.v[0]);
 }
 
+static int cfun_popn(DstArgs args) {
+    DstBuffer *buffer;
+    int32_t i;
+    if (args.n < 2
+            || !dst_checktype(args.v[0], DST_BUFFER)
+            || !dst_checktype(args.v[1], DST_INTEGER)) return dst_throw(args, "expected buffer and integer");
+    buffer = dst_unwrap_buffer(args.v[0]);
+    i = dst_unwrap_integer(args.v[1]);
+    if (i < 0) return dst_throw(args, "expected positive integer");
+    if (buffer->count < i) {
+        buffer->count = 0;
+    } else {
+        buffer->count -= i;
+    }
+    return dst_return(args, args.v[0]);
+}
+
 static int cfun_slice(DstArgs args) {
     const uint8_t *data;
     int32_t len, start, end;
@@ -225,6 +242,7 @@ static const DstReg cfuns[] = {
     {"buffer-push-byte", cfun_u8},
     {"buffer-push-integer", cfun_int},
     {"buffer-push-string", cfun_chars},
+    {"buffer-popn", cfun_popn},
     {"buffer-clear", cfun_clear},
     {"buffer-slice", cfun_slice},
     {NULL, NULL}