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

Parent Directory | Revision Log

---

Revision 377 - (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	354	(* This erases all persistent state: *)
33 :			val clear : unit -> unit
34 :
35 :			val osstring : t -> string
36 :			val descr : t -> string
37 :			val reAnchoredName : t * string -> string option
38 :			val contextOf : t -> context
39 :			val specOf : t -> string
40 :			val contextName : context -> string
41 :			val sameDirContext : t -> context
42 :	blume	366
43 :			(* This will be called at the beginning of most main operations.
44 :			* Therefore, it will automatically do the call to revalidateCwd. *)
45 :	blume	354	val cwdContext : unit -> context
46 :
47 :			val native : { context: context, spec: string } -> t
48 :			val standard : PathConfig.mode -> { context: context, spec: string } -> t
49 :
50 :			val pickle : (bool -> unit) -> t * t -> string list
51 :	blume	367	val unpickle : PathConfig.mode -> string list * t -> t
52 :	blume	354
53 :			val tstamp : t -> TStamp.t
54 :			end
55 :
56 :			structure SrcPath :> SRCPATH = struct
57 :
58 :	blume	367	exception Format = AbsPath.Format
59 :			exception BadAnchor = AbsPath.BadAnchor
60 :
61 :	blume	354	type context = AbsPath.context
62 :			type t = AbsPath.t * int
63 :			type ord_key = t
64 :
65 :			fun compare ((_, i), (_, i')) = Int.compare (i, i')
66 :
67 :			val knownPaths = ref (AbsPathMap.empty: int AbsPathMap.map)
68 :			val nextId = ref 0
69 :
70 :			fun sync () =
71 :			(AbsPath.newEra ();
72 :	blume	377	knownPaths :=
73 :			AbsPathMap.foldli (fn (k, v, m) => AbsPathMap.insert (m, k, v))
74 :			AbsPathMap.empty
75 :			(!knownPaths))
76 :	blume	354
77 :			fun clear () = knownPaths := AbsPathMap.empty
78 :
79 :			val revalidateCwd = AbsPath.revalidateCwd
80 :
81 :			fun intern ap =
82 :			case AbsPathMap.find (!knownPaths, ap) of
83 :			SOME i => (ap, i)
84 :			| NONE => let
85 :			val i = !nextId
86 :			in
87 :			nextId := i + 1;
88 :			knownPaths := AbsPathMap.insert (!knownPaths, ap, i);
89 :			(ap, i)
90 :			end
91 :
92 :			val native = intern o AbsPath.native
93 :			fun standard m = intern o AbsPath.standard m
94 :
95 :			val contextName = AbsPath.contextName
96 :			fun contextOf (ap, _) = AbsPath.contextOf ap
97 :			fun specOf (ap, _) = AbsPath.specOf ap
98 :			fun osstring (ap, _) = AbsPath.osstring ap
99 :			fun descr (ap, _) = AbsPath.descr ap
100 :			fun reAnchoredName ((ap, _), root) = AbsPath.reAnchoredName (ap, root)
101 :			fun tstamp (ap, _) = AbsPath.tstamp ap
102 :			fun sameDirContext (ap, _) = AbsPath.sameDirContext ap
103 :			val cwdContext = AbsPath.cwdContext
104 :
105 :			fun pickle warn ((ap, _), (cap, _)) = AbsPath.pickle warn (ap, cap)
106 :	blume	367	fun unpickle m (l, (cap, _)) = intern (AbsPath.unpickle m (l, cap))
107 :	blume	354	end

---

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