Annotation of /sml/trunk/src/cm/stable/verify.sml

Parent Directory | Revision Log

---

Revision 569 - (view) (download)

1 :	blume	537	(*
2 :			* Verifying the validity of an existing stable file for a (non-stable)
3 :			* library.
4 :			* - This is used for "paranoia" mode during bootstrap compilation.
5 :			* Normally, CM takes stable files and doesn't ask questions, but
6 :			* during bootstrap compilation it takes the stable file only if
7 :			* it is verified to be valid.
8 :			*
9 :			* (C) 2000 Lucent Technologies, Bell Laboratories
10 :			*
11 :			* Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
12 :			*)
13 :			local
14 :	blume	569	structure DG = DependencyGraph
15 :	blume	537	structure GG = GroupGraph
16 :			structure GP = GeneralParams
17 :			structure TS = TStamp
18 :			in
19 :			signature VERIFY_STABLE = sig
20 :	blume	569	type exportmap = SmlInfo.info StableMap.map
21 :			val verify' : GP.info -> exportmap
22 :			-> SrcPath.t * (* grouppath *)
23 :			DG.sbnode list * (* export_nodes *)
24 :			(SrcPath.t * GG.group) list * (* sublibs *)
25 :			SrcPathSet.set (* groups *)
26 :			-> bool
27 :			val verify : GP.info -> exportmap -> GG.group -> bool
28 :	blume	537	end
29 :
30 :	blume	569	functor VerStabFn (structure Stabilize: STABILIZE) :> VERIFY_STABLE = struct
31 :
32 :			type exportmap = SmlInfo.info StableMap.map
33 :
34 :			fun verify' (gp: GP.info) em (grouppath, export_nodes, sublibs, groups) =
35 :			let val groups = SrcPathSet.add (groups, grouppath)
36 :	blume	537	val policy = #fnpolicy (#param gp)
37 :			fun sname p = FilenamePolicy.mkStableName policy p
38 :			val stablename = sname grouppath
39 :	blume	569
40 :	blume	537	fun invalidMember stab_t i = let
41 :			val p = SmlInfo.sourcepath i
42 :	blume	569
43 :	blume	537	val bn = SmlInfo.binname i
44 :			in
45 :			case (SrcPath.tstamp p, TS.fmodTime bn) of
46 :			(TS.TSTAMP src_t, TS.TSTAMP bin_t) =>
47 :			Time.compare (src_t, bin_t) <> EQUAL orelse
48 :			Time.compare (src_t, stab_t) = GREATER
49 :			| _ => true
50 :			end
51 :	blume	569
52 :			fun nonstabSublib (_, GG.GROUP { kind = GG.STABLELIB _, ... }) = false
53 :			| nonstabSublib _ = true
54 :
55 :			fun invalidGroup stab_t p =
56 :			case SrcPath.tstamp p of
57 :			TS.TSTAMP g_t => Time.compare (g_t, stab_t) = GREATER
58 :			| _ => true
59 :
60 :			val validStamp = Stabilize.libStampIsValid gp
61 :
62 :			val isValid =
63 :			case TS.fmodTime stablename of
64 :			TS.TSTAMP st => let
65 :			val (m, i) = Reachable.reachable' export_nodes
66 :			in
67 :			(* The group itself is included in "groups"... *)
68 :			not (SrcPathSet.exists (invalidGroup st) groups) andalso
69 :			not (List.exists nonstabSublib sublibs) andalso
70 :			validStamp (grouppath, export_nodes, sublibs) andalso
71 :			not (SmlInfoSet.exists (invalidMember st) m)
72 :			end
73 :			| _ => false
74 :	blume	537	in
75 :	blume	569	if not isValid then
76 :			OS.FileSys.remove stablename handle _ => ()
77 :			else ();
78 :			isValid
79 :	blume	537	end
80 :	blume	569
81 :			fun verify gp em (group as GG.GROUP g) = let
82 :			val { exports, grouppath, sublibs, ... } = g
83 :			val groups = Reachable.groupsOf group
84 :			in
85 :			verify' gp em (grouppath,
86 :			map (#2 o #1) (SymbolMap.listItems exports),
87 :			sublibs, groups)
88 :			end
89 :	blume	537	end
90 :			end

---

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