Skip to content

Commit

Permalink
compiler: lift ::lang/pure's into nodes
Browse files Browse the repository at this point in the history
  • Loading branch information
@xificurC
xificurC committed Aug 7, 2024
1 parent 5fc3412 commit f294425
Show file tree
Hide file tree
Showing 2 changed files with 52 additions and 33 deletions.
9 changes: 7 additions & 2 deletions src/hyperfiddle/electric/impl/lang_de2.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -632,8 +632,11 @@
(::tag) (let [e (->id)] (recur (second form) e env
(-> (ts/add ts {:db/id e, ::parent pe, ::type ::call, ::uid (->uid), ::call-type ::tag})
(?add-source-map e form))))
(::pure) (let [e (->id)] (recur (second form) e env (-> (ts/add ts {:db/id e, ::parent pe, ::type ::pure})
(?add-source-map e form))))
(::pure) (let [pure (gensym "LANGPURE")]
(recur `(let* [~pure ~(cons ::pure-gen (next form))] ~pure) pe env ts))
(::pure-gen) (let [e (->id)]
(recur (second form) e env (-> (ts/add ts {:db/id e, ::parent pe, ::type ::pure})
(?add-source-map e form))))
(::join) (let [e (->id)] (recur (second form) e env (-> (ts/add ts {:db/id e, ::parent pe, ::type ::join})
(?add-source-map e form))))
(::site) (let [[_ site bform] form, current (::current env), env2 (assoc env ::current site)]
Expand Down Expand Up @@ -1012,6 +1015,8 @@
(recur (cond-> ac (= ::ctor (::type nd)) (conj e)) (::parent nd)))))
ctors-uid (mapv #(e->uid ts %) ctors-e)
localv-e (->localv-e ts mklocal-uid)
ts (cond-> ts (str/starts-with? (name (::k mklocal-nd)) "LANGPURE")
(ensure-node mklocal-uid))
ts (if-some [call-e (in-a-call? ts e mklocal-e)]
(-> ts (ts/upd mklocal-e ::in-call #(conj (or % #{}) (e->uid ts call-e)))
(ensure-node mklocal-uid))
Expand Down
76 changes: 45 additions & 31 deletions test/hyperfiddle/electric/impl/compiler_test.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -110,10 +110,14 @@
(fn [~'frame] (r/pure nil)))])

(match (l/test-compile ::Main (e/pure (e/server 2)))
`[(r/cdef 0 [:server] [] nil
`[(r/cdef 0 [nil :server nil] [] nil
(fn [~'frame]
(r/define-node ~'frame 0 (r/pure 2))
(r/pure (r/incseq ~'frame (r/node ~'frame 0)))))])
(r/define-node ~'frame 0 (r/pure ~'frame))
(r/define-node ~'frame 1 (r/pure 2))
(r/define-node ~'frame 2 (r/pure (r/node ~'frame 1)))
(r/ap (r/pure r/incseq)
(r/node ~'frame 0)
(r/node ~'frame 2))))])

(match (l/test-compile ::Main (let [x (e/server (identity 1))] (inc x)))
`[(r/cdef 0 [:server] [] nil
Expand Down Expand Up @@ -181,10 +185,11 @@
(r/node ~'frame 1)))))]))

(tests "test-pure"
(match (l/test-compile ::Main (::lang/site :client (::lang/pure :foo)))
`[(r/cdef 0 [] [] :client
(match (l/test-compile ::Main (::lang/pure :foo))
`[(r/cdef 0 [nil] [] nil
(fn [~'frame]
(r/pure (r/pure :foo))))]))
(r/define-node ~'frame 0 (r/pure (r/pure :foo)))
(r/node ~'frame 0)))]))

(tests "test-ctor"
(match (l/test-compile ::Main (::lang/ctor :foo))
Expand Down Expand Up @@ -452,19 +457,22 @@
(match (l/test-compile ::Main
(binding [inc dec, dec inc]
(inc (dec 0))))
`[(r/cdef 0 [nil nil] [nil] nil
(fn [~'frame]
(r/define-node ~'frame 0 (r/lookup ~'frame :clojure.core/dec (r/pure dec)))
(r/define-node ~'frame 1 (r/lookup ~'frame :clojure.core/inc (r/pure inc)))
(r/define-call ~'frame 0 (r/ap (r/pure (fn* []
(r/bind (r/ctor ::Main 1)
:clojure.core/inc (r/node ~'frame 0)
:clojure.core/dec (r/node ~'frame 1))))))
`[(r/cdef 0 [nil nil nil nil] [nil] nil
(fn [~'frame]
(r/define-node ~'frame 0 (r/lookup ~'frame :clojure.core/dec (r/pure clojure.core/dec)))
(r/define-node ~'frame 1 (r/lookup ~'frame :clojure.core/inc (r/pure clojure.core/inc)))
(r/define-node ~'frame 2 (r/pure (r/node ~'frame 0)))
(r/define-node ~'frame 3 (r/pure (r/node ~'frame 1)))
(r/define-call ~'frame 0
(r/ap (r/pure r/bind)
(r/pure (r/ctor ::Main 1))
(r/pure :clojure.core/inc) (r/node ~'frame 2)
(r/pure :clojure.core/dec) (r/node ~'frame 3)))
(r/join (r/call ~'frame 0))))
(r/cdef 0 [] [] nil
(fn [~'frame]
(r/ap (r/lookup ~'frame :clojure.core/inc (r/pure inc))
(r/ap (r/lookup ~'frame :clojure.core/dec (r/pure dec))
(r/ap (r/lookup ~'frame :clojure.core/inc (r/pure clojure.core/inc))
(r/ap (r/lookup ~'frame :clojure.core/dec (r/pure clojure.core/dec))
(r/pure 0)))))]))

(tests "test-ap-collapse"
Expand Down Expand Up @@ -558,35 +566,41 @@
(match (l/test-compile ::Main (let [x (binding [::foo 1] (::lang/lookup ::foo))]
(prn x)
(prn x)))
`[(r/cdef 0 [nil nil] [nil nil] nil
`[(r/cdef 0 [nil nil nil] [nil nil] nil
(fn [~'frame]
(r/define-node ~'frame 0 (r/pure 1))
(r/define-node ~'frame 1 (r/pure (r/node ~'frame 0)))
(r/define-call ~'frame 0
(r/ap (r/pure (fn* []
(r/bind (r/ctor ::Main 2)
::foo (r/node ~'frame 0))))))
(r/define-node ~'frame 1 (r/join (r/call ~'frame 0)))
(r/ap (r/pure r/bind)
(r/pure (r/ctor ::Main 2))
(r/pure ::foo) (r/node ~'frame 1)))
(r/define-node ~'frame 2 (r/join (r/call ~'frame 0)))
(r/define-call ~'frame 1
(r/join
(r/ap (r/lookup ~'frame :hyperfiddle.incseq/fixed (r/pure hyperfiddle.incseq/fixed))
(r/ap (r/lookup ~'frame ::i/fixed (r/pure i/fixed))
(r/ap (r/lookup ~'frame ::r/invariant (r/pure r/invariant))
(r/pure (r/ctor ::Main 1 (r/node ~'frame 1))))
(r/pure (r/ctor ::Main 1 (r/node ~'frame 2))))
(r/ap (r/lookup ~'frame ::r/invariant (r/pure r/invariant))
(r/pure (r/ctor ::Main 3 (r/node ~'frame 1)))))))
(r/pure (r/ctor ::Main 3 (r/node ~'frame 2)))))))
(r/join (r/call ~'frame 1))))
(r/cdef 1 [] [] nil
(r/cdef 1 [nil nil] [] nil
(fn [~'frame]
(r/join (r/ap (r/lookup ~'frame ::r/drain (r/pure r/drain))
(r/pure
(r/incseq ~'frame
(r/ap (r/lookup ~'frame :clojure.core/prn (r/pure prn))
(r/free ~'frame 0))))))))
(r/define-node ~'frame 0 (r/pure ~'frame))
(r/define-node ~'frame 1
(r/pure
(r/ap (r/lookup ~'frame :clojure.core/prn (r/pure clojure.core/prn))
(r/free ~'frame 0))))
(r/join
(r/ap (r/lookup ~'frame ::r/drain (r/pure r/drain))
(r/ap (r/pure r/incseq)
(r/node ~'frame 0)
(r/node ~'frame 1))))))
(r/cdef 0 [] [] nil
(fn [~'frame]
(r/lookup ~'frame ::foo)))
(r/cdef 1 [] [] nil
(fn [~'frame]
(r/ap (r/lookup ~'frame :clojure.core/prn (r/pure prn))
(r/ap (r/lookup ~'frame :clojure.core/prn (r/pure clojure.core/prn))
(r/free ~'frame 0))))]))

(comment
Expand Down

0 comments on commit f294425

Please sign in to comment.