aboutsummaryrefslogtreecommitdiffstats
path: root/lib/protocols
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--lib/protocols/Addressable.ml3
-rw-r--r--lib/protocols/Addressable.mli2
-rw-r--r--lib/protocols/Associative.ml11
-rw-r--r--lib/protocols/Associative.mli7
-rw-r--r--lib/protocols/Cursor.ml4
-rw-r--r--lib/protocols/Cursor.mli9
-rw-r--r--lib/protocols/Directory.ml4
-rw-r--r--lib/protocols/Directory.mli2
-rw-r--r--lib/protocols/Enumerable.mli2
-rw-r--r--lib/protocols/Generative.ml3
-rw-r--r--lib/protocols/Handle.ml41
-rw-r--r--lib/protocols/Handle.mli7
-rw-r--r--lib/protocols/Program.ml1
-rw-r--r--lib/protocols/Program.mli1
-rw-r--r--lib/protocols/Registry.ml6
-rw-r--r--lib/protocols/Registry.mli11
-rw-r--r--lib/protocols/Relation.mli3
-rw-r--r--lib/protocols/Schematics.ml4
18 files changed, 41 insertions, 80 deletions
diff --git a/lib/protocols/Addressable.ml b/lib/protocols/Addressable.ml
index 7e97f08..e4ba5b5 100644
--- a/lib/protocols/Addressable.ml
+++ b/lib/protocols/Addressable.ml
@@ -3,11 +3,8 @@ class type implementation = object
end
type Handle.protocol += Addressable of implementation
-
type t = implementation
let make impl = Addressable (impl :> implementation)
-
let from handle = Handle.into handle (function Addressable impl -> Some impl | _ -> None)
-
let address i = Handle.invoke i (fun o -> o#address)
diff --git a/lib/protocols/Addressable.mli b/lib/protocols/Addressable.mli
index 2d9c14d..0301361 100644
--- a/lib/protocols/Addressable.mli
+++ b/lib/protocols/Addressable.mli
@@ -5,7 +5,5 @@ class type implementation = object
end
val make : #implementation -> Handle.protocol
-
val from : Handle.t -> t Handle.interface option
-
val address : t Handle.interface -> Concepts.Hash.hash
diff --git a/lib/protocols/Associative.ml b/lib/protocols/Associative.ml
index 66de5ed..16fdcc8 100644
--- a/lib/protocols/Associative.ml
+++ b/lib/protocols/Associative.ml
@@ -3,14 +3,13 @@ class type implementation = object
end
type Handle.protocol += Associative of implementation
-
type t = implementation
let make impl = Associative (impl :> implementation)
-
let from handle = Handle.into handle (function Associative impl -> Some impl | _ -> None)
-let update i key value = Handle.invoke i (fun o ->
- let open Utilities.Result in
- let* h = o#update key value in
- Handle.require from h)
+let update i key value =
+ Handle.invoke i (fun o ->
+ let open Utilities.Result in
+ let* h = o#update key value in
+ Handle.require from h )
diff --git a/lib/protocols/Associative.mli b/lib/protocols/Associative.mli
index 066cfe4..5886303 100644
--- a/lib/protocols/Associative.mli
+++ b/lib/protocols/Associative.mli
@@ -5,7 +5,10 @@ class type implementation = object
end
val make : #implementation -> Handle.protocol
-
val from : Handle.t -> t Handle.interface option
-val update : t Handle.interface -> string -> Handle.t option -> (t Handle.interface, Concepts.Condition.condition) result
+val update :
+ t Handle.interface ->
+ string ->
+ Handle.t option ->
+ (t Handle.interface, Concepts.Condition.condition) result
diff --git a/lib/protocols/Cursor.ml b/lib/protocols/Cursor.ml
index 75dc77d..f9bd697 100644
--- a/lib/protocols/Cursor.ml
+++ b/lib/protocols/Cursor.ml
@@ -29,9 +29,7 @@ let rec next i =
let rec exists i p =
let open Utilities.Result in
let* found = next i in
- match found with
- | None -> Ok false
- | Some tuple -> if p tuple then Ok true else exists i p
+ match found with None -> Ok false | Some tuple -> if p tuple then Ok true else exists i p
let drain i ?(limit = 256) () =
let open Utilities.Result in
diff --git a/lib/protocols/Cursor.mli b/lib/protocols/Cursor.mli
index c977fec..ff6c027 100644
--- a/lib/protocols/Cursor.mli
+++ b/lib/protocols/Cursor.mli
@@ -1,6 +1,4 @@
-type batch =
- {tuples: Concepts.Tuple.t BatFingerTree.t; exhausted: bool}
-
+type batch = {tuples: Concepts.Tuple.t BatFingerTree.t; exhausted: bool}
type t
class type implementation = object
@@ -11,13 +9,10 @@ val make : #implementation -> Handle.protocol
val from : Handle.t -> t Handle.interface option
val require : Handle.t -> (t Handle.interface, Concepts.Condition.condition) result
val fetch : t Handle.interface -> int -> (batch, Concepts.Condition.condition) result
-
val next : t Handle.interface -> (Concepts.Tuple.t option, Concepts.Condition.condition) result
val exists :
- t Handle.interface ->
- (Concepts.Tuple.t -> bool) ->
- (bool, Concepts.Condition.condition) result
+ t Handle.interface -> (Concepts.Tuple.t -> bool) -> (bool, Concepts.Condition.condition) result
val drain :
t Handle.interface ->
diff --git a/lib/protocols/Directory.ml b/lib/protocols/Directory.ml
index 0d2507e..232a47e 100644
--- a/lib/protocols/Directory.ml
+++ b/lib/protocols/Directory.ml
@@ -4,13 +4,9 @@ class type implementation = object
end
type Handle.protocol += Directory of implementation
-
type t = implementation
let make impl = Directory (impl :> implementation)
-
let from handle = Handle.into handle (function Directory impl -> Some impl | _ -> None)
-
let list i = Handle.invoke i (fun o -> o#list)
-
let find i name = Handle.invoke i (fun o -> o#find name)
diff --git a/lib/protocols/Directory.mli b/lib/protocols/Directory.mli
index 9033235..0d78887 100644
--- a/lib/protocols/Directory.mli
+++ b/lib/protocols/Directory.mli
@@ -6,8 +6,6 @@ class type implementation = object
end
val make : #implementation -> Handle.protocol
-
val from : Handle.t -> t Handle.interface option
-
val list : t Handle.interface -> (string BatFingerTree.t, Concepts.Condition.condition) result
val find : t Handle.interface -> string -> (Handle.t option, Concepts.Condition.condition) result
diff --git a/lib/protocols/Enumerable.mli b/lib/protocols/Enumerable.mli
index d2ab882..2c0ee69 100644
--- a/lib/protocols/Enumerable.mli
+++ b/lib/protocols/Enumerable.mli
@@ -6,7 +6,5 @@ end
val make : #implementation -> Handle.protocol
val from : Handle.t -> t Handle.interface option
-
val require : Handle.t -> (t Handle.interface, Concepts.Condition.condition) result
-
val enumerate : t Handle.interface -> (Handle.t, Concepts.Condition.condition) result
diff --git a/lib/protocols/Generative.ml b/lib/protocols/Generative.ml
index bd89e21..6846e43 100644
--- a/lib/protocols/Generative.ml
+++ b/lib/protocols/Generative.ml
@@ -68,7 +68,8 @@ class virtual membership =
else
let* declaration = self#modes in
let* () =
- if Concepts.Mode.decision declaration bound then Ok () else Error (Error.undecidable bound)
+ if Concepts.Mode.decision declaration bound then Ok ()
+ else Error (Error.undecidable bound)
in
let* cursor = self#generate binding in
let expected = Concepts.Tuple.hash tuple in
diff --git a/lib/protocols/Handle.ml b/lib/protocols/Handle.ml
index 41c88dd..cdadd4a 100644
--- a/lib/protocols/Handle.ml
+++ b/lib/protocols/Handle.ml
@@ -4,7 +4,8 @@ module Error = struct
open Concepts.Condition
let unimplemented_protocol obj_name =
- condition "unimplemented-protocol" "A required protocol was not implemented by the specified object"
+ condition "unimplemented-protocol"
+ "A required protocol was not implemented by the specified object"
("object" |=| Concepts.Value.String obj_name)
end
@@ -16,46 +17,32 @@ class type obj = object
method protocols : protocol list
end
-type t = { valid : bool ref; refers_to : obj }
+type t = {valid: bool ref; refers_to: obj}
+type 'a interface = {handle: t; interface: 'a}
-type 'a interface = { handle : t; interface : 'a }
+let object_of {valid; refers_to} =
+ if !valid then refers_to else failwith "Attempt to dereference an invalid handle!"
-let object_of { valid; refers_to } =
- if !valid then
- refers_to
- else
- failwith "Attempt to dereference an invalid handle!"
+let interface_of handle interface = {handle; interface}
+let make o = {valid= ref true; refers_to= (o :> obj)}
+let into handle f = List.find_map f (object_of handle)#protocols |> Option.map (interface_of handle)
-let interface_of handle interface = { handle; interface }
-
-let make o = { valid = ref true; refers_to = (o :> obj) }
-
-let into handle f =
- List.find_map f (object_of handle)#protocols
- |> Option.map (interface_of handle)
-
-let invoke { handle; interface } f =
+let invoke {handle; interface} f =
let _ = object_of handle in
f interface
-let from { handle; _ } = handle
+let from {handle; _} = handle
let copy handle =
let o = object_of handle in
- if o#reference then
- Some (make o)
- else
- None
-
-let equal h1 h2 =
- Concepts.Hash.hash_equals (object_of h1)#hash (object_of h2)#hash
+ if o#reference then Some (make o) else None
+let equal h1 h2 = Concepts.Hash.hash_equals (object_of h1)#hash (object_of h2)#hash
let hash h = (object_of h)#hash
let protocols h = (object_of h)#protocols
-
let to_string h = (object_of h)#to_string
-let release ({ valid; _ } as handle) =
+let release ({valid; _} as handle) =
let o = object_of handle in
valid := false;
o#release
diff --git a/lib/protocols/Handle.mli b/lib/protocols/Handle.mli
index 40a78ff..a354257 100644
--- a/lib/protocols/Handle.mli
+++ b/lib/protocols/Handle.mli
@@ -1,7 +1,5 @@
type t
-
type 'a interface
-
type protocol = ..
class type obj = object
@@ -13,18 +11,13 @@ class type obj = object
end
val make : #obj -> t
-
val into : t -> (protocol -> 'a option) -> 'a interface option
val from : 'a interface -> t
-
val invoke : 'a interface -> ('a -> 'b) -> 'b
-
val copy : t -> t option
val equal : t -> t -> bool
val release : t -> unit
-
val hash : t -> Concepts.Hash.hash
val protocols : t -> protocol list
val to_string : t -> string
-
val require : (t -> 'a interface option) -> t -> ('a interface, Concepts.Condition.condition) result
diff --git a/lib/protocols/Program.ml b/lib/protocols/Program.ml
index 5b618e6..e50f07d 100644
--- a/lib/protocols/Program.ml
+++ b/lib/protocols/Program.ml
@@ -8,7 +8,6 @@ module Make (P : PROGRAM) = struct
end
type Handle.protocol += Program of implementation
-
type t = implementation
let make impl = Program (impl :> implementation)
diff --git a/lib/protocols/Program.mli b/lib/protocols/Program.mli
index 9cf4455..6cdffd8 100644
--- a/lib/protocols/Program.mli
+++ b/lib/protocols/Program.mli
@@ -11,6 +11,5 @@ module Make (P : PROGRAM) : sig
val make : #implementation -> Handle.protocol
val from : Handle.t -> t Handle.interface option
-
val invoke : t Handle.interface -> P.t -> (Handle.t, Concepts.Condition.condition) result
end
diff --git a/lib/protocols/Registry.ml b/lib/protocols/Registry.ml
index f01f06b..d7c4480 100644
--- a/lib/protocols/Registry.ml
+++ b/lib/protocols/Registry.ml
@@ -1,13 +1,11 @@
class type implementation = object
- method update : string -> Handle.t option -> Handle.t option -> (bool, Concepts.Condition.condition) result
+ method update :
+ string -> Handle.t option -> Handle.t option -> (bool, Concepts.Condition.condition) result
end
type Handle.protocol += Registry of implementation
-
type t = implementation
let make impl = Registry (impl :> implementation)
-
let from handle = Handle.into handle (function Registry impl -> Some impl | _ -> None)
-
let update i key reference value = Handle.invoke i (fun o -> o#update key reference value)
diff --git a/lib/protocols/Registry.mli b/lib/protocols/Registry.mli
index 3390167..627a60f 100644
--- a/lib/protocols/Registry.mli
+++ b/lib/protocols/Registry.mli
@@ -1,11 +1,16 @@
type t
class type implementation = object
- method update : string -> Handle.t option -> Handle.t option -> (bool, Concepts.Condition.condition) result
+ method update :
+ string -> Handle.t option -> Handle.t option -> (bool, Concepts.Condition.condition) result
end
val make : #implementation -> Handle.protocol
-
val from : Handle.t -> t Handle.interface option
-val update : t Handle.interface -> string -> Handle.t option -> Handle.t option -> (bool, Concepts.Condition.condition) result
+val update :
+ t Handle.interface ->
+ string ->
+ Handle.t option ->
+ Handle.t option ->
+ (bool, Concepts.Condition.condition) result
diff --git a/lib/protocols/Relation.mli b/lib/protocols/Relation.mli
index 384877e..b4a11ec 100644
--- a/lib/protocols/Relation.mli
+++ b/lib/protocols/Relation.mli
@@ -16,5 +16,4 @@ val predicate :
val local_constraints :
t Handle.interface -> (Concepts.Hash.hash option, Concepts.Condition.condition) result
-val contains :
- t Handle.interface -> Concepts.Tuple.t -> (bool, Concepts.Condition.condition) result
+val contains : t Handle.interface -> Concepts.Tuple.t -> (bool, Concepts.Condition.condition) result
diff --git a/lib/protocols/Schematics.ml b/lib/protocols/Schematics.ml
index 49d8586..238fa99 100644
--- a/lib/protocols/Schematics.ml
+++ b/lib/protocols/Schematics.ml
@@ -17,10 +17,8 @@ class type implementation = object
end
type Handle.protocol += Schematics of implementation
-
type t = implementation
let make impl = Schematics (impl :> implementation)
-let from handle =
- Handle.into handle (function Schematics impl -> Some impl | _ -> None)
+let from handle = Handle.into handle (function Schematics impl -> Some impl | _ -> None)
let describe impl = Handle.invoke impl (fun o -> o#describe ())
generated by cgit v1.2.3 (git 2.25.1) at 2026-11-04 19:21:25 +0000