Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/cm/stable/verify.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 632 - (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 : 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 632 fun nonstabSublib (_, GG.GROUP { kind = GG.LIB { kind = GG.STABLE _,
55 :     ... }, ... }) = false
56 : blume 569 | nonstabSublib _ = true
57 :    
58 :     fun invalidGroup stab_t p =
59 :     case SrcPath.tstamp p of
60 :     TS.TSTAMP g_t => Time.compare (g_t, stab_t) = GREATER
61 :     | _ => true
62 :    
63 :     val validStamp = Stabilize.libStampIsValid gp
64 :    
65 :     val isValid =
66 :     case TS.fmodTime stablename of
67 :     TS.TSTAMP st => let
68 :     val (m, i) = Reachable.reachable' export_nodes
69 :     in
70 :     (* The group itself is included in "groups"... *)
71 :     not (SrcPathSet.exists (invalidGroup st) groups) andalso
72 :     not (List.exists nonstabSublib sublibs) andalso
73 : blume 632 validStamp ((grouppath, export_nodes, sublibs), version)
74 :     andalso not (SmlInfoSet.exists (invalidMember st) m)
75 : blume 569 end
76 :     | _ => false
77 : blume 537 in
78 : blume 569 if not isValid then
79 :     OS.FileSys.remove stablename handle _ => ()
80 :     else ();
81 :     isValid
82 : blume 537 end
83 : blume 569
84 : blume 587 fun verify _ _ GG.ERRORGROUP = false
85 :     | verify gp em (group as GG.GROUP g) = let
86 : blume 632 val { exports, grouppath, sublibs, kind, ... } = g
87 : blume 587 val groups = Reachable.groupsOf group
88 : blume 632 val version =
89 :     case kind of
90 :     GG.NOLIB _ => NONE
91 :     | GG.LIB { version, ... } => version
92 : blume 587 in
93 :     verify' gp em (grouppath,
94 :     map (#2 o #1) (SymbolMap.listItems exports),
95 : blume 632 sublibs, groups, version)
96 : blume 587 end
97 : blume 537 end
98 :     end

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