aboutsummaryrefslogtreecommitdiffstats
path: root/lib/prl
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--lib/prl/ast.ml13
-rw-r--r--lib/prl/executor.ml20
-rw-r--r--lib/prl/parser.ml5
-rw-r--r--lib/prl/runtime.ml55
-rw-r--r--lib/prl/sublanguage.ml2
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
generated by cgit v1.2.3 (git 2.25.1) at 2026-11-04 21:02:55 +0000