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