[MLton-commit] r4103

[Stephen Weeks]

Used a more robust solution to eliminating the "noisy" stack frames at
the top of the stack in MLton.Exn.history.  For some reason, I was
seeing an extra frame on Cygwin, which is now gone with the more
robust solution.

----------------------------------------------------------------------

U   mlton/trunk/basis-library/mlton/exn.sml

----------------------------------------------------------------------

Modified: mlton/trunk/basis-library/mlton/exn.sml
===================================================================
--- mlton/trunk/basis-library/mlton/exn.sml	2005-10-11 19:17:45 UTC (rev 4102)
+++ mlton/trunk/basis-library/mlton/exn.sml	2005-10-12 00:51:01 UTC (rev 4103)
@@ -14,19 +14,31 @@
       val addExnMessager = General.addExnMessager
 
       val history: t -> string list =
-         if keepHistory
-            then (setInitExtra (NONE: extra)
-                  ; setExtendExtra (fn e =>
-                                    case e of
-                                       NONE => SOME (MLtonCallStack.current ())
-                                     | SOME _ => e)
-                  ; fn e => (case extra e of
-                                NONE => []
-                              | SOME cs =>
-                                   (* The tl gets rid of the anonymous function
-                                    * passed to setExtendExtra above.
-                                    *)
-                                   tl (MLtonCallStack.toStrings cs)))
+         if keepHistory then
+            (setInitExtra (NONE: extra)
+             ; setExtendExtra (fn e =>
+                               case e of
+                                  NONE => SOME (MLtonCallStack.current ())
+                                | SOME _ => e)
+             ; (fn e =>
+                case extra e of
+                   NONE => []
+                 | SOME cs =>
+                      let
+                         (* Gets rid of the anonymous function passed to
+                          * setExtendExtra above.
+                          *)
+                         fun loop xs =
+                            case xs of
+                               [] => []
+                             | x :: xs =>
+                                  if String.isPrefix "MLtonExn.fn " x then
+                                     xs
+                                  else
+                                     loop xs
+                      in
+                         loop (MLtonCallStack.toStrings cs)
+                      end))
          else fn _ => []
 
       local