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

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

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

revision 665, Fri Jun 16 04:43:57 2000 UTC revision 666, Fri Jun 16 08:27:00 2000 UTC
# Line 1  Line 1 
1  (*  (*
2   * Operations over abstract path names.   * Operations over abstract names for CM source files.
  *  This is the "surface" abstraction that the client actually gets to  
  *  see.  It is built on top of the "AbsPath" abstraction, but its  
  *  important improvement over AbsPath is that the ordering relation  
  *  is stable:  once you have created two "SrcPath"s, they will always  
  *  compare the same way -- even if files are moved about, file_ids  
  *  change, etc.  
3   *   *
4   * Copyright (c) 1999 by Lucent Technologies, Bell Laboratories   * Copyright (c) 2000 by Lucent Technologies, Bell Laboratories
5   *   *
6   * Author: Matthias Blume (blume@cs.princeton.edu)   * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
7   *)   *)
8  signature SRCPATH = sig  signature SRCPATH = sig
9    
10      exception Format        (* if something is seriously wrong with a pickle *)      exception Format
     exception BadAnchor of string       (* if anchor cannot be resolved *)  
11    
12      type context      type file
13      type t      type dir
14      type ord_key = t      type env
15        type anchor = string
16        type prefile
17    
18      val compare : ord_key * ord_key -> order      type rebindings = { anchor: anchor, value: prefile } list
19    
20      (* This rebuilds the internal table in a manner consistent with      type ord_key = file
21       * the current state of the file system: *)  
22        (* path comparison *)
23        val compare : file * file -> order
24    
25        (* re-establish stability of ordering *)
26      val sync : unit -> unit      val sync : unit -> unit
27    
28      (* This makes sure CM knows what the current working directory is: *)      (* forget all known path names *)
29        val clear : unit -> unit
30    
31        (* re-validate current working directory *)
32      val revalidateCwd : unit -> unit      val revalidateCwd : unit -> unit
33    
34      (* This marks the cwd cache as invalid so that the next revalidation      (* make sure all servers get notified about cwd during next validation *)
35       * will cause external servers to be notified. *)      val scheduleNotification : unit -> unit
     val invalidateCwd : unit -> unit  
36    
37      (* This erases all persistent state: *)      (* new "empty" env *)
38      val clear : unit -> unit      val newEnv : unit -> env
39    
40        (* destructive updates to anchor settings (for configuration) *)
41        val set_anchor : env * anchor * string option -> unit (* native syntax! *)
42        val get_anchor : env * anchor -> string option
43        val reset_anchors : env -> unit
44    
45        val processSpecFile : env * string -> unit
46    
47        (* non-destructive bindings for anchors (for anchor scoping) *)
48        val bind: env -> rebindings -> env
49    
50        (* make abstract paths *)
51        val native : { err: string -> unit } ->
52                     { context: dir, spec: string } -> prefile
53        val standard : { err: string -> unit, env: env } ->
54                       { context: dir, spec: string } -> prefile
55    
56        (* check that there is at least one arc in after the path's context *)
57        val file : prefile -> file
58    
59        (* To be able to pickle a file, turn it into a prefile first... *)
60        val pre : file -> prefile
61    
62        (* directory paths (contexts) *)
63        val cwd : unit -> dir
64        val dir : file -> dir
65    
66        (* get info out of abstract paths *)
67        val osstring : file -> string
68        val osstring' : file -> string      (* use relative path if shorter *)
69    
70        (* expand root anchors using given function *)
71        val osstring_reanchored : (anchor -> string) -> file -> string option
72    
73        (* get path relative to the file's context; this will produce an
74         * absolute path if the original spec was not relative (i.e., if
75         * it was anchored or absolute) *)
76        val osstring_relative : file -> string
77    
78        (* get name of dir *)
79        val osstring_dir : dir -> string
80    
81        (* get a human-readable (well, sort of) description *)
82        val descr : file -> string
83    
84      val osstring : t -> string      (* get a time stamp *)
85      (* like osstring; return relative path if shorter *)      val tstamp : file -> TStamp.t
     val osstring' : t -> string  
     val descr : t -> string  
     val reAnchoredName : t * string -> string option  
     val contextOf : t -> context  
     val specOf : t -> string  
     val contextName : context -> string  
     val sameDirContext : t -> context  
   
     (* This will be called at the beginning of most main operations.  
      * Therefore, it will automatically do the call to revalidateCwd. *)  
     val cwdContext : unit -> context  
   
     val native : { context: context, spec: string } -> t  
     val standard : PathConfig.mode ->  
                    { context: context, spec: string, err: string -> unit } -> t  
86    
87      val fromDescr : PathConfig.mode -> string -> t      (* portable encodings that avoid whitespace *)
88        val encode : file -> string
89        val decode : env -> string -> file
90    
91      val pickle : (bool -> unit) -> t * t -> string list      val pickle : { warn: bool * string -> unit } ->
92      val unpickle : PathConfig.mode -> string list * t -> t                   { file: prefile, relativeTo: file } -> string list
93    
94      val tstamp : t -> TStamp.t      val unpickle : env -> { pickled: string list, relativeTo: file } -> prefile
95  end  end
96    
97  structure SrcPath :> SRCPATH = struct  structure SrcPath :> SRCPATH = struct
98    
99      exception Format = AbsPath.Format      exception Format
100      exception BadAnchor = AbsPath.BadAnchor  
101        structure P = OS.Path
102        structure F = OS.FileSys
103        structure I = FileId
104    
105        fun impossible s = GenericVC.ErrorMsg.impossible ("SrcPath: " ^ s)
106    
107        type anchor = string
108    
109        type stableid = int
110    
111        (* A pre-path is similar to the result of P.fromString except that
112         * we keep the list of arcs in reversed order.  This makes adding
113         * and removing arcs at the end easier. *)
114        type prepath = { revarcs: string list, vol: string, isAbs: bool }
115    
116        type elab = { pp: prepath, valid: unit -> bool }
117    
118        type anchorval = unit -> elab
119    
120        type env =
121             { get_free: anchor -> elab,
122               set_free: anchor * prepath option -> unit,
123               is_set: anchor -> bool,
124               reset: unit -> unit,
125               bound: anchorval StringMap.map }
126        datatype dir =
127            CWD of { name: string, pp: prepath }
128          | ANCHOR of { name: anchor, look: unit -> elab }
129          | ROOT of string
130          | DIR of file0
131    
132        and file0 =
133            PATH of { context: dir,
134                      arcs: string list,    (* at least one arc! *)
135                      elab: elab ref,
136                      id: I.id option ref }
137    
138        type file = file0 * stableid
139    
140        type prefile = { context: dir, arcs: string list, err: string -> unit }
141    
142        type rebindings = { anchor: anchor, value: prefile } list
143    
144        type ord_key = file
145    
146        fun mk_look (e: env, a) () =
147            case StringMap.find (#bound e, a) of
148                SOME f => f ()
149              | NONE => #get_free e a
150    
151        (* stable comparison *)
152        fun compare (f1: file, f2: file) = Int.compare (#2 f1, #2 f2)
153    
154        val null_pp : prepath = { revarcs = [], vol = "", isAbs = false }
155        val bogus_elab : elab = { pp = null_pp, valid = fn _ => false }
156    
157        fun string2pp n = let
158            val { arcs, vol, isAbs } = P.fromString n
159        in
160            { revarcs = rev arcs, vol = vol, isAbs = isAbs }
161        end
162    
163        val cwd_info =
164            let val n = F.getDir ()
165            in ref { name = n, pp = string2pp n }
166            end
167        val cwd_notify = ref true
168    
169        fun absElab (arcs, vol) =
170            { pp = { revarcs = rev arcs, vol = vol, isAbs = true },
171              valid = fn () => true }
172    
173        fun unintern (f: file) = #1 f
174    
175        fun encode0 bracket (p: file0) = let
176            fun needesc c = not (Char.isPrint c) orelse Char.contains "/:\\$%" c
177            fun esc c =
178                "\\" ^ StringCvt.padLeft #"0" 3 (Int.toString (Char.ord c))
179            fun tc c = if needesc c then esc c else String.str c
180            val ta = String.translate tc
181            val (dot, dotdot) = let
182                val ta' = String.translate esc
183            in
184                (ta' ".", ta' "..")
185            end
186            fun arc a =
187                if a = P.currentArc then "."
188                else if a = P.parentArc then ".."
189                else if a = "." then dot
190                else if a = ".." then dotdot
191                else ta a
192            fun e_p (PATH { arcs, context, ... }, ctxt, a) =
193                let val l = rev arcs
194                    val l = if ctxt andalso bracket then
195                                concat ["(", List.hd l, ")"] :: List.tl l
196                            else l
197                    val a = case l of
198                                [] => a
199                              | h :: t =>
200                                foldl (fn (x, l) => arc x :: "/" :: l)
201                                      (arc h :: a) t
202                in e_c (context, a)
203                end
204            and e_c (ROOT "", a) = concat ("/" :: a)
205              | e_c (ROOT vol, a) = concat ("%" :: ta vol :: "/" :: a)
206              | e_c (CWD _, a) = concat a
207              | e_c (ANCHOR x, a) = concat ("$" :: ta (#name x) :: "/" :: a)
208              | e_c (DIR p, a) = e_p (p, true, ":" :: a)
209        in
210            e_p (p, false, [])
211        end
212    
213        val encode = encode0 false o unintern
214    
215        fun revalidateCwd () = let
216            val { name = n, pp } = !cwd_info
217            val n' = F.getDir ()
218            val pp' = string2pp n'
219        in
220            if n = n' then ()
221            else (cwd_info := { name = n', pp = pp' };
222                  cwd_notify := true);
223            if !cwd_notify then
224                let val p = PATH { arcs = rev (#revarcs pp),
225                                   context = ROOT (#vol pp),
226                                   elab = ref bogus_elab, id = ref NONE }
227                in
228                    Servers.cd (encode0 false p);
229                    cwd_notify := false
230                end
231            else ()
232        end
233    
234        fun scheduleNotification () = cwd_notify := true
235    
236        fun dirPP { revarcs = _ :: revarcs, vol, isAbs } =
237            { revarcs = revarcs, vol = vol, isAbs = isAbs }
238          | dirPP _ = impossible "dirPP"
239    
240        fun dirElab { pp, valid } = { pp = dirPP pp, valid = valid }
241    
242        fun augPP arcs { revarcs, vol, isAbs } =
243            { revarcs = List.revAppend (arcs, revarcs), vol = vol, isAbs = isAbs }
244    
245        fun augElab arcs { pp, valid } = { pp = augPP arcs pp, valid = valid }
246    
247        fun elab_dir (CWD { name, pp }) =
248            let fun valid () = name = #name (!cwd_info)
249            in
250                if valid () then { pp = null_pp, valid = valid }
251                else { pp = pp, valid = fn () => true }
252            end
253          | elab_dir (ANCHOR { name, look }) = look ()
254          | elab_dir (ROOT vol) = absElab ([], vol)
255          | elab_dir (DIR p) = dirElab (elab_file p)
256    
257        and elab_file (PATH { context, arcs, elab, id }) =
258            let val e as { pp, valid } = !elab
259            in
260                if valid () then e
261                else let val e' = augElab arcs (elab_dir context)
262                     in elab := e'; id := NONE; e'
263                     end
264            end
265    
266        fun pp2name { revarcs, vol, isAbs } =
267            P.toString { arcs = rev revarcs, vol = vol, isAbs = isAbs }
268    
269        fun idOf (p as PATH { id, ... }) =
270            let val { pp, ... } = elab_file p
271            in
272                case !id of
273                    SOME i => i
274                  | NONE => let
275                        val i = I.fileId (pp2name pp)
276                    in
277                        id := SOME i; i
278                    end
279            end
280    
281        fun compare0 (f1, f2) = I.compare (idOf f1, idOf f2)
282    
283      type context = AbsPath.context      structure F0M = MapFn (type ord_key = file0 val compare = compare0)
     type t = AbsPath.t * int  
     type ord_key = t  
284    
285      fun compare ((_, i), (_, i')) = Int.compare (i, i')      local
286            val known = ref (F0M.empty: int F0M.map)
287            val next = ref 0
288        in
289            fun clear () = known := F0M.empty
290    
291      val knownPaths = ref (AbsPathMap.empty: int AbsPathMap.map)          fun intern f =
292      val nextId = ref 0              case F0M.find (!known, f) of
293                    SOME i => (f, i)
294                  | NONE => let
295                        val i = !next
296                    in
297                        next := i + 1;
298                        known := F0M.insert (!known, f, i);
299                        (f, i)
300                    end
301    
302      fun sync () =          fun sync () = let
303          (AbsPath.newEra ();              val km = !known
304           knownPaths :=              fun inval (PATH { id, ... }, _) = id := NONE
305             AbsPathMap.foldli (fn (k, v, m) => AbsPathMap.insert (m, k, v))              fun reinsert (k, v, m) = F0M.insert (m, k, v)
306                               AbsPathMap.empty          in
307                               (!knownPaths))              F0M.appi inval km;
308                known := F0M.foldli reinsert F0M.empty km
309            end
310        end
311    
312        val dir0 = DIR
313        val dir = dir0 o unintern
314    
315      fun clear () = knownPaths := AbsPathMap.empty      fun cwd () = (revalidateCwd (); CWD (!cwd_info))
316    
317      val revalidateCwd = AbsPath.revalidateCwd      val osstring = pp2name o #pp o elab_file o unintern
     val invalidateCwd = AbsPath.invalidateCwd  
318    
319      fun intern ap =      val descr = encode0 true o unintern
320          case AbsPathMap.find (!knownPaths, ap) of  
321              SOME i => (ap, i)      val osstring_dir = pp2name o #pp o elab_dir
322    
323        fun osstring' f = let
324            val oss = osstring f
325        in
326            if P.isAbsolute oss then
327                let val ross =
328                        P.mkRelative { path = oss, relativeTo = #name (!cwd_info) }
329                in
330                    if size ross < size oss then ross else oss
331                end
332            else oss
333        end
334    
335        fun newEnv () = let
336            val freeMap = ref StringMap.empty
337            fun fetch a =
338                case StringMap.find (!freeMap, a) of
339                    SOME x => x
340            | NONE => let            | NONE => let
341                  val i = !nextId                      val validity = ref true
342                        val pp = { revarcs = [concat ["$Undef<", a, ">"]],
343                                   vol = "", isAbs = false }
344                        val x = (pp, validity)
345                    in
346                        freeMap := StringMap.insert (!freeMap, a, x);
347                        x
348                    end
349            fun get_free a = let
350                val (pp, validity) = fetch a
351            in
352                { pp = pp, valid = fn () => !validity }
353            end
354            fun set_free (a, ppo) = let
355                val (_, validity) = fetch a
356            in
357                validity := false;          (* invalidate earlier elabs *)
358                freeMap :=
359                (case ppo of
360                     NONE => #1 (StringMap.remove (!freeMap, a))
361                   | SOME pp => StringMap.insert (!freeMap, a, (pp, ref true)))
362            end
363            fun is_set a = StringMap.inDomain (!freeMap, a)
364            fun reset () = let
365                fun invalidate (_, validity) = validity := false
366            in
367                StringMap.app invalidate (!freeMap);
368                freeMap := StringMap.empty
369            end
370        in
371            { get_free = get_free, set_free = set_free, is_set = is_set,
372              reset = reset, bound = StringMap.empty } : env
373        end
374    
375        fun get_anchor (e: env, a) =
376            if #is_set e a then SOME (pp2name (#pp (#get_free e a))) else NONE
377    
378        fun set0 mkAbsolute (e: env, a, so) = let
379            fun name2pp s = string2pp (if P.isAbsolute s then s else mkAbsolute s)
380              in              in
381                  nextId := i + 1;          #set_free e (a, Option.map name2pp so);
382                  knownPaths := AbsPathMap.insert (!knownPaths, ap, i);          sync ()
383                  (ap, i)      end
             end  
   
     val native = intern o AbsPath.native  
     fun standard m = intern o AbsPath.standard m  
     fun fromDescr m = intern o AbsPath.fromDescr m  
   
     val contextName = AbsPath.contextName  
     fun contextOf (ap, _) = AbsPath.contextOf ap  
     fun specOf (ap, _) = AbsPath.specOf ap  
     fun osstring (ap, _) = AbsPath.osstring ap  
     fun osstring' (ap, _) = AbsPath.osstring' ap  
     fun descr (ap, _) = AbsPath.descr ap  
     fun reAnchoredName ((ap, _), root) = AbsPath.reAnchoredName (ap, root)  
     fun tstamp (ap, _) = AbsPath.tstamp ap  
     fun sameDirContext (ap, _) = AbsPath.sameDirContext ap  
     val cwdContext = AbsPath.cwdContext  
384    
385      fun pickle warn ((ap, _), (cap, _)) = AbsPath.pickle warn (ap, cap)      fun set_anchor x =
386      fun unpickle m (l, (cap, _)) = intern (AbsPath.unpickle m (l, cap))          set0 (fn n => P.mkAbsolute { path = n, relativeTo = F.getDir () }) x
387    
388        fun reset_anchors (e: env) = (#reset e (); sync ())
389    
390        fun processSpecFile (e, f) = let
391            val d = P.dir (F.fullPath f)
392            fun set x = set0 (fn n => P.mkAbsolute { path = n, relativeTo = d }) x
393            fun work s = let
394                fun loop () = let
395                    val line = TextIO.inputLine s
396                in
397                    if line = "" then ()
398                    else if String.sub (line, 0) = #"#" then loop ()
399                    else case String.tokens Char.isSpace line of
400                             [a, d] => (set (e, a, SOME d); loop ())
401                           | ["-"] => (reset_anchors e; loop ())
402                           | [a] => (set_anchor (e, a, NONE); loop ())
403                           | [] => loop ()
404                           | _ => (Say.say [f, ": malformed line (ignored)\n"];
405                                   loop ())
406                end
407            in
408                loop ()
409            end
410        in
411            SafeIO.perform { openIt = fn () => TextIO.openIn f,
412                             closeIt = TextIO.closeIn,
413                             work = work,
414                             cleanup = fn _ => () }
415        end
416    
417        datatype stdspec =
418            RELATIVE of string list
419          | ABSOLUTE of string list
420          | ANCHORED of anchor * string list
421    
422        fun parseStdspec err s = let
423            fun delim #"/" = true
424              | delim #"\\" = true
425              | delim _ = false
426            fun transl ".." = P.parentArc
427              | transl "." = P.currentArc
428              | transl arc = arc
429            val impossible = fn s => impossible ("AbsPath.parseStdspec: " ^ s)
430        in
431            case map transl (String.fields delim s) of
432                [""] => impossible "zero-length name"
433              | [] => impossible "no fields"
434              | "" :: arcs => ABSOLUTE arcs
435              | arcs as (["$"] | "$" :: "" :: _) =>
436                (err (concat ["invalid zero-length anchor name in: `", s, "'"]);
437                 RELATIVE arcs)
438              | "$" :: (arcs as (arc1 :: _)) => ANCHORED (arc1, arcs)
439              | arcs as (arc1 :: arcn) =>
440                if String.sub (arc1, 0) <> #"$" then RELATIVE arcs
441                else ANCHORED (String.extract (arc1, 1, NONE), arcn)
442        end
443    
444        fun bind env l = let
445            fun b ({ anchor, value = { arcs, context, err } }, e: env) =
446                { get_free = #get_free e, set_free = #set_free e,
447                  reset = #reset e, is_set = #is_set e,
448                  bound = StringMap.insert
449                              (#bound e, anchor,
450                               fn () => augElab arcs (elab_dir context)) }
451        in
452            foldl b env l
453        end
454    
455        fun file0 ({ context, arcs, err }: prefile) =
456            PATH { context = context, elab = ref bogus_elab, id = ref NONE,
457                   arcs = (case arcs of
458                               [] => (err (concat
459                                      ["path needs at least one arc relative to `",
460                                       pp2name (#pp (elab_dir context)), "'"]);
461                                      ["<bogus>"])
462                             | _ => arcs) }
463    
464        val file = intern o file0
465        fun pre0 (PATH { arcs, context, ... }) =
466            { arcs = arcs, context = context, err = fn (_: string) => () }
467        val pre = pre0 o unintern
468    
469        fun prefile (c, l, e) = { context = c, arcs = l, err = e }
470    
471        (* env argument is not used -- it's just there for uniformity *)
472        fun native { err } { context, spec } =
473            case P.fromString spec of
474                { arcs, vol, isAbs = true } => prefile (ROOT vol, arcs, err)
475              | { arcs, ... } => prefile (context, arcs, err)
476    
477        fun standard { env, err } { context, spec } =
478            case parseStdspec err spec of
479                RELATIVE l => prefile (context, l, err)
480              | ABSOLUTE l => prefile (ROOT "", l, err)
481              | ANCHORED (a, l) =>
482                prefile (ANCHOR { name = a, look = mk_look (env, a) }, l, err)
483    
484        fun osstring_reanchored anchor f = let
485            fun path (PATH { context, arcs, ... }) =
486                Option.map (augPP arcs) (ctxt context)
487            and ctxt (CWD _) = NONE
488              | ctxt (ROOT _) = NONE
489              | ctxt (DIR p) = Option.map dirPP (path p)
490              | ctxt (ANCHOR { name, ... }) = SOME (string2pp (anchor name))
491        in
492            Option.map pp2name (path (unintern f))
493        end
494    
495        fun osstring_relative (p as (PATH { arcs, context, ... }, _)) =
496            case context of
497                DIR _ => P.toString { arcs = arcs, vol = "", isAbs = false }
498              | _ => osstring p
499    
500        fun tstamp f = TStamp.fmodTime (osstring f)
501    
502        fun pickle { warn } { file = (f: prefile), relativeTo = (gf, _) } = let
503            val warn =
504                fn flag =>
505                   warn (flag,
506                         (* HACK! We are cheating here, turning the prefile into
507                          * a file even when there are no arcs.  This is ok
508                          * because of (bracket = false) for encode0. *)
509                         encode0 false (PATH { arcs = #arcs f,
510                                               context = #context f,
511                                               elab = ref bogus_elab,
512                                               id = ref NONE }))
513            fun p_p p = p_pf (pre0 p)
514            and p_pf { arcs, context, err } =
515                P.toString { arcs = arcs, vol = "", isAbs = false } :: p_c context
516            and p_c (ROOT vol) = (warn true; [vol, "r"])
517              | p_c (CWD _) = impossible "pickle: CWD"
518              | p_c (ANCHOR { name, ... }) = [name, "a"]
519              | p_c (DIR p) = if compare0 (p, gf) = EQUAL then (warn false; ["c"])
520                              else p_p p
521        in
522            p_pf f
523        end
524    
525        fun unpickle env { pickled, relativeTo } = let
526            fun u_pf (s :: l) =
527                (case P.fromString s of
528                     { arcs, vol = "", isAbs = false } =>
529                     prefile (u_c l, arcs, fn _ => raise Format)
530                   | _ => raise Format)
531              | u_pf _ = raise Format
532            and u_p l = file0 (u_pf l)
533            and u_c [vol, "r"] = ROOT vol
534              | u_c ["c"] = dir relativeTo
535              | u_c [n, "a"] = ANCHOR { name = n, look = mk_look (env, n) }
536              | u_c l = DIR (u_p l)
537        in
538            u_pf pickled
539        end
540    
541        fun decode env s = let
542            fun isChar (c1: char) c2 = c1 = c2
543            fun unesc s = let
544                val dc = Char.chr o valOf o Int.fromString o implode
545                fun loop ([], r) = String.implode (rev r)
546                  | loop (#"\\" :: d0 :: d1 :: d2 :: l, r) =
547                    (loop (l, dc [d0, d1, d2] :: r)
548                     handle _ => loop (l, d2 :: d1 :: d0 :: #"\\" :: r))
549                  | loop (c :: l, r) = loop (l, c :: r)
550            in
551                loop (String.explode s, [])
552            end
553            fun arc "." = P.currentArc
554              | arc ".." = P.parentArc
555              | arc a = unesc a
556            fun file (c, l) =
557                file0 (prefile (c, l, fn s => raise Fail ("SrcPath.decode: " ^ s)))
558            fun addseg (seg, p) =
559                file (dir0 p, map arc (String.fields (isChar #"/") seg))
560            fun doseg0 s =
561                case String.fields (isChar #"/") s of
562                    [] => impossible "decode: no fields in segment 0"
563                  | arc0 :: arcs => let
564                        val arcs = map arc arcs
565                        fun xtr () = unesc (String.extract (arc0, 1, NONE))
566                    in
567                        if arc0 = "" then file (ROOT "", arcs)
568                        else
569                            case String.sub (arc0, 0) of
570                                #"%" => file (ROOT (xtr ()), arcs)
571                              | #"$" => let
572                                    val n = xtr ()
573                                in
574                                    file (ANCHOR { name = n,
575                                                   look = mk_look (env, n) }, arcs)
576                                end
577                              | _ => file (cwd (), arc arc0 :: arcs)
578                    end
579        in
580            case String.fields (isChar #":") s of
581                [] => impossible "decode: no segments"
582              | seg0 :: segs => intern (foldl addseg (doseg0 seg0) segs)
583        end
584  end  end

Legend:
Removed from v.665  
changed lines
  Added in v.666

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