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

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