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 569, Tue Mar 7 04:01:07 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 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      end
89  end  end
90  end  end

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

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