1(* ========================================================================= *)
2(* MOSCOW ML SPECIFIC FUNCTIONS                                              *)
3(* Copyright (c) 2002 Joe Hurd, distributed under the BSD License            *)
4(* ========================================================================= *)
5
6structure Portable :> Portable =
7struct
8
9(* ------------------------------------------------------------------------- *)
10(* The ML implementation.                                                    *)
11(* ------------------------------------------------------------------------- *)
12
13val ml = "mosml";
14
15(* ------------------------------------------------------------------------- *)
16(* Pointer equality using the run-time system.                               *)
17(* ------------------------------------------------------------------------- *)
18
19local
20  val address : 'a -> int = Obj.magic
21in
22  fun pointerEqual (x : 'a, y : 'a) = address x = address y
23end;
24
25(* ------------------------------------------------------------------------- *)
26(* Marking critical sections of code.                                        *)
27(* ------------------------------------------------------------------------- *)
28
29fun critical f () = f ();
30
31(* ------------------------------------------------------------------------- *)
32(* Generating random values.                                                 *)
33(* ------------------------------------------------------------------------- *)
34
35local
36  val gen = Random.newgenseed 1.0;
37in
38  fun randomInt max = Random.range (0,max) gen;
39
40  fun randomReal () = Random.random gen;
41end;
42
43fun randomBool () = randomInt 2 = 0;
44
45fun randomWord () =
46    let
47      val h = Word.fromInt (randomInt 65536)
48      and l = Word.fromInt (randomInt 65536)
49    in
50      Word.orb (Word.<< (h,0w16), l)
51    end;
52
53(* ------------------------------------------------------------------------- *)
54(* Timing function applications.                                             *)
55(* ------------------------------------------------------------------------- *)
56
57val time = Mosml.time;
58
59end
60
61(* ------------------------------------------------------------------------- *)
62(* Ensuring that interruptions (SIGINTs) are actually seen by the            *)
63(* linked executable as Interrupt exceptions.                                *)
64(* ------------------------------------------------------------------------- *)
65
66prim_val catch_interrupt : bool -> unit = 1 "sys_catch_break";
67val _ = catch_interrupt true;
68
69(* ------------------------------------------------------------------------- *)
70(* Forcing fully qualified names of functions with generic names.            *)
71(* ------------------------------------------------------------------------- *)
72
73(*BasicDebug
74val explode = ()
75and foldl = ()
76and foldr = ()
77and implode = ()
78and map = ()
79and null = ()
80and print = ()
81and rev = ();
82*)
83
84(* ------------------------------------------------------------------------- *)
85(* Ad-hoc upgrading of the Moscow ML basis library.                          *)
86(* ------------------------------------------------------------------------- *)
87
88fun Array_copy {src,dst,di} =
89    let
90      open Array
91    in
92      copy {src = src, si = 0, len = NONE, dst = dst, di = di}
93    end;
94
95fun Array_foldli f b v =
96    let
97      open Array
98    in
99      foldli f b (v,0,NONE)
100    end;
101
102fun Array_foldri f b v =
103    let
104      open Array
105    in
106      foldri f b (v,0,NONE)
107    end;
108
109fun Array_modifyi f a =
110    let
111      open Array
112    in
113      modifyi f (a,0,NONE)
114    end;
115
116fun OS_Process_isSuccess s = s = OS.Process.success;
117
118fun String_concatWith s =
119    let
120      fun add (x,l) = s :: x :: l
121    in
122      fn [] => ""
123       | x :: xs =>
124         let
125           val xs = List.foldl add [] (List.rev xs)
126         in
127           String.concat (x :: xs)
128         end
129    end;
130
131fun String_isSubstring p s =
132    let
133      val sizeP = size p
134      and sizeS = size s
135    in
136      if sizeP > sizeS then false
137      else if sizeP = sizeS then p = s
138      else
139        let
140          fun check i = String.substring (s,i,sizeP) = p
141
142          fun checkn i = check i orelse (i > 0 andalso checkn (i - 1))
143        in
144          checkn (sizeS - sizeP)
145        end
146    end;
147
148fun String_isSuffix p s =
149    let
150      val sizeP = size p
151      and sizeS = size s
152    in
153      sizeP <= sizeS andalso
154      String.extract (s, sizeS - sizeP, NONE) = p
155    end;
156
157fun Substring_full s =
158    let
159      open Substring
160    in
161      all s
162    end;
163
164fun TextIO_inputLine h =
165    let
166      open TextIO
167    in
168      case inputLine h of "" => NONE | s => SOME s
169    end;
170
171fun Vector_foldli f b v =
172    let
173      open Vector
174    in
175      foldli f b (v,0,NONE)
176    end;
177
178fun Vector_mapi f v =
179    let
180      open Vector
181    in
182      mapi f (v,0,NONE)
183    end;
184