1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60
| module type BoundType = sig
type t
val eq : t -> t -> bool
val inf : t -> t -> t
val sup : t -> t -> t
end
module SimpleBound (Ord : Set.OrderedType) : BoundType with type t = Ord.t
= struct
type t = Ord.t
let make (t : Ord.t) = (t : t)
let eq a b = Ord.compare a b = 0
let inf a b = if Ord.compare a b <= 0 then a else b
let sup a b = if Ord.compare a b >= 0 then a else b
end
type 'a with_infinity = Value of 'a | Min_inf | Max_inf
module WithInfinity (Bound : BoundType) : BoundType
with type t = Bound.t with_infinity
= struct
type t = Bound.t with_infinity
let eq a b = match a, b with
| Min_inf, Min_inf | Max_inf, Max_inf -> true
| Value a, Value b -> Bound.eq a b
| _ -> false
let inf a b = match a, b with
| Min_inf, _ | _, Min_inf -> Min_inf
| Max_inf, t | t, Max_inf -> t
| Value x, Value y -> Value (Bound.inf x y)
let sup a b = match a, b with
| Min_inf, t | t, Min_inf -> t
| Max_inf, _ | _, Max_inf -> Max_inf
| Value x, Value y -> Value (Bound.sup x y)
end
module OpenClosed (Bound : BoundType) : BoundType
with type t = bool * Bound.t
= struct
type t = bool * Bound.t
let eq (ta, a) (tb, b) = ta = tb && Bound.eq a b
let inf (ta, a) (tb, b) = ta && tb, Bound.inf a b
let sup (ta, a) (tb, b) = ta && tb, Bound.sup a b
end
module Product (A : BoundType) (B : BoundType) : BoundType
with type t = A.t * B.t
= struct
type t = A.t * B.t
let eq (a, b) (a', b') = A.eq a a' && B.eq b b'
let inf (a, b) (a', b') = A.inf a a', B.inf b b'
let sup (a, b) (a', b') = A.sup a a', B.sup b b'
end
module Interval (Bound : BoundType) = struct
type t = Bound.t * Bound.t
let eq (x, y) (x', y') = Bound.eq x x' && Bound.eq y y'
let intersection (x, y) (x', y') = Bound.sup x x', Bound.inf y y'
let includes a b = eq b (intersection a b)
end |
Partager