[MLton-commit] r6823

[Matthew Fluet]

Move suffix code to mlton/exit.sml.

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

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

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

Modified: mlton/trunk/basis-library/mlton/exit.sml
===================================================================
--- mlton/trunk/basis-library/mlton/exit.sml	2008-09-01 13:19:24 UTC (rev 6822)
+++ mlton/trunk/basis-library/mlton/exit.sml	2008-09-01 13:19:28 UTC (rev 6823)
@@ -51,11 +51,33 @@
             handle _ => (message "Top-level suffix raised exception.\n"
                          ; halt Status.failure
                          ; raise Fail "MLton.Exit.wrapSuffix")
+
+         fun suffixArchiveOrLibrary () =
+            let
+               (* Return to 'lib_open'. *)
+               val () = Primitive.MLton.Thread.returnToC ()
+               (* Enter from 'lib_close'. *)
+               val _ = exiting := true
+               val () = let open Cleaner in clean atExit end
+               (* Return to 'lib_close'. *)
+               val () = Primitive.MLton.Thread.returnToC ()
+            in
+               ()
+            end
+         fun suffixExecutable () = exit Status.success
+         val defaultSuffix =
+            let open Primitive.MLton.Platform.Format
+            in
+               case host of
+                  Archive => suffixArchiveOrLibrary
+                | Executable => suffixExecutable
+                | Library => suffixArchiveOrLibrary
+            end
       in
          val getTopLevelSuffix = Primitive.TopLevel.getSuffix
          val setTopLevelSuffix = Primitive.TopLevel.setSuffix o wrapSuffix
          fun 'a defaultTopLevelSuffix ((): unit): 'a =
-            wrapSuffix (fn () => exit Status.success) ()
+            wrapSuffix defaultSuffix ()
          fun 'a topLevelSuffix ((): unit) : 'a =
             (getTopLevelSuffix () ()
              ; raise Fail "MLton.Exit.topLevelSuffix")

Modified: mlton/trunk/basis-library/mlton/mlton.sml
===================================================================
--- mlton/trunk/basis-library/mlton/mlton.sml	2008-09-01 13:19:24 UTC (rev 6822)
+++ mlton/trunk/basis-library/mlton/mlton.sml	2008-09-01 13:19:28 UTC (rev 6823)
@@ -149,30 +149,8 @@
 end
 
 val _ = 
-   let
-      open MLtonPlatform.Format
-     
-      fun librarySuffix () =
-         let
-            (* Return to 'lib_open'. *)
-            val () = Primitive.MLton.Thread.returnToC ()
-            (* Return from 'lib_close'. *)
-            val () = Cleaner.clean Cleaner.atExit
-            (* Return to 'lib_close'. *)
-            val () = Primitive.MLton.Thread.returnToC ()
-         in
-            ()
-         end
-      
-      val suffix = 
-         case host of
-            Archive => librarySuffix
-          | Executable => Exit.defaultTopLevelSuffix
-          | Library => librarySuffix
-   in
    (Primitive.TopLevel.setHandler MLtonExn.defaultTopLevelHandler
-    ; Primitive.TopLevel.setSuffix suffix)
-   end
+    ; Primitive.TopLevel.setSuffix Exit.defaultTopLevelSuffix)
 end
 
 (* Patch OS.FileSys.tmpName to use mkstemp. *)