abstract exception handler/logger into its own file

Makefile

@@ -5,4 +5,4 @@ run:
 	./build-unix.sh && ./shf
 
 tests:
-	mlton shf-tests.mlb && ./shf-tests
+	mlton -const "Exn.keepHistory true" shf-tests.mlb && ./shf-tests

fcore/app-update.sml

@@ -569,6 +569,7 @@ struct
 
   fun deleteLineBack (app: app_type, count) =
     let
+      val _ = raise Empty
       val {buffer, cursorIdx, ...} = app
       val low = Cursor.vi0 (buffer, cursorIdx)
       val high = Cursor.viDlr (buffer, cursorIdx, 1) + 1

fcore/build-search-list.sml

@@ -130,12 +130,15 @@ struct
     end
 
   fun fromRange (startIdx, length, buffer, searchString, searchList) =
-    let
-      val finishIdx = startIdx + length + String.size searchString
-      val bufferIdx = startIdx - String.size searchString
-      val bufferIdx = Int.max (bufferIdx, 0)
-    in
-      helpFromRange
-        (startIdx, bufferIdx, finishIdx, buffer, searchString, searchList)
-    end
+    if String.size searchString = 0 then
+      (buffer, searchList)
+    else
+      let
+        val finishIdx = startIdx + length + String.size searchString
+        val bufferIdx = startIdx - String.size searchString
+        val bufferIdx = Int.max (bufferIdx, 0)
+      in
+        helpFromRange
+          (startIdx, bufferIdx, finishIdx, buffer, searchString, searchList)
+      end
 end

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 stackTrace = MLton.Exn.history e
+      val stackTrace = String.concatWith "\n" stackTrace
+      val () = print "ERROR:\n"
+      val () = print (stackTrace ^ "\n\n")
+
+      val history = !textCommands ^ "\n\n"
+      val () = print ("HISTORY: " ^ history)
+
+      val textOutput = stackTrace ^ "\n" ^ history
+
+      val io = TextIO.openAppend "exceptions.log"
+      val () = TextIO.output (io, textOutput)
+      val () = TextIO.closeOut io
+    in
+      raise Empty
+    end
+end

shell/update-thread.sml

@@ -2,7 +2,6 @@ structure UpdateThread =
 struct
   open CML
   open MailboxType
-  open InputMsg
 
   fun sendMsg (msg, drawMailbox) =
     case msg of DRAW msg => Mailbox.send (drawMailbox, msg)
@@ -15,46 +14,12 @@ struct
         end
     | [] => ()
 
-  val textCommands = ref ""
-
-  fun addTextCommand inputMsg =
-    case inputMsg of
-      CHAR_EVENT chr =>
-        let
-          val chr = CharVector.fromList [chr]
-          val newInput = !textCommands ^ chr
-        in
-          textCommands := newInput
-        end
-    | _ => ()
-
-  fun handleException e =
-    let
-      (* print stack trace for debugging purposes, 
-       * and then raise another exception to exit the program *)
-      val stackTrace = MLton.Exn.history e
-      val stackTrace = String.concatWith "\n" stackTrace
-      val () = print "ERROR:\n"
-      val () = print (stackTrace ^ "\n\n")
-
-      val history = !textCommands ^ "\n\n"
-      val () = print ("HISTORY: " ^ history)
-
-      val textOutput = stackTrace ^ "\n" ^ history
-
-      val io = TextIO.openAppend "exceptions.log"
-      val () = TextIO.output (io, textOutput)
-      val () = TextIO.closeOut io
-    in
-      raise Empty
-    end
-
   fun loop (app: AppType.app_type, inputMailbox, drawMailbox) =
     let
       val inputMsg = Mailbox.recv inputMailbox
-      val () = addTextCommand inputMsg
+      val () = ExceptionLogger.addCommand inputMsg
 
-      val app = AppUpdate.update (app, inputMsg) handle e => handleException e
+      val app = AppUpdate.update (app, inputMsg) handle e => ExceptionLogger.log e
 
       val () = sendMsgs (#msgs app, drawMailbox)
     in

shf-tests.mlb

@@ -35,6 +35,10 @@ fcore/move.sml
 fcore/app-update.sml
 
 (* TEST FILES *)
+$(SML_LIB)/basis/mlton.mlb
+
+shell/exception-logger.sml
+
 test/Railroad/src/railroad.mlb
 test/normal-move.sml
 test/normal-delete.sml

shf.mlb

@@ -46,6 +46,7 @@ in
   ffi/glfw-input.sml
 end
 
+shell/exception-logger.sml
 shell/update-thread.sml
 shell/gl-shaders.sml
 shell/gl-draw.sml

test/regression.sml

@@ -9,8 +9,8 @@ struct
     else
       let
         val chr = String.sub (str, pos)
+        val () = ExceptionLogger.addCommand (InputMsg.CHAR_EVENT chr)
         val app = AppUpdate.update (app, InputMsg.CHAR_EVENT chr)
-                  handle _ => raise Fail (Int.toString pos)
       in
         updateLoop (pos + 1, str, app)
       end

test/test.sml

@@ -10,6 +10,7 @@ struct
       val tests = concat tests
     in
       runWithConfig [Configuration.PrintPassed false] tests
+      handle e => ExceptionLogger.log e
     end
 end