;;; 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))))))