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

Parent Directory | 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