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 286 - (view) (download)

1 : blume 275 (*
2 : blume 282 * Bundling information pertaining to one SML source file.
3 :     * - only includes information that does not require running
4 :     * the machine-dependent part of the compiler
5 : blume 275 *
6 :     * (C) 1999 Lucent Technologies, Bell Laboratories
7 :     *
8 :     * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
9 :     *)
10 : blume 270 signature SMLINFO = sig
11 :    
12 :     type info
13 :    
14 : blume 281 type complainer = string -> (PrettyPrint.ppstream -> unit) -> unit
15 : blume 282 type parsetree = GenericVC.Ast.dec
16 : blume 274
17 : blume 282 val resync : unit -> unit (* rebuild internal table *)
18 : blume 277
19 : blume 279 val eq : info * info -> bool (* compares sourcepaths *)
20 :     val compare : info * info -> order (* compares sourcepaths *)
21 :    
22 : blume 286 val info : GeneralParams.params ->
23 : blume 274 { sourcepath: AbsPath.t,
24 :     group: AbsPath.t,
25 : blume 281 error: complainer,
26 : blume 274 history: string list,
27 : blume 277 share: bool option }
28 : blume 270 -> info
29 :    
30 : blume 277 val sourcepath : info -> AbsPath.t
31 : blume 281 val error : info -> complainer
32 : blume 277
33 : blume 282 val parsetree : info -> parsetree option
34 : blume 281 val exports : info -> SymbolSet.set
35 : blume 279 val skeleton : info -> Skeleton.decl
36 :    
37 : blume 280 (* different ways of describing an sml file using group and source *)
38 :     val spec : info -> string (* sspec *)
39 :     val fullSpec : info -> string (* gspec(sspec) *)
40 :     val name : info -> string (* sname *)
41 :     val fullName : info -> string (* gname(sspec) *)
42 : blume 270 end
43 :    
44 :     structure SmlInfo :> SMLINFO = struct
45 :    
46 : blume 275 structure Source = GenericVC.Source
47 :     structure Print = GenericVC.Control.Print
48 :     structure SF = GenericVC.SmlFile
49 :     structure EM = GenericVC.ErrorMsg
50 : blume 286 structure FNP = FilenamePolicy
51 : blume 275
52 :     type source = Source.inputSource
53 : blume 274 type parsetree = GenericVC.Ast.dec
54 :    
55 : blume 281 type complainer = string -> (PrettyPrint.ppstream -> unit) -> unit
56 : blume 274
57 : blume 275 datatype info =
58 :     INFO of {
59 :     sourcepath: AbsPath.t,
60 :     group: AbsPath.t,
61 : blume 281 error: complainer,
62 : blume 275 lastseen: TStamp.t ref,
63 :     parsetree: { tree: parsetree, source: source } option ref,
64 :     skelpath: AbsPath.t,
65 :     skeleton: Skeleton.decl option ref
66 :     (* to be extended *)
67 :     }
68 : blume 270
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 : blume 286 fun info params arg = let
91 :     val { fnpolicy, groupreg, primconf } = params
92 :     val { sourcepath, group, error, history, share } = arg
93 : blume 281 fun newinfo () = let
94 :     val i = INFO {
95 :     sourcepath = sourcepath,
96 :     group = group,
97 :     error = error,
98 :     lastseen = ref TStamp.NOTSTAMP,
99 :     parsetree = ref NONE,
100 : blume 286 skelpath = FNP.mkSkelPath fnpolicy sourcepath,
101 : blume 281 skeleton = ref NONE
102 :     }
103 :     in
104 :     knownInfo := AbsPathMap.insert (!knownInfo, sourcepath, i);
105 :     i
106 :     end
107 :     in
108 : blume 277 case AbsPathMap.find (!knownInfo, sourcepath) of
109 :     SOME (i as INFO { group = g, error = e, ... }) =>
110 : blume 281 if AbsPath.compare (group, g) <> EQUAL then
111 : blume 286 (if GroupReg.registered groupreg g then
112 : blume 281 let val n = AbsPath.name sourcepath
113 :     in
114 :     error (concat ["ML source file ", n,
115 :     " appears in more than one group"])
116 :     EM.nullErrorBody;
117 :     e (concat ["(previous occurence of ", n, ")"])
118 :     EM.nullErrorBody
119 :     end
120 :     else ();
121 :     newinfo ())
122 :     else i
123 :     | NONE => newinfo ()
124 :     end
125 : blume 277
126 : blume 275 (* check timestamp and throw away any invalid cache *)
127 :     fun validate (INFO ir) = let
128 :     (* don't use "..." pattern to have the compiler catch later
129 :     * additions to the type! *)
130 :     val { sourcepath, group, error, lastseen,
131 :     parsetree, skelpath, skeleton } = ir
132 :     val ts = !lastseen
133 :     val nts = AbsPath.tstamp sourcepath
134 : blume 274 in
135 : blume 275 if TStamp.earlier (ts, nts) then
136 :     (lastseen := nts;
137 :     parsetree := NONE;
138 :     skeleton := NONE)
139 :     else ()
140 : blume 274 end
141 :    
142 : blume 275 (* the following functions are only concerned with getting the data,
143 :     * not with checking time stamps *)
144 : blume 281 fun getParseTree (INFO ir, quiet, noerrors) = let
145 : blume 275 val { sourcepath, parsetree, error, ... } = ir
146 : blume 276 val name = AbsPath.name sourcepath
147 : blume 281 val err = if noerrors then (fn m => ())
148 :     else (fn m => error m EM.nullErrorBody)
149 : blume 274 in
150 : blume 275 case !parsetree of
151 :     SOME pt => SOME pt
152 :     | NONE => let
153 :     val stream = AbsPath.openTextIn sourcepath
154 : blume 281 val _ = if noerrors orelse quiet then ()
155 : blume 275 else Say.vsay (concat ["[parsing ", name, "]\n"])
156 :     val source =
157 :     Source.newSource (name, 1, stream, false,
158 :     { linewidth = !Print.linewidth,
159 :     flush = Print.flush,
160 :     consumer = Print.say })
161 :     val pto = let
162 :     val tree = SF.parse source
163 :     in
164 :     SOME { tree = tree, source = source }
165 :     end handle SF.Compile msg => (TextIO.closeIn stream;
166 : blume 281 err msg;
167 : blume 275 NONE)
168 : blume 276 | exn => (TextIO.closeIn stream; raise exn)
169 : blume 275 in
170 :     TextIO.closeIn stream;
171 :     parsetree := pto;
172 :     pto
173 : blume 281 end handle exn as IO.Io _ => (err (General.exnMessage exn);
174 :     NONE)
175 : blume 274 end
176 :    
177 : blume 281 fun getSkeleton (INFO ir, noerrors) = let
178 : blume 275 val { skelpath, skeleton, lastseen, error, ... } = ir
179 :     in
180 :     case !skeleton of
181 : blume 281 SOME sk => sk
182 : blume 275 | NONE =>
183 :     (case SkelIO.read (skelpath, !lastseen) of
184 : blume 281 SOME sk => (skeleton := SOME sk; sk)
185 : blume 275 | NONE =>
186 : blume 281 (case getParseTree (INFO ir, false, noerrors) of
187 : blume 275 SOME { tree, source } => let
188 :     fun err sv region s =
189 :     EM.error source region sv s
190 :     EM.nullErrorBody
191 : blume 281 val { skeleton = sk, complain } =
192 : blume 275 SkelCvt.convert { tree = tree,
193 :     err = err }
194 :     in
195 : blume 281 if noerrors then () else complain ();
196 : blume 275 if EM.anyErrors (EM.errors source) then
197 : blume 281 if noerrors then ()
198 :     else error "error(s) in ML source file"
199 :     EM.nullErrorBody
200 : blume 275 else (SkelIO.write (skelpath, sk);
201 : blume 281 skeleton := SOME sk);
202 :     sk
203 : blume 275 end
204 : blume 286 | NONE => Skeleton.Seq []))
205 : blume 275 end
206 :    
207 :     (* first check the time stamp, then do your stuff... *)
208 : blume 281 fun skeleton0 noerrors i = (validate i; getSkeleton (i, noerrors))
209 :    
210 :     (* we only complain at the time of getting the exports *)
211 :     val exports = SkelExports.exports o (skeleton0 false)
212 :     val skeleton = skeleton0 true
213 : blume 275
214 : blume 282 fun parsetree i = Option.map #tree (getParseTree (i, true, true))
215 :    
216 : blume 280 fun spec (INFO { sourcepath, ... }) = AbsPath.spec sourcepath
217 :     fun fullSpec (INFO { group, sourcepath, ... }) =
218 :     concat [AbsPath.spec group, "(", AbsPath.spec sourcepath, ")"]
219 :     fun name (INFO { sourcepath, ... }) = AbsPath.name sourcepath
220 :     fun fullName (INFO { group, sourcepath, ... }) =
221 :     concat [AbsPath.name group, "(", AbsPath.spec sourcepath, ")"]
222 : blume 270 end

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