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

Parent Directory | Revision Log

---

Revision 366 - (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 :			type context
16 :			type t
17 :			type ord_key = t
18 :
19 :			val compare : ord_key * ord_key -> order
20 :
21 :			(* This rebuilds the internal table in a manner consistent with
22 :			* the current state of the file system: *)
23 :			val sync : unit -> unit
24 :
25 :	blume	366	(* This makes sure CM knows what the current working directory is: *)
26 :			val revalidateCwd : unit -> unit
27 :
28 :	blume	354	(* This erases all persistent state: *)
29 :			val clear : unit -> unit
30 :
31 :			val osstring : t -> string
32 :			val descr : t -> string
33 :			val reAnchoredName : t * string -> string option
34 :			val contextOf : t -> context
35 :			val specOf : t -> string
36 :			val contextName : context -> string
37 :			val sameDirContext : t -> context
38 :	blume	366
39 :			(* This will be called at the beginning of most main operations.
40 :			* Therefore, it will automatically do the call to revalidateCwd. *)
41 :	blume	354	val cwdContext : unit -> context
42 :
43 :			val native : { context: context, spec: string } -> t
44 :			val standard : PathConfig.mode -> { context: context, spec: string } -> t
45 :
46 :			val pickle : (bool -> unit) -> t * t -> string list
47 :			val unpickle : PathConfig.mode -> string list * t -> t option
48 :
49 :			val tstamp : t -> TStamp.t
50 :			end
51 :
52 :			structure SrcPath :> SRCPATH = struct
53 :
54 :			type context = AbsPath.context
55 :			type t = AbsPath.t * int
56 :			type ord_key = t
57 :
58 :			fun compare ((_, i), (_, i')) = Int.compare (i, i')
59 :
60 :			val knownPaths = ref (AbsPathMap.empty: int AbsPathMap.map)
61 :			val nextId = ref 0
62 :
63 :			fun sync () =
64 :			(AbsPath.newEra ();
65 :			knownPaths := foldl AbsPathMap.insert' AbsPathMap.empty
66 :			(AbsPathMap.listItemsi (!knownPaths)))
67 :
68 :			fun clear () = knownPaths := AbsPathMap.empty
69 :
70 :			val revalidateCwd = AbsPath.revalidateCwd
71 :
72 :			fun intern ap =
73 :			case AbsPathMap.find (!knownPaths, ap) of
74 :			SOME i => (ap, i)
75 :			| NONE => let
76 :			val i = !nextId
77 :			in
78 :			nextId := i + 1;
79 :			knownPaths := AbsPathMap.insert (!knownPaths, ap, i);
80 :			(ap, i)
81 :			end
82 :
83 :			val native = intern o AbsPath.native
84 :			fun standard m = intern o AbsPath.standard m
85 :
86 :			val contextName = AbsPath.contextName
87 :			fun contextOf (ap, _) = AbsPath.contextOf ap
88 :			fun specOf (ap, _) = AbsPath.specOf ap
89 :			fun osstring (ap, _) = AbsPath.osstring ap
90 :			fun descr (ap, _) = AbsPath.descr ap
91 :			fun reAnchoredName ((ap, _), root) = AbsPath.reAnchoredName (ap, root)
92 :			fun tstamp (ap, _) = AbsPath.tstamp ap
93 :			fun sameDirContext (ap, _) = AbsPath.sameDirContext ap
94 :			val cwdContext = AbsPath.cwdContext
95 :
96 :			fun pickle warn ((ap, _), (cap, _)) = AbsPath.pickle warn (ap, cap)
97 :			fun unpickle m (l, (cap, _)) =
98 :			Option.map intern (AbsPath.unpickle m (l, cap))
99 :			end

---

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