Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] View of /sml/trunk/src/fc/format-combinators.sml
ViewVC logotype

View of /sml/trunk/src/fc/format-combinators.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1190 - (download) (annotate)
Mon May 13 20:39:05 2002 UTC (18 years, 6 months ago) by blume
File size: 6037 byte(s)
some minor bugfixes
(* format-combinators.sml
 *
 *   Well-typed "printf" for SML, aka "Unparsing Combinators".
 *     This code was written by Matthias Blume (2002).  Inspiration
 *     obtained from Olivier Danvy's "Functional Unparsing" work.
 *
 * (C) 2002, Lucent Technologies, Bell Labs
 *
 *
 * Description:
 *
 * The idea is to use combinators for constructing something akin to
 * the format string of C's printf function.  The difference is, however,
 * that our formats aren't strings.  Instead, format( fragment)s have
 * meaningful types, and passing them to function "format" results
 * in a curried function whose arguments have precisely the types that
 * correspond to argument-consuming parts of the format.  (Such
 * argument-consuming parts are similar to the %-specifications of printf.)
 *
 * Here is how the typing works: There is an underlying notion of
 * "abstract formats" of type 'a format.  However, the user operates
 * at the level of "format fragments" which have type ('a, 'b)
 * fragment and are typically polymorphic in 'a (where 'b is
 * instantiated to some type containing 'a).  Fragments are
 * functions from formats to formats and can be composed freely using
 * the function composition operator 'o'.  This form of format
 * composition translates to a corresponding concatenation of the
 * resulting output.
 *
 * Fragments are composed from two kids of primitve fragments called
 * "elements" and "glue", respectively.  An "element" is a fragment that
 * consumes some argument (which thanks to the typing magic appears as a
 * curried argument when the format gets executed).  As "glue" we refer
 * to fragments that do not consume arguments but merely insert fixed
 * text (fixed at format construction time) into the output.
 *
 * There are also adjustment operations that pad, trim, or fit the output
 * of entire fragments (primitive or not) to a given size.
 *
 * A number of elements and some glue has been predefined.  Here are
 * examples on how to use this facility:
 *
 *  open FormatCombinators
 *
 *  format nothing                      ==> ""
 *
 *  format int                          ==> fn: int -> string
 *  format int 1234                     ==> "1234"
 *
 *  format (t"The square of " o int o t" is " o int o t".")
 *                                      ==> fn: int -> int -> string
 *  format (t"The square of " o int o t" is " o int o t".") 2 4
 *                                      ==> "The square of 2 is 4."
 *
 *  format (int o bool o char)          ==> fn : int -> bool -> char -> string
 *  format (int o bool o char) 1 true #"x"
 *                                      ==> "1truex"
 *
 *  format (glue string "glue vs. " o string o glue int 42 o sp 5 o int)
 *         "ordinary text " 17
 *                                      ==> "glue vs. ordinary text 42     17" 
 *
 * Fragments can be padded, trimmed, or fitted to generate text pieces of 
 * specified sizes.  Padding/trimming/fitting may be nested.
 * The operations are parameterized by a place (left, center, right) and
 * a width. Padding never shrinks strings, trimming never extends
 * strings, and fitting is done as necessary by either padding or trimming.
 * Examples:
 *
 *  format (pad left 6 int) 1234        ==> "  1234"
 *  format (pad center 6 int) 1234      ==> " 1234 "
 *  format (pad right 6 int) 1234       ==> "1234  "
 *  format (trim left 2 int) 1234       ==> "34"
 *  format (trim center 2 int) 1234     ==> "23"
 *  format (trim right 2 int) 1234      ==> "12"
 *  format (fit left 3 int) 12          ==> " 12"
 *  format (fit left 3 int) 123         ==> "123"
 *  format (fit left 3 int) 1234        ==> "234"
 *
 * Nesting:
 *
 *  format (pad right 20 (int o pad left 10 real) o t"x") 12 22.3
 *                                      ==> "12      22.3        x"
 *)
structure FormatCombinators :> FORMAT_COMBINATORS = struct

    type 'a format         = string list -> 'a
    type ('a, 'b) fragment = 'a format -> 'b format
    type 'a glue           = ('a, 'a) fragment
    type ('a, 't) element  = ('a, 't -> 'a) fragment

    type place = int * int -> int
    fun left (a, i)   = a - i
    fun center (a, i) = Int.quot (a - i, 2)
    fun right (a, i)  = 0

    local
	(* Generic padding, trimming, and fitting.  Nestability
	 * is achieved by remembering the current state s, passing
	 * a new empty one to the fragment, adjusting the output
	 * from that, and fitting the result back into the remembered
	 * state. ("States" are string lists and correspond to
	 * output coming from fragments to the left of the current point.) *)
	fun ptf adj pl n fr fm s = let
	    fun work s' = let
		val x' = concat (rev s')
		val sz = size x'
	    in
		adj (x', sz, n, pl (sz, n)) :: s
	    end
	in
	    (fr (fm o work)) []
	end

	fun pad0 (s, sz, n, off) =
	    StringCvt.padRight #" " n (StringCvt.padLeft #" " (sz - off) s)
	fun trim0 (s, _, n, off) = String.substring (s, off, n)
	fun pad1 (arg as (s, sz, n, _)) = if n < sz then s else pad0 arg
	fun trim1 (arg as (s, sz, n, _)) = if n > sz then s else trim0 arg
	fun fit1 (arg as (_, sz, n, _)) = (if n < sz then trim0 else pad0) arg
    in
	fun format' rcv fr   = fr (rcv o rev) []
        fun format fr        = format' concat fr

	fun using cvt fm x a = fm (cvt a :: x)

        fun int fm           = using Int.toString fm
	fun real fm          = using Real.toString fm
	fun bool fm          = using Bool.toString fm
	fun string fm        = using (fn x => x) fm
	fun string' fm       = using String.toString fm
	fun char fm          = using String.str fm
	fun char' fm         = using Char.toString fm

	fun int' rdx fm      = using (Int.fmt rdx) fm
	fun real' rfmt fm    = using (Real.fmt rfmt) fm

	fun pad place        = ptf pad1 place
	fun trim place       = ptf trim1 place
	fun fit place        = ptf fit1 place
    end

    fun glue e a fm x = e fm x a

    fun nothing fm    = fm
    fun t s           = glue string s
    fun sp n          = pad left n nothing
    fun nl fm         = t "\n" fm
    fun tab fm        = t "\t" fm
end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0