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 274, Fri May 14 05:23:02 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
# Line 10  Line 17 
17      val new : policy ->      val new : policy ->
18          { sourcepath: AbsPath.t,          { 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 21  Line 29 
29    
30  structure SmlInfo :> SMLINFO = struct  structure SmlInfo :> SMLINFO = struct
31    
32      type source = GenericVC.Source.inputSource      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      type parsetree = GenericVC.Ast.dec
39    
40      type policy = Policy.policy      type policy = Policy.policy
41    
42      type info = Dummy.t      datatype info =
43  (*          INFO of {
         INFO {  
44                sourcepath: AbsPath.t,                sourcepath: AbsPath.t,
45                     group: AbsPath.t,
46                     error: string -> unit,
47                lastseen: TStamp.t ref,                lastseen: TStamp.t ref,
48                parsetree: { tree: parsetree, source: source } option ref,                parsetree: { tree: parsetree, source: source } option ref,
49                skelpath: AbsPath.t,                skelpath: AbsPath.t,
50                skeleton: Skeleton.decl option ref,                   skeleton: Skeleton.decl option ref
51                (* to be extended *)                (* 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 policy { sourcepath, group, error, history, share, stableinfo } =
58      fun new policy { sourcepath, group, history, share, stableinfo = NONE } =          case stableinfo of
59          INFO {              NONE => INFO {
60                sourcepath = sourcepath,                sourcepath = sourcepath,
61                              group = group,
62                              error = error,
63                lastseen = ref TStamp.NOTSTAMP,                lastseen = ref TStamp.NOTSTAMP,
64                parsetree = ref NONE,                parsetree = ref NONE,
65                skelpath = Policy.mkSkelPath policy sourcepath,                skelpath = Policy.mkSkelPath policy sourcepath,
66                skeleton = ref NONE                skeleton = ref NONE
67               }               }
68  *)            | SOME si => Dummy.f ()
     fun new policy arg = Dummy.v  
69    
70  (*      (* check timestamp and throw away any invalid cache *)
71      fun outdated (INFO { sourcepath, lastseen = ref ts, ... }) = let      fun validate (INFO ir) = let
72          val nts = AbsPath.modtime sourcepath          (* 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      in
79          (TStamp.earlier (ts, nts), nts)          if TStamp.earlier (ts, nts) then
80                (lastseen := nts;
81                 parsetree := NONE;
82                 skeleton := NONE)
83            else ()
84      end      end
 *)  
85    
86  (*      (* the following functions are only concerned with getting the data,
87      fun getParseTree (i as INFO { sourcepath, parsetree, lastseen, ... }) = let       * not with checking time stamps *)
88          val (outd, nts) = outdated i      fun getParseTree (INFO ir, quiet) = let
89          fun parse () =          val { sourcepath, parsetree, error, ... } = ir
90      in      in
91          if outd then parse ()          case !parsetree of
92          else case !parsetree of              SOME pt => SOME pt
93              NONE => parse ()            | NONE => let
94            | SOME pt => pt                  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      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 = (ignore Dummy.v; SymbolSet.empty)      fun describe (INFO { sourcepath, ... }) = AbsPath.name sourcepath
     fun describe i = Dummy.f ()  
162  end  end

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

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