Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Tree: 1588ff3f70
Fetching contributors…

Cannot retrieve contributors at this time

108 lines (91 sloc) 3.74 kB
;;; utilities.clj -- part of the pretty printer for Clojure
; Copyright (c) Rich Hickey. All rights reserved.
; The use and distribution terms for this software are covered by the
; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
; which can be found in the file epl-v10.html at the root of this distribution.
; By using this software in any fashion, you are agreeing to be bound by
; the terms of this license.
; You must not remove this notice, or any other, from this software.
;; Author: Tom Faulhaber
;; April 3, 2009
;; This module implements some utility function used in formatting and pretty
;; printing. The functions here could go in a more general purpose library,
;; perhaps.
(in-ns 'clojure.pprint)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Helper functions for digesting formats in the various
;;; phases of their lives.
;;; These functions are actually pretty general.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- map-passing-context [func initial-context lis]
(loop [context initial-context
lis lis
acc []]
(if (empty? lis)
[acc context]
(let [this (first lis)
remainder (next lis)
[result new-context] (apply func [this context])]
(recur new-context remainder (conj acc result))))))
(defn- consume [func initial-context]
(loop [context initial-context
acc []]
(let [[result new-context] (apply func [context])]
(if (not result)
[acc new-context]
(recur new-context (conj acc result))))))
(defn- consume-while [func initial-context]
(loop [context initial-context
acc []]
(let [[result continue new-context] (apply func [context])]
(if (not continue)
[acc context]
(recur new-context (conj acc result))))))
(defn- unzip-map [m]
"Take a map that has pairs in the value slots and produce a pair of maps,
the first having all the first elements of the pairs and the second all
the second elements of the pairs"
[(into {} (for [[k [v1 v2]] m] [k v1]))
(into {} (for [[k [v1 v2]] m] [k v2]))])
(defn- tuple-map [m v1]
"For all the values, v, in the map, replace them with [v v1]"
(into {} (for [[k v] m] [k [v v1]])))
(defn- rtrim [s c]
"Trim all instances of c from the end of sequence s"
(let [len (count s)]
(if (and (pos? len) (= (nth s (dec (count s))) c))
(loop [n (dec len)]
(cond
(neg? n) ""
(not (= (nth s n) c)) (subs s 0 (inc n))
true (recur (dec n))))
s)))
(defn- ltrim [s c]
"Trim all instances of c from the beginning of sequence s"
(let [len (count s)]
(if (and (pos? len) (= (nth s 0) c))
(loop [n 0]
(if (or (= n len) (not (= (nth s n) c)))
(subs s n)
(recur (inc n))))
s)))
(defn- prefix-count [aseq val]
"Return the number of times that val occurs at the start of sequence aseq,
if val is a seq itself, count the number of times any element of val occurs at the
beginning of aseq"
(let [test (if (coll? val) (set val) #{val})]
(loop [pos 0]
(if (or (= pos (count aseq)) (not (test (nth aseq pos))))
pos
(recur (inc pos))))))
(defn- prerr [& args]
"Println to *err*"
(binding [*out* *err*]
(apply println args)))
(defmacro ^{:private true} prlabel [prefix arg & more-args]
"Print args to *err* in name = value format"
`(prerr ~@(cons (list 'quote prefix) (mapcat #(list (list 'quote %) "=" %)
(cons arg (seq more-args))))))
;; Flush the pretty-print buffer without flushing the underlying stream
(definterface PrettyFlush
(^void ppflush []))
Jump to Line
Something went wrong with that request. Please try again.