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

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