1 (* Copyright (C
) 2004-2006, 2008 Henry Cejtin
, Matthew Fluet
, Suresh
2 * Jagannathan
, and Stephen Weeks
.
4 * MLton is released under a BSD
-style license
.
5 * See the file MLton
-LICENSE for details
.
13 val fromInt
= fromRep
o C_Status
.fromInt
14 val toInt
= C_Status
.toInt
o toRep
15 val failure
= fromInt
1
16 val success
= fromInt
0
19 val exiting
= ref
false
24 else Cleaner
.addNew (Cleaner
.atExit
, f
)
26 fun halt (status
: Status
.t
) =
27 Primitive
.MLton
.halt (Status
.toRep status
)
29 fun exit (status
: Status
.t
): 'a
=
31 then raise Fail
"MLton.Exit.exit"
34 val _
= exiting
:= true
35 val i
= Status
.toInt status
37 if 0 <= i
andalso i
< 256
38 then (let open Cleaner
in clean atExit
end
40 ; raise Fail
"MLton.Exit.exit")
41 else raise Fail (concat
["MLton.Exit.exit(", Int.toString i
, "): ",
42 "exit must have 0 <= status < 256"])
46 val message
= PrimitiveFFI
.Stdio
.print
47 fun 'a
wrapSuffix (suffix
: unit
-> unit
) () : 'a
=
49 ; message
"Top-level suffix returned.\n"
50 ; exit Status
.failure
)
51 handle _
=> (message
"Top-level suffix raised exception.\n"
53 ; raise Fail
"MLton.Exit.wrapSuffix")
55 fun suffixArchiveOrLibrary () =
57 (* Return to
'lib_open
'. *)
58 val () = Primitive
.MLton
.Thread
.returnToC ()
59 (* Enter from
'lib_close
'. *)
60 val _
= exiting
:= true
61 val () = let open Cleaner
in clean atExit
end
62 (* Return to
'lib_close
'. *)
63 val () = Primitive
.MLton
.Thread
.returnToC ()
67 fun suffixExecutable () = exit Status
.success
69 let open Primitive
.MLton
.Platform
.Format
72 Archive
=> suffixArchiveOrLibrary
73 | Executable
=> suffixExecutable
74 | LibArchive
=> suffixArchiveOrLibrary
75 | Library
=> suffixArchiveOrLibrary
78 val getTopLevelSuffix
= Primitive
.TopLevel
.getSuffix
79 val setTopLevelSuffix
= Primitive
.TopLevel
.setSuffix
o wrapSuffix
80 fun 'a
defaultTopLevelSuffix ((): unit
): 'a
=
81 wrapSuffix
defaultSuffix ()
82 fun 'a
topLevelSuffix ((): unit
) : 'a
=
83 (getTopLevelSuffix () ()
84 ; raise Fail
"MLton.Exit.topLevelSuffix")