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)