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

Parent Directory | Revision Log

---

Revision 666 - (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 :	blume	666	-> SrcPath.file * (* grouppath *)
23 :	blume	569	DG.sbnode list * (* export_nodes *)
24 :	blume	652	GG.subgrouplist * (* sublibs *)
25 :	blume	632	SrcPathSet.set * (* groups *)
26 :			Version.t option
27 :	blume	569	-> bool
28 :			val verify : GP.info -> exportmap -> GG.group -> bool
29 :	blume	537	end
30 :
31 :	blume	569	functor VerStabFn (structure Stabilize: STABILIZE) :> VERIFY_STABLE = struct
32 :
33 :			type exportmap = SmlInfo.info StableMap.map
34 :
35 :	blume	632	fun verify' (gp: GP.info) em args = let
36 :			val (grouppath, export_nodes, sublibs, groups, version) = args
37 :			val groups = SrcPathSet.add (groups, grouppath)
38 :	blume	537	val policy = #fnpolicy (#param gp)
39 :	blume	632	val stablename =
40 :			FilenamePolicy.mkStableName policy (grouppath, version)
41 :	blume	569
42 :	blume	537	fun invalidMember stab_t i = let
43 :			val p = SmlInfo.sourcepath i
44 :	blume	569
45 :	blume	537	val bn = SmlInfo.binname i
46 :			in
47 :			case (SrcPath.tstamp p, TS.fmodTime bn) of
48 :			(TS.TSTAMP src_t, TS.TSTAMP bin_t) =>
49 :			Time.compare (src_t, bin_t) <> EQUAL orelse
50 :			Time.compare (src_t, stab_t) = GREATER
51 :			| _ => true
52 :			end
53 :	blume	569
54 :	blume	666	fun nonstabSublib (_, gth, _) =
55 :	blume	652	case gth () of
56 :			GG.GROUP { kind = GG.LIB { kind = GG.STABLE _,
57 :			... }, ... } => false
58 :			| _ => true
59 :	blume	569
60 :			fun invalidGroup stab_t p =
61 :			case SrcPath.tstamp p of
62 :			TS.TSTAMP g_t => Time.compare (g_t, stab_t) = GREATER
63 :			| _ => true
64 :
65 :			val validStamp = Stabilize.libStampIsValid gp
66 :
67 :			val isValid =
68 :			case TS.fmodTime stablename of
69 :			TS.TSTAMP st => let
70 :			val (m, i) = Reachable.reachable' export_nodes
71 :			in
72 :			(* The group itself is included in "groups"... *)
73 :			not (SrcPathSet.exists (invalidGroup st) groups) andalso
74 :			not (List.exists nonstabSublib sublibs) andalso
75 :	blume	632	validStamp ((grouppath, export_nodes, sublibs), version)
76 :			andalso not (SmlInfoSet.exists (invalidMember st) m)
77 :	blume	569	end
78 :			| _ => false
79 :	blume	537	in
80 :	blume	569	if not isValid then
81 :			OS.FileSys.remove stablename handle _ => ()
82 :			else ();
83 :			isValid
84 :	blume	537	end
85 :	blume	569
86 :	blume	587	fun verify _ _ GG.ERRORGROUP = false
87 :			| verify gp em (group as GG.GROUP g) = let
88 :	blume	632	val { exports, grouppath, sublibs, kind, ... } = g
89 :	blume	587	val groups = Reachable.groupsOf group
90 :	blume	632	val version =
91 :			case kind of
92 :			GG.NOLIB _ => NONE
93 :			| GG.LIB { version, ... } => version
94 :	blume	652	fun force f = f ()
95 :	blume	587	in
96 :			verify' gp em (grouppath,
97 :	blume	652	map (#2 o force o #1) (SymbolMap.listItems exports),
98 :	blume	632	sublibs, groups, version)
99 :	blume	587	end
100 :	blume	537	end
101 :			end

---

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