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

Parent Directory | Revision Log | Patch

	revision 537, Fri Feb 18 17:20:16 2000 UTC	revision 587, Thu Mar 30 09:01:52 2000 UTC
#	Line 11	Line 11
11	* Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)	* Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
12	*)	*)
13	local	local
14		structure DG = DependencyGraph
15	structure GG = GroupGraph	structure GG = GroupGraph
16	structure GP = GeneralParams	structure GP = GeneralParams
17	structure TS = TStamp	structure TS = TStamp
18	in	in
19	signature VERIFY_STABLE = sig	signature VERIFY_STABLE = sig
20	val verify : GP.info -> GG.group -> bool	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	end	end
29
30	structure VerifyStable :> VERIFY_STABLE = struct	functor VerStabFn (structure Stabilize: STABILIZE) :> VERIFY_STABLE = struct
31	fun verify (gp: GP.info) g = let
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	val policy = #fnpolicy (#param gp)	val policy = #fnpolicy (#param gp)
37	fun sname p = FilenamePolicy.mkStableName policy p	fun sname p = FilenamePolicy.mkStableName policy p
	val GG.GROUP { grouppath, exports, sublibs, ... } = g
38	val stablename = sname grouppath	val stablename = sname grouppath
39	fun invalidSublib st (p, GG.GROUP { kind = GG.STABLELIB _, ... }) =
	let val sn = sname p
	in case TS.fmodTime sn of
	TS.TSTAMP t => Time.compare (t, st) = GREATER
	| _ => true
	end
	| invalidSublib _ _ = true
40	fun invalidMember stab_t i = let	fun invalidMember stab_t i = let
41	val p = SmlInfo.sourcepath i	val p = SmlInfo.sourcepath i
42
43	val bn = SmlInfo.binname i	val bn = SmlInfo.binname i
44	in	in
45	case (SrcPath.tstamp p, TS.fmodTime bn) of	case (SrcPath.tstamp p, TS.fmodTime bn) of
#	Line 42	Line 48
48	Time.compare (src_t, stab_t) = GREATER	Time.compare (src_t, stab_t) = GREATER
49	| _ => true	| _ => true
50	end	end
51
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	in
67	case (TS.fmodTime stablename, SrcPath.tstamp grouppath) of	(* The group itself is included in "groups"... *)
68	(TS.TSTAMP st, TS.TSTAMP gt) =>	not (SrcPathSet.exists (invalidGroup st) groups) andalso
69	if Time.compare (st, gt) = LESS then false	not (List.exists nonstabSublib sublibs) andalso
70	else not (SmlInfoSet.exists (invalidMember st)	validStamp (grouppath, export_nodes, sublibs) andalso
71	(Reachable.reachable g) orelse	not (SmlInfoSet.exists (invalidMember st) m)
72	List.exists (invalidSublib st) sublibs)	end
73	| _ => false	| _ => false
74		in
75		if not isValid then
76		OS.FileSys.remove stablename handle _ => ()
77		else ();
78		isValid
79		end
80
81		fun verify _ _ GG.ERRORGROUP = false
82		| verify gp em (group as GG.GROUP g) = let
83		val { exports, grouppath, sublibs, ... } = g
84		val groups = Reachable.groupsOf group
85		in
86		verify' gp em (grouppath,
87		map (#2 o #1) (SymbolMap.listItems exports),
88		sublibs, groups)
89	end	end
90	end	end
91	end	end

---

Colored Diff Long Colored Diff Unidiff Context Diff Side by Side

Legend: Removed from v.537   changed lines   Added in v.587

---

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