|
1 (* ========================================================================= *) |
|
2 (* MOSCOW ML SPECIFIC FUNCTIONS *) |
|
3 (* Copyright (c) 2002-2004 Joe Hurd, distributed under the GNU GPL version 2 *) |
|
4 (* ========================================================================= *) |
|
5 |
|
6 structure Portable :> Portable = |
|
7 struct |
|
8 |
|
9 (* ------------------------------------------------------------------------- *) |
|
10 (* The ML implementation. *) |
|
11 (* ------------------------------------------------------------------------- *) |
|
12 |
|
13 val ml = "mosml"; |
|
14 |
|
15 (* ------------------------------------------------------------------------- *) |
|
16 (* Pointer equality using the run-time system. *) |
|
17 (* ------------------------------------------------------------------------- *) |
|
18 |
|
19 local val address : 'a -> int = Obj.magic |
|
20 in fun pointerEqual (x : 'a, y : 'a) = address x = address y |
|
21 end; |
|
22 |
|
23 (* ------------------------------------------------------------------------- *) |
|
24 (* Timing function applications a la Mosml.time. *) |
|
25 (* ------------------------------------------------------------------------- *) |
|
26 |
|
27 val time = Mosml.time; |
|
28 |
|
29 end |
|
30 |
|
31 (* ------------------------------------------------------------------------- *) |
|
32 (* Ensuring that interruptions (SIGINTs) are actually seen by the *) |
|
33 (* linked executable as Interrupt exceptions. *) |
|
34 (* ------------------------------------------------------------------------- *) |
|
35 |
|
36 prim_val catch_interrupt : bool -> unit = 1 "sys_catch_break"; |
|
37 val _ = catch_interrupt true; |
|
38 |
|
39 (* ------------------------------------------------------------------------- *) |
|
40 (* Ad-hoc upgrading of the Moscow ML basis library. *) |
|
41 (* ------------------------------------------------------------------------- *) |
|
42 |
|
43 fun TextIO_inputLine h = |
|
44 let |
|
45 open TextIO |
|
46 in |
|
47 case inputLine h of "" => NONE | s => SOME s |
|
48 end; |