From 55174a28581c33c4b6d91066086a2ee7b5c663ea Mon Sep 17 00:00:00 2001 From: Marcos Magueta Date: Sat, 31 Oct 2026 03:15:28 -0300 Subject: bencode helpers between dicts and string maps --- lib/concepts/Encoding.ml | 8 ++++++++ lib/concepts/Tuple.ml | 14 +++++--------- lib/evaluators/FOL.ml | 15 +++------------ lib/kernel/SubstantialRelation.ml | 31 +++++++++---------------------- 4 files changed, 25 insertions(+), 43 deletions(-) (limited to 'lib') diff --git a/lib/concepts/Encoding.ml b/lib/concepts/Encoding.ml index 50eb6e6..34ca3a0 100644 --- a/lib/concepts/Encoding.ml +++ b/lib/concepts/Encoding.ml @@ -113,6 +113,14 @@ module Bencode = struct let as_int = function Int n -> Ok n | _ -> Error (Error.type_mismatch ~expected:"integer") let as_list = function List l -> Ok l | _ -> Error (Error.type_mismatch ~expected:"list") let as_dict = function Dict d -> Ok d | _ -> Error (Error.type_mismatch ~expected:"dict") + let of_map f map = Dict (List.map (fun (k, v) -> k, f v) (BatMap.String.bindings map)) + + let to_map f data = + let open Utilities.Result in + let* kvs = as_dict data in + List.map (fun (k, v) -> f v |> Result.map (fun v -> k, v)) kvs + |> Utilities.List.sequence + |> Result.map BatMap.String.of_list let of_bytes (bytes : bytes) : (t, Condition.condition) result = let open Utilities.Result in diff --git a/lib/concepts/Tuple.ml b/lib/concepts/Tuple.ml index dfb7cbe..943c1f6 100644 --- a/lib/concepts/Tuple.ml +++ b/lib/concepts/Tuple.ml @@ -23,19 +23,15 @@ and Body : Encoding.Record.BODY = struct let fields {type_; attributes} = [ "type", Encoding.Bencode.String type_; - ( "attributes", - Encoding.Bencode.Dict - ( BatMap.String.enum attributes - |> BatEnum.fold (fun acc (name, value) -> (name, bencode_of_value value) :: acc) [] ) ) ] + "attributes", Encoding.Bencode.of_map bencode_of_value attributes ] let of_fields data = let open Utilities.Result in let* type_ = Encoding.Bencode.field "type" data |>> Encoding.Bencode.as_string in - let* kvs = Encoding.Bencode.field "attributes" data |>> Encoding.Bencode.as_dict in - kvs - |> List.map (fun (name, v) -> value_of_bencode v |> Result.map (fun v -> name, v)) - |> Utilities.List.sequence - |> Result.map (fun kvs -> {type_; attributes= BatMap.String.of_list kvs}) + let* attributes = + Encoding.Bencode.field "attributes" data |>> Encoding.Bencode.to_map value_of_bencode + in + Ok {type_; attributes} end let hash tuple = Representation.to_blob tuple |> Hash.hash_of_blob diff --git a/lib/evaluators/FOL.ml b/lib/evaluators/FOL.ml index a7685bd..01264e3 100644 --- a/lib/evaluators/FOL.ml +++ b/lib/evaluators/FOL.ml @@ -53,11 +53,7 @@ let rec bencode_of_term = ( 'w', Bencode.Dict [ "term", bencode_of_term term; - ( "binding", - Bencode.Dict - ( BatMap.String.bindings binding - |> List.map (fun (name, value) -> name, Concepts.Tuple.bencode_of_value value) ) ) - ] ) + "binding", Bencode.of_map Concepts.Tuple.bencode_of_value binding ] ) let rec term_of_bencode = let open Utilities.Result in @@ -74,15 +70,10 @@ let rec term_of_bencode = Ok (Project (term, BatFingerTree.of_list attributes)) | Bencode.Tagged ('w', data) -> let* term = Bencode.field "term" data |>> term_of_bencode in - let* binding = Bencode.field "binding" data |>> Bencode.as_dict in let* binding = - List.map - (fun (name, value) -> - Concepts.Tuple.value_of_bencode value |> Result.map (fun value -> name, value) ) - binding - |> Utilities.List.sequence + Bencode.field "binding" data |>> Bencode.to_map Concepts.Tuple.value_of_bencode in - Ok (Where (term, BatMap.String.of_list binding)) + Ok (Where (term, binding)) | _ -> Error (Error.malformed_program ()) let encode term = bencode_of_term term |> Bencode.to_bytes |> Bytes.to_string diff --git a/lib/kernel/SubstantialRelation.ml b/lib/kernel/SubstantialRelation.ml index e89b008..f269686 100644 --- a/lib/kernel/SubstantialRelation.ml +++ b/lib/kernel/SubstantialRelation.ml @@ -81,22 +81,15 @@ module Make (S : Abstract.Storage.STORAGE) = struct let open Concepts.Encoding in [ "schema", Value.bencode_of_hash schematics; "tuples", Value.bencode_of_hash tuples; - ( "indexes", - Bencode.Dict - (BatMap.String.bindings indexes |> List.map (fun (a, h) -> a, Value.bencode_of_hash h)) - ) ] + "indexes", Bencode.of_map Value.bencode_of_hash indexes ] let of_fields fields = let open Utilities.Result in let open Concepts.Encoding in let* schematics = Bencode.field "schema" fields |>> Value.hash_of_bencode in let* tuples = Bencode.field "tuples" fields |>> Value.hash_of_bencode in - let* indexes = Bencode.field "indexes" fields |>> Bencode.as_dict in - let* indexes = - List.map (fun (a, h) -> Value.hash_of_bencode h |> Result.map (fun h -> a, h)) indexes - |> Utilities.List.sequence - in - Ok {schematics; tuples; indexes= BatMap.String.of_list indexes} + let* indexes = Bencode.field "indexes" fields |>> Bencode.to_map Value.hash_of_bencode in + Ok {schematics; tuples; indexes} end let encode = Representation.to_blob @@ -109,23 +102,17 @@ module Make (S : Abstract.Storage.STORAGE) = struct let store_schema tx description = Concepts.Encoding.Bencode.( - Dict - ( BatMap.String.bindings description - |> List.map (fun (name, {Protocols.Schematics.domain; _}) -> name, String domain) ) - |> to_blob ) + of_map (fun {Protocols.Schematics.domain; _} -> String domain) description |> to_blob ) |> SI.store_blob tx let schema_of tx schematics = let open Utilities.Result in + let open Concepts.Encoding in let* data = SI.get_req tx (S.Hash schematics) in - let* fields = Concepts.Encoding.Bencode.of_blob data in - let* kvs = Concepts.Encoding.Bencode.as_dict fields in - kvs - |> List.map (fun (name, domain) -> - Concepts.Encoding.Bencode.as_string domain - |> Result.map (fun domain -> name, {Protocols.Schematics.domain; provenance= []}) ) - |> Utilities.List.sequence - |> Result.map BatMap.String.of_list + Bencode.of_blob data + |>> Bencode.to_map (fun domain -> + Bencode.as_string domain + |> Result.map (fun domain -> {Protocols.Schematics.domain; provenance= []}) ) let prefix value = Concepts.Encoding.Bencode.to_bytes (Concepts.Tuple.bencode_of_value value) -- cgit v1.2.3