Annotation of /sml/trunk/src/ml-lex/export-lex.sml

Parent Directory | Revision Log

---

Revision 656 - (view) (download)

1 :	monnier	249	(* export-lex.sml
2 :			*
3 :	blume	569	* Revision 1.2 2000/03/07 04:01:05 blume
4 :	blume	656	* - build script now use new ml-build mechanism
5 :	monnier	249	*)
6 :			structure ExportLexGen : sig
7 :			val lexGen : (string * string list) -> OS.Process.status
8 :	blume	569	end = struct
9 :	monnier	249
10 :			exception Interrupt
11 :
12 :			(* This function applies operation to (). If it handles an interrupt
13 :			* signal (Control-C), it raises the exception Interrupt. Example:
14 :			* (handleInterrupt foo) handle Interrupt => print "Bang!\n"
15 :			*)
16 :			fun handleInterrupt (operation : unit -> unit) =
17 :			let exception Done
18 :			val old'handler = Signals.inqHandler(Signals.sigINT)
19 :			fun reset'handler () =
20 :			Signals.setHandler(Signals.sigINT, old'handler)
21 :			in (SMLofNJ.Cont.callcc (fn k =>
22 :			(Signals.setHandler(Signals.sigINT, Signals.HANDLER(fn _ => k));
23 :			operation ();
24 :			raise Done));
25 :			raise Interrupt)
26 :			handle Done => (reset'handler ())
27 :			| exn => (reset'handler (); raise exn)
28 :			end
29 :
30 :			fun err msg = TextIO.output(TextIO.stdErr, String.concat msg)
31 :
32 :			fun lexGen (name, args) = let
33 :	blume	569	fun lex_gen () =
34 :			case args of
35 :			[] => (err [name, ": missing filename\n"];
36 :			OS.Process.exit OS.Process.failure)
37 :			| files => List.app LexGen.lexGen files
38 :			in
39 :			(handleInterrupt lex_gen; OS.Process.success)
40 :			handle Interrupt => (err [name, ": Interrupt\n"]; OS.Process.failure)
41 :			| any => (err [name, ": uncaught exception ",
42 :			exnMessage any, "\n"];
43 :			OS.Process.failure)
44 :			end
45 :			end

---

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