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/smlnj-lib/TraceDebugProf/back-trace.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch 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 ()

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