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