Skip to content

Commit

Permalink
compiler: if
Browse files Browse the repository at this point in the history
  • Loading branch information
@xificurC
xificurC committed Jan 24, 2024
1 parent 20d94ff commit aab7c70
Show file tree
Hide file tree
Showing 3 changed files with 48 additions and 28 deletions.
8 changes: 5 additions & 3 deletions src/hyperfiddle/electric/impl/lang_de2.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -41,8 +41,8 @@
(assoc cljs-env :ns ast)
(if-some [src (cljs-ana/locate-src nssym)]
(let [ast (:ast (with-redefs [cljs-ana/missing-use-macro? (constantly nil)]
(binding [cljs-ana/*passes* []]
(cljs-ana/parse-ns src {:load-macros true, :restore false}))))]
(binding [cljs-ana/*passes* [cljs-ana/ns-side-effects]]
(cljs-ana/parse-ns src {:load-macros true, :analyze-deps true, :restore false}))))]
;; we parsed the ns form without `ns-side-effects` because it triggers weird bugs
;; this means the macro nss from `:require-macros` might not be loaded
(run! serialized-require (-> ast :require-macros vals set))
Expand Down Expand Up @@ -210,6 +210,8 @@
clauses2)
has-default-clause? (conj (xpand (last clauses)))))))

(if) (let [[_ test then else] o] (?meta o (list 'case test '(nil false) else then)))

(quote) o

(fn*) (let [[?name more] (if (symbol? (second o)) [(second o) (nnext o)] [nil (next o)])
Expand Down Expand Up @@ -242,7 +244,7 @@
(?meta o (list 'set! (-expand-all (nth o 1) env) (-expand-all (nth o 2) env))))

(::site) (?meta o (seq (conj (into [] (take 2) o)
(-expand-all (cons 'do (drop 2 o)) (assoc env ::current (second o))))))
(-expand-all (cons 'do (drop 2 o)) (assoc env ::current (second o))))))

#_else
(if (symbol? (first o))
Expand Down
21 changes: 18 additions & 3 deletions test/hyperfiddle/electric/impl/compiler_test.cljc
View file
Original file line number Diff line number Diff line change
@@ -1,13 +1,13 @@
(ns hyperfiddle.electric.impl.compiler-test
(:require [hyperfiddle.electic :as-alias e]
[hyperfiddle.incseq :as i]
[hyperfiddle.electric.impl.lang-de2 :as lang]
#?(:clj [hyperfiddle.electric.impl.lang-de2 :as lang])
[hyperfiddle.electric.impl.runtime-de :as r]
[hyperfiddle.electric-local-def-de :as l]
#?(:clj [hyperfiddle.electric.impl.compiler-test-clj :refer [cannot-be-unsited]]
:cljs [hyperfiddle.electric.impl.compiler-test-cljs :refer [cannot-be-unsited]])
[hyperfiddle.rcf :as rcf :refer [tests]]
[contrib.test-match :as tm]
#?(:clj [contrib.test-match :as tm])
[fipp.edn]
[missionary.core :as m])
#?(:clj (:import [clojure.lang ExceptionInfo])))
Expand Down Expand Up @@ -374,7 +374,22 @@
(fn [~'frame]
(r/pure :else)))])

;; (match (l/test-compile ::Main (if 1 2 3)))
(match (l/test-compile ::Main (if 1 2 3))
`[(r/cdef 0 [nil] [nil] nil
(fn [~'frame]
(r/define-node ~'frame 0 (r/pure (r/make-ctor ~'frame ::Main 1)))
(r/define-call ~'frame 0 (r/ap (r/ap (r/lookup ~'frame :clojure.core/hash-map (r/pure clojure.core/hash-map))
(r/pure 'nil) (r/node ~'frame 0)
(r/pure 'false) (r/node ~'frame 0))
(r/pure 1)
(r/pure (r/make-ctor ~'frame ::Main 2))))
(r/join (r/call ~'frame 0))))
(r/cdef 0 [] [] nil
(fn [~'frame]
(r/pure 3)))
(r/cdef 0 [] [] nil
(fn [~'frame]
(r/pure 2)))])
)

;; TODO test site is cleared on ctor boundary
Expand Down
47 changes: 25 additions & 22 deletions test/hyperfiddle/electric/impl/expand_de_test.cljc
View file
Original file line number Diff line number Diff line change
@@ -1,17 +1,17 @@
(ns hyperfiddle.electric.impl.expand-de-test
(:require #?(:clj [cljs.env])
#?(:clj [cljs.analyzer])
#?(:clj [hyperfiddle.electric.impl.lang-de :as c])
#?(:clj [hyperfiddle.electric.impl.lang-de2 :as l])
#?(:clj [hyperfiddle.electric.impl.runtime-de :as r])
#?(:clj [hyperfiddle.electric :as-alias e])
[hyperfiddle.electric.impl.expand-require-referred :as ref :refer [referred]]
#?(:clj [hyperfiddle.rcf :as rcf :refer [tests]]))
#?(:cljs (:require-macros [hyperfiddle.electric.impl.expand-macro :as mac :refer [twice]])))

#?(:clj
(defmacro all [o] `(c/expand-all ~(if (:js-globals &env)
(assoc &env ::c/peers {:client :cljs, :server :cljs}, ::c/current :client)
{:locals &env, ::c/peers {:client :clj, :server :clj}, ::c/current :client})
(defmacro all [o] `(l/expand-all ~(if (:js-globals &env)
(assoc &env ::l/peers {:client :cljs, :server :cljs}, ::l/current :client)
{:locals &env, ::l/peers {:client :clj, :server :clj}, ::l/current :client})
~o)))

#?(:clj (defmacro test-peer-expansion [] (if (:js-globals &env) :cljs :clj)))
Expand Down Expand Up @@ -57,6 +57,9 @@
(all '(case (-> 1 inc) (2) (-> 2 inc) (with-open) 3 4)) := '(case (inc 1) (2) (inc 2) (with-open) 3 4)
(has-line-meta? (all '(case (-> 1 inc) (2) (-> 2 inc) (with-open) 3 4))) := true

(all '(if 1 2 3)) := '(case 1 (nil false) 3 2)
(has-line-meta? (all '(if 1 2 3))) := true

(all ''(-> 1 inc)) := ''(-> 1 inc)

(all '(fn [x] 1)) := '(fn* ([x] 1))
Expand All @@ -75,7 +78,7 @@
(->> [x] x)]
(-> (->> x) inc)))]
x := '(let* [[foo bar baz ->>]
(::c/letfn [foo (fn* foo ([with-open] (with-open 1)))
(::l/letfn [foo (fn* foo ([with-open] (with-open 1)))
bar (fn* bar ([x] (inc x)))
baz (fn* baz ([x] (->> x)))
->> (fn* ->> ([x] x))])]
Expand Down Expand Up @@ -109,7 +112,7 @@

(let [x (all '(loop [with-open inc, x 2] (-> x with-open)))]
x := `(~'binding [r/rec
(::c/closure
(::l/closure
(let* [~'with-open r/%0, ~'x r/%1]
(~'with-open ~'x)))]
(new r/rec ~'inc 2))
Expand All @@ -127,7 +130,7 @@

(all '(hyperfiddle.impl.expand-test/X.)) := '(new hyperfiddle.impl.expand-test/X)

(c/-expand-all '(#{:ok} 1) {:js-globals {}})
(l/-expand-all '(#{:ok} 1) {:js-globals {}})

"cljs var lookup doesn't produce undeclared-ns warnings"
(let [!warns (atom [])]
Expand All @@ -136,41 +139,41 @@
(when (typ cljs.analyzer/*cljs-warnings*)
(swap! !warns conj [typ env extra])))]
(binding [*err* *out*]
(with-out-str (c/-expand-all '(r/reflect 1) {::c/peers {:client :cljs, :server :clj} ::c/current :client})))))
(with-out-str (l/-expand-all '(r/reflect 1) {::l/peers {:client :cljs, :server :clj} ::l/current :client})))))
@!warns := [])

"expansion is peer-aware"
(c/expand-all {::c/peers {:client :cljs, :server :clj}, ::c/current :server}
`[(test-peer-expansion) (::c/toggle :client {} (test-peer-expansion))])
:= `[:clj (::c/toggle :client {} :cljs)]
(l/expand-all {::l/peers {:client :cljs, :server :clj}, ::l/current :server}
`[(test-peer-expansion) (::l/site :client (test-peer-expansion))])
:= `[:clj (::l/site :client :cljs)]

(c/expand-all {::c/peers {:client :cljs, :server :clj}, ::c/current :client}
`[(test-peer-expansion) (::c/toggle :server {} (test-peer-expansion))])
:= `[:cljs (::c/toggle :server {} :clj)]
(l/expand-all {::l/peers {:client :cljs, :server :clj}, ::l/current :client}
`[(test-peer-expansion) (::l/site :server (test-peer-expansion))])
:= `[:cljs (::l/site :server :clj)]

"cljs require-macros work in clj expansion"
(c/expand-all {::c/peers {:client :cljs, :server :clj}, ::c/current :client, :ns 'hyperfiddle.electric.impl.expand-test}
(l/expand-all {::l/peers {:client :cljs, :server :clj}, ::l/current :client, :ns {:name 'hyperfiddle.electric.impl.expand-de-test}}
'(hyperfiddle.electric.impl.expand-macro/twice 1))
:= '[1 1]
(c/expand-all {::c/peers {:client :cljs, :server :clj}, ::c/current :client, :ns 'hyperfiddle.electric.impl.expand-test}
(l/expand-all {::l/peers {:client :cljs, :server :clj}, ::l/current :client, :ns {:name 'hyperfiddle.electric.impl.expand-de-test}}
'(mac/twice 1))
:= '[1 1]
(c/expand-all {::c/peers {:client :cljs, :server :clj}, ::c/current :client, :ns 'hyperfiddle.electric.impl.expand-test}
(l/expand-all {::l/peers {:client :cljs, :server :clj}, ::l/current :client, :ns {:name 'hyperfiddle.electric.impl.expand-de-test}}
'(twice 1))
:= '[1 1]

"require referred macros work in cljs"
(c/expand-all {::c/peers {:client :cljs, :server :clj}, ::c/current :client, :ns 'hyperfiddle.electric.impl.expand-test}
(l/expand-all {::l/peers {:client :cljs, :server :clj}, ::l/current :client, :ns {:name 'hyperfiddle.electric.impl.expand-de-test}}
'(referred))
:= :referred

"required macros work in cljs when fully qualified"
(c/expand-all {::c/peers {:client :cljs, :server :clj}, ::c/current :client, :ns 'hyperfiddle.electric.impl.expand-test}
(l/expand-all {::l/peers {:client :cljs, :server :clj}, ::l/current :client, :ns {:name 'hyperfiddle.electric.impl.expand-de-test}}
'(hyperfiddle.electric.impl.expand-require-referred/referred))
:= :referred

"required macros work in cljs when alias qualified"
(c/expand-all {::c/peers {:client :cljs, :server :clj}, ::c/current :client, :ns 'hyperfiddle.electric.impl.expand-test}
(l/expand-all {::l/peers {:client :cljs, :server :clj}, ::l/current :client, :ns {:name 'hyperfiddle.electric.impl.expand-de-test}}
'(ref/referred))
:= :referred

Expand All @@ -180,8 +183,8 @@
#?(:clj
(when-not (= 'let* (first
(binding [*ns* (create-ns 'hyperfiddle.electric.impl.expand-unloaded)]
(c/expand-all {::c/peers {:client :cljs, :server :clj}
::c/current :server, ::c/me :client
(l/expand-all {::l/peers {:client :cljs, :server :clj}
::l/current :server, ::l/me :client
:ns 'hyperfiddle.electric.impl.expand-unloaded}
'(let [x 1])))))
(throw (ex-info "clj macroexpansion for unloaded ns fails" {}))))

0 comments on commit aab7c70

Please sign in to comment.