summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorTom Faulhaber <git_net@infolace.com>2010-05-03 09:12:47 -0700
committerStuart Halloway <stu@thinkrelevance.com>2010-05-03 21:38:43 -0400
commit10f849fad0d8e61b5c8a47075a34ca78a0ffc298 (patch)
treede56bd9837f50a876bc9fb0d155ce46e6a1d446f
parentab6fc90d56bfb3b969ed84058e1b3a4b30faa400 (diff)
Added the pretty printer, clojure.pprint
Signed-off-by: Stuart Halloway <stu@thinkrelevance.com>
-rw-r--r--build.xml1
-rw-r--r--doc/pprint/CommonLispFormat.markdown202
-rw-r--r--doc/pprint/PrettyPrinting.markdown270
-rw-r--r--src/clj/clojure/pprint.clj48
-rw-r--r--src/clj/clojure/pprint/cl_format.clj1896
-rw-r--r--src/clj/clojure/pprint/column_writer.clj79
-rw-r--r--src/clj/clojure/pprint/dispatch.clj448
-rw-r--r--src/clj/clojure/pprint/pprint_base.clj369
-rw-r--r--src/clj/clojure/pprint/pretty_writer.clj483
-rw-r--r--src/clj/clojure/pprint/utilities.clj104
-rw-r--r--test/clojure/test_clojure.clj1
-rw-r--r--test/clojure/test_clojure/pprint.clj18
-rw-r--r--test/clojure/test_clojure/pprint/test_cl_format.clj688
-rw-r--r--test/clojure/test_clojure/pprint/test_helper.clj22
-rw-r--r--test/clojure/test_clojure/pprint/test_pretty.clj194
15 files changed, 4823 insertions, 0 deletions
diff --git a/build.xml b/build.xml
index 0f7f14d2..615ba5b1 100644
--- a/build.xml
+++ b/build.xml
@@ -104,6 +104,7 @@
<arg value="clojure.test"/>
<arg value="clojure.test.tap"/>
<arg value="clojure.test.junit"/>
+ <arg value="clojure.pprint"/>
</java>
</target>
diff --git a/doc/pprint/CommonLispFormat.markdown b/doc/pprint/CommonLispFormat.markdown
new file mode 100644
index 00000000..4bb38ace
--- /dev/null
+++ b/doc/pprint/CommonLispFormat.markdown
@@ -0,0 +1,202 @@
+# A Common Lisp-compatible Format Function
+cl-format is an implementation of the incredibly baroque Common Lisp format function as specified
+in [Common Lisp, the Language, 2nd edition, Chapter 22](http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/clm/node200.html#SECTION002633000000000000000).
+
+Format gives you an easy and powerful way to format text and data for output. It supports rich
+formatting of strings and numbers, loops, conditionals, embedded formats, etc. It is really a
+domain-specific language for formatting.
+
+This implementation for clojure has the following goals:
+
+ * Support the full feature set of the Common Lisp format function (including the X3J13 extensions) with the only exception being concepts that make no sense or are differently interpreted in Clojure.
+ * Make porting code from Common Lisp easier.
+ * Provide a more native feeling solution for Clojure programmers than the Java format method and its relatives.
+ * Be fast. This includes the ability to precompile formats that are going to be used reptitively.
+ * Include useful error handling and comprehensive documentation.
+
+## Why would I use cl-format?
+
+For some people the answer to this question is that they are used to
+Common Lisp and, therefore, they already know the syntax of format
+strings and all the directives.
+
+A more interesting answer is that cl-format provides a way of
+rendering strings that is much more suited to Lisp and its data
+structures.
+
+Because iteration and conditionals are built into the directive
+structure of cl-format, it is possible to render sequences and other
+complex data structures directly without having to loop over the data
+structure.
+
+For example, to print the elements of a sequence separated by commas,
+you simply say:
+
+ (cl-format true "~{~a~^, ~}" aseq)
+
+(This example is taken from
+[Practical Common Lisp](http://www.gigamonkeys.com/book/)
+by Peter Seibel.)
+
+The corresponding output using Clojure's Java-based _format_ function
+would involve a nasty loop/recur with some code to figure out about
+the commas. Yuck!
+
+## Current Status of cl-format
+
+cl-format is 100% compatible with the Common Lisp standard as
+specified in CLtLv2.
+This includes all of the functionality of Common
+Lisp's format function including iteration, conditionals,
+text justification and rich
+options for displaying real and integer values. It also includes the
+directives to support pretty printing structured output.
+
+If you find a bug in a directive, drop me a line
+with a chunk of code that exhibits the bug and the version of
+cl-format you found it in and I'll try to get it fixed.
+
+I also intend to have good built-in documentation for the directives,
+but I haven't built that yet.
+
+The following directives are
+not yet supported: ~:T and ~@:T (but all other forms of ~T work)
+and extensions with ~/.
+
+The pretty printer interface is similar, but not identical to the
+interface in Common Lisp.
+
+Next up:
+
+ * Support for ~/
+ * True compiled formats
+ * Restructure unit tests into modular chunks.
+ * Import tests from CLISP and SBCL.
+ * Unit tests for exception conditions.
+ * Interactive documentation
+
+## How to use cl-format
+
+### Loading cl-format in your program
+
+Once cl-format is in your path, adding it to your code is easy:
+
+ (ns your-namespace-here
+ (:use [clojure.pprint :only (cl-format)]))
+
+If you want to refer to the cl-format function as "format" (rather
+than using the clojure function of that name), you can use this idiom:
+
+ (ns your-namespace-here
+ (:refer-clojure :exclude [format])
+ (:use clojure.pprint))
+
+ (def format cl-format)
+
+You might want to do this in code that you've ported from Common Lisp,
+for instance, or maybe just because old habits die hard.
+
+From the REPL, you can grab it using (use):
+
+ (use 'clojure.pprint)
+
+### Calling cl-format
+
+cl-format is a standard clojure function that takes a variable number
+of arguments. You call it like this:
+
+ (cl-format stream format args...)
+
+_stream_ can be any Java Writer (that is java.io.Writer) or the values
+_true_, _false_, or _nil_. The argument _true_ is identical to using
+`*`out`*` while _false_ or _nil_ indicate that cl-format should return
+its result as a string rather than writing it to a stream.
+
+_format_ is either a format string or a compiled format (see
+below). The format string controls the output that's written in a way
+that's similar to (but much more powerful than) the standard Clojure
+API format function (which is based on Java's
+java.lang.String.Format).
+
+Format strings consist of characters that are to be written to the
+output stream plus directives (which are marked by ~) as in "The
+answer is ~,2f". Format strings are documented in detail in
+[*Common Lisp the Language*, 2nd edition, Chapter 22](http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/clm/node200.html#SECTION002633000000000000000).
+
+_args_ is a set of arguments whose use is defined by the format.
+
+## Using column aware streams across format invocations
+
+Writers in Java have no real idea of current column or device page width, so the format
+directives that want to work relative to the current position on the
+page have nothing to work with. To deal with this, cl-format contains
+an extension to writer called pretty-writer. A pretty-writer watches the
+output and keeps track of what column the current output is going to.
+
+When you call format and your format includes a directive that cares
+about what column it's in (~T, ~&, ~<...~>), cl-format will
+automatically wrap the Writer you passed in with a pretty-writer. This
+means that by default all cl-format statements act like they begin on
+a fresh line and have a page width of 72.
+
+For many applications, these assumptions are fine and you need to do
+nothing more. But sometimes you want to use multiple cl-format calls
+that output partial lines. You may also want to mix cl-format calls
+with the native clojure calls like print. If you want stay
+column-aware while doing this you need to create a pretty-writer of
+your own (and possibly bind it to `*`out`*`).
+
+As an example of this, this function takes a nested list and prints it
+as a table (returning the result as a string):
+
+ (defn list-to-table [aseq column-width]
+ (let [string-writer (java.io.StringWriter.)
+ stream (get-pretty-writer string-writer)]
+ (binding [*out* stream]
+ (doseq [row aseq]
+ (doseq [col row]
+ (cl-format true "~4D~7,vT" col column-width))
+ (prn)))
+ (.flush stream)
+ (.toString string-writer)))
+
+(In reality, you'd probably do this as a single call to cl-format.)
+
+The get-pretty-writer function takes the Writer to wrap and
+(optionally) the page width (in columns) for use with ~<...~>.
+
+## Examples
+
+The following function uses cl-format to dump a columnized table of the Java system properties:
+
+ (defn show-props [stream]
+ (let [p (mapcat
+ #(vector (key %) (val %))
+ (sort-by key (System/getProperties)))]
+ (cl-format stream "~30A~A~%~{~20,,,'-A~10A~}~%~{~30A~S~%~}"
+ "Property" "Value" ["" "" "" ""] p)))
+
+There are some more examples in the pretty print examples gallery at
+http://github.com/tomfaulhaber/pprint-examples:
+
+ * hexdump - a program that uses cl-format to create a standard formatted hexdump of the requested stream.
+ * multiply - a function to show a formatted multipication table in a very "first-order" way.
+ * props - the show-props example shown above.
+ * show_doc - some utilities for showing documentation from various name spaces.
+
+## Differences from the Common Lisp format function
+
+The floating point directives that show exponents (~E, ~G) show E for
+the exponent character in all cases (unless overridden with an
+_exponentchar_). Clojure does not distinguish between floats and
+doubles in its printed representation and neither does cl-format.
+
+The ~A and ~S directives accept the colon prefix, but ignore it since
+() and nil are not equivalent in Clojure.
+
+Clojure has 3 different reader syntaxes for characters. The ~@c
+directive to cl-format has an argument extension to let you choose:
+
+ * ~@c (with no argument) prints "\c" (backslash followed by the printed representation of the character or \newline, \space, \tab, \backspace, \return)
+ * ~'o@c prints "\oDDD" where DDD are the octal digits representing the character.
+ * ~'u@c prints "\uXXXX" prints the hex Unicode representation of the character.
diff --git a/doc/pprint/PrettyPrinting.markdown b/doc/pprint/PrettyPrinting.markdown
new file mode 100644
index 00000000..db7b26bb
--- /dev/null
+++ b/doc/pprint/PrettyPrinting.markdown
@@ -0,0 +1,270 @@
+# A Pretty Printer for Clojure
+
+## Overview
+
+This namespace adds a new feature to Clojure: a generalized pretty
+printer.
+
+The pretty printer is easy to use:
+
+ user=> (println (for [x (range 10)] (range x)))
+ (() (0) (0 1) (0 1 2) (0 1 2 3) (0 1 2 3 4) (0 1 2 3 4 5) (0 1 2 3 4 5 6) (0 1 2 3 4 5 6 7) (0 1 2 3 4 5 6 7 8))
+ nil
+ user=> (use 'clojure.pprint)
+ nil
+ user=> (pprint (for [x (range 10)] (range x)))
+ (()
+ (0)
+ (0 1)
+ (0 1 2)
+ (0 1 2 3)
+ (0 1 2 3 4)
+ (0 1 2 3 4 5)
+ (0 1 2 3 4 5 6)
+ (0 1 2 3 4 5 6 7)
+ (0 1 2 3 4 5 6 7 8))
+ nil
+ user=>
+
+The pretty printer supports two modes: _code_ which has special
+formatting for special forms and core macros and _simple_ (the
+default) which formats the various Clojure data structures as
+appropriate for raw data. In fact, the pretty printer is
+highly customizable, but basic use is pretty simple.
+
+All the functions and variables described here are in the
+clojure.pprint namespace. Using them is as simple as adding a
+`(:use clojure.pprint)` to
+your namespace declarations. Or, better practice would be
+`(:use [clojure.pprint :only (<functions you wish to use>)])`.
+
+pprint is being developed by Tom Faulhaber (to mail me you can use
+my first name at my domain which is infolace.com).
+
+As with the rest of Clojure, the pretty printer is licensed under the
+[http://opensource.org/licenses/eclipse-1.0.php Eclipse Public License 1.0].
+
+Future development is guided by those using it, so send feedback about
+what's working and not working for you and what you'd like to see in the
+pretty printer.
+
+## Pretty Printing Basics
+
+Pretty printing is primarily implemented with the function
+pprint. pprint takes a single argument and formats it according to the
+settings of several special variables.
+
+Generally, the defaults are fine for pretty printing and you can
+simply use:
+
+ (pprint obj)
+
+to print your object. If you wish to write to
+another stream besides `*`out`*`, you can use:
+
+ (write obj :pretty true :stream foo)
+
+where foo is the stream to which you wish to write. (The write
+function has a lot more options which are not yet documented. Stay
+tuned.)
+
+When at the REPL, the pp macro pretty prints the last output
+value. This is useful when you get something too complex to read
+comfortably. Just type:
+
+ user=> (pp)
+
+and you'll get a pretty printed version of the last thing output (the
+magic variable `*`1).
+
+## Dispatch tables and code formatting
+
+The behavior of the pretty printer can be finely controlled through
+the use of _dispatch tables_ that contain descriptions for how
+different structures should be formatted.
+
+Using custom dispatch tables, the pretty printer can create formatted
+output for data structures that is customized for the
+application. This allows pretty printing to be baked into any
+structured output. For information and examples, see below in
+[#Custom_Dispatch_Functions Custom Dispatch Functions].
+
+The pretty printer comes with two pre-defined dispatch tables to cover
+the most common situations:
+
+`*`simple-dispatch`*` - supports basic representation of data in various
+Clojure structures: seqs, maps, vectors, etc. in a fairly statndard
+way. When structures need to be broken across lines, following lines
+are indented to line up with the first element. `*`simple-dispatch`*` is
+the default and is good for showing the output of most operations.
+
+`*`code-dispatch`*` - has special representation for various structures
+found in code: defn, condp, binding vectors, anonymous functions,
+etc. This dispatch indents following lines of a list one more space as
+appropriate for a function/argument type of list.
+
+An example formatted with code dispatch:
+
+ user=> (def code '(defn cl-format
+ "An implementation of a Common Lisp compatible format function"
+ [stream format-in & args] (let [compiled-format (if (string? format-in)
+ (compile-format format-in) format-in) navigator (init-navigator args)]
+ (execute-format stream compiled-format navigator))))
+ #'user/code
+ user=> (with-pprint-dispatch *code-dispatch* (pprint code))
+ (defn cl-format
+ "An implementation of a Common Lisp compatible format function"
+ [stream format-in & args]
+ (let [compiled-format (if (string? format-in)
+ (compile-format format-in)
+ format-in)
+ navigator (init-navigator args)]
+ (execute-format stream compiled-format navigator)))
+ nil
+ user=>
+
+There are three ways to set the current dispatch: set it to a specific
+table permanantly with set-pprint-dispatch, bind it with
+with-pprint-dispatch (as shown in the example above), or use the
+:dispatch keyword argument to write.
+
+## Control variables
+
+The operation of pretty printing is also controlled by a set of variables
+that control general parameters of how the pretty printer makes
+decisions. The current list is as follows:
+
+*`*`print-pretty`*`*: Default: *true*
+
+Bind to true if you want write to use pretty printing. (pprint and pp automatically
+bind this to true.)
+
+*`*`print-right-margin`*`*: Default: *72*
+
+Pretty printing will try to avoid anything going beyond this column.
+
+*`*`print-miser-width`*`*: Default: *40*
+
+The column at which to enter miser style. Depending on the dispatch table,
+miser style add newlines in more places to try to keep lines short allowing for further
+levels of nesting. For example, in the code dispatch table, the pretty printer will
+insert a newline between the "if" and its condition when in miser style.
+
+*`*`print-suppress-namespaces`*`*: Default: *false*
+
+Don't print namespaces with symbols. This is particularly useful when
+pretty printing the results of macro expansions
+
+*`*`print-level`*`*: Default: *nil*
+
+As with the regular Clojure print function, this variable controls the
+depth of structure that is printed. The argument itself is level 0,
+the first level of a collection is level 1, etc. When the structure
+gets deeper than the specified `*`print-level`*`, a hash sign (#) is
+printed.
+
+For example:
+
+ user=> (binding [*print-level* 2] (pprint '(a b (c d) ((e) ((f d) g)))))
+ (a b (c d) (# #))
+ nil
+ user=>
+
+*`*`print-length`*`*: Default: *nil*
+
+As with the regular Clojure print function, this variable controls the
+number of items that are printed at each layer of structure. When a
+layer has too many items, elipses (...) are displayed.
+
+For example:
+
+ user=> (defn foo [x] (for [i (range x) ] (range 1 (- x (dec i)))))
+ #'user/foo
+ user=> (binding [*print-length* 6] (pprint (foo 10)))
+ ((1 2 3 4 5 6 ...)
+ (1 2 3 4 5 6 ...)
+ (1 2 3 4 5 6 ...)
+ (1 2 3 4 5 6 ...)
+ (1 2 3 4 5 6)
+ (1 2 3 4 5)
+ ...)
+ nil
+ user=>
+
+## Custom Dispatch Functions
+
+Using custom dispatch, you can easily create your own formatted output
+for structured data. Examples included with the pretty printer show
+how to use custom dispatch to translate simple Clojure structures into
+nicely formatted JSON and XML.
+
+### Basic Concepts of Pretty Printing
+
+In order to create custom dispatch functions, you need to understand
+the fundamentals of pretty printing. The clojure pretty printer is
+based on the XP pretty printer algorithm (used in many Lisps including
+Common Lisp) which supports sophisticated decision-making about line
+breaking and indentation with reasonable performance even for very
+large structures. The XP algorithm is documented in the paper,
+[http://dspace.mit.edu/handle/1721.1/6504 XP. A Common Lisp Pretty
+Printing System].
+
+The Clojure implementation of XP is similar in spirit to the Common
+Lisp implementation, but the details of the interface are somewhat
+different. The result is that writing custom dispatch in Clojure is
+more "Clojure-y."
+
+There are three key concepts to understand when creating custom pretty
+printing functions: _logical blocks_, _conditional newlines_, and
+_indentation_.
+
+A _logical block_ marks a set of output that should be thought about
+as a single unit by the pretty printer. Logical blocks can contain
+other logical blocks (that is, they nest). As a simple example, when
+printing list structure, every sublist will typically be a logical
+block.
+
+_Conditional newlines_ tell the pretty printer where it can insert
+line breaks and how to make the decisions about when to do it. There
+are four types of conditional newline:
+
+ * Linear newlines tell the pretty printer to insert a newline in a
+ place whenever the enclosing logical block won't fit on a single
+ line. Linear newlines are an all-or-nothing proposition; if the
+ logical block doesn't fit on a single line, *all* the linear
+ newlines are emitted as actual newlines.
+ * Fill newlines tell the pretty printer that it should fit as many
+ chunks of the logical block as possible on this line and then emit
+ a newline.
+ * Mandatory newlines tell the pretty printer to emit a newline
+ regardless of where it is in the output line.
+ * Miser newlines tell the pretty printer to emit a newline if the
+ output column is in the miser region (as defined by the pretty
+ printer variable `*`pprint-miser-width`*`). This allows you to
+ define special behavior as the output gets heavily nested near the
+ right margin.
+
+_Indentation_ commands allow you to specify how wrapped lines should
+be indented. Indentation can be relative to either the start column of
+the current logical block or the current column position of the output.
+
+(This section is still incomplete...)
+
+## Current limitations and future plans
+
+This is an early version release of the pretty printer and there is
+plenty that is yet to come.
+
+Here are some examples:
+
+ * Support all the types and forms in Clojure (most of the way there now).
+ * Support for limiting pretty printing based on line counts.
+ * Support for circular and shared substructure detection.
+ * Finishing the integration with the format function (support for ~/ and tabular pretty printing).
+ * Performance! (Not much thought has been made to making this go fast, but there are a bunch of pretty obvious speedups to be had.)
+ * Handle Java objects intelligently
+
+Please let me know about anything that's not working right, anything that
+should work differently, or the feature you think should be at the top
+of my list.
+
diff --git a/src/clj/clojure/pprint.clj b/src/clj/clojure/pprint.clj
new file mode 100644
index 00000000..99fc605a
--- /dev/null
+++ b/src/clj/clojure/pprint.clj
@@ -0,0 +1,48 @@
+;;; pprint.clj -- Pretty printer and Common Lisp compatible format function (cl-format) 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
+
+(ns
+ ^{:author "Tom Faulhaber",
+ :doc "A Pretty Printer for Clojure
+
+clojure.pprint implements a flexible system for printing structured data
+in a pleasing, easy-to-understand format. Basic use of the pretty printer is
+simple, just call pprint instead of println. More advanced users can use
+the building blocks provided to create custom output formats.
+
+Out of the box, pprint supports a simple structured format for basic data
+and a specialized format for Clojure source code. More advanced formats,
+including formats that don't look like Clojure data at all like XML and
+JSON, can be rendered by creating custom dispatch functions.
+
+In addition to the pprint function, this module contains cl-format, a text
+formatting function which is fully compatible with the format function in
+Common Lisp. Because pretty printing directives are directly integrated with
+cl-format, it supports very concise custom dispatch. It also provides
+a more powerful alternative to Clojure's standard format function.
+
+See documentation for pprint and cl-format for more information or
+complete documentation on the the clojure web site on github.",
+ :added "1.2"}
+ clojure.pprint
+ (:refer-clojure :exclude (deftype)))
+
+
+(load "pprint/utilities")
+(load "pprint/column_writer")
+(load "pprint/pretty_writer")
+(load "pprint/pprint_base")
+(load "pprint/cl_format")
+(load "pprint/dispatch")
+
+nil
diff --git a/src/clj/clojure/pprint/cl_format.clj b/src/clj/clojure/pprint/cl_format.clj
new file mode 100644
index 00000000..71feeeed
--- /dev/null
+++ b/src/clj/clojure/pprint/cl_format.clj
@@ -0,0 +1,1896 @@
+;;; cl_format.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 the Common Lisp compatible format function as documented
+;; in "Common Lisp the Language, 2nd edition", Chapter 22 (available online at:
+;; http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/clm/node200.html#SECTION002633000000000000000)
+
+(in-ns 'clojure.pprint)
+
+;;; Forward references
+(declare compile-format)
+(declare execute-format)
+(declare init-navigator)
+;;; End forward references
+
+(defn cl-format
+ "An implementation of a Common Lisp compatible format function. cl-format formats its
+arguments to an output stream or string based on the format control string given. It
+supports sophisticated formatting of structured data.
+
+Writer is an instance of java.io.Writer, true to output to *out* or nil to output
+to a string, format-in is the format control string and the remaining arguments
+are the data to be formatted.
+
+The format control string is a string to be output with embedded 'format directives'
+describing how to format the various arguments passed in.
+
+If writer is nil, cl-format returns the formatted result string. Otherwise, cl-format
+returns nil.
+
+For example:
+ (let [results [46 38 22]]
+ (cl-format true \"There ~[are~;is~:;are~]~:* ~d result~:p: ~{~d~^, ~}~%\"
+ (count results) results))
+
+Prints to *out*:
+ There are 3 results: 46, 38, 22
+
+Detailed documentation on format control strings is available in the \"Common Lisp the
+Language, 2nd edition\", Chapter 22 (available online at:
+http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/clm/node200.html#SECTION002633000000000000000)
+and in the Common Lisp HyperSpec at
+http://www.lispworks.com/documentation/HyperSpec/Body/22_c.htm
+"
+ {:added "1.2",
+ :see-also [["http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/clm/node200.html#SECTION002633000000000000000"
+ "Common Lisp the Language"]
+ ["http://www.lispworks.com/documentation/HyperSpec/Body/22_c.htm"
+ "Common Lisp HyperSpec"]]}
+ [writer format-in & args]
+ (let [compiled-format (if (string? format-in) (compile-format format-in) format-in)
+ navigator (init-navigator args)]
+ (execute-format writer compiled-format navigator)))
+
+(def ^{:private true} *format-str* nil)
+
+(defn- format-error [message offset]
+ (let [full-message (str message \newline *format-str* \newline
+ (apply str (repeat offset \space)) "^" \newline)]
+ (throw (RuntimeException. full-message))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Argument navigators manage the argument list
+;;; as the format statement moves through the list
+;;; (possibly going forwards and backwards as it does so)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defstruct ^{:private true}
+ arg-navigator :seq :rest :pos )
+
+(defn- init-navigator
+ "Create a new arg-navigator from the sequence with the position set to 0"
+ {:skip-wiki true}
+ [s]
+ (let [s (seq s)]
+ (struct arg-navigator s s 0)))
+
+;; TODO call format-error with offset
+(defn- next-arg [ navigator ]
+ (let [ rst (:rest navigator) ]
+ (if rst
+ [(first rst) (struct arg-navigator (:seq navigator ) (next rst) (inc (:pos navigator)))]
+ (throw (new Exception "Not enough arguments for format definition")))))
+
+(defn- next-arg-or-nil [navigator]
+ (let [rst (:rest navigator)]
+ (if rst
+ [(first rst) (struct arg-navigator (:seq navigator ) (next rst) (inc (:pos navigator)))]
+ [nil navigator])))
+
+;; Get an argument off the arg list and compile it if it's not already compiled
+(defn- get-format-arg [navigator]
+ (let [[raw-format navigator] (next-arg navigator)
+ compiled-format (if (instance? String raw-format)
+ (compile-format raw-format)
+ raw-format)]
+ [compiled-format navigator]))
+
+(declare relative-reposition)
+
+(defn- absolute-reposition [navigator position]
+ (if (>= position (:pos navigator))
+ (relative-reposition navigator (- (:pos navigator) position))
+ (struct arg-navigator (:seq navigator) (drop position (:seq navigator)) position)))
+
+(defn- relative-reposition [navigator position]
+ (let [newpos (+ (:pos navigator) position)]
+ (if (neg? position)
+ (absolute-reposition navigator newpos)
+ (struct arg-navigator (:seq navigator) (drop position (:rest navigator)) newpos))))
+
+(defstruct ^{:private true}
+ compiled-directive :func :def :params :offset)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; When looking at the parameter list, we may need to manipulate
+;;; the argument list as well (for 'V' and '#' parameter types).
+;;; We hide all of this behind a function, but clients need to
+;;; manage changing arg navigator
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; TODO: validate parameters when they come from arg list
+(defn- realize-parameter [[param [raw-val offset]] navigator]
+ (let [[real-param new-navigator]
+ (cond
+ (contains? #{ :at :colon } param) ;pass flags through unchanged - this really isn't necessary
+ [raw-val navigator]
+
+ (= raw-val :parameter-from-args)
+ (next-arg navigator)
+
+ (= raw-val :remaining-arg-count)
+ [(count (:rest navigator)) navigator]
+
+ true
+ [raw-val navigator])]
+ [[param [real-param offset]] new-navigator]))
+
+(defn- realize-parameter-list [parameter-map navigator]
+ (let [[pairs new-navigator]
+ (map-passing-context realize-parameter navigator parameter-map)]
+ [(into {} pairs) new-navigator]))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Functions that support individual directives
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Common handling code for ~A and ~S
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(declare opt-base-str)
+
+(def ^{:private true}
+ special-radix-markers {2 "#b" 8 "#o", 16 "#x"})
+
+(defn- format-simple-number [n]
+ (cond
+ (integer? n) (if (= *print-base* 10)
+ (str n (if *print-radix* "."))
+ (str
+ (if *print-radix* (or (get special-radix-markers *print-base*) (str "#" *print-base* "r")))
+ (opt-base-str *print-base* n)))
+ (ratio? n) (str
+ (if *print-radix* (or (get special-radix-markers *print-base*) (str "#" *print-base* "r")))
+ (opt-base-str *print-base* (.numerator n))
+ "/"
+ (opt-base-str *print-base* (.denominator n)))
+ :else nil))
+
+(defn- format-ascii [print-func params arg-navigator offsets]
+ (let [ [arg arg-navigator] (next-arg arg-navigator)
+ ^String base-output (or (format-simple-number arg) (print-func arg))
+ base-width (.length base-output)
+ min-width (+ base-width (:minpad params))
+ width (if (>= min-width (:mincol params))
+ min-width
+ (+ min-width
+ (* (+ (quot (- (:mincol params) min-width 1)
+ (:colinc params) )
+ 1)
+ (:colinc params))))
+ chars (apply str (repeat (- width base-width) (:padchar params)))]
+ (if (:at params)
+ (print (str chars base-output))
+ (print (str base-output chars)))
+ arg-navigator))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Support for the integer directives ~D, ~X, ~O, ~B and some
+;;; of ~R
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn- integral?
+ "returns true if a number is actually an integer (that is, has no fractional part)"
+ [x]
+ (cond
+ (integer? x) true
+ (decimal? x) (>= (.ulp (.stripTrailingZeros (bigdec 0))) 1) ; true iff no fractional part
+ (float? x) (= x (Math/floor x))
+ (ratio? x) (let [^clojure.lang.Ratio r x]
+ (= 0 (rem (.numerator r) (.denominator r))))
+ :else false))
+
+(defn- remainders
+ "Return the list of remainders (essentially the 'digits') of val in the given base"
+ [base val]
+ (reverse
+ (first
+ (consume #(if (pos? %)
+ [(rem % base) (quot % base)]
+ [nil nil])
+ val))))
+
+;;; TODO: xlated-val does not seem to be used here.
+(defn- base-str
+ "Return val as a string in the given base"
+ [base val]
+ (if (zero? val)
+ "0"
+ (let [xlated-val (cond
+ (float? val) (bigdec val)
+ (ratio? val) (let [^clojure.lang.Ratio r val]
+ (/ (.numerator r) (.denominator r)))
+ :else val)]
+ (apply str
+ (map
+ #(if (< % 10) (char (+ (int \0) %)) (char (+ (int \a) (- % 10))))
+ (remainders base val))))))
+
+(def ^{:private true}
+ java-base-formats {8 "%o", 10 "%d", 16 "%x"})
+
+(defn- opt-base-str
+ "Return val as a string in the given base, using clojure.core/format if supported
+for improved performance"
+ [base val]
+ (let [format-str (get java-base-formats base)]
+ (if (and format-str (integer? val))
+ (clojure.core/format format-str val)
+ (base-str base val))))
+
+(defn- group-by* [unit lis]
+ (reverse
+ (first
+ (consume (fn [x] [(seq (reverse (take unit x))) (seq (drop unit x))]) (reverse lis)))))
+
+(defn- format-integer [base params arg-navigator offsets]
+ (let [[arg arg-navigator] (next-arg arg-navigator)]
+ (if (integral? arg)
+ (let [neg (neg? arg)
+ pos-arg (if neg (- arg) arg)
+ raw-str (opt-base-str base pos-arg)
+ group-str (if (:colon params)
+ (let [groups (map #(apply str %) (group-by* (:commainterval params) raw-str))
+ commas (repeat (count groups) (:commachar params))]
+ (apply str (next (interleave commas groups))))
+ raw-str)
+ ^String signed-str (cond
+ neg (str "-" group-str)
+ (:at params) (str "+" group-str)
+ true group-str)
+ padded-str (if (< (.length signed-str) (:mincol params))
+ (str (apply str (repeat (- (:mincol params) (.length signed-str))
+ (:padchar params)))
+ signed-str)
+ signed-str)]
+ (print padded-str))
+ (format-ascii print-str {:mincol (:mincol params) :colinc 1 :minpad 0
+ :padchar (:padchar params) :at true}