Skip to content

Commit 8e203f7

Browse files
tonskytonsky
committed
Added util/if+ which allows sharing vars between if condition and then clause
1 parent 9ae1fd5 commit 8e203f7

File tree

4 files changed

+105
-25
lines changed

4 files changed

+105
-25
lines changed

‎deps.edn

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -22,11 +22,13 @@
2222

2323
:dev
2424
{:extra-paths ["dev"]
25+
:jvm-opts ["-ea" "-Ddatascript.debug" "-Dclojure.main.report=stderr"]
2526
:extra-deps
2627
{io.github.tonsky/duti {:git/sha "fc833a87a8687b67e66281e216eeee1ad6048168"}}}
2728

2829
:test
2930
{:extra-paths ["test"]
31+
:jvm-opts ["-ea" "-Ddatascript.debug" "-Dclojure.main.report=stderr"]
3032
:extra-deps
3133
{org.clojure/clojurescript {:mvn/version "1.10.520"}
3234
metosin/jsonista {:mvn/version "0.3.3"}

‎dev/user.clj

Lines changed: 2 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -7,10 +7,8 @@
77
(def reload
88
duti/reload)
99

10-
(defn -main [& {:as args}]
11-
(set! *warn-on-reflection* true)
12-
(require 'datascript.test)
13-
(duti/start-socket-repl))
10+
(def -main
11+
duti/-main)
1412

1513
(defn test-all []
1614
(duti/test #"datascript\.test\..*"))

‎src/datascript/db.cljc

Lines changed: 18 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -56,7 +56,7 @@
5656
:do `(do ~expr (cond+ ~@rest))
5757
:let `(let ~expr (cond+ ~@rest))
5858
:some `(or ~expr (cond+ ~@rest))
59-
`(if ~test ~expr (cond+ ~@rest))))))
59+
`(util/if+ ~test ~expr (cond+ ~@rest))))))
6060

6161
#?(:clj
6262
(defmacro some-of
@@ -1354,17 +1354,13 @@
13541354
entity
13551355
(assoc entity :db/id (auto-tempid))))
13561356

1357-
(not (sequential? entity))
1358-
entity
1359-
1360-
:let [[op e a v] entity]
1361-
1362-
(and (= :db/add op) (ref? db a))
1363-
(cond
1364-
(and (multival? db a) (sequential? v))
1357+
(and
1358+
(sequential? entity)
1359+
:let [[op e a v] entity]
1360+
(= :db/add op)
1361+
(ref? db a))
1362+
(if (and (multival? db a) (sequential? v))
13651363
[op e a (assoc-auto-tempids db v)]
1366-
1367-
:else
13681364
[op e a (first (assoc-auto-tempids db [v]))])
13691365

13701366
:else
@@ -1664,7 +1660,8 @@
16641660
(assoc tempid upserted-eid))
16651661
report' (-> initial-report
16661662
(assoc :tempids tempids')
1667-
(update ::upserted-tempids assoc tempid upserted-eid))]
1663+
(update ::upserted-tempids assoc tempid upserted-eid))]
1664+
(util/log "retry" tempid "->" upserted-eid)
16681665
(transact-tx-data-impl report' es))))
16691666

16701667
(def builtin-fn?
@@ -1718,6 +1715,7 @@
17181715
initial-es)]
17191716
(loop [report initial-report'
17201717
es initial-es']
1718+
(util/log "transact" es)
17211719
(cond+
17221720
(empty? es)
17231721
(-> report
@@ -1858,8 +1856,9 @@
18581856
(or (= op :db/add) (= op :db/retract))
18591857
(not (::internal (meta entity)))
18601858
(tuple? db a)
1861-
(not= v (resolve-tuple-refs db a v)))
1862-
(recur report (cons [op e a (resolve-tuple-refs db a v)] entities))
1859+
:let [v' (resolve-tuple-refs db a v)]
1860+
(not= v v'))
1861+
(recur report (cons [op e a v'] entities))
18631862

18641863
(tempid? e)
18651864
(let [upserted-eid (when (is-attr? db a :db.unique/identity)
@@ -1873,11 +1872,12 @@
18731872
(and
18741873
(is-attr? db a :db.unique/identity)
18751874
(contains? (::reverse-tempids report) e)
1876-
(let [upserted-eid (:e (first (-datoms db :avet a v nil nil)))]
1877-
(and e upserted-eid (not= e upserted-eid))))
1875+
:let [upserted-eid (:e (first (-datoms db :avet a v nil nil)))]
1876+
e
1877+
upserted-eid
1878+
(not= e upserted-eid))
18781879
(let [tempids (get (::reverse-tempids report) e)
1879-
tempid (util/find #(not (contains? (::upserted-tempids report) %)) tempids)
1880-
upserted-eid (:e (first (-datoms db :avet a v nil nil)))]
1880+
tempid (util/find #(not (contains? (::upserted-tempids report) %)) tempids)]
18811881
(if tempid
18821882
(retry-with-tempid initial-report report initial-es tempid upserted-eid)
18831883
(raise "Conflicting upsert: " e " resolves to " upserted-eid " via " entity

‎src/datascript/util.cljc

Lines changed: 83 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -7,9 +7,89 @@
77
(def ^:dynamic *debug*
88
false)
99

10-
(defmacro log [& body]
11-
`(when *debug*
12-
(println ~@body)))
10+
#?(:clj
11+
(defmacro log [& body]
12+
(when (System/getProperty "datascript.debug")
13+
`(when *debug*
14+
(println ~@body)))))
15+
16+
#?(:clj
17+
(def ^:private ^:dynamic *if+-syms))
18+
19+
#?(:clj
20+
(defn- if+-rewrite-cond-impl [cond]
21+
(clojure.core/cond
22+
(empty? cond)
23+
true
24+
25+
(and
26+
(= :let (first cond))
27+
(empty? (second cond)))
28+
(if+-rewrite-cond-impl (nnext cond))
29+
30+
(= :let (first cond))
31+
(let [[var val & rest] (second cond)
32+
sym (gensym)]
33+
(vswap! *if+-syms conj [var sym])
34+
(list 'let [var (list 'clojure.core/vreset! sym val)]
35+
(if+-rewrite-cond-impl
36+
(cons
37+
:let
38+
(cons rest
39+
(nnext cond))))))
40+
41+
:else
42+
(list 'and
43+
(first cond)
44+
(if+-rewrite-cond-impl (next cond))))))
45+
46+
#?(:clj
47+
(defn- if+-rewrite-cond [cond]
48+
(binding [*if+-syms (volatile! [])]
49+
[(if+-rewrite-cond-impl cond) @*if+-syms])))
50+
51+
#?(:clj
52+
(defn- flatten-1 [xs]
53+
(vec
54+
(mapcat identity xs))))
55+
56+
#?(:clj
57+
(defmacro if+
58+
"Allows sharing local variables between condition and then clause.
59+
60+
Use `:let [...]` form (not nested!) inside `and` condition and its bindings
61+
will be visible in later `and` clauses and inside `then` branch:
62+
63+
(if+ (and
64+
(= 1 2)
65+
;; same :let syntax as in doseq/for
66+
:let [x 3
67+
y (+ x 4)]
68+
;; x and y visible downstream
69+
(> y x))
70+
71+
;; then: x and y visible here!
72+
(+ x y 5)
73+
74+
;; else: no x or y
75+
6)"
76+
[cond then else]
77+
(if (and
78+
(seq? cond)
79+
(or
80+
(= 'and (first cond))
81+
(= 'clojure.core/and (first cond))))
82+
(let [[cond' syms] (if+-rewrite-cond (next cond))]
83+
`(let ~(flatten-1
84+
(for [[_ sym] syms]
85+
[sym '(volatile! nil)]))
86+
(if ~cond'
87+
(let ~(flatten-1
88+
(for [[binding sym] syms]
89+
[binding (list 'deref sym)]))
90+
~then)
91+
~else)))
92+
(list 'if cond then else))))
1393

1494
(defn- rand-bits [pow]
1595
(rand-int (bit-shift-left 1 pow)))

0 commit comments

Comments
 (0)