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

Parent Directory | Revision Log

---

Revision 249 - (view) (download)
Original Path: sml/branches/SMLNJ/src/ml-lex/export-lex.sml

1 :	monnier	249	(* export-lex.sml
2 :			*
3 :			* $Log$
4 :			* Revision 1.1.1.8 1999/04/17 18:56:05 monnier
5 :			* version 110.16
6 :			*
7 :			* Revision 1.2 1997/03/03 17:10:35 george
8 :			* moved callcc related functions to SMLofNJ.Cont
9 :			*
10 :			# Revision 1.1.1.1 1997/01/14 01:38:01 george
11 :			# Version 109.24
12 :			#
13 :			* Revision 1.3 1996/02/26 16:55:18 jhr
14 :			* Moved exportFn/exportML to SMLofNJ structure.
15 :			*
16 :			* Revision 1.2 1996/02/26 15:02:26 george
17 :			* print no longer overloaded.
18 :			* use of makestring has been removed and replaced with Int.toString ..
19 :			* use of IO replaced with TextIO
20 :			*
21 :			* Revision 1.1.1.1 1996/01/31 16:01:15 george
22 :			* Version 109
23 :			*
24 :			*)
25 :
26 :			structure ExportLexGen : sig
27 :
28 :			val lexGen : (string * string list) -> OS.Process.status
29 :
30 :			end = struct
31 :
32 :			exception Interrupt
33 :
34 :			(* This function applies operation to (). If it handles an interrupt
35 :			* signal (Control-C), it raises the exception Interrupt. Example:
36 :			* (handleInterrupt foo) handle Interrupt => print "Bang!\n"
37 :			*)
38 :			fun handleInterrupt (operation : unit -> unit) =
39 :			let exception Done
40 :			val old'handler = Signals.inqHandler(Signals.sigINT)
41 :			fun reset'handler () =
42 :			Signals.setHandler(Signals.sigINT, old'handler)
43 :			in (SMLofNJ.Cont.callcc (fn k =>
44 :			(Signals.setHandler(Signals.sigINT, Signals.HANDLER(fn _ => k));
45 :			operation ();
46 :			raise Done));
47 :			raise Interrupt)
48 :			handle Done => (reset'handler ())
49 :			| exn => (reset'handler (); raise exn)
50 :			end
51 :
52 :			fun err msg = TextIO.output(TextIO.stdErr, String.concat msg)
53 :
54 :			fun lexGen (name, args) = let
55 :			fun lex_gen () = (case args
56 :			of [] => (
57 :			err [name, ": missing filename\n"];
58 :			OS.Process.exit OS.Process.failure)
59 :			| files => List.app LexGen.lexGen files
60 :			(* end case *))
61 :			in
62 :			(handleInterrupt lex_gen; OS.Process.success)
63 :			handle Interrupt => (
64 :			err [name, ": Interrupt\n"];
65 :			OS.Process.failure)
66 :			| any => (
67 :			err [
68 :			name, ": uncaught exception ", exnMessage any, "\n"
69 :			];
70 :			OS.Process.failure)
71 :			end
72 :
73 :			end;
74 :
75 :			fun export name = SMLofNJ.exportFn (name, ExportLexGen.lexGen);
76 :

---

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