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

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