Diff of /sml/trunk/src/smlnj-lib/TraceDebugProf/back-trace.sml

Parent Directory | Revision Log | Patch

	revision 1656, Wed Oct 20 20:05:45 2004 UTC	revision 1669, Wed Oct 27 22:49:25 2004 UTC
#	Line 18	Line 18
18	* Author: Matthias Blume (blume@tti-c.org)	* Author: Matthias Blume (blume@tti-c.org)
19	*)	*)
20	structure BackTrace : sig	structure BackTrace : sig
	exception BTraceTriggered of unit -> string list
21	val trigger : unit -> 'a	val trigger : unit -> 'a
22	val monitor : (unit -> 'a) -> 'a	val monitor : (unit -> 'a) -> 'a
23	val install : unit -> unit	val install : unit -> unit
#	Line 187	Line 186
186
187	fun monitor work =	fun monitor work =
188	let val restore = save ()	let val restore = save ()
189	fun hdl (e, []) = raise e	fun last (x, []) = x
190		| last (_, x :: xs) = last (x, xs)
191		fun emsg e =
192		case SMLofNJ.exnHistory e of
193		[] => General.exnMessage e
194		| (h :: t) =>
195		concat [last (h, t), ": ", General.exnMessage e]
196		fun hdl (e, []) =
197		(Control.Print.say (emsg e ^ "\n\n");
198		raise e)
199	| hdl (e, hist) =	| hdl (e, hist) =
200	(Control.Print.say	(Control.Print.say
201	(concat ("\n*** BACK-TRACE ***\n" :: hist));	(concat ("\n*** BACK-TRACE ***\n" :: hist));
202	Control.Print.say "\n";	Control.Print.say
203		(concat ["\n", emsg e, "\n\n"]);
204	raise e)	raise e)
205	in	in
206	work ()	work ()

---

Colored Diff Long Colored Diff Unidiff Context Diff Side by Side

Legend: Removed from v.1656   changed lines   Added in v.1669

---

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