diff options
| -rw-r--r-- | bin/main.ml | 10 | ||||
| -rw-r--r-- | lib/attribute.ml | 29 | ||||
| -rw-r--r-- | lib/conventions.ml | 12 | ||||
| -rw-r--r-- | lib/prelude/standard.ml | 11 | ||||
| -rw-r--r-- | lib/tuple.ml | 4 |
5 files changed, 26 insertions, 40 deletions
diff --git a/bin/main.ml b/bin/main.ml index adbf1dc..46bb9f1 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -3,9 +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; + let tuple = + Relational_engine.Tuple.make_materialized + ~relation: "natural_less_than" + ~attributes: (Relational_engine.Tuple.AttributeMap.of_list [("left", Obj.magic 0); ("right", Obj.magic 1)]) + 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 index 05d33f4..27214b0 100644 --- a/lib/attribute.ml +++ b/lib/attribute.ml @@ -1,21 +1,14 @@ -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 referenced = { value_hash : Conventions.Hash.t } -type materialized = { - name: Conventions.Name.t; - value: Conventions.AbstractValue.t -} +type materialized = { 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 } +type t = + | Referenced of referenced + | Materialized of materialized -let make_with_hashes ~hash ~name ~name_hash ~value ~value_hash = - { hash; name; name_hash; value; value_hash } +let make_referenced ~value = + let value_hash = Conventions.AbstractValue.hash value in + Referenced { value_hash } + +let make_materialized ~value = + Materialized { value }
\ No newline at end of file diff --git a/lib/conventions.ml b/lib/conventions.ml index 74f6cc3..538bc5c 100644 --- a/lib/conventions.ml +++ b/lib/conventions.ml @@ -13,14 +13,6 @@ module Cardinality = struct 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 + type t = Obj.t + let hash (elem: t) = Interop.Sha256.compute_hash @@ Marshal.to_bytes elem [] end
\ No newline at end of file diff --git a/lib/prelude/standard.ml b/lib/prelude/standard.ml index 43ffc44..d6f8cf3 100644 --- a/lib/prelude/standard.ml +++ b/lib/prelude/standard.ml @@ -10,11 +10,12 @@ let less_than_natural: Relation.t = (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 = + let left, right = pair_of_nat position in + (* let left: Attribute.t = Attribute.make_materialized ~value: (Obj.magic left) in *) + (* let right: Attribute.t = Attribute.make_materialized ~value: (Obj.magic right) in *) + let left = Obj.magic left in + let right = Obj.magic right in + let attributes: Attribute.materialized 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." diff --git a/lib/tuple.ml b/lib/tuple.ml index 07632db..3c11fba 100644 --- a/lib/tuple.ml +++ b/lib/tuple.ml @@ -3,12 +3,12 @@ module AttributeMap = Map.Make(String) type non_materialized = { hash : Conventions.Hash.t; relation : Conventions.Name.t; - attributes : Conventions.Hash.t AttributeMap.t; + attributes : Attribute.referenced AttributeMap.t; } type materialized = { relation: Conventions.Name.t; - attributes: Conventions.AbstractValue.t AttributeMap.t + attributes: Attribute.materialized AttributeMap.t } type t = |
