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 304, Mon May 31 09:10:08 1999 UTC revision 305, Mon May 31 15:00:06 1999 UTC
# Line 9  Line 9 
9    
10      type context      type context
11      type t      type t
12        type ord_key = t
13    
14      val revalidateCwd : unit -> unit      val revalidateCwd : unit -> unit
15      val newEra : unit -> unit      val newEra : unit -> unit
# Line 22  Line 23 
23      val context : t -> context      val context : t -> context
24      val spec : t -> string      val spec : t -> string
25      val contextName : context -> string      val contextName : context -> string
     val pickle : t -> string  
     val pickleSpec : t -> string  
26    
27      val native : { context: context, spec: string } -> t      val native : { context: context, spec: string } -> t
28      val standard : { context: context, spec: string } -> t      val standard : { context: context, spec: string } -> t
29      val unpickle : string -> t  
30      val unpickleSpec : { context: context, pickledSpec: string } -> t      val pickle : t -> string list
31        val unpickle : string list -> t option
32    
33      val joinDirFile : { dir: t, file: string } -> t      val joinDirFile : { dir: t, file: string } -> t
34      val splitDirFile : t -> { dir: t, file: string }      val splitDirFile : t -> { dir: t, file: string }
# Line 89  Line 89 
89      and  t =      and  t =
90          PATH of { context: context,          PATH of { context: context,
91                    spec: string,                    spec: string,
                   native: bool,  
92                    cache: elaboration option ref }                    cache: elaboration option ref }
93    
94        type ord_key = t
95    
96      local      local
97          val elabStamp = ref (ref ())          val elabStamp = ref (ref ())
98          val cwdInfoCache : cwdinfo option ref = ref NONE          val cwdInfoCache : cwdinfo option ref = ref NONE
# Line 162  Line 163 
163                         | NONE => mkElab (cache, fetch ()))                         | NONE => mkElab (cache, fetch ()))
164                | RELATIVE p => elab p                | RELATIVE p => elab p
165    
166          and elab (PATH { context, spec, cache, native }) =          and elab (PATH { context, spec, cache }) =
167              (case validElab (!cache) of              (case validElab (!cache) of
168                   SOME e => e                   SOME e => e
169                 | NONE => let                 | NONE => let
# Line 198  Line 199 
199          (* get the spec back *)          (* get the spec back *)
200          fun spec (PATH { spec = s, ... }) = s          fun spec (PATH { spec = s, ... }) = s
201    
         (* make a pickle-string *)  
         fun pickle (PATH { context, spec, cache, native }) = Dummy.f ()  
         fun pickleSpec (PATH _) = Dummy.f ()  
         fun unpickle s = Dummy.f ()  
         fun unpickleSpec { context, pickledSpec } = Dummy.f ()  
   
202          (* compare pathnames efficiently *)          (* compare pathnames efficiently *)
203          fun compare (p1, p2) = compareId (id p1, id p2)          fun compare (p1, p2) = compareId (id p1, id p2)
204    
205          fun fresh (context, spec, native) =          fun fresh (context, spec) =
206              PATH { context = context, spec = spec, cache = ref NONE,              PATH { context = context, spec = spec, cache = ref NONE }
                    native = native }  
207    
208          (* make an abstract path from a native string *)          (* make an abstract path from a native string *)
209          fun native { spec, context } = fresh (context, spec, true)          fun native { spec, context } = fresh (context, spec)
210    
211          (* make an abstract path from a standard string *)          (* make an abstract path from a standard string *)
212          fun standard { spec, context } = let          fun standard { spec, context } = let
# Line 227  Line 221 
221              fun mk (isAbs, arcs, context) =              fun mk (isAbs, arcs, context) =
222                  fresh (context,                  fresh (context,
223                         P.toString { isAbs = isAbs, vol = "",                         P.toString { isAbs = isAbs, vol = "",
224                                      arcs = map transl arcs },                                      arcs = map transl arcs })
                        false)  
225          in          in
226              case String.fields delim spec of              case String.fields delim spec of
227                  "" :: arcs => mk (true, arcs, context)                  "" :: arcs => mk (true, arcs, context)
# Line 247  Line 240 
240                           end)                           end)
241          end          end
242    
243            (* make a pickle-string *)
244            fun pickle p = let
245                fun p_p (PATH { context, spec, ... }) = spec :: p_c context
246                and p_c (CUR _) = ["c"]
247                  | p_c (CONFIG_ANCHOR { config_name = n, ... }) = [n, "a"]
248                  | p_c (RELATIVE p) = p_p p
249            in
250                p_p p
251            end
252    
253            fun unpickle l = let
254                exception Format
255                fun u_p (h :: t) =
256                    PATH { context = u_c t, spec = h, cache = ref NONE }
257                  | u_p [] = raise Format
258                and u_c ["c"] = cwdContext ()
259                  | u_c [n, "a"] =
260                    (case PathConfig.configAnchor n of
261                         NONE => raise Format
262                       | SOME fetch => CONFIG_ANCHOR { fetch = fetch,
263                                                       cache = ref NONE,
264                                                       config_name = n })
265                  | u_c l = RELATIVE (u_p l)
266            in
267                SOME (u_p l) handle Format => NONE
268            end
269    
270          (* . and .. are not permitted as file parameter *)          (* . and .. are not permitted as file parameter *)
271          fun joinDirFile { dir = PATH { context, spec, native, ... }, file } =          fun joinDirFile { dir = PATH { context, spec, ... }, file } =
272              if file = P.currentArc orelse file = P.parentArc then              if file = P.currentArc orelse file = P.parentArc then
273                  raise Fail "AbsPath.joinDirFile: . or .."                  raise Fail "AbsPath.joinDirFile: . or .."
274              else fresh (context, P.joinDirFile { dir = spec, file = file },              else fresh (context, P.joinDirFile { dir = spec, file = file })
                         native)  
275    
276          (* splitDirFile never walks past a context.          (* splitDirFile never walks past a context.
277           * Moreover, it is an error to split something that ends in "..". *)           * Moreover, it is an error to split something that ends in "..". *)
278          fun splitDirFile (PATH { context, spec, native, ... }) = let          fun splitDirFile (PATH { context, spec, ... }) = let
279              fun loop "" =              fun loop "" =
280                  raise Fail "AbsPath.splitDirFile: tried to split a context"                  raise Fail "AbsPath.splitDirFile: tried to split a context"
281                | loop spec = let                | loop spec = let
# Line 270  Line 289 
289              val (dir, file) = loop spec              val (dir, file) = loop spec
290              val dir = if dir = "" then P.currentArc else dir              val dir = if dir = "" then P.currentArc else dir
291          in          in
292              { dir = fresh (context, dir, native), file = file }              { dir = fresh (context, dir), file = file }
293          end          end
294    
295          val dir = #dir o splitDirFile          val dir = #dir o splitDirFile

Legend:
Removed from v.304  
changed lines
  Added in v.305

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