This week only. Pastebin PRO Accounts Christmas Special! Don't miss out!Want more features on Pastebin? Sign Up, it's FREE!
Guest

Untitled

By: a guest on Oct 2nd, 2012  |  syntax: None  |  size: 1.84 KB  |  views: 22  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. type 'a bounding_f = min:'a -> max:'a -> 'a -> 'a option
  2.  
  3. let bounding_of_ord ?default_low ?default_high ord =
  4.   fun ~min ~max -> assert (ord min max != Gt);
  5.   fun x ->
  6.     match ord x min, ord x max with
  7.     | Lt, _ -> default_low
  8.     | _, Gt -> default_high
  9.     | Eq, _
  10.     | _, Eq
  11.     | Gt, _ -> Some x
  12.  
  13. module type BoundedOrdType = sig
  14.   type t
  15.   val min : t
  16.   val max : t
  17.   val ord : t -> t -> BatOrd.order
  18.   val default_high : t option
  19.   val default_low : t option
  20. end
  21.  
  22. module type BoundedType = sig
  23.   type t
  24.   val min : t
  25.   val max : t
  26.   val bounded : t bounding_f
  27.   val default_high : t option
  28.   val default_low : t option
  29. end
  30.  
  31. module type S = sig
  32.   type u
  33.   type t = private u
  34.   exception Out_of_range
  35.   val min : t
  36.   val max : t
  37.   val default_high : t option
  38.   val default_low : t option
  39.   val make : u -> t option
  40.   val make_exn : u -> t
  41. end
  42.  
  43. module Make(M : BoundedType) : (S with type u = M.t) = struct
  44.   include M
  45.   type u = t
  46.   exception Out_of_range
  47.   let make x = bounded ~min ~max x
  48.   let make_exn x =
  49.     match make x with
  50.     | Some n -> n
  51.     | None -> raise Out_of_range
  52. end
  53.  
  54. module MakeOrd(M : BoundedOrdType) : (S with type u = M.t) = struct
  55.   include M
  56.   type u = t
  57.   exception Out_of_range
  58.   let make x = bounding_of_ord ?default_low ?default_high ord ~min ~max x
  59.   let make_exn x = BatOption.get_exn (make x) Out_of_range
  60. end
  61.  
  62. module Int10_base = struct
  63.   type t = int
  64.   let min = 1
  65.   let max = 10
  66.   let default_low = Some 1
  67.   let default_high = Some 10
  68.   let bounded = bounded_of_ord ?default_low ?default_high BatOrd.poly_ord
  69. end
  70.  
  71. (** Only accept integers between 1 and 10 *)
  72. module Int10 = Make(Int10_base)
  73.  
  74. module Int10_base_ord = struct
  75.   type t = int
  76.   let min = 1
  77.   let max = 10
  78.   let default_low = Some 1
  79.   let default_high = Some 10
  80.   let ord = poly_ord
  81. end
  82.  
  83. (** Only accept integers between 1 and 10 *)
  84. module Int10_ord = MakeOrd(Int10_base_ord)
clone this paste RAW Paste Data