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

Annotation of /sml/trunk/src/cm/smlfile/smlinfo.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 280 - (view) (download)

1 : blume 275 (*
2 :     * Bundling all information pertaining to one SML source file.
3 :     *
4 :     * (C) 1999 Lucent Technologies, Bell Laboratories
5 :     *
6 :     * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
7 :     *)
8 : blume 270 signature SMLINFO = sig
9 :    
10 :     type info
11 :    
12 : blume 274 type policy = Policy.policy
13 :    
14 : blume 270 type fileoffset = AbsPath.t * int
15 :    
16 : blume 277 val resync : unit -> unit
17 :    
18 : blume 279 val eq : info * info -> bool (* compares sourcepaths *)
19 :     val compare : info * info -> order (* compares sourcepaths *)
20 :    
21 : blume 276 val info : policy ->
22 : blume 274 { sourcepath: AbsPath.t,
23 :     group: AbsPath.t,
24 : blume 277 error: string -> (PrettyPrint.ppstream -> unit) -> unit,
25 : blume 274 history: string list,
26 : blume 277 share: bool option }
27 : blume 270 -> info
28 :    
29 : blume 277 val sourcepath : info -> AbsPath.t
30 :     val error : info -> string -> (PrettyPrint.ppstream -> unit) -> unit
31 :    
32 : blume 270 val exports : info -> SymbolSet.set
33 : blume 279 val skeleton : info -> Skeleton.decl
34 :    
35 : blume 280 (* different ways of describing an sml file using group and source *)
36 :     val spec : info -> string (* sspec *)
37 :     val fullSpec : info -> string (* gspec(sspec) *)
38 :     val name : info -> string (* sname *)
39 :     val fullName : info -> string (* gname(sspec) *)
40 : blume 270 end
41 :    
42 :     structure SmlInfo :> SMLINFO = struct
43 :    
44 : blume 275 structure Source = GenericVC.Source
45 :     structure Print = GenericVC.Control.Print
46 :     structure SF = GenericVC.SmlFile
47 :     structure EM = GenericVC.ErrorMsg
48 :    
49 :     type source = Source.inputSource
50 : blume 274 type parsetree = GenericVC.Ast.dec
51 :    
52 :     type policy = Policy.policy
53 :    
54 : blume 275 datatype info =
55 :     INFO of {
56 :     sourcepath: AbsPath.t,
57 :     group: AbsPath.t,
58 : blume 277 error: string -> (PrettyPrint.ppstream -> unit) -> unit,
59 : blume 275 lastseen: TStamp.t ref,
60 :     parsetree: { tree: parsetree, source: source } option ref,
61 :     skelpath: AbsPath.t,
62 :     skeleton: Skeleton.decl option ref
63 :     (* to be extended *)
64 :     }
65 : blume 270
66 :     type fileoffset = AbsPath.t * int
67 :     type stableinfo = { skeleton: Skeleton.decl, binary: fileoffset }
68 :    
69 : blume 277 fun sourcepath (INFO { sourcepath = sp, ... }) = sp
70 :     fun error (INFO { error = e, ... }) = e
71 : blume 270
72 : blume 279 fun compare (INFO { sourcepath = p, ... }, INFO { sourcepath = p', ... }) =
73 :     AbsPath.compare (p, p')
74 :     fun eq (i, i') = compare (i, i') = EQUAL
75 :    
76 : blume 277 (* If files change their file ids, then CM will be seriously
77 :     * disturbed because the ordering relation will change.
78 :     * We'll asume that this won't happen in general. However, we provide
79 :     * a "resync" function that -- at the very least -- should be run
80 :     * at startup time. *)
81 :     val knownInfo : info AbsPathMap.map ref = ref AbsPathMap.empty
82 :    
83 :     fun resync () = let
84 :     val l = AbsPathMap.listItemsi (!knownInfo)
85 :     in
86 :     AbsPath.newEra (); (* force recalculation of file ids *)
87 :     knownInfo := foldl AbsPathMap.insert' AbsPathMap.empty l
88 :     end
89 :    
90 :     fun info policy { sourcepath, group, error, history, share } =
91 :     case AbsPathMap.find (!knownInfo, sourcepath) of
92 :     SOME (i as INFO { group = g, error = e, ... }) =>
93 :     (if AbsPath.compare (group, g) <> EQUAL then
94 :     let val n = AbsPath.name sourcepath
95 :     in
96 :     error (concat ["ML source file ", n,
97 :     " appears in more than one group"])
98 :     EM.nullErrorBody;
99 :     e (concat ["(previous occurence of ", n, ")"])
100 :     EM.nullErrorBody
101 :     end
102 :     else ();
103 :     i)
104 :     | NONE => let
105 :     val i = INFO {
106 :     sourcepath = sourcepath,
107 :     group = group,
108 :     error = error,
109 :     lastseen = ref TStamp.NOTSTAMP,
110 :     parsetree = ref NONE,
111 :     skelpath = Policy.mkSkelPath policy sourcepath,
112 :     skeleton = ref NONE
113 :     }
114 :     in
115 :     knownInfo := AbsPathMap.insert (!knownInfo, sourcepath, i);
116 :     i
117 :     end
118 :    
119 : blume 275 (* check timestamp and throw away any invalid cache *)
120 :     fun validate (INFO ir) = let
121 :     (* don't use "..." pattern to have the compiler catch later
122 :     * additions to the type! *)
123 :     val { sourcepath, group, error, lastseen,
124 :     parsetree, skelpath, skeleton } = ir
125 :     val ts = !lastseen
126 :     val nts = AbsPath.tstamp sourcepath
127 : blume 274 in
128 : blume 275 if TStamp.earlier (ts, nts) then
129 :     (lastseen := nts;
130 :     parsetree := NONE;
131 :     skeleton := NONE)
132 :     else ()
133 : blume 274 end
134 :    
135 : blume 275 (* the following functions are only concerned with getting the data,
136 :     * not with checking time stamps *)
137 :     fun getParseTree (INFO ir, quiet) = let
138 :     val { sourcepath, parsetree, error, ... } = ir
139 : blume 276 val name = AbsPath.name sourcepath
140 : blume 274 in
141 : blume 275 case !parsetree of
142 :     SOME pt => SOME pt
143 :     | NONE => let
144 :     val stream = AbsPath.openTextIn sourcepath
145 :     val _ = if quiet then ()
146 :     else Say.vsay (concat ["[parsing ", name, "]\n"])
147 :     val source =
148 :     Source.newSource (name, 1, stream, false,
149 :     { linewidth = !Print.linewidth,
150 :     flush = Print.flush,
151 :     consumer = Print.say })
152 :     val pto = let
153 :     val tree = SF.parse source
154 :     in
155 :     SOME { tree = tree, source = source }
156 :     end handle SF.Compile msg => (TextIO.closeIn stream;
157 : blume 277 error msg EM.nullErrorBody;
158 : blume 275 NONE)
159 : blume 276 | exn => (TextIO.closeIn stream; raise exn)
160 : blume 275 in
161 :     TextIO.closeIn stream;
162 :     parsetree := pto;
163 :     pto
164 : blume 277 end handle exn as IO.Io _ => (error (General.exnMessage exn)
165 :     EM.nullErrorBody;
166 : blume 276 NONE)
167 : blume 274 end
168 :    
169 : blume 275 fun getSkeleton (INFO ir) = let
170 :     val { skelpath, skeleton, lastseen, error, ... } = ir
171 :     in
172 :     case !skeleton of
173 :     SOME sk => SOME sk
174 :     | NONE =>
175 :     (case SkelIO.read (skelpath, !lastseen) of
176 :     SOME sk => (skeleton := SOME sk; SOME sk)
177 :     | NONE =>
178 :     (case getParseTree (INFO ir, false) of
179 :     SOME { tree, source } => let
180 :     fun err sv region s =
181 :     EM.error source region sv s
182 :     EM.nullErrorBody
183 :     val sk =
184 :     SkelCvt.convert { tree = tree,
185 :     err = err }
186 :     in
187 :     if EM.anyErrors (EM.errors source) then
188 :     (error "error(s) in ML source file";
189 :     NONE)
190 :     else (SkelIO.write (skelpath, sk);
191 :     skeleton := SOME sk;
192 :     SOME sk)
193 :     end
194 :     | NONE => NONE))
195 :     end
196 :    
197 :     (* first check the time stamp, then do your stuff... *)
198 :     fun exports i =
199 :     (validate i;
200 :     case getSkeleton i of
201 :     NONE => SymbolSet.empty
202 :     | SOME sk => SkelExports.exports sk)
203 :    
204 : blume 279 fun skeleton i =
205 :     (validate i;
206 :     case getSkeleton i of
207 :     NONE => Skeleton.SeqDecl []
208 :     | SOME sk => sk)
209 :    
210 : blume 280 fun spec (INFO { sourcepath, ... }) = AbsPath.spec sourcepath
211 :     fun fullSpec (INFO { group, sourcepath, ... }) =
212 :     concat [AbsPath.spec group, "(", AbsPath.spec sourcepath, ")"]
213 :     fun name (INFO { sourcepath, ... }) = AbsPath.name sourcepath
214 :     fun fullName (INFO { group, sourcepath, ... }) =
215 :     concat [AbsPath.name group, "(", AbsPath.spec sourcepath, ")"]
216 : blume 270 end

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