From 755a00d0513819e0a617bbee2586e0d4dd85b7f0 Mon Sep 17 00:00:00 2001 From: Nikita Prokopov Date: Wed, 19 Jun 2024 01:21:07 +0200 Subject: [PATCH] Added util/if+ which allows sharing vars between if condition and then clause --- deps.edn | 2 + dev/user.clj | 6 +-- src/datascript/db.cljc | 36 +++++++++--------- src/datascript/util.cljc | 80 ++++++++++++++++++++++++++++++++++++++-- 4 files changed, 99 insertions(+), 25 deletions(-) diff --git a/deps.edn b/deps.edn index 44092959..22311563 100644 --- a/deps.edn +++ b/deps.edn @@ -22,11 +22,13 @@ :dev {:extra-paths ["dev"] + :jvm-opts ["-ea" "-Ddatascript.debug" "-Dclojure.main.report=stderr"] :extra-deps {io.github.tonsky/duti {:git/sha "fc833a87a8687b67e66281e216eeee1ad6048168"}}} :test {:extra-paths ["test"] + :jvm-opts ["-ea" "-Ddatascript.debug" "-Dclojure.main.report=stderr"] :extra-deps {org.clojure/clojurescript {:mvn/version "1.10.520"} metosin/jsonista {:mvn/version "0.3.3"} diff --git a/dev/user.clj b/dev/user.clj index f649ae6a..bb7930fe 100644 --- a/dev/user.clj +++ b/dev/user.clj @@ -7,10 +7,8 @@ (def reload duti/reload) -(defn -main [& {:as args}] - (set! *warn-on-reflection* true) - (require 'datascript.test) - (duti/start-socket-repl)) +(def -main + duti/-main) (defn test-all [] (duti/test #"datascript\.test\..*")) diff --git a/src/datascript/db.cljc b/src/datascript/db.cljc index dbf218b8..79b83eb1 100644 --- a/src/datascript/db.cljc +++ b/src/datascript/db.cljc @@ -56,7 +56,7 @@ :do `(do ~expr (cond+ ~@rest)) :let `(let ~expr (cond+ ~@rest)) :some `(or ~expr (cond+ ~@rest)) - `(if ~test ~expr (cond+ ~@rest)))))) + `(util/if+ ~test ~expr (cond+ ~@rest)))))) #?(:clj (defmacro some-of @@ -1354,17 +1354,13 @@ entity (assoc entity :db/id (auto-tempid)))) - (not (sequential? entity)) - entity - - :let [[op e a v] entity] - - (and (= :db/add op) (ref? db a)) - (cond - (and (multival? db a) (sequential? v)) + (and + (sequential? entity) + :let [[op e a v] entity] + (= :db/add op) + (ref? db a)) + (if (and (multival? db a) (sequential? v)) [op e a (assoc-auto-tempids db v)] - - :else [op e a (first (assoc-auto-tempids db [v]))]) :else @@ -1664,7 +1660,8 @@ (assoc tempid upserted-eid)) report' (-> initial-report (assoc :tempids tempids') - (update ::upserted-tempids assoc tempid upserted-eid))] + (update ::upserted-tempids assoc tempid upserted-eid))] + (util/log "retry" tempid "->" upserted-eid) (transact-tx-data-impl report' es)))) (def builtin-fn? @@ -1718,6 +1715,7 @@ initial-es)] (loop [report initial-report' es initial-es'] + (util/log "transact" es) (cond+ (empty? es) (-> report @@ -1858,8 +1856,9 @@ (or (= op :db/add) (= op :db/retract)) (not (::internal (meta entity))) (tuple? db a) - (not= v (resolve-tuple-refs db a v))) - (recur report (cons [op e a (resolve-tuple-refs db a v)] entities)) + :let [v' (resolve-tuple-refs db a v)] + (not= v v')) + (recur report (cons [op e a v'] entities)) (tempid? e) (let [upserted-eid (when (is-attr? db a :db.unique/identity) @@ -1873,11 +1872,12 @@ (and (is-attr? db a :db.unique/identity) (contains? (::reverse-tempids report) e) - (let [upserted-eid (:e (first (-datoms db :avet a v nil nil)))] - (and e upserted-eid (not= e upserted-eid)))) + :let [upserted-eid (:e (first (-datoms db :avet a v nil nil)))] + e + upserted-eid + (not= e upserted-eid)) (let [tempids (get (::reverse-tempids report) e) - tempid (util/find #(not (contains? (::upserted-tempids report) %)) tempids) - upserted-eid (:e (first (-datoms db :avet a v nil nil)))] + tempid (util/find #(not (contains? (::upserted-tempids report) %)) tempids)] (if tempid (retry-with-tempid initial-report report initial-es tempid upserted-eid) (raise "Conflicting upsert: " e " resolves to " upserted-eid " via " entity diff --git a/src/datascript/util.cljc b/src/datascript/util.cljc index 3b375067..991182b1 100644 --- a/src/datascript/util.cljc +++ b/src/datascript/util.cljc @@ -7,9 +7,83 @@ (def ^:dynamic *debug* false) -(defmacro log [& body] - `(when *debug* - (println ~@body))) +#?(:clj + (defmacro log [& body] + (when (System/getProperty "datascript.debug") + `(when *debug* + (println ~@body))))) + +#?(:clj + (def ^:private ^:dynamic *if+-syms)) + +#?(:clj + (defn- if+-rewrite-cond-impl [cond] + (clojure.core/cond + (empty? cond) + true + + (and + (= :let (first cond)) + (empty? (second cond))) + (if+-rewrite-cond-impl (nnext cond)) + + (= :let (first cond)) + (let [[var val & rest] (second cond) + sym (gensym)] + (vswap! *if+-syms conj [var sym]) + (list 'let [var (list 'clojure.core/vreset! sym val)] + (if+-rewrite-cond-impl + (cons + :let + (cons rest + (nnext cond)))))) + + :else + (list 'and + (first cond) + (if+-rewrite-cond-impl (next cond)))))) + +#?(:clj + (defn- if+-rewrite-cond [cond] + (binding [*if+-syms (volatile! [])] + [(if+-rewrite-cond-impl cond) @*if+-syms]))) + +#?(:clj + (defn- flatten-1 [xs] + (vec + (mapcat identity xs)))) + +#?(:clj + (defmacro if+ + "Allows sharing local variables between condition and then clause. + + Use `:let [...]` form (not nested!) inside `and` condition and its bindings + will be visible in later `and` clauses and inside `then` branch: + + (if+ (and + (= 1 2) + :let [x 3 + y (+ x 4)] + (> y x)) + (+ x y 5) + 6)" + [cond then else] + (if (and + (seq? cond) + (or + (= 'and (first cond)) + (= 'clojure.core/and (first cond)))) + (let [[cond' syms] (if+-rewrite-cond (next cond))] + `(let ~(flatten-1 + (for [[_ sym] syms] + [sym '(volatile! nil)])) + (if ~cond' + (let ~(flatten-1 + (for [[binding sym] syms] + [binding (list 'deref sym)])) + ~then) + ~else))) + (list 'if cond then else)))) (defn- rand-bits [pow] (rand-int (bit-shift-left 1 pow)))