Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/trunk/src/cm/smlfile/smlinfo.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 272, Wed May 12 07:09:28 1999 UTC revision 275, Sat May 15 09:54:52 1999 UTC
# Line 1  Line 1 
1    (*
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  signature SMLINFO = sig  signature SMLINFO = sig
9    
10      type info      type info
11    
12        type policy = Policy.policy
13    
14      type fileoffset = AbsPath.t * int      type fileoffset = AbsPath.t * int
15      type stableinfo = { skeleton: Skeleton.decl, binary: fileoffset }      type stableinfo = { skeleton: Skeleton.decl, binary: fileoffset }
16    
17      val new : { sourcepath: AbsPath.t,      val new : policy ->
18            { sourcepath: AbsPath.t,
19                  group: AbsPath.t,                  group: AbsPath.t,
20              error: string -> unit,
21                  history: string list,                  history: string list,
22                  share: bool option,                  share: bool option,
23                  stableinfo: stableinfo option }                  stableinfo: stableinfo option }
# Line 18  Line 29 
29    
30  structure SmlInfo :> SMLINFO = struct  structure SmlInfo :> SMLINFO = struct
31    
32      type info = Dummy.t      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        type parsetree = GenericVC.Ast.dec
39    
40        type policy = Policy.policy
41    
42        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    
54      type fileoffset = AbsPath.t * int      type fileoffset = AbsPath.t * int
55      type stableinfo = { skeleton: Skeleton.decl, binary: fileoffset }      type stableinfo = { skeleton: Skeleton.decl, binary: fileoffset }
56    
57      fun new { sourcepath, group, history, share, stableinfo } = Dummy.v      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    
70        (* 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        in
79            if TStamp.earlier (ts, nts) then
80                (lastseen := nts;
81                 parsetree := NONE;
82                 skeleton := NONE)
83            else ()
84        end
85    
86        (* 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        in
91            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        end
125    
126        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 exports i = Dummy.f ()      fun describe (INFO { sourcepath, ... }) = AbsPath.name sourcepath
     fun describe i = Dummy.f ()  
162  end  end

Legend:
Removed from v.272  
changed lines
  Added in v.275

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