diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/kernel/Generator.mli | 4 | ||||
| -rw-r--r-- | lib/kernel/Path.ml | 28 | ||||
| -rw-r--r-- | lib/kernel/Path.mli | 2 | ||||
| -rw-r--r-- | lib/kernel/Tuple.ml | 4 | ||||
| -rw-r--r-- | lib/protocols/Context.ml | 30 | ||||
| -rw-r--r-- | lib/protocols/Context.mli | 15 |
6 files changed, 17 insertions, 66 deletions
diff --git a/lib/kernel/Generator.mli b/lib/kernel/Generator.mli deleted file mode 100644 index f30f8ef..0000000 --- a/lib/kernel/Generator.mli +++ /dev/null @@ -1,4 +0,0 @@ -val cursor_of : - ?on_release:(unit -> unit) -> - (yield:(Concepts.Tuple.t -> unit) -> (unit, Concepts.Condition.condition) result) -> - Protocols.Handle.t diff --git a/lib/kernel/Path.ml b/lib/kernel/Path.ml index cd51efb..803d8cf 100644 --- a/lib/kernel/Path.ml +++ b/lib/kernel/Path.ml @@ -1,21 +1,17 @@ -type t = string BatFingerTree.t +type t = string list -let this = BatFingerTree.empty +let this = [] +let (@/) x y = x::y -let of_string s = - String.split_on_char '/' s |> List.filter (fun s -> s <> "") |> BatFingerTree.of_list - -let (@/) segment path = BatFingerTree.cons path segment - -let rec lookup handle path = - let open Utilities.Result in - match BatFingerTree.front path with - | None -> Ok (Some handle) - | Some (rest, segment) -> ( +let rec lookup handle = function + | [] -> Ok (Some handle) + | x::xs -> + let open Utilities.Result in + let open Protocols in match Protocols.Directory.from handle with | None -> Ok None - | Some dir -> ( - let* found = Protocols.Directory.find dir segment in - match found with + | Some dir -> + let* elem = Directory.find dir x in + match elem with | None -> Ok None - | Some handle' -> lookup handle' rest)) + | Some elem -> lookup elem xs diff --git a/lib/kernel/Path.mli b/lib/kernel/Path.mli index 9ef4103..85d0ca9 100644 --- a/lib/kernel/Path.mli +++ b/lib/kernel/Path.mli @@ -1,6 +1,6 @@ type t val this : t -val of_string : string -> t val (@/) : string -> t -> t + val lookup : Protocols.Handle.t -> t -> (Protocols.Handle.t option, Concepts.Condition.condition) result diff --git a/lib/kernel/Tuple.ml b/lib/kernel/Tuple.ml index e8f2f7f..50ce5b5 100644 --- a/lib/kernel/Tuple.ml +++ b/lib/kernel/Tuple.ml @@ -42,6 +42,10 @@ module Make (S : Abstract.Storage.STORAGE) = struct module AttributeM = Merkle.Interface (S) (Merkle.StringKey) (Attribute) + (* TODO: ephemeral tuples are served by instantiating this functor + over an in-memory storage. Consider later splitting [t] into + resident (an address) and ephemeral (an in-memory attribute map) + forms instead. *) type t = { type_ : string; attributes : AttributeM.address } module rec Representation : (Concepts.Encoding.Record.S with type t = t) = diff --git a/lib/protocols/Context.ml b/lib/protocols/Context.ml deleted file mode 100644 index ea314a6..0000000 --- a/lib/protocols/Context.ml +++ /dev/null @@ -1,30 +0,0 @@ -module Error = struct - open Concepts.Condition - - let unresolved name = - condition "unresolved-name" "A name did not resolve to any object reachable from this context" - ("name" |=| Concepts.Value.String name) -end - -class type implementation = object - method resolve : string -> (Handle.t option, Concepts.Condition.condition) result - method cancelled : bool - method charge : int -> (unit, Concepts.Condition.condition) result - method nest : ?authority:string BatSet.t -> unit -> implementation -end - -(* Unlike every other protocol here, a context is handed to [Program.invoke] directly rather than - looked up through [Handle.into], exactly as evaluators.org's pseudocode shows. It therefore needs - no extensible-variant constructor and [make] is a plain upcast. *) -type t = implementation - -let make impl = (impl :> implementation) -let resolve context name = context#resolve name -let cancelled context = context#cancelled -let charge context n = context#charge n -let nest ?authority context = context#nest ?authority () |> make - -let require context name = - let open Utilities.Result in - let* found = resolve context name in - Option.to_result ~none:(Error.unresolved name) found diff --git a/lib/protocols/Context.mli b/lib/protocols/Context.mli deleted file mode 100644 index ec585cd..0000000 --- a/lib/protocols/Context.mli +++ /dev/null @@ -1,15 +0,0 @@ -type t - -class type implementation = object - method resolve : string -> (Handle.t option, Concepts.Condition.condition) result - method cancelled : bool - method charge : int -> (unit, Concepts.Condition.condition) result - method nest : ?authority:string BatSet.t -> unit -> implementation -end - -val make : #implementation -> t -val resolve : t -> string -> (Handle.t option, Concepts.Condition.condition) result -val require : t -> string -> (Handle.t, Concepts.Condition.condition) result -val cancelled : t -> bool -val charge : t -> int -> (unit, Concepts.Condition.condition) result -val nest : ?authority:string BatSet.t -> t -> t |
