Add 'shf/' from commit 'b6c5a95b664aeb861d7b33ffc9eefe447ba99dd7'

git-subtree-dir: shf
git-subtree-mainline: 401408448f
git-subtree-split: b6c5a95b66

shf/shell/exception-logger.sml

@@ -0,0 +1,38 @@
+structure ExceptionLogger =
+struct
+  open InputMsg
+
+  val textCommands = ref ""
+
+  fun addCommand inputMsg =
+    case inputMsg of
+      CHAR_EVENT chr =>
+        let
+          val chr = CharVector.fromList [chr]
+          val newInput = !textCommands ^ chr
+        in
+          textCommands := newInput
+        end
+    | _ => ()
+
+  fun log e =
+    let
+      (* print stack trace for debugging purposes, 
+       * and then raise another exception to exit the program *)
+      val errName = General.exnName e ^ "\n"
+      val stackTrace = MLton.Exn.history e
+      val stackTrace = (String.concatWith "\n" stackTrace) ^ "\n"
+      val history = !textCommands ^ "\n\n"
+
+      val log = String.concat
+        ["ERROR: ", errName, stackTrace, "HISTORY: ", history]
+
+      val () = print ("\n" ^ log)
+
+      val io = TextIO.openAppend "exceptions.log"
+      val () = TextIO.output (io, log)
+      val () = TextIO.closeOut io
+    in
+      raise e
+    end
+end