1(* ========================================================================= *) 2(* POLY/ML SPECIFIC FUNCTIONS *) 3(* Copyright (c) 2008 Joe Hurd, distributed under the BSD License *) 4(* ========================================================================= *) 5 6structure Portable :> Portable = 7struct 8 9(* ------------------------------------------------------------------------- *) 10(* The ML implementation. *) 11(* ------------------------------------------------------------------------- *) 12 13val ml = "polyml"; 14 15(* ------------------------------------------------------------------------- *) 16(* Pointer equality using the run-time system. *) 17(* ------------------------------------------------------------------------- *) 18 19fun pointerEqual (x : 'a, y : 'a) = PolyML.pointerEq(x,y); 20 21(* ------------------------------------------------------------------------- *) 22(* Marking critical sections of code. *) 23(* ------------------------------------------------------------------------- *) 24 25fun critical f () = f (); 26 27(* ------------------------------------------------------------------------- *) 28(* Generating random values. *) 29(* ------------------------------------------------------------------------- *) 30 31val randomWord = Random.nextWord; 32 33val randomBool = Random.nextBool; 34 35val randomInt = Random.nextInt; 36 37val randomReal = Random.nextReal; 38 39(* ------------------------------------------------------------------------- *) 40(* Timing function applications. *) 41(* ------------------------------------------------------------------------- *) 42 43fun time f x = 44 let 45 fun p t = 46 let 47 val s = Time.fmt 3 t 48 in 49 case size (List.last (String.fields (fn x => x = #".") s)) of 50 3 => s 51 | 2 => s ^ "0" 52 | 1 => s ^ "00" 53 | _ => raise Fail "Portable.time" 54 end 55 56 val c = Timer.startCPUTimer () 57 58 val r = Timer.startRealTimer () 59 60 fun pt () = 61 let 62 val {usr,sys} = Timer.checkCPUTimer c 63 val real = Timer.checkRealTimer r 64 in 65 print 66 ("User: " ^ p usr ^ " System: " ^ p sys ^ 67 " Real: " ^ p real ^ "\n") 68 end 69 70 val y = f x handle e => (pt (); raise e) 71 72 val () = pt () 73 in 74 y 75 end; 76 77end 78 79(* ------------------------------------------------------------------------- *) 80(* Quotations a la Moscow ML. *) 81(* ------------------------------------------------------------------------- *) 82 83datatype 'a frag = QUOTE of string | ANTIQUOTE of 'a; 84