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/cm/smlfile/skel-io.sml
ViewVC logotype

Annotation of /sml/trunk/src/cm/smlfile/skel-io.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 349 - (view) (download)

1 : blume 275 (*
2 :     * Reading and writing skeletons to skeleton files.
3 :     *
4 :     * (C) 1999 Lucent Technologies, Bell Laboratories
5 :     *
6 :     * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
7 :     *)
8 :     signature SKELIO = sig
9 :     val read : AbsPath.t * TStamp.t -> Skeleton.decl option
10 : blume 345 val write : AbsPath.t * Skeleton.decl * TStamp.t -> unit
11 : blume 275 end
12 :    
13 :     structure SkelIO :> SKELIO = struct
14 :    
15 :     structure SK = Skeleton
16 :     structure SS = SymbolSet
17 : blume 278 structure S = Symbol
18 : blume 275 structure SP = GenericVC.SymPath
19 :    
20 :     exception FormatError
21 :    
22 :     val s2b = Byte.stringToBytes
23 :     val b2c = Byte.byteToChar
24 :    
25 : blume 286 val version = "Skeleton 1\n"
26 : blume 275
27 :     fun makeset l = SS.addList (SS.empty, l)
28 :    
29 :     fun inputLine s = let
30 :     fun finish acc = String.implode (rev acc)
31 :     fun loop acc =
32 :     case Option.map b2c (BinIO.input1 s) of
33 :     NONE => finish (#"\n" :: acc)
34 :     | SOME #"\n" => finish (#"\n" :: acc)
35 :     | SOME c => loop (c :: acc)
36 :     in
37 :     loop []
38 :     end
39 :    
40 : blume 304 (* We are consing up the whole output as a list of strings
41 :     * before concatenating it to form the final result and
42 : blume 340 * writing it out using one single `output' call. *)
43 : blume 304 fun w_name (n, r) =
44 :     (case S.nameSpace n of
45 :     S.SIGspace => "'" (* only tyvars could start like that *)
46 :     | S.FCTspace => "(" (* no sym can start like that *)
47 :     | S.FSIGspace => ")" (* no sym can start like that *)
48 :     | S.STRspace => "" (* this should be safe now *)
49 : blume 340 | _ => GenericVC.ErrorMsg.impossible "SkelIO.w_name")
50 : blume 304 :: S.name n :: "." :: r
51 :    
52 : blume 275 fun write_decl (s, d) = let
53 :    
54 : blume 294 (* foldl means that last element appears first in output! *)
55 :     fun w_list w (l, r) = foldl w (";" :: r) l
56 : blume 275
57 :     fun w_path (SP.SPATH p, r) = w_list w_name (p, r)
58 :    
59 : blume 286 fun w_decl (SK.Bind (name, def), r) =
60 :     "b" :: w_name (name, w_modExp (def, r))
61 :     | w_decl (SK.Local (x, y), r) = "l" :: w_decl (x, w_decl (y, r))
62 :     | w_decl (SK.Par l, r) = "p" :: w_list w_decl (l, r)
63 :     | w_decl (SK.Seq l, r) = "q" :: w_list w_decl (l, r)
64 :     | w_decl (SK.Open d, r) = "o" :: w_modExp (d, r)
65 :     | w_decl (SK.Ref s, r) = "r" :: w_list w_name (SS.listItems s, r)
66 : blume 275
67 : blume 286 and w_modExp (SK.Var p, r) = "v" :: w_path (p, r)
68 : blume 293 | w_modExp (SK.Decl d, r) = "d" :: w_list w_decl (d, r)
69 :     | w_modExp (SK.Let (d, m), r) =
70 :     "l" :: w_list w_decl (d, w_modExp (m, r))
71 : blume 291 | w_modExp (SK.Ign1 (m1, m2), r) =
72 :     "i" :: w_modExp (m1, w_modExp (m2, r))
73 : blume 275 in
74 :     BinIO.output (s, s2b (concat (version :: w_decl (d, ["\n"]))))
75 :     end
76 :    
77 :     fun read_decl s = let
78 :    
79 :     fun rd () = Option.map b2c (BinIO.input1 s)
80 :    
81 :     local
82 :     fun get (ns, first) = let
83 :     fun loop (accu, NONE) = raise FormatError
84 :     | loop ([], SOME #".") = raise FormatError
85 :     | loop (accu, SOME #".") = ns (String.implode (rev accu))
86 :     | loop (accu, SOME s) = loop (s :: accu, rd ())
87 :     in
88 :     loop ([], first)
89 :     end
90 :     in
91 : blume 294 fun r_name (SOME #"'") = get (S.sigSymbol, rd ())
92 : blume 293 | r_name (SOME #"(") = get (S.fctSymbol, rd ())
93 :     | r_name (SOME #")") = get (S.fsigSymbol, rd ())
94 :     | r_name first = get (S.strSymbol, first)
95 : blume 275 end
96 :    
97 : blume 294 (* lists are written in reverse order, so a tail-recursive
98 :     * reader is exactly right because it undoes the reversal *)
99 :     fun r_list r first = let
100 :     (* argument order important: side effects in arguments! *)
101 :     fun rl (l, SOME #";") = l
102 :     | rl (l, first) = rl (r first :: l, rd ())
103 : blume 275 in
104 : blume 294 rl ([], first)
105 : blume 275 end
106 :    
107 :     fun r_path first = SP.SPATH (r_list r_name first)
108 :    
109 : blume 286 fun r_decl (SOME #"b") = SK.Bind (r_name (rd ()), r_modExp (rd ()))
110 :     | r_decl (SOME #"l") = SK.Local (r_decl (rd ()), r_decl (rd ()))
111 :     | r_decl (SOME #"p") = SK.Par (r_list r_decl (rd ()))
112 :     | r_decl (SOME #"q") = SK.Seq (r_list r_decl (rd ()))
113 :     | r_decl (SOME #"o") = SK.Open (r_modExp (rd ()))
114 :     | r_decl (SOME #"r") = SK.Ref (makeset (r_list r_name (rd ())))
115 : blume 275 | r_decl _ = raise FormatError
116 :    
117 : blume 286 and r_modExp (SOME #"v") = SK.Var (r_path (rd ()))
118 : blume 293 | r_modExp (SOME #"d") = SK.Decl (r_list r_decl (rd ()))
119 :     | r_modExp (SOME #"l") =
120 :     SK.Let (r_list r_decl (rd ()), r_modExp (rd ()))
121 : blume 291 | r_modExp (SOME #"i") = SK.Ign1 (r_modExp (rd ()), r_modExp (rd ()))
122 : blume 286 | r_modExp _ = raise FormatError
123 : blume 275
124 :     val firstline = inputLine s
125 :     val r = if firstline = version then r_decl (rd ())
126 :     else raise FormatError
127 :     val nl = rd ()
128 :     in
129 :     if nl = SOME #"\n" then r else raise FormatError
130 :     end
131 :    
132 :     fun read (ap, ts) =
133 : blume 345 if TStamp.needsUpdate { target = AbsPath.tstamp ap, source = ts } then
134 :     NONE
135 :     else
136 :     SOME (SafeIO.perform { openIt = fn () => AbsPath.openBinIn ap,
137 :     closeIt = BinIO.closeIn,
138 :     work = read_decl,
139 :     cleanup = fn () => () })
140 :     handle _ => NONE
141 : blume 275
142 : blume 345 fun write (ap, sk, ts) = let
143 : blume 349 fun cleanup () =
144 :     (AbsPath.delete ap;
145 :     Say.say ["[writing ", AbsPath.name ap, " failed]\n"])
146 : blume 345 in
147 :     SafeIO.perform { openIt = fn () => AbsPath.openBinOut ap,
148 :     closeIt = BinIO.closeOut,
149 :     work = fn s => write_decl (s, sk),
150 :     cleanup = cleanup };
151 :     AbsPath.setTime (ap, ts)
152 :     end
153 : blume 275 end

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