diff options
| -rw-r--r-- | bin/main.ml | 5 | ||||
| -rw-r--r-- | lib/attribute.ml | 21 | ||||
| -rw-r--r-- | lib/constraint.ml | 8 | ||||
| -rw-r--r-- | lib/conventions.ml | 26 | ||||
| -rw-r--r-- | lib/core_functions.ml | 24 | ||||
| -rw-r--r-- | lib/domain.ml | 9 | ||||
| -rw-r--r-- | lib/dune | 5 | ||||
| -rw-r--r-- | lib/generator.ml | 6 | ||||
| -rw-r--r-- | lib/prelude/standard.ml | 36 | ||||
| -rw-r--r-- | lib/relation.ml | 81 | ||||
| -rw-r--r-- | lib/tuple.ml | 18 |
11 files changed, 165 insertions, 74 deletions
diff --git a/bin/main.ml b/bin/main.ml index c5e2c1d..adbf1dc 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -3,4 +3,9 @@ let main () = print_endline digest let () = + (* TODO: Since the comparison on the standard function is done atop of the abstract value, a change on the abstract name incurs into an alteration of the order as well *) + let left_value: Relational_engine.Conventions.AbstractValue.t = {fields = Relational_engine.Conventions.AbstractValue.StringMap.of_list [("value!!!!!", "0")]} in + let right_value: Relational_engine.Conventions.AbstractValue.t = {fields = Relational_engine.Conventions.AbstractValue.StringMap.of_list [("value", "1")]} in + let tuple = Relational_engine.Tuple.make_materialized ~relation: "natural_less_than" ~attributes: (Relational_engine.Conventions.AbstractValue.StringMap.of_list [("left", left_value); ("right", right_value)]) in + print_endline @@ string_of_bool @@ Relational_engine.Prelude.Standard.less_than_natural.membership_criteria tuple; main () diff --git a/lib/attribute.ml b/lib/attribute.ml new file mode 100644 index 0000000..05d33f4 --- /dev/null +++ b/lib/attribute.ml @@ -0,0 +1,21 @@ +type t = { + hash : Conventions.Hash.t; + name : Conventions.Name.t; + name_hash : Conventions.Hash.t; + value : Conventions.AbstractValue.t; + value_hash : Conventions.Hash.t; +} + +type materialized = { + name: Conventions.Name.t; + value: Conventions.AbstractValue.t +} + +let make ~name ~value = + let name_hash = Conventions.Hash.hash_text name in + let value_hash = Conventions.AbstractValue.hash_text value in + let hash = Conventions.Hash.hash_text (name_hash ^ value_hash) in + { hash; name; name_hash; value; value_hash } + +let make_with_hashes ~hash ~name ~name_hash ~value ~value_hash = + { hash; name; name_hash; value; value_hash } diff --git a/lib/constraint.ml b/lib/constraint.ml new file mode 100644 index 0000000..f6164b2 --- /dev/null +++ b/lib/constraint.ml @@ -0,0 +1,8 @@ +type relation_name = string +type t = + | MemberOf of relation_name + | Not of t * relation_name option + | And of t list + | Or of t list + | Exists of {variable: string; quantifier: relation_name; constraint': t} + | Forall of {variable: string; quantifier: relation_name; constraint': t} diff --git a/lib/conventions.ml b/lib/conventions.ml new file mode 100644 index 0000000..74f6cc3 --- /dev/null +++ b/lib/conventions.ml @@ -0,0 +1,26 @@ +module Hash = struct + type t = Interop.Sha256.t + let hash_text text = Interop.Sha256.compute_hash (Bytes.of_string text) + let compare = String.compare +end + +module Name = struct + type t = string +end + +module Cardinality = struct + type t = Finite of int | AlephZero | Continuum +end + +module AbstractValue = struct + module StringMap = Map.Make(String) + type t = { + fields: string StringMap.t; + } + let hash_text value = + let folder (name: string) (value: string) (acc: Hash.t) = + Hash.(hash_text (acc ^ hash_text name ^ hash_text value)) + in StringMap.fold folder value.fields "" + let compare a b = + StringMap.compare String.compare a.fields b.fields +end
\ No newline at end of file diff --git a/lib/core_functions.ml b/lib/core_functions.ml index 083e0cf..059cd14 100644 --- a/lib/core_functions.ml +++ b/lib/core_functions.ml @@ -1,11 +1,27 @@ +(* open Ctypes *) + module Types = Types_generated module Functions (F : Ctypes.FOREIGN) = struct - open F + (* open F *) + open Ctypes_static + + let os_extension = + if Sys.os_type = "Unix" then + let ic = Unix.open_process_in "uname" in + let uname = input_line ic in + let () = close_in ic in + if uname = "Darwin" then "dylib" else "so" + else "dll" + + let libmerklecpp = + Dl.dlopen ~flags:[ RTLD_GLOBAL; RTLD_NOW ] + ~filename: + (Sys.getenv "LIBRELATIONAL_ENGINE_LIB_PATH" + ^ "/librelational_engine." ^ os_extension) let compute_hash = - foreign "compute_hash" - (F.(@->) (Ctypes.ptr Ctypes.char) - (F.(@->) Ctypes.string (F.returning Ctypes.void))) + Foreign.foreign ~from:libmerklecpp "compute_hash" + (ptr char @-> Ctypes.string @-> returning void) end diff --git a/lib/domain.ml b/lib/domain.ml new file mode 100644 index 0000000..753a7b9 --- /dev/null +++ b/lib/domain.ml @@ -0,0 +1,9 @@ +type t = { + name : Conventions.Name.t; + generator : Generator.t; + membership_criteria : Tuple.t -> bool; + cardinality : Conventions.Cardinality.t; +} + +let make ~name ~generator ~membership_criteria ~cardinality = + { name; generator; membership_criteria; cardinality } @@ -1,3 +1,4 @@ +(include_subdirs qualified) (library (name relational_engine) (libraries @@ -11,9 +12,7 @@ sexplib) (preprocess (pps ppx_deriving.show ppx_sexp_conv ppx_protocol_conv)) - (c_library_flags - (-L %{env:LIBRELATIONAL_ENGINE_LIB_PATH=}) - (-lrelational_engine)) + ;; (c_library_flags -lssl -lcrypto -L %{env:LIBRESSL_LIB_PATH=}) ;; (foreign_stubs ;; (language cxx) ;; (names merklecpp_stubs) diff --git a/lib/generator.ml b/lib/generator.ml new file mode 100644 index 0000000..44f1579 --- /dev/null +++ b/lib/generator.ml @@ -0,0 +1,6 @@ +type result = + | Done + | Value of Tuple.t * (int option -> result) + | Error of string + + and t = int option -> result
\ No newline at end of file diff --git a/lib/prelude/standard.ml b/lib/prelude/standard.ml new file mode 100644 index 0000000..43ffc44 --- /dev/null +++ b/lib/prelude/standard.ml @@ -0,0 +1,36 @@ +let less_than_natural: Relation.t = + let rec generator (position: int option): Generator.result = + let pair_of_nat n = + let nf = float_of_int n in + let r = + int_of_float (floor ((1. +. sqrt (1. +. 8. *. nf)) /. 2.)) + in + let t_prev = (r * (r - 1)) / 2 in + let left = n - t_prev in + (left, r) in + match position with + | Some position -> + let (left: Conventions.AbstractValue.t), (right: Conventions.AbstractValue.t) = + let (left_value, right_value) = pair_of_nat position in + ({ fields = Conventions.AbstractValue.StringMap.of_list [("value", string_of_int left_value)] }, + { fields = Conventions.AbstractValue.StringMap.of_list [("value", string_of_int right_value)] }) + in let attributes: Conventions.AbstractValue.t Tuple.AttributeMap.t = + Tuple.AttributeMap.of_list [("left", left); ("right", right)] + in Generator.Value (Tuple.make_materialized ~relation: "less_than" ~attributes: attributes, generator) + | None -> Error "Cannot produce a randomly enumerated value for less_than over naturals." + in let membership_criteria: Tuple.t -> bool = function + | Tuple.Materialized materialized -> + let left = Tuple.AttributeMap.find "left" materialized.attributes + in let right = Tuple.AttributeMap.find "right" materialized.attributes + in left < right + | Tuple.NonMaterialized _non_materialized -> false (* TODO: Handle references later *) + in Relation.make + ~hash: None + ~name: "natural_natural_less_than" + ~tree: None + ~constraints: None + ~cardinality: Conventions.Cardinality.AlephZero + ~generator: (Some generator) + ~membership_criteria: membership_criteria + ~provenance: (Relation.Provenance.Base "less_than") + ~lineage: (Relation.Lineage.Base "less_than")
\ No newline at end of file diff --git a/lib/relation.ml b/lib/relation.ml index f3f536a..705dcc5 100644 --- a/lib/relation.ml +++ b/lib/relation.ml @@ -1,61 +1,25 @@ -module Hash = struct - type t = Interop.Sha256.t - - let compare = String.compare -end - -module Name = struct - type t = string - - let compare = String.compare -end - module Tree = struct - type t = unit + type t = unit (* TODO: Radix Merkle tree here *) end -module Schema = struct - type t = (string, string) Hashtbl.t - - let create () = Hashtbl.create 16 -end - -module RelationConstraints = struct - type t = (string * string) list -end - -module Cardinality = struct - type t = Finite of int | AlephZero | Continuum -end - -module Generator = struct - type result = - | Done - | Value of (string, string) Hashtbl.t * t - | Error of string - - and t = (string, string) Hashtbl.t -> result -end - -module MembershipCriteria = struct - type t = (string, string) Hashtbl.t - - let create () = Hashtbl.create 16 +module RelationConstraint = struct + type name = string + type t = (name * Constraint.t) list end module Provenance = struct type t = | Undefined - | Base of Name.t + | Base of Conventions.Name.t | Join of t * t - | Select of t * MembershipCriteria.t + | Select of t * (Tuple.t -> bool) | Project of t * string list | Take of t * int end module Lineage = struct type t = - | Base of Name.t + | Base of Conventions.Name.t | Select of (string -> bool) * t | Project of string list * t | Join of string * t * t @@ -66,44 +30,27 @@ module Lineage = struct end type t = { - hash : Hash.t; - name : Name.t; + hash : Conventions.Hash.t option; + name : Conventions.Name.t; tree : Tree.t option; - schema : Schema.t; - constraints : RelationConstraints.t; - cardinality : Cardinality.t; + constraints : RelationConstraint.t option; + cardinality : Conventions.Cardinality.t; generator : Generator.t option; - membership_criteria : MembershipCriteria.t; + membership_criteria : Tuple.t -> bool; provenance : Provenance.t; lineage : Lineage.t; } -let make ~hash ~name ~tree ~schema ~constraints ~cardinality ~generator +let make ~hash ~name ~tree ~constraints ~cardinality ~generator ~membership_criteria ~provenance ~lineage = { hash; name; tree; - schema; constraints; cardinality; generator; membership_criteria; provenance; lineage; - } - -let compare left right = - match Name.compare left.name right.name with - | 0 -> Hash.compare left.hash right.hash - | n -> n - -module Ord = struct - type nonrec t = t - - let compare = compare -end - -module Set = Set.Make (Ord) -module Map = Map.Make (Ord) - + }
\ No newline at end of file diff --git a/lib/tuple.ml b/lib/tuple.ml new file mode 100644 index 0000000..07632db --- /dev/null +++ b/lib/tuple.ml @@ -0,0 +1,18 @@ +module AttributeMap = Map.Make(String) + +type non_materialized = { + hash : Conventions.Hash.t; + relation : Conventions.Name.t; + attributes : Conventions.Hash.t AttributeMap.t; +} + +type materialized = { + relation: Conventions.Name.t; + attributes: Conventions.AbstractValue.t AttributeMap.t +} + +type t = + | Materialized of materialized + | NonMaterialized of non_materialized + +let make_materialized ~relation ~attributes = Materialized { relation; attributes } |