Smooth Operators

Edit: Of course the module Num is already present in the standard library. I've renamed the module to Arith.

The newly-released OCaml 3.12 includes many extensions to the sub-language of modules. One of the simplest but most practical is the syntax for locally opening modules (let open M in e), and for evaluating expressions in the context of an implicitly-opened module (M.(e), equivalent to the former). The biggest payoff this syntax affords is overloading operators and functions in an expression, in a delimited context denoted by a module used as a dictionary:

let degree n =
  let pi =  3.1415926535897931 in
  Arith.F.(2. * pi / 180. * of_int n)

Note that the operators are the usual ones! Another neat example:

let rgba r g b a =
  Arith.I32.((of_int r lsl 8 lor of_int g) lsl 8 lor of_int b) lsl 8 lor of_int a)

(I've purposefully written the example to showcase the operator precedence, not for clarity). Unfortunately, the standard library doesn't yet include the modules necessary for this to work. Here's my version of the built-in numeric instances, suitable for inclusion in your .ocamlinit file. It is structured as a top-level module Arith, but can be put into a arith.ml file for separate compilation (if you do that, take care to include in the .mli interface file the complete module signature, including externals, so that the compiler can inline the definitions). This module contains sub-modules with definitions for each of the types int, int32, int64, Big_int, float, and Ratio. Every sub-module conforms to the NUM signature (inspired by the type classes in Haskell's Prelude):

module type NUM = sig
 type t
 val min_value : t
 val max_value : t
 val of_int    : int -> t
 val to_int    : t -> int
 val of_string : string -> t
 val to_string : t -> string
 val ( ~- )    : t -> t
 val ( ~+ )    : t -> t
 val (  + )    : t -> t -> t
 val (  - )    : t -> t -> t
 val (  * )    : t -> t -> t
 val (  / )    : t -> t -> t
 val (mod )    : t -> t -> t
 val abs       : t -> t
end

so that with the following top-level definitions:

let show (type t) d =
  let module N = (val d : NUM with type t = t) in N.to_string

let read (type t) d =
  let module N = (val d : NUM with type t = t) in N.of_string

(note the syntax for modules as first-class values) the following code works:

# read (module Arith.I : NUM with type t = int) "123" ;;
- : int = 123
# read (module Arith.I32 : NUM with type t = int32) "123" ;;
- : int32 = 123l
# read (module Arith.I64 : NUM with type t = int64) "123" ;;
- : int64 = 123L
# read (module Arith.F : NUM with type t = float) "123" ;;
- : float = 123.

(the syntax for binding first-class module values is pretty heavy). They also conform to the ORD signature (also borrowed from Haskell):

module type ORD = sig
  type t
  val compare   : t -> t -> int
  val ( =  )    : t -> t -> bool
  val ( <> )    : t -> t -> bool
  val ( <  )    : t -> t -> bool
  val ( <= )    : t -> t -> bool
  val ( >  )    : t -> t -> bool
  val ( >= )    : t -> t -> bool
end

so that the following code is generic on the module implementing it:

let max (type t) d (x : t) (y : t) : t =
  let module N = (val d : ORD with type t = t) in
  N.(if x < y then y else x)

let min (type t) d (x : t) (y : t) : t =
  let module N = (val d : ORD with type t = t) in
  N.(if x < y then x else y)

The sub-modules have short, mnemonic names I, I32, I64, Z, F and Q so that they don't clash with the corresponding standard modules. The first four, the binary integral types, conform to the following BIN signature:

module type BIN = sig
  type t
  val succ   : t -> t
  val pred   : t -> t
  val (land) : t -> t -> t
  val (lor ) : t -> t -> t
  val (lxor) : t -> t -> t
  val lnot   : t -> t
  val (lsl ) : t -> int -> t
  val (lsr ) : t -> int -> t
  val (asr ) : t -> int -> t
end

So, for those of you that can't or won't avail yourselves to extension libraries like OCaml Batteries, here is the complete code for the module Arith:

module Arith = struct
  module I = struct
    type t = int
    let min_value      : t = 1 lsl (if 1 lsl 31 = 0 then 30 else 62)
    let max_value      : t = min_value - 1
    external of_int    : int -> t = "%identity"
    external to_int    : t -> int = "%identity"
    external of_string : string -> t = "caml_int_of_string"
    let      to_string : t -> string = Pervasives.string_of_int
    external ( ~- )    : t -> t = "%negint"
    external ( ~+ )    : t -> t = "%identity"
    external (  + )    : t -> t -> t = "%addint"
    external (  - )    : t -> t -> t = "%subint"
    external (  * )    : t -> t -> t = "%mulint"
    external (  / )    : t -> t -> t = "%divint"
    external (mod )    : t -> t -> t = "%modint"
    let abs  (x: t)    : t = if x >= 0 then x else -x
    let compare        : t -> t -> int  = Pervasives.compare
    let      ( =  )    : t -> t -> bool = Pervasives.( =  )
    let      ( <> )    : t -> t -> bool = Pervasives.( <> )
    let      ( <  )    : t -> t -> bool = Pervasives.( <  )
    let      ( <= )    : t -> t -> bool = Pervasives.( <= )
    let      ( >  )    : t -> t -> bool = Pervasives.( >  )
    let      ( >= )    : t -> t -> bool = Pervasives.( >= )
    external succ      : t -> t = "%succint"
    external pred      : t -> t = "%predint"
    external (land)    : t -> t -> t = "%andint"
    external (lor )    : t -> t -> t = "%orint"
    external (lxor)    : t -> t -> t = "%xorint"
    let lnot (x: t)    : t = x lxor (-1)
    external (lsl )    : t -> int -> t = "%lslint"
    external (lsr )    : t -> int -> t = "%lsrint"
    external (asr )    : t -> int -> t = "%asrint"
  end
  module I32 = struct
    type t = int32
    let min_value      : t = Int32.min_int
    let max_value      : t = Int32.max_int
    external of_int    : int -> t = "%int32_of_int"
    external to_int    : t -> int = "%int32_to_int"
    external of_string : string -> t = "caml_int32_of_string"
    let      to_string : t -> string = Int32.to_string
    external ( ~- )    : t -> t = "%int32_neg"
    external ( ~+ )    : t -> t = "%identity"
    external (  + )    : t -> t -> t = "%int32_add"
    external (  - )    : t -> t -> t = "%int32_sub"
    external (  * )    : t -> t -> t = "%int32_mul"
    external (  / )    : t -> t -> t = "%int32_div"
    external (mod )    : t -> t -> t = "%int32_mod"
    let abs  (x: t)    : t = if x >= 0l then x else -x
    let compare        : t -> t -> int  = Pervasives.compare
    let      ( =  )    : t -> t -> bool = Pervasives.( =  )
    let      ( <> )    : t -> t -> bool = Pervasives.( <> )
    let      ( <  )    : t -> t -> bool = Pervasives.( <  )
    let      ( <= )    : t -> t -> bool = Pervasives.( <= )
    let      ( >  )    : t -> t -> bool = Pervasives.( >  )
    let      ( >= )    : t -> t -> bool = Pervasives.( >= )
    let      succ      : t -> t = Int32.succ
    let      pred      : t -> t = Int32.pred
    external (land)    : t -> t -> t = "%int32_and"
    external (lor )    : t -> t -> t = "%int32_or"
    external (lxor)    : t -> t -> t = "%int32_xor"
    let lnot (x: t)    : t = x lxor (-1l)
    external (lsl )    : t -> int -> t = "%int32_lsl"
    external (lsr )    : t -> int -> t = "%int32_asr"
    external (asr )    : t -> int -> t = "%int32_lsr"
  end
  module I64 = struct
    type t = int64
    let min_value      : t = Int64.min_int
    let max_value      : t = Int64.max_int
    external of_int    : int -> t = "%int64_of_int"
    external to_int    : t -> int = "%int64_to_int"
    external of_string : string -> t = "caml_int64_of_string"
    let      to_string : t -> string = Int64.to_string
    external ( ~- )    : t -> t = "%int64_neg"
    external ( ~+ )    : t -> t = "%identity"
    external (  + )    : t -> t -> t = "%int64_add"
    external (  - )    : t -> t -> t = "%int64_sub"
    external (  * )    : t -> t -> t = "%int64_mul"
    external (  / )    : t -> t -> t = "%int64_div"
    external (mod )    : t -> t -> t = "%int64_mod"
    let abs  (x: t)    : t = if x >= 0L then x else -x
    let compare        : t -> t -> int  = Pervasives.compare
    let      ( =  )    : t -> t -> bool = Pervasives.( =  )
    let      ( <> )    : t -> t -> bool = Pervasives.( <> )
    let      ( <  )    : t -> t -> bool = Pervasives.( <  )
    let      ( <= )    : t -> t -> bool = Pervasives.( <= )
    let      ( >  )    : t -> t -> bool = Pervasives.( >  )
    let      ( >= )    : t -> t -> bool = Pervasives.( >= )
    let      succ      : t -> t = Int64.succ
    let      pred      : t -> t = Int64.pred
    external (land)    : t -> t -> t = "%int64_and"
    external (lor )    : t -> t -> t = "%int64_or"
    external (lxor)    : t -> t -> t = "%int64_xor"
    let lnot (x: t)    : t = x lxor (-1L)
    external (lsl )    : t -> int -> t = "%int64_lsl"
    external (lsr )    : t -> int -> t = "%int64_asr"
    external (asr )    : t -> int -> t = "%int64_lsr"
  end
  module Z = struct
    type t = Big_int.big_int
    let min_value   : t = Big_int.zero_big_int
    let max_value   : t = Big_int.zero_big_int
    let of_int      : int -> t = Big_int.big_int_of_int
    let to_int      : t -> int = Big_int.int_of_big_int
    let of_string   : string -> t = Big_int.big_int_of_string
    let to_string   : t -> string = Big_int.string_of_big_int
    let ( ~- )      : t -> t = Big_int.minus_big_int
    external ( ~+ ) : t -> t = "%identity"
    let (  + )      : t -> t -> t = Big_int.add_big_int
    let (  - )      : t -> t -> t = Big_int.sub_big_int
    let (  * )      : t -> t -> t = Big_int.mult_big_int
    let (  / )      : t -> t -> t = Big_int.div_big_int
    let (mod )      : t -> t -> t = Big_int.mod_big_int
    let abs         : t -> t = Big_int.abs_big_int
    let compare     : t -> t -> int  = Big_int.compare_big_int
    let ( =  )      : t -> t -> bool = Big_int.eq_big_int
    let ( <> )      (x:t) (y:t) = not (x = y)
    let ( <  )      : t -> t -> bool = Big_int.lt_big_int
    let ( <= )      : t -> t -> bool = Big_int.le_big_int
    let ( >  )      : t -> t -> bool = Big_int.gt_big_int
    let ( >= )      : t -> t -> bool = Big_int.ge_big_int
    let succ        : t -> t = Big_int.succ_big_int
    let pred        : t -> t = Big_int.pred_big_int
    let (land)      : t -> t -> t = Big_int.and_big_int
    let (lor )      : t -> t -> t = Big_int.or_big_int
    let (lxor)      : t -> t -> t = Big_int.xor_big_int
    let lnot        : t -> t = let m1 = of_int (-1) in fun x -> x lxor m1
    let (lsl )      : t -> int -> t = Big_int.shift_left_big_int
    let (lsr )      : t -> int -> t = Big_int.shift_right_big_int
    let (asr )      : t -> int -> t = Big_int.shift_right_towards_zero_big_int
  end
  module F = struct
    type t = float
    let min_value      : t = Int64.float_of_bits 0xFF_F0_00_00_00_00_00_00L
    let max_value      : t = Int64.float_of_bits 0x7F_F0_00_00_00_00_00_00L
    external of_int    : int -> t = "%floatofint"
    external to_int    : t -> int = "%intoffloat"
    external of_string : string -> t = "caml_float_of_string"
    let      to_string : t -> string = Pervasives.string_of_float
    external ( ~- )    : t -> t = "%negfloat"
    external ( ~+ )    : t -> t = "%identity"
    external (  + )    : t -> t -> t = "%addfloat"
    external (  - )    : t -> t -> t = "%subfloat"
    external (  * )    : t -> t -> t = "%mulfloat"
    external (  / )    : t -> t -> t = "%divfloat"
    external (mod )    : t -> t -> t = "caml_modf_float"
    let abs  (x: t)    : t = if x >= 0. then x else -x
    external compare   : t -> t -> int = "%compare"
    external ( =  )    : t -> t -> bool = "%equal"
    external ( <> )    : t -> t -> bool = "%notequal"
    external ( <  )    : t -> t -> bool = "%lessthan"
    external ( <= )    : t -> t -> bool = "%lessequal"
    external ( >  )    : t -> t -> bool = "%greaterthan"
    external ( >= )    : t -> t -> bool = "%greaterequal"
  end
  module Q = struct
    type t = Ratio.ratio
    let min_value   : t =
      let flag = Arith_status.get_error_when_null_denominator () in
      Arith_status.set_error_when_null_denominator false;
      let v = Ratio.minus_ratio (Ratio.create_ratio Big_int.unit_big_int Big_int.zero_big_int) in
      Arith_status.set_error_when_null_denominator flag;
      v
    let max_value   : t =
      let flag = Arith_status.get_error_when_null_denominator () in
      Arith_status.set_error_when_null_denominator false;
      let v = Ratio.create_ratio Big_int.unit_big_int Big_int.zero_big_int in
      Arith_status.set_error_when_null_denominator flag;
      v
    let of_int      : int -> t = Ratio.ratio_of_int
    let to_int      : t -> int = Ratio.int_of_ratio
    let of_string   : string -> t = Ratio.ratio_of_string
    let to_string   : t -> string = Ratio.string_of_ratio
    let ( ~- )      : t -> t = Ratio.minus_ratio
    external ( ~+ ) : t -> t = "%identity"
    let (  + )      : t -> t -> t = Ratio.add_ratio
    let (  - )      : t -> t -> t = Ratio.sub_ratio
    let (  * )      : t -> t -> t = Ratio.mult_ratio
    let (  / )      : t -> t -> t = Ratio.div_ratio
    let (mod ) (x:t) (y:t) : t =
      Ratio.sub_ratio x 
        (Ratio.mult_ratio y
          (Ratio.ratio_of_big_int
            (Ratio.floor_ratio
              (Ratio.div_ratio x y))))
    let abs         : t -> t = Ratio.abs_ratio
    let compare     : t -> t -> int  = Ratio.compare_ratio
    let ( =  )      : t -> t -> bool = Ratio.eq_ratio
    let ( <> ) (x:t) (y:t) = not (x = y)
    let ( <  )      : t -> t -> bool = Ratio.lt_ratio
    let ( <= )      : t -> t -> bool = Ratio.le_ratio
    let ( >  )      : t -> t -> bool = Ratio.gt_ratio
    let ( >= )      : t -> t -> bool = Ratio.ge_ratio
  end
end

In the case of Z, there are no meaningful extremal values. I haven't included a module for NativeInt, but you can do so quite easily. Note that, if any of the external functions in the standard library changes, this module must be revised. I hope you find it useful.