Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/cm/paths/srcpath.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 643 - (view) (download)

1 : blume 354 (*
2 :     * Operations over abstract path names.
3 :     * This is the "surface" abstraction that the client actually gets to
4 :     * see. It is built on top of the "AbsPath" abstraction, but its
5 :     * important improvement over AbsPath is that the ordering relation
6 :     * is stable: once you have created two "SrcPath"s, they will always
7 :     * compare the same way -- even if files are moved about, file_ids
8 :     * change, etc.
9 :     *
10 :     * Copyright (c) 1999 by Lucent Technologies, Bell Laboratories
11 :     *
12 :     * Author: Matthias Blume (blume@cs.princeton.edu)
13 :     *)
14 :     signature SRCPATH = sig
15 : blume 367
16 :     exception Format (* if something is seriously wrong with a pickle *)
17 :     exception BadAnchor of string (* if anchor cannot be resolved *)
18 :    
19 : blume 354 type context
20 :     type t
21 :     type ord_key = t
22 :    
23 :     val compare : ord_key * ord_key -> order
24 :    
25 :     (* This rebuilds the internal table in a manner consistent with
26 :     * the current state of the file system: *)
27 :     val sync : unit -> unit
28 :    
29 : blume 366 (* This makes sure CM knows what the current working directory is: *)
30 :     val revalidateCwd : unit -> unit
31 :    
32 : blume 464 (* This marks the cwd cache as invalid so that the next revalidation
33 :     * will cause external servers to be notified. *)
34 :     val invalidateCwd : unit -> unit
35 :    
36 : blume 354 (* This erases all persistent state: *)
37 :     val clear : unit -> unit
38 :    
39 :     val osstring : t -> string
40 : blume 492 (* like osstring; return relative path if shorter *)
41 :     val osstring' : t -> string
42 : blume 354 val descr : t -> string
43 :     val reAnchoredName : t * string -> string option
44 :     val contextOf : t -> context
45 :     val specOf : t -> string
46 :     val contextName : context -> string
47 :     val sameDirContext : t -> context
48 : blume 366
49 :     (* This will be called at the beginning of most main operations.
50 :     * Therefore, it will automatically do the call to revalidateCwd. *)
51 : blume 354 val cwdContext : unit -> context
52 :    
53 :     val native : { context: context, spec: string } -> t
54 : blume 643 val standard : PathConfig.mode ->
55 :     { context: context, spec: string, err: string -> unit } -> t
56 : blume 354
57 : blume 457 val fromDescr : PathConfig.mode -> string -> t
58 :    
59 : blume 354 val pickle : (bool -> unit) -> t * t -> string list
60 : blume 367 val unpickle : PathConfig.mode -> string list * t -> t
61 : blume 354
62 :     val tstamp : t -> TStamp.t
63 :     end
64 :    
65 :     structure SrcPath :> SRCPATH = struct
66 :    
67 : blume 367 exception Format = AbsPath.Format
68 :     exception BadAnchor = AbsPath.BadAnchor
69 :    
70 : blume 354 type context = AbsPath.context
71 :     type t = AbsPath.t * int
72 :     type ord_key = t
73 :    
74 :     fun compare ((_, i), (_, i')) = Int.compare (i, i')
75 :    
76 :     val knownPaths = ref (AbsPathMap.empty: int AbsPathMap.map)
77 :     val nextId = ref 0
78 :    
79 :     fun sync () =
80 :     (AbsPath.newEra ();
81 : blume 377 knownPaths :=
82 :     AbsPathMap.foldli (fn (k, v, m) => AbsPathMap.insert (m, k, v))
83 :     AbsPathMap.empty
84 :     (!knownPaths))
85 : blume 354
86 :     fun clear () = knownPaths := AbsPathMap.empty
87 :    
88 :     val revalidateCwd = AbsPath.revalidateCwd
89 : blume 464 val invalidateCwd = AbsPath.invalidateCwd
90 : blume 354
91 :     fun intern ap =
92 :     case AbsPathMap.find (!knownPaths, ap) of
93 :     SOME i => (ap, i)
94 :     | NONE => let
95 :     val i = !nextId
96 :     in
97 :     nextId := i + 1;
98 :     knownPaths := AbsPathMap.insert (!knownPaths, ap, i);
99 :     (ap, i)
100 :     end
101 :    
102 :     val native = intern o AbsPath.native
103 :     fun standard m = intern o AbsPath.standard m
104 : blume 457 fun fromDescr m = intern o AbsPath.fromDescr m
105 : blume 354
106 :     val contextName = AbsPath.contextName
107 :     fun contextOf (ap, _) = AbsPath.contextOf ap
108 :     fun specOf (ap, _) = AbsPath.specOf ap
109 :     fun osstring (ap, _) = AbsPath.osstring ap
110 : blume 492 fun osstring' (ap, _) = AbsPath.osstring' ap
111 : blume 354 fun descr (ap, _) = AbsPath.descr ap
112 :     fun reAnchoredName ((ap, _), root) = AbsPath.reAnchoredName (ap, root)
113 :     fun tstamp (ap, _) = AbsPath.tstamp ap
114 :     fun sameDirContext (ap, _) = AbsPath.sameDirContext ap
115 :     val cwdContext = AbsPath.cwdContext
116 :    
117 :     fun pickle warn ((ap, _), (cap, _)) = AbsPath.pickle warn (ap, cap)
118 : blume 367 fun unpickle m (l, (cap, _)) = intern (AbsPath.unpickle m (l, cap))
119 : blume 354 end

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