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/ml-nlffigen/cpif-dev.sml
ViewVC logotype

Annotation of /sml/trunk/src/ml-nlffigen/cpif-dev.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1067 - (view) (download)

1 : blume 1067 (* cpif-dev.sml
2 :     * A simple pretty-printing device that eventually writes to a
3 :     * text file unless the current contents of that file coincides
4 :     * with what's being written.
5 :     *
6 :     * (C) 2002, Lucent Technologies, Bell Labs
7 :     *
8 :     * author: Matthias Blume (blume@research.bell-labs.com)
9 :     *)
10 :     structure CPIFDev : sig
11 :    
12 :     include PP_DEVICE
13 :    
14 :     val openOut : string * int -> device
15 :     val closeOut : device -> unit
16 :    
17 :     end = struct
18 :    
19 :     datatype device =
20 :     DEV of { filename: string,
21 :     buffer : string list ref,
22 :     wid : int }
23 :    
24 :     (* no style support *)
25 :     type style = unit
26 :     fun sameStyle _ = true
27 :     fun pushStyle _ = ()
28 :     fun popStyle _ = ()
29 :     fun defaultStyle _ = ()
30 :    
31 :     (* Allocate an empty buffer and remember the file name. *)
32 :     fun openOut (f, w) = DEV { filename = f, buffer = ref [], wid = w }
33 :    
34 :     (* Calculate the final output and compare it with the current
35 :     * contents of the file. If they do not coincide, write the file. *)
36 :     fun closeOut (DEV { buffer = ref l, filename, ... }) = let
37 :     val s = concat (rev l)
38 :     fun write () = let
39 :     val f = TextIO.openOut filename
40 :     in
41 :     TextIO.output (f, s);
42 :     TextIO.closeOut f
43 :     end
44 :     in
45 :     let val f = TextIO.openIn filename
46 :     val s' = TextIO.inputAll f
47 :     in
48 :     TextIO.closeIn f;
49 :     if s = s' then () else write ()
50 :     end handle _ => write ()
51 :     end
52 :    
53 :     (* maximum printing depth (in terms of boxes) *)
54 :     fun depth _ = NONE
55 :    
56 :     (* the width of the device *)
57 :     fun lineWidth (DEV{wid, ...}) = SOME wid
58 :     (* the suggested maximum width of text on a line *)
59 :     fun textWidth _ = NONE
60 :    
61 :     (* output a string/character in the current style to the device *)
62 :     fun string (DEV { buffer, ... }, s) = buffer := s :: !buffer
63 :    
64 :     fun char (d, c) = string (d, String.str c)
65 :     fun space (d, n) = string (d, StringCvt.padLeft #" " n "")
66 :     fun newline d = string (d, "\n")
67 :    
68 :     fun flush d = ()
69 :     end

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