|
rlm@10
|
1 ;;; utilities.clj -- part of the pretty printer for Clojure
|
|
rlm@10
|
2
|
|
rlm@10
|
3 ; Copyright (c) Rich Hickey. All rights reserved.
|
|
rlm@10
|
4 ; The use and distribution terms for this software are covered by the
|
|
rlm@10
|
5 ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
|
|
rlm@10
|
6 ; which can be found in the file epl-v10.html at the root of this distribution.
|
|
rlm@10
|
7 ; By using this software in any fashion, you are agreeing to be bound by
|
|
rlm@10
|
8 ; the terms of this license.
|
|
rlm@10
|
9 ; You must not remove this notice, or any other, from this software.
|
|
rlm@10
|
10
|
|
rlm@10
|
11 ;; Author: Tom Faulhaber
|
|
rlm@10
|
12 ;; April 3, 2009
|
|
rlm@10
|
13
|
|
rlm@10
|
14 ;; This module implements some utility function used in formatting and pretty
|
|
rlm@10
|
15 ;; printing. The functions here could go in a more general purpose library,
|
|
rlm@10
|
16 ;; perhaps.
|
|
rlm@10
|
17
|
|
rlm@10
|
18 (in-ns 'clojure.pprint)
|
|
rlm@10
|
19
|
|
rlm@10
|
20 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
rlm@10
|
21 ;;; Helper functions for digesting formats in the various
|
|
rlm@10
|
22 ;;; phases of their lives.
|
|
rlm@10
|
23 ;;; These functions are actually pretty general.
|
|
rlm@10
|
24 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
rlm@10
|
25
|
|
rlm@10
|
26 (defn- map-passing-context [func initial-context lis]
|
|
rlm@10
|
27 (loop [context initial-context
|
|
rlm@10
|
28 lis lis
|
|
rlm@10
|
29 acc []]
|
|
rlm@10
|
30 (if (empty? lis)
|
|
rlm@10
|
31 [acc context]
|
|
rlm@10
|
32 (let [this (first lis)
|
|
rlm@10
|
33 remainder (next lis)
|
|
rlm@10
|
34 [result new-context] (apply func [this context])]
|
|
rlm@10
|
35 (recur new-context remainder (conj acc result))))))
|
|
rlm@10
|
36
|
|
rlm@10
|
37 (defn- consume [func initial-context]
|
|
rlm@10
|
38 (loop [context initial-context
|
|
rlm@10
|
39 acc []]
|
|
rlm@10
|
40 (let [[result new-context] (apply func [context])]
|
|
rlm@10
|
41 (if (not result)
|
|
rlm@10
|
42 [acc new-context]
|
|
rlm@10
|
43 (recur new-context (conj acc result))))))
|
|
rlm@10
|
44
|
|
rlm@10
|
45 (defn- consume-while [func initial-context]
|
|
rlm@10
|
46 (loop [context initial-context
|
|
rlm@10
|
47 acc []]
|
|
rlm@10
|
48 (let [[result continue new-context] (apply func [context])]
|
|
rlm@10
|
49 (if (not continue)
|
|
rlm@10
|
50 [acc context]
|
|
rlm@10
|
51 (recur new-context (conj acc result))))))
|
|
rlm@10
|
52
|
|
rlm@10
|
53 (defn- unzip-map [m]
|
|
rlm@10
|
54 "Take a map that has pairs in the value slots and produce a pair of maps,
|
|
rlm@10
|
55 the first having all the first elements of the pairs and the second all
|
|
rlm@10
|
56 the second elements of the pairs"
|
|
rlm@10
|
57 [(into {} (for [[k [v1 v2]] m] [k v1]))
|
|
rlm@10
|
58 (into {} (for [[k [v1 v2]] m] [k v2]))])
|
|
rlm@10
|
59
|
|
rlm@10
|
60 (defn- tuple-map [m v1]
|
|
rlm@10
|
61 "For all the values, v, in the map, replace them with [v v1]"
|
|
rlm@10
|
62 (into {} (for [[k v] m] [k [v v1]])))
|
|
rlm@10
|
63
|
|
rlm@10
|
64 (defn- rtrim [s c]
|
|
rlm@10
|
65 "Trim all instances of c from the end of sequence s"
|
|
rlm@10
|
66 (let [len (count s)]
|
|
rlm@10
|
67 (if (and (pos? len) (= (nth s (dec (count s))) c))
|
|
rlm@10
|
68 (loop [n (dec len)]
|
|
rlm@10
|
69 (cond
|
|
rlm@10
|
70 (neg? n) ""
|
|
rlm@10
|
71 (not (= (nth s n) c)) (subs s 0 (inc n))
|
|
rlm@10
|
72 true (recur (dec n))))
|
|
rlm@10
|
73 s)))
|
|
rlm@10
|
74
|
|
rlm@10
|
75 (defn- ltrim [s c]
|
|
rlm@10
|
76 "Trim all instances of c from the beginning of sequence s"
|
|
rlm@10
|
77 (let [len (count s)]
|
|
rlm@10
|
78 (if (and (pos? len) (= (nth s 0) c))
|
|
rlm@10
|
79 (loop [n 0]
|
|
rlm@10
|
80 (if (or (= n len) (not (= (nth s n) c)))
|
|
rlm@10
|
81 (subs s n)
|
|
rlm@10
|
82 (recur (inc n))))
|
|
rlm@10
|
83 s)))
|
|
rlm@10
|
84
|
|
rlm@10
|
85 (defn- prefix-count [aseq val]
|
|
rlm@10
|
86 "Return the number of times that val occurs at the start of sequence aseq,
|
|
rlm@10
|
87 if val is a seq itself, count the number of times any element of val occurs at the
|
|
rlm@10
|
88 beginning of aseq"
|
|
rlm@10
|
89 (let [test (if (coll? val) (set val) #{val})]
|
|
rlm@10
|
90 (loop [pos 0]
|
|
rlm@10
|
91 (if (or (= pos (count aseq)) (not (test (nth aseq pos))))
|
|
rlm@10
|
92 pos
|
|
rlm@10
|
93 (recur (inc pos))))))
|
|
rlm@10
|
94
|
|
rlm@10
|
95 (defn- prerr [& args]
|
|
rlm@10
|
96 "Println to *err*"
|
|
rlm@10
|
97 (binding [*out* *err*]
|
|
rlm@10
|
98 (apply println args)))
|
|
rlm@10
|
99
|
|
rlm@10
|
100 (defmacro ^{:private true} prlabel [prefix arg & more-args]
|
|
rlm@10
|
101 "Print args to *err* in name = value format"
|
|
rlm@10
|
102 `(prerr ~@(cons (list 'quote prefix) (mapcat #(list (list 'quote %) "=" %)
|
|
rlm@10
|
103 (cons arg (seq more-args))))))
|
|
rlm@10
|
104
|
