Bind entity-bound vars in pattern value position; widen Instant to int64 with cljs transit reps; fix multival 2-vector disambiguation

.github/workflows/ci.yml

@@ -18,7 +18,7 @@ jobs:
     strategy:
       fail-fast: false
       matrix:
-        ocaml-compiler: ["5.2.1"]
+        ocaml-compiler: ["5.5.1"]
 
     steps:
       - name: Checkout
@@ -50,9 +50,25 @@ jobs:
       - name: Install system dependencies
         run: sudo apt-get update && sudo apt-get install -y libsqlite3-dev pkg-config
 
+      - name: Restore opam switch cache
+        id: opam-cache
+        uses: actions/cache/restore@v4
+        with:
+          path: ~/.opam
+          key: ${{ runner.os }}-ocaml-${{ matrix.ocaml-compiler }}-opam-${{ hashFiles('*.opam') }}
+          restore-keys: |
+            ${{ runner.os }}-ocaml-${{ matrix.ocaml-compiler }}-opam-
+
       - name: Install OCaml dependencies
         run: opam install . --deps-only --with-test -y
 
+      - name: Save opam switch cache
+        if: steps.opam-cache.outputs.cache-hit != 'true'
+        uses: actions/cache/save@v4
+        with:
+          path: ~/.opam
+          key: ${{ steps.opam-cache.outputs.cache-primary-key }}
+
       - name: Cache upstream DataScript
         id: cache-upstream-datascript
         uses: actions/cache@v4

bench/memory_scenario.ml

@@ -162,7 +162,7 @@ let canonical_value attr = function
   | Float value -> "float:" ^ string_of_float value
   | Nil -> "nil"
   | Uuid value -> "uuid:" ^ value
-  | Instant value -> "instant:" ^ string_of_int value
+  | Instant value -> "instant:" ^ Int64.to_string value
   | Regex value -> "regex:" ^ value
   | TxRef -> "tx-ref"
   | Ref_to _ -> "ref-to"

datascript-ocaml-lg.opam

@@ -10,3 +10,6 @@ depends: [
   "lg"
 ]
 build: [["dune" "build" "-p" name "-j" jobs]]
+pin-depends: [
+  ["lg.dev" "git+https://github.com/logseq/lg.git#main"]
+]

examples/logseq_query_runner.ml

@@ -42,7 +42,7 @@ let rec edn_value = function
   | Bool false -> "false"
   | Keyword value -> edn_keyword value
   | Uuid value -> "#uuid " ^ json_string value
-  | Instant value -> string_of_int value
+  | Instant value -> Int64.to_string value
   | Regex value -> "#\"" ^ String.escaped value ^ "\""
   | Ref value -> string_of_int value
   | List values -> "(" ^ String.concat " " (List.map edn_value values) ^ ")"

examples/logseq_sqlite_storage.ml

@@ -246,8 +246,8 @@ let rec value_to_transit = function
   | Symbol value -> Transit.Symbol value
   | Bool value -> Transit.Bool value
   | Keyword value -> Transit.Keyword value
-  | Uuid value -> Transit.Tagged ("u", Transit.String value)
-  | Instant value -> Transit.Tagged ("m", Transit.Int value)
+  | Uuid value -> Transit.Uuid value
+  | Instant value -> Transit.Date value
   | Regex value -> Transit.Tagged ("regex", Transit.String value)
   | Ref entity_id -> Transit.Int entity_id
   | List values -> Transit.List (List.map value_to_transit values)
@@ -393,12 +393,12 @@ let rec value_of_transit = function
     if value >= Int64.of_int min_int && value <= Int64.of_int max_int then
       Int (Int64.to_int value)
     else
-      Instant (Int64.to_int value)
+      Instant value
   | Transit.Float value -> Float value
   | Transit.Binary value -> String value
   | Transit.Big_decimal value -> Float (float_of_string value)
   | Transit.Big_int value -> Transit.Int64 (Int64.of_string value) |> value_of_transit
-  | Transit.Date value -> Instant (Int64.to_int value)
+  | Transit.Date value -> Instant value
   | Transit.Uuid value -> Uuid value
   | Transit.Uri value -> String value
   | Transit.Keyword value -> Keyword value
@@ -409,8 +409,8 @@ let rec value_of_transit = function
   | Transit.Set values -> Set (List.map value_of_transit values)
   | Transit.List values -> List (List.map value_of_transit values)
   | Transit.Tagged ("u", Transit.String value) -> Uuid value
-  | Transit.Tagged ("m", Transit.Int value) -> Instant value
-  | Transit.Tagged ("m", Transit.Int64 value) -> Instant (Int64.to_int value)
+  | Transit.Tagged ("m", Transit.Int value) -> Instant (Int64.of_int value)
+  | Transit.Tagged ("m", Transit.Int64 value) -> Instant value
   | Transit.Tagged ("regex", Transit.String value) -> Regex value
   | Transit.Tagged (tag, value) ->
     Vector [ String tag; value_of_transit value ]

impl/built_ins.ml

@@ -290,7 +290,7 @@ let string_of_query_value = function
   | Bool false -> "false"
   | Keyword value -> ":" ^ value
   | Uuid value -> value
-  | Instant value -> string_of_int value
+  | Instant value -> Int64.to_string value
   | Regex value -> value
   | Ref entity_id -> string_of_int entity_id
   | List _ | Vector _ | Map _ | Set _ | Tuple _ | TxRef | Ref_to _ -> invalid_arg "cannot stringify composite query value"
@@ -320,7 +320,7 @@ let rec print_query_value ~readably = function
   | Bool false -> "false"
   | Keyword value -> ":" ^ value
   | Uuid value -> value
-  | Instant value -> string_of_int value
+  | Instant value -> Int64.to_string value
   | Regex value -> "#\"" ^ value ^ "\""
   | Ref entity_id -> string_of_int entity_id
   | List values -> "(" ^ print_query_values ~readably values ^ ")"

impl/datascript.ml

@@ -191,7 +191,7 @@ let rec edn_string_of_value = function
   | Keyword value -> ":" ^ value
   | Symbol value -> value
   | Uuid value -> "#uuid \"" ^ value ^ "\""
-  | Instant millis -> string_of_int millis
+  | Instant millis -> Int64.to_string millis
   | Regex value -> "#\"" ^ String.escaped value ^ "\""
   | Ref entity_id -> string_of_int entity_id
   | TxRef -> ":db/current-tx"
@@ -352,6 +352,7 @@ let transact_resolve_context : Transact_impl.context =
   ; is_reverse_ref
   ; reverse_ref
   ; cardinality
+  ; is_unique_identity
   ; max_eid_with_entity_id = Db_impl.max_eid_with_entity_id
   ; max_eid_in_value
   }
@@ -688,8 +689,15 @@ let transact_apply_context : Transact_impl.apply_context =
   { resolve_context = transact_resolve_context
   ; is_filtered
   ; schema_from_transaction_datoms =
-      (fun ~strict ~removed_attrs ~removed_fields ~ignored_schema_entities schema datoms ->
-        schema_from_transaction_datoms ~strict ~removed_attrs ~removed_fields ~ignored_schema_entities schema datoms)
+      (fun ?(validate = true) ~strict ~removed_attrs ~removed_fields ~ignored_schema_entities schema datoms ->
+        schema_from_transaction_datoms
+          ~validate
+          ~strict
+          ~removed_attrs
+          ~removed_fields
+          ~ignored_schema_entities
+          schema
+          datoms)
   ; schema_datoms = schema_datoms_for_tx
   ; schema_fields
   ; current_attr_value = current_attr_value_db
@@ -1092,6 +1100,9 @@ let query_entity_id_term db = function
 
 let query_value_term = function
   | QValue value -> Some value
+  (* a variable bound to an entity id substitutes to QEntity; in value position
+     that entity is the ref value of the datom *)
+  | QEntity entity_id -> Some (Ref entity_id)
   | _ -> None
 
 let query_tx_term = function

impl/parser.ml

@@ -64,7 +64,11 @@ let parse_instant_millis value =
   in
   let days = days_from_civil year month day in
   let local_minutes = ((days * 24 + hour) * 60) + minute in
-  (((local_minutes - timezone_offset_minutes) * 60 + second) * 1000) + millis
+  (* epoch milliseconds exceed int32; compute in int64 *)
+  let ( - ) = Int64.sub and ( + ) = Int64.add and ( * ) = Int64.mul in
+  let to_i = Int64.of_int in
+  (((to_i local_minutes - to_i timezone_offset_minutes) * 60L + to_i second) * 1000L)
+  + to_i millis
 
 let read_edn input =
   let length = String.length input in
@@ -335,7 +339,7 @@ let rec query_form_of_value = function
   | Map entries ->
     QueryFormMap (List.map (fun (key, value) -> query_form_of_value key, query_form_of_value value) entries)
   | Uuid value -> QueryFormTagged ("uuid", QueryFormString value)
-  | Instant value -> QueryFormInt value
+  | Instant value -> QueryFormInt (Int64.to_int value)
   | Regex value -> QueryFormTagged ("regex", QueryFormString value)
   | Ref entity_id -> QueryFormInt entity_id
   | TxRef

impl/pull_parser.ml

@@ -100,7 +100,7 @@ let pull_string_of_value = function
   | Bool false -> "false"
   | Keyword value -> ":" ^ value
   | Uuid value -> value
-  | Instant value -> string_of_int value
+  | Instant value -> Int64.to_string value
   | Regex value -> value
   | Ref entity_id -> string_of_int entity_id
   | List _ | Vector _ | Map _ | Set _ | Tuple _ | TxRef | Ref_to _ -> invalid_arg "cannot stringify composite pull value"

impl/schema.ml

@@ -285,6 +285,7 @@ let replace_schema_attr schema (attr, spec) =
 
 let schema_from_transaction_datoms
       ?(strict = true)
+      ?(validate = true)
       ?(removed_attrs = [])
       ?(removed_fields = [])
       ?(ignored_schema_entities = [])
@@ -302,7 +303,7 @@ let schema_from_transaction_datoms
          | Some entry -> replace_schema_attr schema entry
          | None -> schema)
        schema
-  |> validate_schema
+  |> fun schema -> if validate then validate_schema schema else schema
 
 
 let split_namespaced_attr attr =

impl/schema.mli

@@ -9,6 +9,7 @@ val schema_has_no_history : schema -> attr -> bool
 val schema_fields : attr list
 val schema_from_transaction_datoms :
   ?strict:bool ->
+  ?validate:bool ->
   ?removed_attrs:attr list ->
   ?removed_fields:(attr * attr) list ->
   ?ignored_schema_entities:entity_id list ->

impl/transact.ml

@@ -12,6 +12,7 @@ type context =
   ; is_reverse_ref : attr -> bool
   ; reverse_ref : attr -> attr
   ; cardinality : db -> attr -> cardinality
+  ; is_unique_identity : db -> attr -> bool
   ; max_eid_with_entity_id : int -> entity_id -> entity_id
   ; max_eid_in_value : int -> value -> int
   }
@@ -186,10 +187,13 @@ let resolve_value_for_attr context db attr datoms tx max_eid tempids value =
 let attr_expands_collection context db attr =
   context.cardinality db attr = Many || context.is_reverse_ref attr
 
-let ref_lookup_collection_value = function
-  | (List _ | Vector _) as value ->
-    (match entity_ref_of_ref_attr_value value with
-     | Some _ -> true
+(* upstream maybe-wrap-multival: in a multival context a 2-element collection is
+   a lookup ref only when its head names a :db.unique/identity attr; any other
+   collection expands into individual values *)
+let ref_lookup_collection_value context db = function
+  | List [ attr; _ ] | Vector [ attr; _ ] ->
+    (match attr_name_of_value attr with
+     | Some attr -> context.is_unique_identity db attr
      | None -> false)
   | _ -> false
 
@@ -209,7 +213,7 @@ let resolve_optional_existing_entity_ref context db datoms tx max_eid tempids =
     Some e, max_eid, tempids
 
 let resolve_tx_value_for_attr context db attr datoms tx max_eid tempids = function
-  | One_value ((List values | Vector values) as value) when attr_expands_collection context db attr && not (ref_lookup_collection_value value) ->
+  | One_value ((List values | Vector values) as value) when attr_expands_collection context db attr && not (ref_lookup_collection_value context db value) ->
     let values, max_eid, tempids =
       List.fold_left
         (fun (values, max_eid, tempids) value ->
@@ -309,7 +313,7 @@ let remap_tempid_entity old_e new_e tempids =
 type apply_context =
   { resolve_context : context
   ; is_filtered : db -> bool
-  ; schema_from_transaction_datoms : strict:bool -> removed_attrs:attr list -> removed_fields:(attr * attr) list -> ignored_schema_entities:entity_id list -> schema -> datom list -> schema
+  ; schema_from_transaction_datoms : ?validate:bool -> strict:bool -> removed_attrs:attr list -> removed_fields:(attr * attr) list -> ignored_schema_entities:entity_id list -> schema -> datom list -> schema
   ; schema_datoms : db -> datom list -> datom list
   ; schema_fields : attr list
   ; current_attr_value : db -> entity_id -> attr -> value option
@@ -359,8 +363,12 @@ let apply_tx context tx_ops db =
   in
   let refresh_schema tx_db tx_data =
     let schema_datoms = context.schema_datoms (db_with_current_metadata tx_db) tx_data in
+    (* mid-tx refreshes can see a partially-installed schema spec (e.g.
+       db.type/tuple before its db/tupleTypes land); upstream does not
+       revalidate the whole schema during a transaction *)
     current_schema
     := context.schema_from_transaction_datoms
+         ~validate:false
          ~strict:false
          ~removed_attrs:!removed_schema_attrs
          ~removed_fields:!removed_schema_fields

impl/transact.mli

@@ -12,6 +12,7 @@ type context =
   ; is_reverse_ref : attr -> bool
   ; reverse_ref : attr -> attr
   ; cardinality : db -> attr -> cardinality
+  ; is_unique_identity : db -> attr -> bool
   ; max_eid_with_entity_id : int -> entity_id -> entity_id
   ; max_eid_in_value : int -> value -> int
   }
@@ -28,7 +29,7 @@ val entity_ref_of_ref_attr_value : value -> entity_ref option
 val ref_attr_for_value_resolution : context -> db -> attr -> attr option
 val resolve_value_for_attr : context -> db -> attr -> db -> tx -> entity_id -> (string * entity_id) list -> value -> value * entity_id * (string * entity_id) list
 val attr_expands_collection : context -> db -> attr -> bool
-val ref_lookup_collection_value : value -> bool
+val ref_lookup_collection_value : context -> db -> value -> bool
 val resolve_existing_entity_ref : context -> db -> db -> tx -> entity_id -> (string * entity_id) list -> entity_ref -> entity_id * entity_id * (string * entity_id) list
 val resolve_optional_existing_entity_ref : context -> db -> db -> tx -> entity_id -> (string * entity_id) list -> entity_ref -> entity_id option * entity_id * (string * entity_id) list
 val resolve_tx_value_for_attr : context -> db -> attr -> db -> tx -> entity_id -> (string * entity_id) list -> tx_value -> tx_value * entity_id * (string * entity_id) list
@@ -42,7 +43,7 @@ val remap_tempid_entity : entity_id -> entity_id -> (string * entity_id) list ->
 type apply_context =
   { resolve_context : context
   ; is_filtered : db -> bool
-  ; schema_from_transaction_datoms : strict:bool -> removed_attrs:attr list -> removed_fields:(attr * attr) list -> ignored_schema_entities:entity_id list -> schema -> datom list -> schema
+  ; schema_from_transaction_datoms : ?validate:bool -> strict:bool -> removed_attrs:attr list -> removed_fields:(attr * attr) list -> ignored_schema_entities:entity_id list -> schema -> datom list -> schema
   ; schema_datoms : db -> datom list -> datom list
   ; schema_fields : attr list
   ; current_attr_value : db -> entity_id -> attr -> value option

impl/util.ml

@@ -264,7 +264,7 @@ let rec clojure_hasheq = function
     |> murmur3_hash_ordered
   | Ref value -> murmur3_hash_long (Int64.of_int value)
   | Uuid value -> java_uuid_hash value
-  | Instant value -> murmur3_hash_long (Int64.of_int value)
+  | Instant value -> murmur3_hash_long value
   | Regex value -> Hashtbl.hash value
   | TxRef -> Hashtbl.hash TxRef
   | Ref_to value -> Hashtbl.hash (Ref_to value)

js/datascript_js.ml

@@ -217,7 +217,7 @@ let rec json_of_value = function
   | Bool value -> `Bool value
   | Keyword value -> `String (":" ^ value)
   | Uuid value -> `String value
-  | Instant value -> `Int value
+  | Instant value -> `Intlit (Int64.to_string value)
   | Regex value -> `String value
   | Ref entity_id -> `Int entity_id
   | List values | Vector values | Set values -> `List (List.map json_of_value values)

melange/datascript_melange_storage.ml

@@ -182,8 +182,8 @@ let rec value_to_transit = function
   | Symbol value -> Transit.Symbol value
   | Bool value -> Transit.Bool value
   | Keyword value -> Transit.Keyword value
-  | Uuid value -> Transit.Tagged ("u", Transit.String value)
-  | Instant value -> Transit.Tagged ("m", Transit.Int value)
+  | Uuid value -> Transit.Uuid value
+  | Instant value -> Transit.Date value
   | Regex value -> Transit.Tagged ("regex", Transit.String value)
   | Ref entity_id -> Transit.Int entity_id
   | List values -> Transit.List (List.map value_to_transit values)
@@ -211,12 +211,12 @@ let rec value_of_transit = function
         Int64.compare value (Int64.of_int min_int) >= 0
         && Int64.compare value (Int64.of_int max_int) <= 0
       then Int (Int64.to_int value)
-      else Instant (Int64.to_int value)
+      else Instant value
   | Float value -> Float value
   | Binary value -> String value
   | Big_decimal value -> Float (float_of_string value)
   | Big_int value -> Transit.Int64 (Int64.of_string value) |> value_of_transit
-  | Date value -> Instant (Int64.to_int value)
+  | Date value -> Instant value
   | Uuid value -> Uuid value
   | Uri value -> String value
   | Keyword value -> Keyword value
@@ -226,8 +226,8 @@ let rec value_of_transit = function
   | Set values -> Set (List.map value_of_transit values)
   | List values -> List (List.map value_of_transit values)
   | Tagged ("u", Transit.String value) -> Uuid value
-  | Tagged ("m", Transit.Int value) -> Instant value
-  | Tagged ("m", Transit.Int64 value) -> Instant (Int64.to_int value)
+  | Tagged ("m", Transit.Int value) -> Instant (Int64.of_int value)
+  | Tagged ("m", Transit.Int64 value) -> Instant value
   | Tagged ("regex", Transit.String value) -> Regex value
   | Tagged (tag, value) -> Vector [ String tag; value_of_transit value ]
 

sqlite/datascript_sqlite_codec.ml

@@ -182,8 +182,8 @@ let rec value_to_transit = function
   | Symbol value -> Transit.Symbol value
   | Bool value -> Transit.Bool value
   | Keyword value -> Transit.Keyword value
-  | Uuid value -> Transit.Tagged ("u", Transit.String value)
-  | Instant value -> Transit.Tagged ("m", Transit.Int value)
+  | Uuid value -> Transit.Uuid value
+  | Instant value -> Transit.Date value
   | Regex value -> Transit.Tagged ("regex", Transit.String value)
   | Ref entity_id -> Transit.Int entity_id
   | List values -> Transit.List (List.map value_to_transit values)
@@ -211,12 +211,12 @@ let rec value_of_transit = function
         Int64.compare value (Int64.of_int min_int) >= 0
         && Int64.compare value (Int64.of_int max_int) <= 0
       then Int (Int64.to_int value)
-      else Instant (Int64.to_int value)
+      else Instant value
   | Float value -> Float value
   | Binary value -> String value
   | Big_decimal value -> Float (float_of_string value)
   | Big_int value -> Transit.Int64 (Int64.of_string value) |> value_of_transit
-  | Date value -> Instant (Int64.to_int value)
+  | Date value -> Instant value
   | Uuid value -> Uuid value
   | Uri value -> String value
   | Keyword value -> Keyword value
@@ -226,8 +226,8 @@ let rec value_of_transit = function
   | Set values -> Set (List.map value_of_transit values)
   | List values -> List (List.map value_of_transit values)
   | Tagged ("u", Transit.String value) -> Uuid value
-  | Tagged ("m", Transit.Int value) -> Instant value
-  | Tagged ("m", Transit.Int64 value) -> Instant (Int64.to_int value)
+  | Tagged ("m", Transit.Int value) -> Instant (Int64.of_int value)
+  | Tagged ("m", Transit.Int64 value) -> Instant value
   | Tagged ("regex", Transit.String value) -> Regex value
   | Tagged (tag, value) -> Vector [ String tag; value_of_transit value ]
 

test/cross_runtime_ocaml.ml

@@ -78,7 +78,7 @@ let rec value_json = function
   | Bool value -> json_bool value
   | Keyword value -> json_string (":" ^ value)
   | Uuid value -> json_string value
-  | Instant value -> json_int value
+  | Instant value -> json_int (Int64.to_int value)
   | Regex value -> json_string value
   | Ref value -> json_int value
   | List values | Vector values | Set values -> json_list (List.map value_json values)