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 293 - (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 :     exception InternalError
10 :     val read : AbsPath.t * TStamp.t -> Skeleton.decl option
11 :     val write : AbsPath.t * Skeleton.decl -> unit
12 :     end
13 :    
14 :     structure SkelIO :> SKELIO = struct
15 :    
16 :     structure SK = Skeleton
17 :     structure SS = SymbolSet
18 : blume 278 structure S = Symbol
19 : blume 275 structure SP = GenericVC.SymPath
20 :    
21 :     exception InternalError
22 :     exception FormatError
23 :    
24 :     val s2b = Byte.stringToBytes
25 :     val b2c = Byte.byteToChar
26 :    
27 : blume 286 val version = "Skeleton 1\n"
28 : blume 275
29 :     fun makeset l = SS.addList (SS.empty, l)
30 :    
31 :     fun inputLine s = let
32 :     fun finish acc = String.implode (rev acc)
33 :     fun loop acc =
34 :     case Option.map b2c (BinIO.input1 s) of
35 :     NONE => finish (#"\n" :: acc)
36 :     | SOME #"\n" => finish (#"\n" :: acc)
37 :     | SOME c => loop (c :: acc)
38 :     in
39 :     loop []
40 :     end
41 :    
42 :     fun write_decl (s, d) = let
43 :    
44 :     (* We are consing up the whole output as a list of strings
45 :     * before concatenating it to form the final result and
46 :     * wrinting it out using one single `output' call. *)
47 :     fun w_name (n, r) = let
48 :     val ns = S.nameSpace n
49 :     val prefix =
50 :     case ns of
51 : blume 293 S.SIGspace => ";"
52 :     | S.FCTspace => "("
53 :     | S.FSIGspace => ")"
54 :     | S.STRspace => "" (* this should be safe now *)
55 : blume 275 | _ => raise InternalError
56 :     in
57 :     prefix :: S.name n :: "." :: r
58 :     end
59 :    
60 : blume 293 fun w_list w ([], r) = "0" :: r
61 :     | w_list w ([a], r) = "1" :: w (a, r)
62 :     | w_list w ([a, b], r) = "2" :: w (a, w (b, r))
63 :     | w_list w ([a, b, c], r) = "3" :: w (a, w (b, w (c, r)))
64 :     | w_list w ([a, b, c, d], r) = "4" :: w (a, w (b, w (c, w (d, r))))
65 :     | w_list w (a :: b :: c :: d :: e :: x, r) =
66 :     "5" :: w (a, w (b, w (c, w (d, w (e, w_list w (x, r))))))
67 : blume 275
68 :     fun w_path (SP.SPATH p, r) = w_list w_name (p, r)
69 :    
70 : blume 286 fun w_decl (SK.Bind (name, def), r) =
71 :     "b" :: w_name (name, w_modExp (def, r))
72 :     | w_decl (SK.Local (x, y), r) = "l" :: w_decl (x, w_decl (y, r))
73 :     | w_decl (SK.Par l, r) = "p" :: w_list w_decl (l, r)
74 :     | w_decl (SK.Seq l, r) = "q" :: w_list w_decl (l, r)
75 :     | w_decl (SK.Open d, r) = "o" :: w_modExp (d, r)
76 :     | w_decl (SK.Ref s, r) = "r" :: w_list w_name (SS.listItems s, r)
77 : blume 275
78 : blume 286 and w_modExp (SK.Var p, r) = "v" :: w_path (p, r)
79 : blume 293 | w_modExp (SK.Decl d, r) = "d" :: w_list w_decl (d, r)
80 :     | w_modExp (SK.Let (d, m), r) =
81 :     "l" :: w_list w_decl (d, w_modExp (m, r))
82 : blume 291 | w_modExp (SK.Ign1 (m1, m2), r) =
83 :     "i" :: w_modExp (m1, w_modExp (m2, r))
84 : blume 275 in
85 :     BinIO.output (s, s2b (concat (version :: w_decl (d, ["\n"]))))
86 :     end
87 :    
88 :     fun read_decl s = let
89 :    
90 :     fun rd () = Option.map b2c (BinIO.input1 s)
91 :    
92 :     local
93 :     fun get (ns, first) = let
94 :     fun loop (accu, NONE) = raise FormatError
95 :     | loop ([], SOME #".") = raise FormatError
96 :     | loop (accu, SOME #".") = ns (String.implode (rev accu))
97 :     | loop (accu, SOME s) = loop (s :: accu, rd ())
98 :     in
99 :     loop ([], first)
100 :     end
101 :     in
102 : blume 293 fun r_name (SOME #";") = get (S.sigSymbol, rd ())
103 :     | r_name (SOME #"(") = get (S.fctSymbol, rd ())
104 :     | r_name (SOME #")") = get (S.fsigSymbol, rd ())
105 :     | r_name first = get (S.strSymbol, first)
106 : blume 275 end
107 :    
108 :     fun r_list r = let
109 : blume 293 fun n () = r (rd ())
110 :     fun rl (SOME #"0") = []
111 :     | rl (SOME #"1") = [n ()]
112 :     | rl (SOME #"2") = [n (), n ()]
113 :     | rl (SOME #"3") = [n (), n (), n ()]
114 :     | rl (SOME #"4") = [n (), n (), n (), n ()]
115 :     | rl (SOME #"5") =
116 :     n () :: n () :: n () :: n () :: n () :: rl (rd ())
117 :     | rl _ = raise FormatError
118 : blume 275 in
119 : blume 293 rl
120 : blume 275 end
121 :    
122 :     fun r_path first = SP.SPATH (r_list r_name first)
123 :    
124 : blume 286 fun r_decl (SOME #"b") = SK.Bind (r_name (rd ()), r_modExp (rd ()))
125 :     | r_decl (SOME #"l") = SK.Local (r_decl (rd ()), r_decl (rd ()))
126 :     | r_decl (SOME #"p") = SK.Par (r_list r_decl (rd ()))
127 :     | r_decl (SOME #"q") = SK.Seq (r_list r_decl (rd ()))
128 :     | r_decl (SOME #"o") = SK.Open (r_modExp (rd ()))
129 :     | r_decl (SOME #"r") = SK.Ref (makeset (r_list r_name (rd ())))
130 : blume 275 | r_decl _ = raise FormatError
131 :    
132 : blume 286 and r_modExp (SOME #"v") = SK.Var (r_path (rd ()))
133 : blume 293 | r_modExp (SOME #"d") = SK.Decl (r_list r_decl (rd ()))
134 :     | r_modExp (SOME #"l") =
135 :     SK.Let (r_list r_decl (rd ()), r_modExp (rd ()))
136 : blume 291 | r_modExp (SOME #"i") = SK.Ign1 (r_modExp (rd ()), r_modExp (rd ()))
137 : blume 286 | r_modExp _ = raise FormatError
138 : blume 275
139 :     val firstline = inputLine s
140 :     val r = if firstline = version then r_decl (rd ())
141 :     else raise FormatError
142 :     val nl = rd ()
143 :     in
144 :     if nl = SOME #"\n" then r else raise FormatError
145 :     end
146 :    
147 :     fun read (ap, ts) =
148 :     if TStamp.earlier (AbsPath.tstamp ap, ts) then NONE
149 :     else let
150 :     val s = AbsPath.openBinIn ap
151 :     val r = read_decl s
152 :     handle exn => (BinIO.closeIn s; raise exn)
153 :     in
154 :     BinIO.closeIn s; SOME r
155 :     end handle _ => NONE
156 :    
157 :     fun write (ap, sk) = let
158 :     val s = AbsPath.openBinOut Say.vsay ap
159 :     in
160 :     (Interrupt.guarded (fn () => write_decl (s, sk));
161 :     BinIO.closeOut s)
162 :     handle exn => let
163 :     val p = AbsPath.name ap
164 :     in
165 :     BinIO.closeOut s;
166 :     OS.FileSys.remove p handle _ => ();
167 :     Say.say (concat ["[writing ", p, " failed]\n"]);
168 :     raise exn
169 :     end
170 :     end handle Interrupt.Interrupt => raise Interrupt.Interrupt
171 :     | InternalError => raise InternalError
172 :     | _ => ()
173 :     end

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