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 280, Tue May 18 09:05:13 1999 UTC revision 281, Tue May 18 14:57:00 1999 UTC
# Line 10  Line 10 
10      type info      type info
11    
12      type policy = Policy.policy      type policy = Policy.policy
13        type complainer = string -> (PrettyPrint.ppstream -> unit) -> unit
     type fileoffset = AbsPath.t * int  
14    
15      val resync : unit -> unit      val resync : unit -> unit
16    
# Line 21  Line 20 
20      val info : policy ->      val info : policy ->
21          { sourcepath: AbsPath.t,          { sourcepath: AbsPath.t,
22            group: AbsPath.t,            group: AbsPath.t,
23            error: string -> (PrettyPrint.ppstream -> unit) -> unit,            error: complainer,
24            history: string list,            history: string list,
25            share: bool option }            share: bool option }
26          -> info          -> info
27    
28      val sourcepath : info -> AbsPath.t      val sourcepath : info -> AbsPath.t
29      val error : info -> string -> (PrettyPrint.ppstream -> unit) -> unit      val error : info -> complainer
30    
31      val exports : info -> SymbolSet.set      val exports : info -> SymbolSet.set
32      val skeleton : info -> Skeleton.decl      val skeleton : info -> Skeleton.decl
# Line 50  Line 49 
49      type parsetree = GenericVC.Ast.dec      type parsetree = GenericVC.Ast.dec
50    
51      type policy = Policy.policy      type policy = Policy.policy
52        type complainer = string -> (PrettyPrint.ppstream -> unit) -> unit
53    
54      datatype info =      datatype info =
55          INFO of {          INFO of {
56                   sourcepath: AbsPath.t,                   sourcepath: AbsPath.t,
57                   group: AbsPath.t,                   group: AbsPath.t,
58                   error: string -> (PrettyPrint.ppstream -> unit) -> unit,                   error: complainer,
59                   lastseen: TStamp.t ref,                   lastseen: TStamp.t ref,
60                   parsetree: { tree: parsetree, source: source } option ref,                   parsetree: { tree: parsetree, source: source } option ref,
61                   skelpath: AbsPath.t,                   skelpath: AbsPath.t,
# Line 63  Line 63 
63                   (* to be extended *)                   (* to be extended *)
64                  }                  }
65    
     type fileoffset = AbsPath.t * int  
     type stableinfo = { skeleton: Skeleton.decl, binary: fileoffset }  
   
66      fun sourcepath (INFO { sourcepath = sp, ... }) = sp      fun sourcepath (INFO { sourcepath = sp, ... }) = sp
67      fun error (INFO { error = e, ... }) = e      fun error (INFO { error = e, ... }) = e
68    
# Line 87  Line 84 
84          knownInfo := foldl AbsPathMap.insert' AbsPathMap.empty l          knownInfo := foldl AbsPathMap.insert' AbsPathMap.empty l
85      end      end
86    
87      fun info policy { sourcepath, group, error, history, share } =      fun info policy { sourcepath, group, error, history, share } = let
88          case AbsPathMap.find (!knownInfo, sourcepath) of          fun newinfo () = let
             SOME (i as INFO { group = g, error = e, ... }) =>  
                 (if AbsPath.compare (group, g) <> EQUAL then  
                      let val n = AbsPath.name sourcepath  
                      in  
                          error (concat ["ML source file ", n,  
                                         " appears in more than one group"])  
                                EM.nullErrorBody;  
                          e (concat ["(previous occurence of ", n, ")"])  
                            EM.nullErrorBody  
                      end  
                  else ();  
                  i)  
           | NONE => let  
89                  val i = INFO {                  val i = INFO {
90                                sourcepath = sourcepath,                                sourcepath = sourcepath,
91                                group = group,                                group = group,
# Line 115  Line 99 
99                  knownInfo := AbsPathMap.insert (!knownInfo, sourcepath, i);                  knownInfo := AbsPathMap.insert (!knownInfo, sourcepath, i);
100                  i                  i
101              end              end
102        in
103            case AbsPathMap.find (!knownInfo, sourcepath) of
104                SOME (i as INFO { group = g, error = e, ... }) =>
105                    if AbsPath.compare (group, g) <> EQUAL then
106                        (if GroupReg.registered g then
107                             let val n = AbsPath.name sourcepath
108                             in
109                                 error (concat ["ML source file ", n,
110                                                " appears in more than one group"])
111                                       EM.nullErrorBody;
112                                 e (concat ["(previous occurence of ", n, ")"])
113                                   EM.nullErrorBody
114                             end
115                         else ();
116                         newinfo ())
117                    else i
118              | NONE => newinfo ()
119        end
120    
121      (* check timestamp and throw away any invalid cache *)      (* check timestamp and throw away any invalid cache *)
122      fun validate (INFO ir) = let      fun validate (INFO ir) = let
# Line 134  Line 136 
136    
137      (* the following functions are only concerned with getting the data,      (* the following functions are only concerned with getting the data,
138       * not with checking time stamps *)       * not with checking time stamps *)
139      fun getParseTree (INFO ir, quiet) = let      fun getParseTree (INFO ir, quiet, noerrors) = let
140          val { sourcepath, parsetree, error, ... } = ir          val { sourcepath, parsetree, error, ... } = ir
141          val name = AbsPath.name sourcepath          val name = AbsPath.name sourcepath
142            val err = if noerrors then (fn m => ())
143                      else (fn m => error m EM.nullErrorBody)
144      in      in
145          case !parsetree of          case !parsetree of
146              SOME pt => SOME pt              SOME pt => SOME pt
147            | NONE => let            | NONE => let
148                  val stream = AbsPath.openTextIn sourcepath                  val stream = AbsPath.openTextIn sourcepath
149                  val _ = if quiet then ()                  val _ = if noerrors orelse quiet then ()
150                          else Say.vsay (concat ["[parsing ", name, "]\n"])                          else Say.vsay (concat ["[parsing ", name, "]\n"])
151                  val source =                  val source =
152                      Source.newSource (name, 1, stream, false,                      Source.newSource (name, 1, stream, false,
# Line 154  Line 158 
158                  in                  in
159                      SOME { tree = tree, source = source }                      SOME { tree = tree, source = source }
160                  end handle SF.Compile msg => (TextIO.closeIn stream;                  end handle SF.Compile msg => (TextIO.closeIn stream;
161                                                error msg EM.nullErrorBody;                                                err msg;
162                                                NONE)                                                NONE)
163                           | exn => (TextIO.closeIn stream; raise exn)                           | exn => (TextIO.closeIn stream; raise exn)
164              in              in
165                  TextIO.closeIn stream;                  TextIO.closeIn stream;
166                  parsetree := pto;                  parsetree := pto;
167                  pto                  pto
168              end handle exn as IO.Io _ => (error (General.exnMessage exn)              end handle exn as IO.Io _ => (err (General.exnMessage exn);
                                                 EM.nullErrorBody;  
169                                            NONE)                                            NONE)
170      end      end
171    
172      fun getSkeleton (INFO ir) = let      fun getSkeleton (INFO ir, noerrors) = let
173          val { skelpath, skeleton, lastseen, error, ... } = ir          val { skelpath, skeleton, lastseen, error, ... } = ir
174      in      in
175          case !skeleton of          case !skeleton of
176              SOME sk => SOME sk              SOME sk => sk
177            | NONE =>            | NONE =>
178                  (case SkelIO.read (skelpath, !lastseen) of                  (case SkelIO.read (skelpath, !lastseen) of
179                       SOME sk => (skeleton := SOME sk; SOME sk)                       SOME sk => (skeleton := SOME sk; sk)
180                     | NONE =>                     | NONE =>
181                           (case getParseTree (INFO ir, false) of                           (case getParseTree (INFO ir, false, noerrors) of
182                                SOME { tree, source } => let                                SOME { tree, source } => let
183                                    fun err sv region s =                                    fun err sv region s =
184                                        EM.error source region sv s                                        EM.error source region sv s
185                                           EM.nullErrorBody                                           EM.nullErrorBody
186                                    val sk =                                    val { skeleton = sk, complain } =
187                                        SkelCvt.convert { tree = tree,                                        SkelCvt.convert { tree = tree,
188                                                          err = err }                                                          err = err }
189                                in                                in
190                                      if noerrors then () else complain ();
191                                    if EM.anyErrors (EM.errors source) then                                    if EM.anyErrors (EM.errors source) then
192                                        (error "error(s) in ML source file";                                        if noerrors then ()
193                                         NONE)                                        else error "error(s) in ML source file"
194                                                     EM.nullErrorBody
195                                    else (SkelIO.write (skelpath, sk);                                    else (SkelIO.write (skelpath, sk);
196                                          skeleton := SOME sk;                                          skeleton := SOME sk);
197                                          SOME sk)                                    sk
198                                end                                end
199                              | NONE => NONE))                              | NONE => Skeleton.SeqDecl []))
200      end      end
201    
202      (* first check the time stamp, then do your stuff... *)      (* first check the time stamp, then do your stuff... *)
203      fun exports i =      fun skeleton0 noerrors i = (validate i; getSkeleton (i, noerrors))
204          (validate i;  
205           case getSkeleton i of      (* we only complain at the time of getting the exports *)
206               NONE => SymbolSet.empty      val exports = SkelExports.exports o (skeleton0 false)
207             | SOME sk => SkelExports.exports sk)      val skeleton = skeleton0 true
   
     fun skeleton i =  
         (validate i;  
          case getSkeleton i of  
              NONE => Skeleton.SeqDecl []  
            | SOME sk => sk)  
208    
209      fun spec (INFO { sourcepath, ... }) = AbsPath.spec sourcepath      fun spec (INFO { sourcepath, ... }) = AbsPath.spec sourcepath
210      fun fullSpec (INFO { group, sourcepath, ... }) =      fun fullSpec (INFO { group, sourcepath, ... }) =

Legend:
Removed from v.280  
changed lines
  Added in v.281

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