diff options
Diffstat (limited to 'lib/concepts')
| -rw-r--r-- | lib/concepts/Cardinality.ml | 20 | ||||
| -rw-r--r-- | lib/concepts/Cardinality.mli | 9 | ||||
| -rw-r--r-- | lib/concepts/Mode.ml | 30 | ||||
| -rw-r--r-- | lib/concepts/Mode.mli | 27 |
4 files changed, 86 insertions, 0 deletions
diff --git a/lib/concepts/Cardinality.ml b/lib/concepts/Cardinality.ml new file mode 100644 index 0000000..d878aa9 --- /dev/null +++ b/lib/concepts/Cardinality.ml @@ -0,0 +1,20 @@ +type t = Empty | Bounded of int | Finite | Countable + +let bounded n = if n <= 0 then Empty else Bounded n +let rank = function Empty -> 0 | Bounded _ -> 1 | Finite -> 2 | Countable -> 3 + +let compare a b = + match a, b with + | Bounded n, Bounded m -> Utilities.Ordering.of_int (Int.compare n m) + | _ -> Utilities.Ordering.of_int (Int.compare (rank a) (rank b)) + +let equal a b = compare a b = Utilities.Ordering.Equal +let leq a b = compare a b <> Utilities.Ordering.Greater +let meet a b = if leq a b then a else b +let exhaustible = function Countable -> false | Empty | Bounded _ | Finite -> true + +let to_string = function + | Empty -> "empty" + | Bounded n -> Printf.sprintf "bounded(%d)" n + | Finite -> "finite" + | Countable -> "countable" diff --git a/lib/concepts/Cardinality.mli b/lib/concepts/Cardinality.mli new file mode 100644 index 0000000..d345bce --- /dev/null +++ b/lib/concepts/Cardinality.mli @@ -0,0 +1,9 @@ +type t = Empty | Bounded of int | Finite | Countable + +val bounded : int -> t +val compare : t -> t -> Utilities.Ordering.t +val equal : t -> t -> bool +val leq : t -> t -> bool +val meet : t -> t -> t +val exhaustible : t -> bool +val to_string : t -> string diff --git a/lib/concepts/Mode.ml b/lib/concepts/Mode.ml new file mode 100644 index 0000000..b7aa814 --- /dev/null +++ b/lib/concepts/Mode.ml @@ -0,0 +1,30 @@ +type attribute = string +type attributes = BatSet.String.t +type affordance = Decides | Generates of Cardinality.t +type mode = {bound: attributes; affords: affordance} +type t = mode list + +let attributes_of_list = BatSet.String.of_list +let attributes_of_map map = BatMap.String.keys map |> BatSet.String.of_enum +let decides_when bound = {bound= attributes_of_list bound; affords= Decides} +let enumerable cardinality = {bound= BatSet.String.empty; affords= Generates cardinality} +let of_list modes = modes + +let generation declaration bound = + List.fold_left + (fun tightest {bound= declared; affords} -> + match affords with + | Generates cardinality when BatSet.String.subset declared bound -> + Some (Option.fold ~none:cardinality ~some:(Cardinality.meet cardinality) tightest) + | Generates _ | Decides -> tightest ) + None declaration + +let exhaustible declaration bound = + Option.fold ~none:false ~some:Cardinality.exhaustible (generation declaration bound) + +let decision declaration bound = + exhaustible declaration bound + || List.exists + (fun {bound= declared; affords} -> + match affords with Decides -> BatSet.String.equal declared bound | Generates _ -> false ) + declaration diff --git a/lib/concepts/Mode.mli b/lib/concepts/Mode.mli new file mode 100644 index 0000000..6a906d1 --- /dev/null +++ b/lib/concepts/Mode.mli @@ -0,0 +1,27 @@ +type attribute = string +type attributes = BatSet.String.t + +(** what asking a relation under a given set of bound attributes + affords. The answer is to whether anything satisfies the binding, + or the bindings of the attributes left free together with the + class of what is produced. *) +type affordance = Decides | Generates of Cardinality.t + +type mode = {bound: attributes; affords: affordance} +type t + +val attributes_of_list : attribute list -> attributes +val attributes_of_map : 'a BatMap.String.t -> attributes +val decides_when : attribute list -> mode +val enumerable : Cardinality.t -> mode +val of_list : mode list -> t + +(** the tightest class declared for generating under [bound]. A mode + declared for fewer bound attributes applies to more, since the + attributes left free are then fewer and no more numerous. *) +val generation : t -> attributes -> Cardinality.t option + +val exhaustible : t -> attributes -> bool + +(** declared outright, or implied by a generation that can be exhausted. *) +val decision : t -> attributes -> bool |
