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 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