CVS: sml-dist/src/cm/smlfile smlinfo.sml,1.53,1.54

Update of /cvsroot/smlnj/sml-dist/src/cm/smlfile
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv19679/src/cm/smlfile

Modified Files:
	smlinfo.sml 
Log Message:
improved error handling in CM

Index: smlinfo.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/cm/smlfile/smlinfo.sml,v
retrieving revision 1.53
retrieving revision 1.54
diff -C2 -d -r1.53 -r1.54
*** smlinfo.sml	27 Sep 2004 22:18:07 -0000	1.53
--- smlinfo.sml	16 Dec 2005 06:13:13 -0000	1.54
***************
*** 66,70 ****
  
      val parsetree : GeneralParams.info -> info -> (ast * source) option
-     val parse_for_errors: GeneralParams.info -> info -> unit
      val exports : GeneralParams.info -> info  -> SymbolSet.set option
      val skeleton : GeneralParams.info -> info -> Skeleton.decl option
--- 66,69 ----
***************
*** 348,357 ****
      (* the following functions are only concerned with getting the data,
       * not with checking time stamps *)
!     fun getParseTree gp (i as INFO ir, quiet, noerrors) = let
  	val { sourcepath, persinfo = PERS { parsetree, ... },
  	      controllers, ... } =
  	    ir
! 	val err = if noerrors then (fn m => ())
! 		  else (fn m => error gp i EM.COMPLAIN m EM.nullErrorBody)
      in
  	case !parsetree of
--- 347,355 ----
      (* the following functions are only concerned with getting the data,
       * not with checking time stamps *)
!     fun getParseTree gp (i as INFO ir, quiet) = let
  	val { sourcepath, persinfo = PERS { parsetree, ... },
  	      controllers, ... } =
  	    ir
! 	fun err m = error gp i EM.COMPLAIN m EM.nullErrorBody
      in
  	case !parsetree of
***************
*** 361,404 ****
  		    map (fn c => #save'restore c ()) controllers
  		fun work stream = let
! 		    val _ = if noerrors orelse quiet then ()
  			    else Say.vsay ["[parsing ",
  					   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
! 			val source =
! 			    Source.newSource (SrcPath.osstring' sourcepath,
! 					      1, stream, false, normal_ec)
! 		    in
! 			if noerrors then let
! 			    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)
! 		    before app (fn r => r ()) orig_settings
  		end
  		fun openIt () = TextIO.openIn (SrcPath.osstring sourcepath)
--- 359,371 ----
  		    map (fn c => #save'restore c ()) controllers
  		fun work stream = let
! 		    val _ = if quiet then ()
  			    else Say.vsay ["[parsing ",
  					   SrcPath.descr sourcepath, "]\n"]
! 		    val source =
! 			Source.newSource (SrcPath.osstring' sourcepath,
! 					  1, stream, false, #errcons gp)
! 		in app (fn c => #set c ()) controllers;
! 		   (SF.parse source, source)
! 		   before app (fn r => r ()) orig_settings
  		end
  		fun openIt () = TextIO.openIn (SrcPath.osstring sourcepath)
***************
*** 425,429 ****
      end
  
!     fun getSkeleton gp (i as INFO ir, noerrors) = let
  	val { sourcepath, mkSkelname, persinfo = PERS pir, ... } = ir
  	val { skeleton, lastseen, ... } = pir
--- 392,396 ----
      end
  
!     fun skeleton gp (i as INFO ir) = let
  	val { sourcepath, mkSkelname, persinfo = PERS pir, ... } = ir
  	val { skeleton, lastseen, ... } = pir
***************
*** 437,458 ****
  		    SOME sk => (skeleton := SOME sk; SOME sk)
  		  | NONE =>
! 			(case getParseTree gp (i, false, noerrors) of
  			     SOME (tree, source) => let
  				 fun err sv region s =
  				     EM.error source region sv s
! 				              EM.nullErrorBody
  				 val { skeleton = sk, complain } =
! 				     SkelCvt.convert { tree = tree,
! 						       err = err }
! 			     in
! 				 if noerrors then () else complain ();
! 				  if EM.anyErrors (EM.errors source) then
! 					 if noerrors then ()
! 					 else error gp i EM.COMPLAIN
! 					         "error(s) in ML source file"
! 						 EM.nullErrorBody
! 				  else (SkelIO.write (skelname, sk, !lastseen);
! 					skeleton := SOME sk);
! 				  SOME sk
  			     end
  			   | NONE => NONE)
--- 404,422 ----
  		    SOME sk => (skeleton := SOME sk; SOME sk)
  		  | NONE =>
! 			(case getParseTree gp (i, false) of
  			     SOME (tree, source) => let
  				 fun err sv region s =
  				     EM.error source region sv s
! 					      EM.nullErrorBody
  				 val { skeleton = sk, complain } =
! 				     SkelCvt.convert { tree = tree, err = err }
! 			     in complain ();
! 				if EM.anyErrors (EM.errors source) then
! 				    error gp i EM.COMPLAIN
! 					  "error(s) in ML source file"
! 					  EM.nullErrorBody
! 				else (SkelIO.write (skelname, sk, !lastseen);
! 				      skeleton := SOME sk);
! 				SOME sk
  			     end
  			   | NONE => NONE)
***************
*** 460,471 ****
      end
  
-     fun skeleton0 noerrors gp i = getSkeleton gp (i, noerrors)
-  
      (* we only complain at the time of getting the exports *)
!     fun exports gp i = Option.map SkelExports.exports (skeleton0 false gp i)
!     val skeleton = skeleton0 true
  
!     fun parsetree gp i = getParseTree gp (i, true, true)
!     fun parse_for_errors gp i = ignore (getParseTree gp (i, false, false))
  
      fun descr (INFO { sourcepath, ... }) = SrcPath.descr sourcepath
--- 424,431 ----
      end
  
      (* we only complain at the time of getting the exports *)
!     fun exports gp i = Option.map SkelExports.exports (skeleton gp i)
  
!     fun parsetree gp i = getParseTree gp (i, true)
  
      fun descr (INFO { sourcepath, ... }) = SrcPath.descr sourcepath



-------------------------------------------------------
This SF.net email is sponsored by: Splunk Inc. Do you grep through log files
for problems?  Stop!  Download the new AJAX search engine that makes
searching your log files as easy as surfing the  web.  DOWNLOAD SPLUNK!
http://ads.osdn.com/?ad_id=7637&alloc_id=16865&op=click