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/smlfile/smlinfo.sml
ViewVC logotype

Diff of /sml/trunk/src/cm/smlfile/smlinfo.sml

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

revision 459, Fri Oct 29 06:22:25 1999 UTC revision 487, Fri Nov 19 07:18:17 1999 UTC
# Line 20  Line 20 
20      val eq : info * info -> bool        (* compares sourcepaths *)      val eq : info * info -> bool        (* compares sourcepaths *)
21      val compare : info * info -> order  (* compares sourcepaths *)      val compare : info * info -> order  (* compares sourcepaths *)
22    
23        (* The idea behind "newGeneration" is the following:
24         * Before parsing .cm files (on behalf of CM.make/recomp or CMB.make etc.)
25         * we start a new generation.  While parsing, when we encounter a new
26         * SML source we re-use existing information and bump its generation
27         * number to "now".  After we are done with one group we can safely
28         * evict all info records for files in this group if their generation
29         * is not "now".
30         * Moreover, if we encounter an entry that has a different owner group,
31         * we can either signal an error (if the generation is "now" which means
32         * that the file was found in another group during the same parse) or
33         * issue a "switched groups" warning (if the generation is older than
34         * now which means that the file used to be in another group). *)
35        val newGeneration : unit -> unit
36    
37      val info : GeneralParams.info ->      val info : GeneralParams.info ->
38          { sourcepath: SrcPath.t,          { sourcepath: SrcPath.t,
39            group: SrcPath.t * region,            group: SrcPath.t * region,
# Line 44  Line 58 
58      (* forget a parse tree that we are done with *)      (* forget a parse tree that we are done with *)
59      val forgetParsetree : info -> unit      val forgetParsetree : info -> unit
60    
61      (* evict all but the reachable nodes in the cache *)      (* Evict all elements that belong to a given group but which
62      val forgetAllBut : SrcPathSet.set -> unit       * are not of the current generation. "cleanGroup" should be
63         * called right after finishing to parse the group file. *)
64        val cleanGroup : SrcPath.t -> unit
65    
66        (* Delete all known info. *)
67        val reset : unit -> unit
68    
69      (* different ways of describing an sml file using group and source *)      (* different ways of describing an sml file using group and source *)
70      val spec : info -> string           (* sspec *)      val spec : info -> string           (* sspec *)
# Line 69  Line 88 
88    
89      type complainer = EM.complainer      type complainer = EM.complainer
90    
91        type generation = unit ref
92    
93      (* sh_mode is an elaboration of sh_spec;  it must be persistent      (* sh_mode is an elaboration of sh_spec;  it must be persistent
94       * and gets properly re-computed when there is a new sh_spec *)       * and gets properly re-computed when there is a new sh_spec *)
95      datatype persinfo =      datatype persinfo =
96          PERS of { group: SrcPath.t * region,          PERS of { group: SrcPath.t * region,
97                      generation: generation ref,
98                    lastseen: TStamp.t ref,                    lastseen: TStamp.t ref,
99                    parsetree: (ast * source) option ref,                    parsetree: (ast * source) option ref,
100                    skeleton: Skeleton.decl option ref,                    skeleton: Skeleton.decl option ref,
# Line 88  Line 110 
110    
111      type ord_key = info      type ord_key = info
112    
113        local
114            val generation = ref (ref ())
115        in
116            fun now () = !generation
117            fun newGeneration () = generation := ref ()
118        end
119    
120      fun sourcepath (INFO { sourcepath = sp, ... }) = sp      fun sourcepath (INFO { sourcepath = sp, ... }) = sp
121      fun skelname (INFO { mkSkelname = msn, ... }) = msn ()      fun skelname (INFO { mkSkelname = msn, ... }) = msn ()
122      fun binname (INFO { mkBinname = mbn, ... }) = mbn ()      fun binname (INFO { mkBinname = mbn, ... }) = mbn ()
# Line 121  Line 150 
150      fun forgetParsetree (INFO { persinfo = PERS { parsetree, ... }, ... }) =      fun forgetParsetree (INFO { persinfo = PERS { parsetree, ... }, ... }) =
151          parsetree := NONE          parsetree := NONE
152    
153      fun forgetAllBut reachable = let      fun cleanGroup g = let
154          fun isReachable (p, m) = SrcPathSet.member (reachable, p)          val n = now ()
155            fun isCurrent (PERS { generation = ref gen, group = (g', _), ... }) =
156                gen = n orelse SrcPath.compare (g, g') <> EQUAL
157      in      in
158          knownInfo := SrcPathMap.filteri isReachable (!knownInfo)          knownInfo := SrcPathMap.filter isCurrent (!knownInfo)
159      end      end
160    
161        fun reset () = knownInfo := SrcPathMap.empty
162    
163      (* check timestamp and throw away any invalid cache *)      (* check timestamp and throw away any invalid cache *)
164      fun validate (sourcepath, PERS pir) = let      fun validate (sourcepath, PERS pir) = let
165          (* don't use "..." pattern to have the compiler catch later          (* don't use "..." pattern to have the compiler catch later
166           * additions to the type! *)           * additions to the type! *)
167          val { group, lastseen, parsetree, skeleton, sh_mode } = pir          val { group, lastseen, parsetree, skeleton, sh_mode, generation } = pir
168          val ts = !lastseen          val ts = !lastseen
169          val nts = SrcPath.tstamp sourcepath          val nts = SrcPath.tstamp sourcepath
170      in      in
171          if TStamp.needsUpdate { source = nts, target = ts } then          if TStamp.needsUpdate { source = nts, target = ts } then
172              (lastseen := nts;              (lastseen := nts;
173                 generation := now ();
174               parsetree := NONE;               parsetree := NONE;
175               skeleton := NONE)               skeleton := NONE)
176          else ()          else ()
# Line 152  Line 186 
186              val ts = SrcPath.tstamp sourcepath              val ts = SrcPath.tstamp sourcepath
187              val pi = PERS { group = gr, lastseen = ref ts,              val pi = PERS { group = gr, lastseen = ref ts,
188                              parsetree = ref NONE, skeleton = ref NONE,                              parsetree = ref NONE, skeleton = ref NONE,
189                              sh_mode = ref (Sharing.SHARE false) }                              sh_mode = ref (Sharing.SHARE false),
190                                generation = ref (now ()) }
191          in          in
192              knownInfo := SrcPathMap.insert (!knownInfo, sourcepath, pi);              knownInfo := SrcPathMap.insert (!knownInfo, sourcepath, pi);
193              pi              pi
# Line 160  Line 195 
195          fun persinfo () =          fun persinfo () =
196              case SrcPathMap.find (!knownInfo, sourcepath) of              case SrcPathMap.find (!knownInfo, sourcepath) of
197                  NONE => newpersinfo ()                  NONE => newpersinfo ()
198                | SOME (pi as PERS { group = gr' as (g, r), ... }) =>                | SOME (pi as PERS { group = gr' as (g, r), generation, ... }) =>
199                      if SrcPath.compare (group, g) <> EQUAL then let                      if SrcPath.compare (group, g) <> EQUAL then let
200                          val n = SrcPath.descr sourcepath                          val n = SrcPath.descr sourcepath
201                      in                      in
202                          if GroupReg.registered groupreg g then                          if !generation = now () then
203                              (gerror gp gr EM.COMPLAIN                              (gerror gp gr EM.COMPLAIN
204                                  (concat ["ML source file ", n,                                  (concat ["ML source file ", n,
205                                           " appears in more than one group"])                                           " appears in more than one group"])

Legend:
Removed from v.459  
changed lines
  Added in v.487

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