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 537 - (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 :     structure GG = GroupGraph
15 :     structure GP = GeneralParams
16 :     structure TS = TStamp
17 :     in
18 :     signature VERIFY_STABLE = sig
19 :     val verify : GP.info -> GG.group -> bool
20 :     end
21 :    
22 :     structure VerifyStable :> VERIFY_STABLE = struct
23 :     fun verify (gp: GP.info) g = let
24 :     val policy = #fnpolicy (#param gp)
25 :     fun sname p = FilenamePolicy.mkStableName policy p
26 :     val GG.GROUP { grouppath, exports, sublibs, ... } = g
27 :     val stablename = sname grouppath
28 :     fun invalidSublib st (p, GG.GROUP { kind = GG.STABLELIB _, ... }) =
29 :     let val sn = sname p
30 :     in case TS.fmodTime sn of
31 :     TS.TSTAMP t => Time.compare (t, st) = GREATER
32 :     | _ => true
33 :     end
34 :     | invalidSublib _ _ = true
35 :     fun invalidMember stab_t i = let
36 :     val p = SmlInfo.sourcepath i
37 :     val bn = SmlInfo.binname i
38 :     in
39 :     case (SrcPath.tstamp p, TS.fmodTime bn) of
40 :     (TS.TSTAMP src_t, TS.TSTAMP bin_t) =>
41 :     Time.compare (src_t, bin_t) <> EQUAL orelse
42 :     Time.compare (src_t, stab_t) = GREATER
43 :     | _ => true
44 :     end
45 :     in
46 :     case (TS.fmodTime stablename, SrcPath.tstamp grouppath) of
47 :     (TS.TSTAMP st, TS.TSTAMP gt) =>
48 :     if Time.compare (st, gt) = LESS then false
49 :     else not (SmlInfoSet.exists (invalidMember st)
50 :     (Reachable.reachable g) orelse
51 :     List.exists (invalidSublib st) sublibs)
52 :     | _ => false
53 :     end
54 :     end
55 :     end

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