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/paths/abspath.sml
ViewVC logotype

Diff of /sml/trunk/src/cm/paths/abspath.sml

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

revision 354, Fri Jun 25 08:36:12 1999 UTC revision 369, Sun Jul 4 12:55:20 1999 UTC
# Line 7  Line 7 
7   *)   *)
8  signature ABSPATH = sig  signature ABSPATH = sig
9    
10        exception Format        (* if something is seriously wrong with a pickle *)
11        exception BadAnchor of string       (* if anchor cannot be resolved *)
12    
13      type context      type context
14      type t      type t
15      type ord_key = t      type ord_key = t
16    
     val revalidateCwd : unit -> unit  
17      val newEra : unit -> unit      val newEra : unit -> unit
18        val revalidateCwd : unit -> unit
19    
20      val cwdContext: unit -> context      val cwdContext: unit -> context
21      val sameDirContext: t -> context      val sameDirContext: t -> context
# Line 34  Line 37 
37      (* the second path argument is the path of the group spec that      (* the second path argument is the path of the group spec that
38       * pickling is based upon. *)       * pickling is based upon. *)
39      val pickle : (bool -> unit) -> t * t -> string list      val pickle : (bool -> unit) -> t * t -> string list
40      val unpickle : PathConfig.mode -> string list * t -> t option      val unpickle : PathConfig.mode -> string list * t -> t
41    
42      val tstamp : t -> TStamp.t      val tstamp : t -> TStamp.t
   
     val openTextIn : t -> TextIO.instream  
43  end  end
44    
45  structure AbsPath :> ABSPATH = struct  structure AbsPath :> ABSPATH = struct
# Line 47  Line 48 
48      structure F = OS.FileSys      structure F = OS.FileSys
49      val impossible = GenericVC.ErrorMsg.impossible      val impossible = GenericVC.ErrorMsg.impossible
50    
51        exception Format
52        exception BadAnchor of string
53    
54      (* unique file id that can handle absent files *)      (* unique file id that can handle absent files *)
55      datatype id =      datatype id =
56          PRESENT of F.file_id          PRESENT of F.file_id
# Line 90  Line 94 
94      type ord_key = t      type ord_key = t
95    
96      local      local
         val elabStamp = ref (ref ())  
97          val cwdInfoCache : cwdinfo option ref = ref NONE          val cwdInfoCache : cwdinfo option ref = ref NONE
98          fun cwdInfo () =          fun cwdInfo () =
99              case !cwdInfoCache of              case !cwdInfoCache of
# Line 109  Line 112 
112          val cwdId = #id o cwdInfo          val cwdId = #id o cwdInfo
113      in      in
114          (* start a new era (i.e., invalidate all previous elaborations) *)          (* start a new era (i.e., invalidate all previous elaborations) *)
115          fun newEra () = elabStamp := ref ()          val newEra = Era.newEra
116    
117          (* make sure the cwd is consistent *)          (* make sure the cwd is consistent *)
118          fun revalidateCwd () =          fun revalidateCwd () =
# Line 127  Line 130 
130                  end                  end
131    
132          fun cwdContext () =          fun cwdContext () =
133              THEN_CWD { stamp = cwdStamp (), name = cwdName (), id = cwdId () }              (revalidateCwd ();
134                 THEN_CWD { stamp = cwdStamp (),
135                            name = cwdName (),
136                            id = cwdId () })
137    
138          fun sameDirContext p = DIR_OF p          fun sameDirContext p = DIR_OF p
139    
140          fun mkElab (cache, name) = let          fun mkElab (cache, name) = let
141              val e : elaboration =              val e : elaboration =
142                  { stamp = !elabStamp, name = name, id = ref NONE }                  { stamp = Era.thisEra (), name = name, id = ref NONE }
143          in          in
144              cache := SOME e; e              cache := SOME e; e
145          end          end
146    
147          fun validElab NONE = NONE          fun validElab NONE = NONE
148            | validElab (SOME (e as { stamp, name, id })) =            | validElab (SOME (e as { stamp, name, id })) =
149              if stamp = !elabStamp then SOME e else NONE              if Era.isThisEra stamp then SOME e else NONE
150    
151          val rootName = P.toString { isAbs = true, arcs = [], vol = "" }          val rootName = P.toString { isAbs = true, arcs = [], vol = "" }
152          val rootId = ref (NONE: id option)          val rootId = ref (NONE: id option)
# Line 148  Line 154 
154          fun elabContext c =          fun elabContext c =
155              case c of              case c of
156                  THEN_CWD { stamp, name, id } =>                  THEN_CWD { stamp, name, id } =>
157                      { stamp = !elabStamp, id = ref (SOME id),                      { stamp = Era.thisEra (), id = ref (SOME id),
158                        name = if stamp = cwdStamp () orelse name = cwdName ()                        name = if stamp = cwdStamp () orelse name = cwdName ()
159                               then P.currentArc else name }                               then P.currentArc else name }
160                | CONFIG_ANCHOR { fetch, cache, config_name } =>                | CONFIG_ANCHOR { fetch, cache, config_name } =>
# Line 160  Line 166 
166                  in                  in
167                      { name = P.dir name, stamp = stamp, id = ref NONE }                      { name = P.dir name, stamp = stamp, id = ref NONE }
168                  end                  end
169                | ROOT => { stamp = !elabStamp, name = rootName, id = rootId }                | ROOT => { stamp = Era.thisEra (),
170                              name = rootName, id = rootId }
171    
172          and elab (PATH { context, spec, cache }) =          and elab (PATH { context, spec, cache }) =
173              case validElab (!cache) of              case validElab (!cache) of
174                  SOME e => e                  SOME e => e
175                | NONE => let                | NONE => mkElab (cache,
176                      val name = P.mkCanonical                                  P.mkCanonical (P.concat
177                          (P.concat (#name (elabContext context),                                           (#name (elabContext context), spec)))
                                    spec))  
                 in  
                     mkElab (cache, name)  
                 end  
178    
179          (* get the file id (calls elab, so don't cache externally!) *)          (* get the file id (calls elab, so don't cache externally!) *)
180          fun id p = let          fun id p = let
# Line 259  Line 262 
262    
263          fun unpickle mode (l, gpath) = let          fun unpickle mode (l, gpath) = let
264              fun u_p (s :: l) =              fun u_p (s :: l) =
265                  Option.map                  PATH { spec = s, context = u_c l, cache = ref NONE }
266                     (fn c => PATH { spec = s, context = c, cache = ref NONE })                | u_p [] = raise Format
267                  (u_c l)              and u_c ["r"] = ROOT
268                | u_p [] = NONE                | u_c ["c"] = DIR_OF gpath
             and u_c ["r"] = SOME ROOT  
               | u_c ["c"] = SOME (DIR_OF gpath)  
269                | u_c [n, "a"] =                | u_c [n, "a"] =
270                  (case PathConfig.configAnchor mode n of                  (case PathConfig.configAnchor mode n of
271                       NONE => NONE                       NONE => raise BadAnchor n
272                     | SOME fetch =>                     | SOME fetch =>
273                           SOME (CONFIG_ANCHOR { config_name = n,                           CONFIG_ANCHOR { config_name = n,
274                                                 fetch = fetch,                                                 fetch = fetch,
275                                                 cache = ref NONE }))                                           cache = ref NONE })
276                | u_c l = Option.map DIR_OF (u_p l)                | u_c l = DIR_OF (u_p l)
277          in          in
278              u_p l              u_p l
279          end          end
280    
281          fun tstamp p = TStamp.fmodTime (osstring p)          fun tstamp p = TStamp.fmodTime (osstring p)
282    
         val openTextIn = TextIO.openIn o osstring  
   
283          fun descr (PATH { spec, context, ... }) = let          fun descr (PATH { spec, context, ... }) = let
284              fun dir (x, l) =              fun dir (x, l) =
285                  case OS.Path.dir x of                  case P.dir x of
286                      "" => l                      "" => l
287                    | d => d :: "/" :: l                    | d => d :: "/" :: l
288              fun d_c (CONFIG_ANCHOR { config_name = n, ... }, l) =              fun d_c (CONFIG_ANCHOR { config_name = n, ... }, l) =

Legend:
Removed from v.354  
changed lines
  Added in v.369

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