diff options
| author | Marcos Magueta <maguetamarcos@gmail.com> | 2025-07-03 19:43:29 -0300 |
|---|---|---|
| committer | Marcos Magueta <maguetamarcos@gmail.com> | 2025-07-03 19:43:29 -0300 |
| commit | 481063c322ecc729bc9d3c5d2bca830f70ce8022 (patch) | |
| tree | 948d88af8345a3a493bffff796c5b212f29acd85 | |
| parent | ab7ce52387d0de7160f1fac71f61c76ab1b150f7 (diff) | |
| download | Sakura-ocaml_archive.tar.gz Sakura-ocaml_archive.zip | |
schema propagation commandocaml_archive
| -rw-r--r-- | client.el | 1 | ||||
| -rw-r--r-- | lib/disk.ml | 2 | ||||
| -rw-r--r-- | lib/planner.ml | 2 | ||||
| -rw-r--r-- | lib/protocol.ml | 3 | ||||
| -rw-r--r-- | lib/server.ml | 12 |
5 files changed, 17 insertions, 3 deletions
@@ -20,6 +20,7 @@ (setq msg "(SequentialRead (relation_name address))") (setq msg "(Nest (relation_name user))") +(setq msg "State") (relational-client msg) diff --git a/lib/disk.ml b/lib/disk.ml index 05f4d82..a6c3a21 100644 --- a/lib/disk.ml +++ b/lib/disk.ml @@ -452,6 +452,7 @@ module Command = struct open Protocol_conv_xml type t = + | State | SequentialRead of { relation_name : string } | SpecifyRelation of { relation_name: string; attributes: (string*Executor.relational_type) list } @@ -480,6 +481,7 @@ module Command = struct type return = | ComputedHash of string | Read of (int64 * (string*Executor.relational_literal) list) list + | Schema of (string * (string * Executor.relational_type) list) list | Nothing [@@deriving show, sexp, protocol ~driver:(module Xml_light)] diff --git a/lib/planner.ml b/lib/planner.ml index c66e46b..8127c41 100644 --- a/lib/planner.ml +++ b/lib/planner.ml @@ -162,6 +162,8 @@ module Executor = struct open Disk.Executor let perform (commit : Executor.commit) (locations : Executor.locations) (command : Command.t) = match command with + | State -> + Ok ((commit, locations), Command.Schema (StringMap.to_list commit.schema)) | Nest {relation_name;} -> let results = Join.nest commit locations relation_name in Ok ((commit, locations), Command.Read results) diff --git a/lib/protocol.ml b/lib/protocol.ml index c67fb9a..1cf3635 100644 --- a/lib/protocol.ml +++ b/lib/protocol.ml @@ -6,6 +6,9 @@ type tuple = string list [@@deriving sexp, protocol ~driver:(module Xml_light)] type command = Disk.Command.t [@@deriving sexp, protocol ~driver:(module Xml_light)] +type schema = (string * (string * Disk.Executor.relational_type) list) list +[@@deriving sexp, protocol ~driver:(module Xml_light)] + type relation = { attribute_name : string; attribute_type : string; diff --git a/lib/server.ml b/lib/server.ml index d06f8e8..ea1a79a 100644 --- a/lib/server.ml +++ b/lib/server.ml @@ -31,9 +31,15 @@ let client_read sock maxlen = let command = Protocol.command_of_sexp (Sexplib.Sexp.of_string x) in (* let command = Protocol.command_of_xml_light_exn (Protocol_conv_xml.Xml_light.of_string x) in *) let Ok (commit, locations) = Relation.prepare () in - let Ok (_, (Disk.Command.Read response)) = - Planner.Executor.perform commit locations command - in return @@ Sexplib.Sexp.to_string (Protocol.sexp_of_facts response) + (* let Ok (_, (Disk.Command.Read response)) = *) + (* Planner.Executor.perform commit locations command *) + (* Ok (_, (Disk.Command.Read response)) = *) + match Planner.Executor.perform commit locations command with + | Ok (_, Disk.Command.Read response) -> + return @@ Sexplib.Sexp.to_string (Protocol.sexp_of_facts response) + | Ok (_, Disk.Command.Schema response) -> + return @@ Sexplib.Sexp.to_string (Protocol.sexp_of_schema response) + | _ -> failwith "Case not supported" (* in return @@ Xml.to_string (Protocol.facts_to_xml_light response) *) (* match *) (* Relation.write_and_retrieve () *) |