diff options
Diffstat (limited to 'lib/protocols')
| -rw-r--r-- | lib/protocols/Evaluator.ml | 12 | ||||
| -rw-r--r-- | lib/protocols/Evaluator.mli | 11 | ||||
| -rw-r--r-- | lib/protocols/Schematics.ml | 42 | ||||
| -rw-r--r-- | lib/protocols/Schematics.mli | 31 |
4 files changed, 35 insertions, 61 deletions
diff --git a/lib/protocols/Evaluator.ml b/lib/protocols/Evaluator.ml deleted file mode 100644 index 95c2ef8..0000000 --- a/lib/protocols/Evaluator.ml +++ /dev/null @@ -1,12 +0,0 @@ -class type implementation = object - method capabilities : string BatSet.t - method admit : string -> (Handle.t, Concepts.Condition.condition) result -end - -type Handle.protocol += Evaluator of implementation -type t = implementation - -let make impl = Evaluator (impl :> implementation) -let from handle = Handle.into handle (function Evaluator impl -> Some impl | _ -> None) -let capabilities i = Handle.invoke i (fun o -> o#capabilities) -let admit i source = Handle.invoke i (fun o -> o#admit source) diff --git a/lib/protocols/Evaluator.mli b/lib/protocols/Evaluator.mli deleted file mode 100644 index 8400fd2..0000000 --- a/lib/protocols/Evaluator.mli +++ /dev/null @@ -1,11 +0,0 @@ -type t - -class type implementation = object - method capabilities : string BatSet.t - method admit : string -> (Handle.t, Concepts.Condition.condition) result -end - -val make : #implementation -> Handle.protocol -val from : Handle.t -> t Handle.interface option -val capabilities : t Handle.interface -> string BatSet.t -val admit : t Handle.interface -> string -> (Handle.t, Concepts.Condition.condition) result diff --git a/lib/protocols/Schematics.ml b/lib/protocols/Schematics.ml index b0297e7..d2e50ad 100644 --- a/lib/protocols/Schematics.ml +++ b/lib/protocols/Schematics.ml @@ -1,30 +1,24 @@ -module type S = sig - module Schema : Abstract.Schematics.SCHEMA - type t +type multigroup_description = string BatMap.String.t +type relation_description = string BatMap.String.t +type tuple_description = {relation: relation_description; attributes: string BatMap.String.t} - class type implementation = object - method schema : (Schema.t, Concepts.Condition.condition) result - end +(* TODO: For now the description is completely detached from actual + types and domains. Later figure out a way to represent the links + without strings. *) +type description = + | Multigroup of multigroup_description + | Relation of relation_description + | Tuple of tuple_description - val make : #implementation -> Handle.protocol - val from : Handle.t -> t Handle.interface option - val schema : t Handle.interface -> (Schema.t, Concepts.Condition.condition) result - val attributes : - t Handle.interface -> - ((string * Schema.attribute) BatFingerTree.t, Concepts.Condition.condition) result +class type implementation = object + method describe : unit -> (description, Concepts.Condition.condition) result end -module Make (Schema : Abstract.Schematics.SCHEMA) = struct - module Schema = Schema - class type implementation = object - method schema : (Schema.t, Concepts.Condition.condition) result - end +type Handle.protocol += Schematics of implementation - type Handle.protocol += Schematics of implementation - type t = implementation +type t = implementation - let make impl = Schematics (impl :> implementation) - let from handle = Handle.into handle (function Schematics impl -> Some impl | _ -> None) - let schema i = Handle.invoke i (fun o -> o#schema) - let attributes i = Result.map Schema.attributes (schema i) -end +let make impl = Schematics (impl :> implementation) +let from handle = + Handle.into handle (function Schematics impl -> Some impl | _ -> None) +let describe impl = Handle.invoke impl (fun o -> o#describe ()) diff --git a/lib/protocols/Schematics.mli b/lib/protocols/Schematics.mli index d8533bf..dc8f320 100644 --- a/lib/protocols/Schematics.mli +++ b/lib/protocols/Schematics.mli @@ -1,18 +1,21 @@ -(** Instantiate once and share the protocol with schema providers and evaluators. *) -module type S = sig - module Schema : Abstract.Schematics.SCHEMA - type t +type t - class type implementation = object - method schema : (Schema.t, Concepts.Condition.condition) result - end +(* TODO: For now the description is completely detached from actual + types and domains. Later figure out a way to represent the links + without strings. *) +type multigroup_description = string BatMap.String.t +type relation_description = string BatMap.String.t +type tuple_description = {relation: relation_description; attributes: string BatMap.String.t} - val make : #implementation -> Handle.protocol - val from : Handle.t -> t Handle.interface option - val schema : t Handle.interface -> (Schema.t, Concepts.Condition.condition) result - val attributes : - t Handle.interface -> - ((string * Schema.attribute) BatFingerTree.t, Concepts.Condition.condition) result +type description = + | Multigroup of multigroup_description + | Relation of relation_description + | Tuple of tuple_description + +class type implementation = object + method describe : unit -> (description, Concepts.Condition.condition) result end -module Make (Schema : Abstract.Schematics.SCHEMA) : S with module Schema = Schema +val make : #implementation -> Handle.protocol +val from : Handle.t -> t Handle.interface option +val describe : t Handle.interface -> (description, Concepts.Condition.condition) result |
