 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Printing ;;;;;;;;;;;;;;;;
 
 (defn pr-sequential-writer [writer print-one begin sep end opts coll]
-  (-write writer begin)
-  (when (seq coll)
-    (print-one (first coll) writer opts))
-  (loop [coll (next coll) n (:print-length opts)]
-    (when (and coll (or (nil? n) (not (zero? n))))
-      (-write writer sep)
-      (print-one (first coll) writer opts)
-      (recur (next coll) (dec n))))
-  (when (:print-length opts)
-    (-write writer sep)
-    (print-one "..." writer opts))
-  (-write writer end))
+  (binding [*print-level* (when-not (nil? *print-level*) (dec *print-level*))]
+    (if (and (not (nil? *print-level*)) (neg? *print-level*))
+      (-write writer "#")
+      (do
+        (-write writer begin)
+        (when (seq coll)
+          (print-one (first coll) writer opts))
+        (loop [coll (next coll) n (:print-length opts)]
+          (when (and coll (or (nil? n) (not (zero? n))))
+            (-write writer sep)
+            (print-one (first coll) writer opts)
+            (recur (next coll) (dec n))))
+        (when (:print-length opts)
+          (-write writer sep)
+          (print-one "..." writer opts))
+        (-write writer end)))))
 
 (defn write-all [writer & ss]
   (doseq [s ss]


  PersistentArrayMap
  (-pr-writer [coll writer opts]
    (let [pr-pair (fn [keyval] (pr-sequential-writer writer pr-writer "" " " "" opts keyval))]
      (pr-sequential-writer writer pr-pair "{" ", " "}" opts coll)))

  PersistentHashMap
  (-pr-writer [coll writer opts]
    (let [pr-pair (fn [keyval] (pr-sequential-writer writer pr-writer "" " " "" opts keyval))]
      (pr-sequential-writer writer pr-pair "{" ", " "}" opts coll)))

  PersistentTreeMap
  (-pr-writer [coll writer opts]
    (let [pr-pair (fn [keyval] (pr-sequential-writer writer pr-writer "" " " "" opts keyval))]
      (pr-sequential-writer writer pr-pair "{" ", " "}" opts coll)))

  PersistentHashSet
  (-pr-writer [coll writer opts] (pr-sequential-writer writer pr-writer "#{" " " "}" opts coll))

  (when *print-newline*
    (newline (pr-opts))))

(defn print-map [m print-one writer opts]
  (pr-sequential-writer
    writer
    (fn [e w opts]
      (do (print-one (key e) w opts)
          (-write w \space)
          (print-one (val e) w opts)))
    "{" ", " "}"
    opts (seq m)))

(extend-protocol IPrintWithWriter
  LazySeq
  (-pr-writer [coll writer opts] (pr-sequential-writer writer pr-writer "(" " " ")" opts coll))
