diff options
| author | Marcos Magueta <maguetamarcos@gmail.com> | 2026-06-23 23:53:26 -0300 |
|---|---|---|
| committer | GitHub <noreply@github.com> | 2026-06-23 23:53:26 -0300 |
| commit | c284fcd570342c31bc21169960579a20a763e32e (patch) | |
| tree | ce7485055116d794c55090ad0978e0b3f5ff4c2a /lib/prl | |
| parent | b81586ee4a0543a5f9866586c78dccdd6328934a (diff) | |
| download | Sakura-c284fcd570342c31bc21169960579a20a763e32e.tar.gz Sakura-c284fcd570342c31bc21169960579a20a763e32e.zip | |
Format
Diffstat (limited to '')
| -rw-r--r-- | lib/prl/ast.ml | 13 | ||||
| -rw-r--r-- | lib/prl/executor.ml | 20 | ||||
| -rw-r--r-- | lib/prl/parser.ml | 5 | ||||
| -rw-r--r-- | lib/prl/runtime.ml | 55 | ||||
| -rw-r--r-- | lib/prl/sublanguage.ml | 2 |
5 files changed, 44 insertions, 51 deletions
diff --git a/lib/prl/ast.ml b/lib/prl/ast.ml index 1969da6..ab63c31 100644 --- a/lib/prl/ast.ml +++ b/lib/prl/ast.ml @@ -1,12 +1,11 @@ open Sexplib.Std -type function_predicate = { - name : string; - schema : (string * string) list; - symbol : string; - purity : Conventions.Purity.t; - cardinality : Conventions.Cardinality.t; -} +type function_predicate = + { name: string; + schema: (string * string) list; + symbol: string; + purity: Conventions.Purity.t; + cardinality: Conventions.Cardinality.t } [@@deriving sexp] type statement = diff --git a/lib/prl/executor.ml b/lib/prl/executor.ml index fcd4ec0..4a055ae 100644 --- a/lib/prl/executor.ml +++ b/lib/prl/executor.ml @@ -1,11 +1,16 @@ module Make (NT : Nt.S) = struct module Error = struct open Condition + (* TODO: more structure *) let parse_error msg = condition "parse-error" msg empty let runtime_error msg = condition "runtime-error" msg empty - let unknown_plugin_symbol name = condition "unknown-plugin-symbol" "Unknown plugin" ("name" |=| (of_string name)) - let relation_not_found name = condition "relation-not-found" "Relation not found" ("name" |=| (of_string name)) + + let unknown_plugin_symbol name = + condition "unknown-plugin-symbol" "Unknown plugin" ("name" |=| of_string name) + + let relation_not_found name = + condition "relation-not-found" "Relation not found" ("name" |=| of_string name) end let ( let* ) = Result.bind @@ -19,16 +24,15 @@ module Make (NT : Nt.S) = struct let execute (_ctx : Sublanguage_context.t) (_stmt : Ast.statement) : (Sublanguage_types.result, Condition.t) result = - Error (Error.runtime_error - "PRL execution is temporarily disabled pending VM callback-cursor support") + Error + (Error.runtime_error + "PRL execution is temporarily disabled pending VM callback-cursor support" ) - let _execute_load_library _ctx _path = - Error (Error.runtime_error "PRL disabled") + let _execute_load_library _ctx _path = Error (Error.runtime_error "PRL disabled") let _execute_define_function_predicate _ctx (_spec : Ast.function_predicate) = let* _ = Ok () in Error (Error.runtime_error "PRL disabled") - let _execute_list_function_predicates _ctx = - Error (Error.runtime_error "PRL disabled") + let _execute_list_function_predicates _ctx = Error (Error.runtime_error "PRL disabled") end diff --git a/lib/prl/parser.ml b/lib/prl/parser.ml index 2567eea..e009b97 100644 --- a/lib/prl/parser.ml +++ b/lib/prl/parser.ml @@ -1,12 +1,11 @@ module Error = struct open Condition + let parse_error msg = condition "parse-error" msg empty end let of_sexp sexp = - let sexp = - match sexp with Sexplib.Sexp.List [ atom ] -> atom | other -> other - in + let sexp = match sexp with Sexplib.Sexp.List [atom] -> atom | other -> other in match Ast.statement_of_sexp sexp with | stmt -> Ok stmt | exception exn -> Error (Error.parse_error (Printexc.to_string exn)) diff --git a/lib/prl/runtime.ml b/lib/prl/runtime.ml index 9ebef84..103b5c1 100644 --- a/lib/prl/runtime.ml +++ b/lib/prl/runtime.ml @@ -1,7 +1,6 @@ -type t = { loaded_libraries : (string, unit) Hashtbl.t; mutex : Mutex.t } +type t = {loaded_libraries: (string, unit) Hashtbl.t; mutex: Mutex.t} -let state : t = - { loaded_libraries = Hashtbl.create 16; mutex = Mutex.create () } +let state : t = {loaded_libraries= Hashtbl.create 16; mutex= Mutex.create ()} let load_library path : (unit, string) result = Mutex.protect state.mutex (fun () -> @@ -11,44 +10,40 @@ let load_library path : (unit, string) result = Dynlink.loadfile path; Hashtbl.replace state.loaded_libraries path (); Ok () - with Dynlink.Error e -> Error (Dynlink.error_message e)) + with Dynlink.Error e -> Error (Dynlink.error_message e) ) (* Convert an engine materialized tuple to the plugin's (string * Obj.t) list format. *) -let to_plugin_row (schema : Schema.t) (tuple : Tuple.materialized) : - Sakura_prl_api.tuple option = +let to_plugin_row (schema : Schema.t) (tuple : Tuple.materialized) : Sakura_prl_api.tuple option = let rec go acc = function | [] -> Some (List.rev acc) | (attr_name, _) :: rest -> ( - match Tuple.AttributeMap.find_opt attr_name tuple.attributes with - | None -> None - | Some attr -> go ((attr_name, attr.Attribute.value) :: acc) rest) + match Tuple.AttributeMap.find_opt attr_name tuple.attributes with + | None -> None + | Some attr -> go ((attr_name, attr.Attribute.value) :: acc) rest ) in go [] schema (* Convert a plugin row back to an engine materialized tuple. *) -let of_plugin_row relation_name (schema : Schema.t) (row : Sakura_prl_api.tuple) - : Tuple.materialized option = +let of_plugin_row relation_name (schema : Schema.t) (row : Sakura_prl_api.tuple) : + Tuple.materialized option = let rec go acc = function - | [] -> Some { Tuple.relation = relation_name; attributes = acc } + | [] -> Some {Tuple.relation= relation_name; attributes= acc} | (attr_name, _) :: rest -> ( - match List.assoc_opt attr_name row with - | None -> None - | Some value -> - go (Tuple.AttributeMap.add attr_name { Attribute.value } acc) rest) + match List.assoc_opt attr_name row with + | None -> None + | Some value -> go (Tuple.AttributeMap.add attr_name {Attribute.value} acc) rest ) in go Tuple.AttributeMap.empty schema (* Wrap a list of plugin rows as a generator. Uses an array for O(1) indexing. *) -let rows_to_generator relation_name schema (rows : Sakura_prl_api.tuple list) : - Generator.t = +let rows_to_generator relation_name schema (rows : Sakura_prl_api.tuple list) : Generator.t = let arr = Array.of_list rows in let n = Array.length arr in let rec gen i _pos = if i >= n then Generator.Done else match of_plugin_row relation_name schema arr.(i) with - | None -> - Generator.Error "Plugin row does not conform to predicate schema." + | None -> Generator.Error "Plugin row does not conform to predicate schema." | Some tuple -> Generator.Value (Tuple.Materialized tuple, gen (i + 1)) in gen 0 @@ -62,21 +57,19 @@ let make_generator relation_name schema (impl : Sakura_prl_api.implementation) fun _pos -> match Lazy.force rows_result with | Error e -> Generator.Error e - | Ok rows -> rows_to_generator relation_name schema rows _pos) + | Ok rows -> rows_to_generator relation_name schema rows _pos ) -let make_producer relation_name schema (impl : Sakura_prl_api.implementation) : - Relation.producer = +let make_producer relation_name schema (impl : Sakura_prl_api.implementation) : Relation.producer = fun bindings -> make_generator relation_name schema impl bindings -let make_membership_criteria schema (impl : Sakura_prl_api.implementation) : - Tuple.t -> bool = +let make_membership_criteria schema (impl : Sakura_prl_api.implementation) : Tuple.t -> bool = match impl.membership_criteria with | None -> fun _ -> false | Some check -> ( (* fun _tree_of -> *) - function - | Tuple.NonMaterialized _ -> false - | Tuple.Materialized m -> ( - match to_plugin_row schema m with - | None -> false - | Some row -> ( match check row with Ok b -> b | Error _ -> false))) + function + | Tuple.NonMaterialized _ -> false + | Tuple.Materialized m -> ( + match to_plugin_row schema m with + | None -> false + | Some row -> ( match check row with Ok b -> b | Error _ -> false ) ) ) diff --git a/lib/prl/sublanguage.ml b/lib/prl/sublanguage.ml index 387da34..405d266 100644 --- a/lib/prl/sublanguage.ml +++ b/lib/prl/sublanguage.ml @@ -6,8 +6,6 @@ module Make (NT : Nt.S) = struct let name = "prl" let parse _ = Ok () - let parse_sexp sexp = Parser.of_sexp sexp - let execute = Exec.execute end |
