Added util/if+ which allows sharing vars between if condition and the…

…n clause

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"}

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\..*"))

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

src/datascript/util.cljc

@@ -7,9 +7,84 @@
 (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
+         (vector? (first cond))
+         (= :let (first (first cond)))
+         (empty? (next (first cond))))
+       (if+-rewrite-cond-impl (next cond))
+
+       (and
+         (vector? (first cond))
+         (= :let (first (first cond))))
+       (let [[_ var val & rest] (first cond)
+             sym (gensym)]
+         (vswap! *if+-syms conj [var sym])
+         (list 'let [var (list 'clojure.core/vreset! sym val)]
+           (if+-rewrite-cond-impl
+             (cons 
+               (vec (cons :let rest))
+               (next 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 inside `and` condition and its bindings will
+      be visible in later `and` clauses and inside `then` branch:
+      
+        (if+ (and
+               (= a b)
+               [:let x 1, y (+ x 2)]
+               (> y x))
+          (+ x y 3)
+          4)"
+     [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)))