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 1878, Mon Nov 21 19:54:57 2005 UTC revision 1879, Fri Dec 16 06:13:13 2005 UTC
# Line 65  Line 65 
65      val error : GeneralParams.info -> info -> complainer      val error : GeneralParams.info -> info -> complainer
66    
67      val parsetree : GeneralParams.info -> info -> (ast * source) option      val parsetree : GeneralParams.info -> info -> (ast * source) option
     val parse_for_errors: GeneralParams.info -> info -> unit  
68      val exports : GeneralParams.info -> info  -> SymbolSet.set option      val exports : GeneralParams.info -> info  -> SymbolSet.set option
69      val skeleton : GeneralParams.info -> info -> Skeleton.decl option      val skeleton : GeneralParams.info -> info -> Skeleton.decl option
70      val sh_spec : info -> Sharing.request      val sh_spec : info -> Sharing.request
# Line 347  Line 346 
346    
347      (* the following functions are only concerned with getting the data,      (* the following functions are only concerned with getting the data,
348       * not with checking time stamps *)       * not with checking time stamps *)
349      fun getParseTree gp (i as INFO ir, quiet, noerrors) = let      fun getParseTree gp (i as INFO ir, quiet) = let
350          val { sourcepath, persinfo = PERS { parsetree, ... },          val { sourcepath, persinfo = PERS { parsetree, ... },
351                controllers, ... } =                controllers, ... } =
352              ir              ir
353          val err = if noerrors then (fn m => ())          fun err m = error gp i EM.COMPLAIN m EM.nullErrorBody
                   else (fn m => error gp i EM.COMPLAIN m EM.nullErrorBody)  
354      in      in
355          case !parsetree of          case !parsetree of
356              SOME pt => SOME pt              SOME pt => SOME pt
# Line 360  Line 358 
358                  val orig_settings =                  val orig_settings =
359                      map (fn c => #save'restore c ()) controllers                      map (fn c => #save'restore c ()) controllers
360                  fun work stream = let                  fun work stream = let
361                      val _ = if noerrors orelse quiet then ()                      val _ = if quiet then ()
362                              else Say.vsay ["[parsing ",                              else Say.vsay ["[parsing ",
363                                             SrcPath.descr sourcepath, "]\n"]                                             SrcPath.descr sourcepath, "]\n"]
                     (* The logic is a bit tricky here:  
                      *  If "noerrors" is set we want to suppress error  
                      *  messages from the parser.  This is done using  
                      *  a dummy error consumer that does nothing.  However,  
                      *  if we do that we get a "source" object that has  
                      *  a dummy error consumer hard-wired into it.  As a  
                      *  result we also don't see error messages from the  
                      *  elaborator in this case -- bad.  So we make  
                      *  TWO "source" objects that share the same input  
                      *  stream but used different error consumers. *)  
                     val (source, parse_source) = let  
                         val normal_ec = #errcons gp  
364                          val source =                          val source =
365                              Source.newSource (SrcPath.osstring' sourcepath,                              Source.newSource (SrcPath.osstring' sourcepath,
366                                                1, stream, false, normal_ec)                                            1, stream, false, #errcons gp)
367                      in                  in app (fn c => #set c ()) controllers;
368                          if noerrors then let                     (SF.parse source, source)
                             val dummy_ec = { consumer = fn (x: string) => (),  
                                             linewidth = #linewidth normal_ec,  
                                             flush = fn () => () }  
                             val parse_source =  
                                 (* clone of "source", mute error consumer *)  
                                 { sourceMap = #sourceMap source,  
                                   fileOpened = #fileOpened source,  
                                   interactive = #interactive source,  
                                   sourceStream = #sourceStream source,  
                                   anyErrors = #anyErrors source,  
                                   errConsumer = dummy_ec }  
                         in  
                             (source, parse_source)  
                         end  
                         else (source, source)  
                     end  
                 in  
                     app (fn c => #set c ()) controllers;  
                     (SF.parse parse_source, source)  
369                      before app (fn r => r ()) orig_settings                      before app (fn r => r ()) orig_settings
370                  end                  end
371                  fun openIt () = TextIO.openIn (SrcPath.osstring sourcepath)                  fun openIt () = TextIO.openIn (SrcPath.osstring sourcepath)
# Line 424  Line 391 
391                       | CompileExn.Compile msg => (err msg; NONE)                       | CompileExn.Compile msg => (err msg; NONE)
392      end      end
393    
394      fun getSkeleton gp (i as INFO ir, noerrors) = let      fun skeleton gp (i as INFO ir) = let
395          val { sourcepath, mkSkelname, persinfo = PERS pir, ... } = ir          val { sourcepath, mkSkelname, persinfo = PERS pir, ... } = ir
396          val { skeleton, lastseen, ... } = pir          val { skeleton, lastseen, ... } = pir
397      in      in
# Line 436  Line 403 
403                  case SkelIO.read (skelname, !lastseen) of                  case SkelIO.read (skelname, !lastseen) of
404                      SOME sk => (skeleton := SOME sk; SOME sk)                      SOME sk => (skeleton := SOME sk; SOME sk)
405                    | NONE =>                    | NONE =>
406                          (case getParseTree gp (i, false, noerrors) of                          (case getParseTree gp (i, false) of
407                               SOME (tree, source) => let                               SOME (tree, source) => let
408                                   fun err sv region s =                                   fun err sv region s =
409                                       EM.error source region sv s                                       EM.error source region sv s
410                                                EM.nullErrorBody                                                EM.nullErrorBody
411                                   val { skeleton = sk, complain } =                                   val { skeleton = sk, complain } =
412                                       SkelCvt.convert { tree = tree,                                       SkelCvt.convert { tree = tree, err = err }
413                                                         err = err }                               in complain ();
                              in  
                                  if noerrors then () else complain ();  
414                                    if EM.anyErrors (EM.errors source) then                                    if EM.anyErrors (EM.errors source) then
415                                           if noerrors then ()                                      error gp i EM.COMPLAIN
                                          else error gp i EM.COMPLAIN  
416                                                   "error(s) in ML source file"                                                   "error(s) in ML source file"
417                                                   EM.nullErrorBody                                                   EM.nullErrorBody
418                                    else (SkelIO.write (skelname, sk, !lastseen);                                    else (SkelIO.write (skelname, sk, !lastseen);
# Line 459  Line 423 
423              end              end
424      end      end
425    
     fun skeleton0 noerrors gp i = getSkeleton gp (i, noerrors)  
   
426      (* we only complain at the time of getting the exports *)      (* we only complain at the time of getting the exports *)
427      fun exports gp i = Option.map SkelExports.exports (skeleton0 false gp i)      fun exports gp i = Option.map SkelExports.exports (skeleton gp i)
     val skeleton = skeleton0 true  
428    
429      fun parsetree gp i = getParseTree gp (i, true, true)      fun parsetree gp i = getParseTree gp (i, true)
     fun parse_for_errors gp i = ignore (getParseTree gp (i, false, false))  
430    
431      fun descr (INFO { sourcepath, ... }) = SrcPath.descr sourcepath      fun descr (INFO { sourcepath, ... }) = SrcPath.descr sourcepath
432    

Legend:
Removed from v.1878  
changed lines
  Added in v.1879

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