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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1190 - (view) (download)

1 : blume 1190 (* format-combinators.sml
2 :     *
3 :     * Well-typed "printf" for SML, aka "Unparsing Combinators".
4 :     * This code was written by Matthias Blume (2002). Inspiration
5 :     * obtained from Olivier Danvy's "Functional Unparsing" work.
6 :     *
7 :     * (C) 2002, Lucent Technologies, Bell Labs
8 :     *
9 :     *
10 :     * Description:
11 :     *
12 :     * The idea is to use combinators for constructing something akin to
13 :     * the format string of C's printf function. The difference is, however,
14 :     * that our formats aren't strings. Instead, format( fragment)s have
15 :     * meaningful types, and passing them to function "format" results
16 :     * in a curried function whose arguments have precisely the types that
17 :     * correspond to argument-consuming parts of the format. (Such
18 :     * argument-consuming parts are similar to the %-specifications of printf.)
19 :     *
20 :     * Here is how the typing works: There is an underlying notion of
21 :     * "abstract formats" of type 'a format. However, the user operates
22 :     * at the level of "format fragments" which have type ('a, 'b)
23 :     * fragment and are typically polymorphic in 'a (where 'b is
24 :     * instantiated to some type containing 'a). Fragments are
25 :     * functions from formats to formats and can be composed freely using
26 :     * the function composition operator 'o'. This form of format
27 :     * composition translates to a corresponding concatenation of the
28 :     * resulting output.
29 :     *
30 :     * Fragments are composed from two kids of primitve fragments called
31 :     * "elements" and "glue", respectively. An "element" is a fragment that
32 :     * consumes some argument (which thanks to the typing magic appears as a
33 :     * curried argument when the format gets executed). As "glue" we refer
34 :     * to fragments that do not consume arguments but merely insert fixed
35 :     * text (fixed at format construction time) into the output.
36 :     *
37 :     * There are also adjustment operations that pad, trim, or fit the output
38 :     * of entire fragments (primitive or not) to a given size.
39 :     *
40 :     * A number of elements and some glue has been predefined. Here are
41 :     * examples on how to use this facility:
42 :     *
43 :     * open FormatCombinators
44 :     *
45 :     * format nothing ==> ""
46 :     *
47 :     * format int ==> fn: int -> string
48 :     * format int 1234 ==> "1234"
49 :     *
50 :     * format (t"The square of " o int o t" is " o int o t".")
51 :     * ==> fn: int -> int -> string
52 :     * format (t"The square of " o int o t" is " o int o t".") 2 4
53 :     * ==> "The square of 2 is 4."
54 :     *
55 :     * format (int o bool o char) ==> fn : int -> bool -> char -> string
56 :     * format (int o bool o char) 1 true #"x"
57 :     * ==> "1truex"
58 :     *
59 :     * format (glue string "glue vs. " o string o glue int 42 o sp 5 o int)
60 :     * "ordinary text " 17
61 :     * ==> "glue vs. ordinary text 42 17"
62 :     *
63 :     * Fragments can be padded, trimmed, or fitted to generate text pieces of
64 :     * specified sizes. Padding/trimming/fitting may be nested.
65 :     * The operations are parameterized by a place (left, center, right) and
66 :     * a width. Padding never shrinks strings, trimming never extends
67 :     * strings, and fitting is done as necessary by either padding or trimming.
68 :     * Examples:
69 :     *
70 :     * format (pad left 6 int) 1234 ==> " 1234"
71 :     * format (pad center 6 int) 1234 ==> " 1234 "
72 :     * format (pad right 6 int) 1234 ==> "1234 "
73 :     * format (trim left 2 int) 1234 ==> "34"
74 :     * format (trim center 2 int) 1234 ==> "23"
75 :     * format (trim right 2 int) 1234 ==> "12"
76 :     * format (fit left 3 int) 12 ==> " 12"
77 :     * format (fit left 3 int) 123 ==> "123"
78 :     * format (fit left 3 int) 1234 ==> "234"
79 :     *
80 :     * Nesting:
81 :     *
82 :     * format (pad right 20 (int o pad left 10 real) o t"x") 12 22.3
83 :     * ==> "12 22.3 x"
84 :     *)
85 :     structure FormatCombinators :> FORMAT_COMBINATORS = struct
86 :    
87 :     type 'a format = string list -> 'a
88 :     type ('a, 'b) fragment = 'a format -> 'b format
89 :     type 'a glue = ('a, 'a) fragment
90 :     type ('a, 't) element = ('a, 't -> 'a) fragment
91 :    
92 :     type place = int * int -> int
93 :     fun left (a, i) = a - i
94 :     fun center (a, i) = Int.quot (a - i, 2)
95 :     fun right (a, i) = 0
96 :    
97 :     local
98 :     (* Generic padding, trimming, and fitting. Nestability
99 :     * is achieved by remembering the current state s, passing
100 :     * a new empty one to the fragment, adjusting the output
101 :     * from that, and fitting the result back into the remembered
102 :     * state. ("States" are string lists and correspond to
103 :     * output coming from fragments to the left of the current point.) *)
104 :     fun ptf adj pl n fr fm s = let
105 :     fun work s' = let
106 :     val x' = concat (rev s')
107 :     val sz = size x'
108 :     in
109 :     adj (x', sz, n, pl (sz, n)) :: s
110 :     end
111 :     in
112 :     (fr (fm o work)) []
113 :     end
114 :    
115 :     fun pad0 (s, sz, n, off) =
116 :     StringCvt.padRight #" " n (StringCvt.padLeft #" " (sz - off) s)
117 :     fun trim0 (s, _, n, off) = String.substring (s, off, n)
118 :     fun pad1 (arg as (s, sz, n, _)) = if n < sz then s else pad0 arg
119 :     fun trim1 (arg as (s, sz, n, _)) = if n > sz then s else trim0 arg
120 :     fun fit1 (arg as (_, sz, n, _)) = (if n < sz then trim0 else pad0) arg
121 :     in
122 :     fun format' rcv fr = fr (rcv o rev) []
123 :     fun format fr = format' concat fr
124 :    
125 :     fun using cvt fm x a = fm (cvt a :: x)
126 :    
127 :     fun int fm = using Int.toString fm
128 :     fun real fm = using Real.toString fm
129 :     fun bool fm = using Bool.toString fm
130 :     fun string fm = using (fn x => x) fm
131 :     fun string' fm = using String.toString fm
132 :     fun char fm = using String.str fm
133 :     fun char' fm = using Char.toString fm
134 :    
135 :     fun int' rdx fm = using (Int.fmt rdx) fm
136 :     fun real' rfmt fm = using (Real.fmt rfmt) fm
137 :    
138 :     fun pad place = ptf pad1 place
139 :     fun trim place = ptf trim1 place
140 :     fun fit place = ptf fit1 place
141 :     end
142 :    
143 :     fun glue e a fm x = e fm x a
144 :    
145 :     fun nothing fm = fm
146 :     fun t s = glue string s
147 :     fun sp n = pad left n nothing
148 :     fun nl fm = t "\n" fm
149 :     fun tab fm = t "\t" fm
150 :     end

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