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

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