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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 537, Fri Feb 18 17:20:16 2000 UTC revision 652, Tue Jun 6 02:14:56 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               GG.subgrouplist *            (* sublibs *)
25               SrcPathSet.set *             (* groups *)
26               Version.t option
27            -> bool
28        val verify : GP.info -> exportmap -> GG.group -> bool
29  end  end
30    
31  structure VerifyStable :> VERIFY_STABLE = struct  functor VerStabFn (structure Stabilize: STABILIZE) :> VERIFY_STABLE = struct
32      fun verify (gp: GP.info) g = let  
33        type exportmap = SmlInfo.info StableMap.map
34    
35        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          val policy = #fnpolicy (#param gp)          val policy = #fnpolicy (#param gp)
39          fun sname p = FilenamePolicy.mkStableName policy p          val stablename =
40          val GG.GROUP { grouppath, exports, sublibs, ... } = g              FilenamePolicy.mkStableName policy (grouppath, version)
41          val stablename = sname grouppath  
         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  
42          fun invalidMember stab_t i = let          fun invalidMember stab_t i = let
43              val p = SmlInfo.sourcepath i              val p = SmlInfo.sourcepath i
44    
45              val bn = SmlInfo.binname i              val bn = SmlInfo.binname i
46          in          in
47              case (SrcPath.tstamp p, TS.fmodTime bn) of              case (SrcPath.tstamp p, TS.fmodTime bn) of
# Line 42  Line 50 
50                      Time.compare (src_t, stab_t) = GREATER                      Time.compare (src_t, stab_t) = GREATER
51                | _ => true                | _ => true
52          end          end
53    
54            fun nonstabSublib (_, gth) =
55                case gth () of
56                    GG.GROUP { kind = GG.LIB { kind = GG.STABLE _,
57                                               ... }, ... } => false
58                  | _ => true
59    
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      in
72          case (TS.fmodTime stablename, SrcPath.tstamp grouppath) of                      (* The group itself is included in "groups"... *)
73              (TS.TSTAMP st, TS.TSTAMP gt) =>                      not (SrcPathSet.exists (invalidGroup st) groups) andalso
74                  if Time.compare (st, gt) = LESS then false                      not (List.exists nonstabSublib sublibs) andalso
75                  else not (SmlInfoSet.exists (invalidMember st)                      validStamp ((grouppath, export_nodes, sublibs), version)
76                                              (Reachable.reachable g) orelse                      andalso not (SmlInfoSet.exists (invalidMember st) m)
77                            List.exists (invalidSublib st) sublibs)                  end
78            | _ => false            | _ => false
79        in
80            if not isValid then
81                OS.FileSys.remove stablename handle _ => ()
82            else ();
83            isValid
84        end
85    
86        fun verify _ _ GG.ERRORGROUP = false
87          | verify gp em (group as GG.GROUP g) = let
88                val { exports, grouppath, sublibs, kind, ... } = g
89                val groups = Reachable.groupsOf group
90                val version =
91                    case kind of
92                        GG.NOLIB _ => NONE
93                      | GG.LIB { version, ... } => version
94                fun force f = f ()
95            in
96                verify' gp em (grouppath,
97                               map (#2 o force o #1) (SymbolMap.listItems exports),
98                               sublibs, groups, version)
99      end      end
100  end  end
101  end  end

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

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