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 651 - (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 : blume 354 val read : string * TStamp.t -> Skeleton.decl option
10 :     val write : string * 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 : blume 398 structure PU = PickleUtil
20 :     structure PSymPid = PickleSymPid
21 : blume 384 structure UU = UnpickleUtil
22 : blume 275
23 : blume 384 infix 3 $
24 : blume 275
25 : blume 384 exception Format = UU.Format
26 :    
27 : blume 275 val s2b = Byte.stringToBytes
28 : blume 391 val b2s = Byte.bytesToString
29 : blume 275 val b2c = Byte.byteToChar
30 :    
31 : blume 513 val version = "Skeleton 4\n"
32 : blume 275
33 :     fun makeset l = SS.addList (SS.empty, l)
34 :    
35 :     fun inputLine s = let
36 :     fun finish acc = String.implode (rev acc)
37 :     fun loop acc =
38 :     case Option.map b2c (BinIO.input1 s) of
39 :     NONE => finish (#"\n" :: acc)
40 :     | SOME #"\n" => finish (#"\n" :: acc)
41 :     | SOME c => loop (c :: acc)
42 :     in
43 :     loop []
44 :     end
45 :    
46 :     fun write_decl (s, d) = let
47 :    
48 : blume 513 val (P, D, M) = (1, 2, 3)
49 : blume 398 val symbol = PSymPid.w_symbol
50 : blume 384 val list = PU.w_list
51 : blume 275
52 : blume 513 val op $ = PU.$ P
53 :     fun path (SP.SPATH p) = "p" $ [list symbol p]
54 : blume 275
55 : blume 384 fun decl arg = let
56 :     val op $ = PU.$ D
57 : blume 513 fun d (SK.Bind (name, def)) = "a" $ [symbol name, modExp def]
58 :     | d (SK.Local (x, y)) = "b" $ [decl x, decl y]
59 :     | d (SK.Par l) = "c" $ [list decl l]
60 :     | d (SK.Seq l) = "d" $ [list decl l]
61 :     | d (SK.Open d) = "e" $ [modExp d]
62 :     | d (SK.Ref s) = "f" $ [list symbol (SS.listItems s)]
63 : blume 384 in
64 :     d arg
65 :     end
66 : blume 275
67 : blume 384 and modExp arg = let
68 :     val op $ = PU.$ M
69 : blume 513 fun m (SK.Var p) = "g" $ [path p]
70 :     | m (SK.Decl d) = "h" $ [list decl d]
71 :     | m (SK.Let (d, e)) = "i" $ [list decl d, modExp e]
72 :     | m (SK.Ign1 (e1, e2)) = "j" $ [modExp e1, modExp e2]
73 : blume 384 in
74 :     m arg
75 :     end
76 :    
77 : blume 398 val pickle = s2b (PU.pickle () (decl d))
78 : blume 275 in
79 : blume 384 BinIO.output (s, Byte.stringToBytes version);
80 :     BinIO.output (s, pickle)
81 : blume 275 end
82 :    
83 :     fun read_decl s = let
84 :    
85 : blume 392 val firstLine = inputLine s
86 :    
87 : blume 391 val session = UU.mkSession (UU.stringGetter (b2s (BinIO.inputAll s)))
88 : blume 275
89 : blume 393 val string = UU.r_string session
90 : blume 398 val symbol = UnpickleSymPid.r_symbol (session, string)
91 : blume 384 fun list m r = UU.r_list session m r
92 :     fun share m f = UU.share session m f
93 :    
94 : blume 513 val pathM = UU.mkMap ()
95 : blume 384 val symbolListM = UU.mkMap ()
96 :     val declM = UU.mkMap ()
97 :     val declListM = UU.mkMap ()
98 :     val modExpM = UU.mkMap ()
99 :    
100 :     val symbollist = list symbolListM symbol
101 :    
102 : blume 513 fun path () = let
103 :     fun p #"p" = SP.SPATH (symbollist ())
104 :     | p _ = raise Format
105 :     in
106 :     share pathM p
107 :     end
108 : blume 384
109 :     fun decl () = let
110 :     fun d #"a" = SK.Bind (symbol (), modExp ())
111 :     | d #"b" = SK.Local (decl (), decl ())
112 :     | d #"c" = SK.Par (decllist ())
113 :     | d #"d" = SK.Seq (decllist ())
114 :     | d #"e" = SK.Open (modExp ())
115 :     | d #"f" = SK.Ref (makeset (symbollist ()))
116 :     | d _ = raise Format
117 : blume 275 in
118 : blume 384 share declM d
119 : blume 275 end
120 :    
121 : blume 384 and decllist () = list declListM decl ()
122 :    
123 :     and modExp () = let
124 :     fun m #"g" = SK.Var (path ())
125 :     | m #"h" = SK.Decl (decllist ())
126 :     | m #"i" = SK.Let (decllist (), modExp ())
127 :     | m #"j" = SK.Ign1 (modExp (), modExp ())
128 :     | m _ = raise Format
129 : blume 275 in
130 : blume 384 share modExpM m
131 : blume 275 end
132 :     in
133 : blume 392 if firstLine = version then decl () else raise Format
134 : blume 275 end
135 :    
136 : blume 354 fun read (s, ts) =
137 :     if TStamp.needsUpdate { target = TStamp.fmodTime s, source = ts } then
138 : blume 345 NONE
139 :     else
140 : blume 354 SOME (SafeIO.perform { openIt = fn () => BinIO.openIn s,
141 : blume 345 closeIt = BinIO.closeIn,
142 :     work = read_decl,
143 : blume 459 cleanup = fn _ => () })
144 : blume 345 handle _ => NONE
145 : blume 275
146 : blume 354 fun write (s, sk, ts) = let
147 : blume 459 fun cleanup _ =
148 : blume 354 (OS.FileSys.remove s handle _ => ();
149 :     Say.say ["[writing ", s, " failed]\n"])
150 : blume 345 in
151 : blume 354 SafeIO.perform { openIt = fn () => AutoDir.openBinOut s,
152 : blume 345 closeIt = BinIO.closeOut,
153 :     work = fn s => write_decl (s, sk),
154 :     cleanup = cleanup };
155 : blume 354 TStamp.setTime (s, ts)
156 : blume 345 end
157 : blume 275 end

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