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 275 - (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 :     type stableinfo = { skeleton: Skeleton.decl, binary: fileoffset }
16 :    
17 : blume 274 val new : policy ->
18 :     { sourcepath: AbsPath.t,
19 :     group: AbsPath.t,
20 : blume 275 error: string -> unit,
21 : blume 274 history: string list,
22 :     share: bool option,
23 :     stableinfo: stableinfo option }
24 : blume 270 -> info
25 :    
26 :     val exports : info -> SymbolSet.set
27 :     val describe : info -> string
28 :     end
29 :    
30 :     structure SmlInfo :> SMLINFO = struct
31 :    
32 : blume 275 structure Source = GenericVC.Source
33 :     structure Print = GenericVC.Control.Print
34 :     structure SF = GenericVC.SmlFile
35 :     structure EM = GenericVC.ErrorMsg
36 :    
37 :     type source = Source.inputSource
38 : blume 274 type parsetree = GenericVC.Ast.dec
39 :    
40 :     type policy = Policy.policy
41 :    
42 : blume 275 datatype info =
43 :     INFO of {
44 :     sourcepath: AbsPath.t,
45 :     group: AbsPath.t,
46 :     error: string -> unit,
47 :     lastseen: TStamp.t ref,
48 :     parsetree: { tree: parsetree, source: source } option ref,
49 :     skelpath: AbsPath.t,
50 :     skeleton: Skeleton.decl option ref
51 :     (* to be extended *)
52 :     }
53 : blume 270
54 :     type fileoffset = AbsPath.t * int
55 :     type stableinfo = { skeleton: Skeleton.decl, binary: fileoffset }
56 :    
57 : blume 275 fun new policy { sourcepath, group, error, history, share, stableinfo } =
58 :     case stableinfo of
59 :     NONE => INFO {
60 :     sourcepath = sourcepath,
61 :     group = group,
62 :     error = error,
63 :     lastseen = ref TStamp.NOTSTAMP,
64 :     parsetree = ref NONE,
65 :     skelpath = Policy.mkSkelPath policy sourcepath,
66 :     skeleton = ref NONE
67 :     }
68 :     | SOME si => Dummy.f ()
69 : blume 270
70 : blume 275 (* check timestamp and throw away any invalid cache *)
71 :     fun validate (INFO ir) = let
72 :     (* don't use "..." pattern to have the compiler catch later
73 :     * additions to the type! *)
74 :     val { sourcepath, group, error, lastseen,
75 :     parsetree, skelpath, skeleton } = ir
76 :     val ts = !lastseen
77 :     val nts = AbsPath.tstamp sourcepath
78 : blume 274 in
79 : blume 275 if TStamp.earlier (ts, nts) then
80 :     (lastseen := nts;
81 :     parsetree := NONE;
82 :     skeleton := NONE)
83 :     else ()
84 : blume 274 end
85 :    
86 : blume 275 (* the following functions are only concerned with getting the data,
87 :     * not with checking time stamps *)
88 :     fun getParseTree (INFO ir, quiet) = let
89 :     val { sourcepath, parsetree, error, ... } = ir
90 : blume 274 in
91 : blume 275 case !parsetree of
92 :     SOME pt => SOME pt
93 :     | NONE => let
94 :     val stream = AbsPath.openTextIn sourcepath
95 :     val name = AbsPath.name sourcepath
96 :     val _ = if quiet then ()
97 :     else Say.vsay (concat ["[parsing ", name, "]\n"])
98 :     val source =
99 :     Source.newSource (name, 1, stream, false,
100 :     { linewidth = !Print.linewidth,
101 :     flush = Print.flush,
102 :     consumer = Print.say })
103 :     val pto = let
104 :     val tree = SF.parse source
105 :     in
106 :     SOME { tree = tree, source = source }
107 :     end handle SF.Compile msg => (TextIO.closeIn stream;
108 :     error "parse error";
109 :     NONE)
110 :     | exn as IO.Io _ =>
111 :     (TextIO.closeIn stream;
112 :     error (General.exnMessage exn);
113 :     NONE)
114 :     | exn => (TextIO.closeIn stream;
115 :     error (concat ["parsing of \"", name,
116 :     "\" failed: ",
117 :     General.exnMessage exn]);
118 :     raise exn)
119 :     in
120 :     TextIO.closeIn stream;
121 :     parsetree := pto;
122 :     pto
123 :     end
124 : blume 274 end
125 :    
126 : blume 275 fun getSkeleton (INFO ir) = let
127 :     val { skelpath, skeleton, lastseen, error, ... } = ir
128 :     in
129 :     case !skeleton of
130 :     SOME sk => SOME sk
131 :     | NONE =>
132 :     (case SkelIO.read (skelpath, !lastseen) of
133 :     SOME sk => (skeleton := SOME sk; SOME sk)
134 :     | NONE =>
135 :     (case getParseTree (INFO ir, false) of
136 :     SOME { tree, source } => let
137 :     fun err sv region s =
138 :     EM.error source region sv s
139 :     EM.nullErrorBody
140 :     val sk =
141 :     SkelCvt.convert { tree = tree,
142 :     err = err }
143 :     in
144 :     if EM.anyErrors (EM.errors source) then
145 :     (error "error(s) in ML source file";
146 :     NONE)
147 :     else (SkelIO.write (skelpath, sk);
148 :     skeleton := SOME sk;
149 :     SOME sk)
150 :     end
151 :     | NONE => NONE))
152 :     end
153 :    
154 :     (* first check the time stamp, then do your stuff... *)
155 :     fun exports i =
156 :     (validate i;
157 :     case getSkeleton i of
158 :     NONE => SymbolSet.empty
159 :     | SOME sk => SkelExports.exports sk)
160 :    
161 :     fun describe (INFO { sourcepath, ... }) = AbsPath.name sourcepath
162 : blume 270 end

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