Annotation of /sml/trunk/src/cm/compile/bfc.sml

Parent Directory | Revision Log

---

Revision 403 - (view) (download)

1 :	blume	403	(*
2 :			* Keeping binfiles for short periods of time.
3 :			* This is used in "stabilize" and in "make" where first there is a
4 :			* "compile" traversal that produces certain binfile contents, and
5 :			* then there is a "consumer" traversal that uses the binfile contents.
6 :			* No error checking is done -- the "get" operation assumes that the
7 :			* stuff is either in its cache or in the file system.
8 :			*
9 :			* (C) 1999 Lucent Technologies, Bell Laboratories
10 :			*
11 :			* Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
12 :			*)
13 :			signature BFC = sig
14 :			type bfc
15 :			val new : unit -> { store: SmlInfo.info * bfc -> unit,
16 :			get: SmlInfo.info -> bfc }
17 :			end
18 :
19 :			functor BfcFn (structure MachDepVC : MACHDEP_VC) :> BFC
20 :			where type bfc = MachDepVC.Binfile.bfContent =
21 :			struct
22 :
23 :			structure BF = MachDepVC.Binfile
24 :			structure E = GenericVC.Environment
25 :			type bfc = BF.bfContent
26 :
27 :			val estat = E.staticPart E.emptyEnv
28 :
29 :			fun new () = let
30 :			val m = ref SmlInfoMap.empty
31 :
32 :			fun store (i, bfc) = m := SmlInfoMap.insert (!m, i, bfc)
33 :
34 :			fun get i =
35 :			case SmlInfoMap.find (!m, i) of
36 :			SOME bfc => bfc
37 :			| NONE => let
38 :			val binname = SmlInfo.binname i
39 :			fun reader s = let
40 :			val bfc = BF.read { stream = s, name = binname,
41 :			senv = estat }
42 :			in
43 :			store (i, bfc);
44 :			bfc
45 :			end
46 :			in
47 :			SafeIO.perform { openIt = fn () => BinIO.openIn binname,
48 :			closeIt = BinIO.closeIn,
49 :			work = reader,
50 :			cleanup = fn () => () }
51 :			end
52 :			in
53 :			{ store = store, get = get }
54 :			end
55 :			end

---

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