Skip to content

Commit

Permalink
compiler: fix ::lang/pure lift, fix e/frame
Browse files Browse the repository at this point in the history
  • Loading branch information
@xificurC
xificurC committed Aug 7, 2024
1 parent f294425 commit 3a9c9d6
Show file tree
Hide file tree
Showing 3 changed files with 31 additions and 39 deletions.
10 changes: 6 additions & 4 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,8 @@
(::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 [pure (gensym "LANGPURE")]
(recur `(let* [~pure ~(cons ::pure-gen (next form))] ~pure) pe env ts))
(::pure) (let [pure (gensym "HF_PURE__")]
(recur `(let* [~pure ~(second form)] (::pure-gen ~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))))
Expand All @@ -650,7 +650,9 @@
;; Electric aggressively inlines locals, so the generated code size will stay the same.
(let [g (gensym "site-local")]
(recur `(::mklocal ~g (::bindlocal ~g ~form ~g)) pe env2 ts))))
(::frame) (ts/add ts {:db/id (->id), ::parent pe, ::type ::frame})
(::frame) (let [e (->id)] (-> ts
(ts/add {:db/id e, ::parent pe, ::type ::pure})
(ts/add {:db/id (->id), ::parent e, ::type ::frame})))
(::lookup) (let [[_ sym] form] (ts/add ts {:db/id (->id), ::parent pe, ::type ::lookup, ::sym sym}))
(::static-vars) (recur (second form) pe (assoc env ::static-vars true) ts)
(::debug) (recur (second form) pe (assoc env ::debug true) ts)
Expand Down Expand Up @@ -1015,7 +1017,7 @@
(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")
ts (cond-> ts (str/starts-with? (name (::k mklocal-nd)) "HF_PURE__")
(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)))
Expand Down
3 changes: 1 addition & 2 deletions src/hyperfiddle/electric_de.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -30,8 +30,7 @@
(defmacro sited-ctor [expr] `(::lang/ctor (::lang/site ~(::lang/current &env) ~expr)))
(defmacro $ [F & args] `(check-electric $ (lang/$ ~F ~@args)))

(defmacro frame []
`(::lang/pure (::lang/frame)))
(defmacro frame [] `(::lang/frame))

(defmacro pure "
Syntax :
Expand Down
57 changes: 24 additions & 33 deletions test/hyperfiddle/electric/impl/compiler_test.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -110,14 +110,11 @@
(fn [~'frame] (r/pure nil)))])

(match (l/test-compile ::Main (e/pure (e/server 2)))
`[(r/cdef 0 [nil :server nil] [] nil
`[(r/cdef 0 [:server nil] [] nil
(fn [~'frame]
(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))))])
(r/define-node ~'frame 0 (r/pure 2))
(r/define-node ~'frame 1 (r/node ~'frame 0))
(r/pure (r/incseq ~'frame (r/node ~'frame 1)))))])

(match (l/test-compile ::Main (let [x (e/server (identity 1))] (inc x)))
`[(r/cdef 0 [:server] [] nil
Expand Down Expand Up @@ -188,8 +185,8 @@
(match (l/test-compile ::Main (::lang/pure :foo))
`[(r/cdef 0 [nil] [] nil
(fn [~'frame]
(r/define-node ~'frame 0 (r/pure (r/pure :foo)))
(r/node ~'frame 0)))]))
(r/define-node ~'frame 0 (r/pure :foo))
(r/pure (r/node ~'frame 0))))]))

(tests "test-ctor"
(match (l/test-compile ::Main (::lang/ctor :foo))
Expand Down Expand Up @@ -457,17 +454,15 @@
(match (l/test-compile ::Main
(binding [inc dec, dec inc]
(inc (dec 0))))
`[(r/cdef 0 [nil nil nil nil] [nil] nil
`[(r/cdef 0 [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/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/join (r/call ~'frame 0))))
(r/cdef 0 [] [] nil
(fn [~'frame]
Expand Down Expand Up @@ -566,35 +561,31 @@
(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] nil
`[(r/cdef 0 [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 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/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/define-call ~'frame 1
(r/join
(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 2))))
(r/pure (r/ctor ::Main 1 (r/node ~'frame 1))))
(r/ap (r/lookup ~'frame ::r/invariant (r/pure r/invariant))
(r/pure (r/ctor ::Main 3 (r/node ~'frame 2)))))))
(r/pure (r/ctor ::Main 3 (r/node ~'frame 1)))))))
(r/join (r/call ~'frame 1))))
(r/cdef 1 [nil nil] [] nil
(r/cdef 1 [nil] [] nil
(fn [~'frame]
(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/define-node ~'frame 0
(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/pure (r/incseq ~'frame (r/node ~'frame 0)))))))
(r/cdef 0 [] [] nil
(fn [~'frame]
(r/lookup ~'frame ::foo)))
Expand Down

0 comments on commit 3a9c9d6

Please sign in to comment.