aboutsummaryrefslogtreecommitdiffstats
path: root/lib/concepts
diff options
context:
space:
mode:
Diffstat (limited to 'lib/concepts')
-rw-r--r--lib/concepts/Cardinality.ml20
-rw-r--r--lib/concepts/Cardinality.mli9
-rw-r--r--lib/concepts/Mode.ml30
-rw-r--r--lib/concepts/Mode.mli27
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