From 63e82b23ef0f96fc971faa5795553bfc35df98b9 Mon Sep 17 00:00:00 2001 From: Michiel Borkent Date: Sun, 7 Aug 2022 13:01:16 +0200 Subject: [PATCH] Fix #46: keyword calls --- compile.clj | 4 +- package.json | 2 +- src/cherry/compiler.cljc | 111 ++++++++++++++++++--------------- test/cherry/compiler_test.cljs | 6 ++ 4 files changed, 69 insertions(+), 54 deletions(-) diff --git a/compile.clj b/compile.clj index 93aee976..209127ea 100644 --- a/compile.clj +++ b/compile.clj @@ -1,5 +1,5 @@ -(require '[cherry.compiler :refer [transpile-string]]) +(require '[cherry.compiler :refer [compile-string*]]) (let [{:keys [imports exports body]} - (transpile-string (slurp *in*))] + (compile-string* (slurp *in*))] (str imports exports body)) diff --git a/package.json b/package.json index fb539320..b224593d 100644 --- a/package.json +++ b/package.json @@ -2,7 +2,7 @@ "type": "module", "name": "cherry-cljs", "sideEffects": false, - "version": "0.0.0-alpha.44", + "version": "0.0.0-alpha.45", "files": [ "cljs.core.js", "lib", diff --git a/src/cherry/compiler.cljc b/src/cherry/compiler.cljc index 890d984d..e824c49c 100644 --- a/src/cherry/compiler.cljc +++ b/src/cherry/compiler.cljc @@ -428,13 +428,21 @@ clauses )) -(defmethod emit-special 'funcall [_type env [fname & args :as expr]] - (emit-wrap env - (str - (emit fname (expr-env env)) - (comma-list (emit-args env args))))) - -(defmethod emit-special 'str [_type env [str & args]] +(defmethod emit-special 'funcall [_type env [fname & args :as _expr]] + (let [interop? (and (symbol? fname) + (= "js" (namespace fname)))] + (emit-wrap env + (str + (emit fname (expr-env env)) + ;; this is needed when calling keywords, symbols, etc. We could + ;; optimize this later by inferring that we're not directly + ;; calling a `function`. + (when-not interop? ".call") + (comma-list (emit-args env + (if interop? args + (cons nil args)))))))) + +(defmethod emit-special 'str [_type env [_str & args]] (apply clojure.core/str (interpose " + " (emit-args env args)))) (defn emit-method [env obj method args] @@ -587,14 +595,14 @@ break;}" body) (first expr) expr)] (->> (if name - (let [signature (first expr) - body (rest expr)] - (str (when *async* - "async ") "function " name " " - (emit-function env name signature body true))) - (let [signature (first expr) - body (rest expr)] - (str (emit-function env nil signature body)))) + (let [signature (first expr) + body (rest expr)] + (str (when *async* + "async ") "function " name " " + (emit-function env name signature body true))) + (let [signature (first expr) + body (rest expr)] + (str (emit-function env nil signature body)))) (emit-wrap env)))) (defmethod emit-special 'fn* [_type env [_fn & sigs :as expr]] @@ -666,39 +674,40 @@ break;}" body) (swap! *imported-core-vars* conj 'list) (format "list(%s)" (str/join ", " (emit-args env expr)))) - (if (symbol? (first expr)) - (let [head* (first expr) - head (strip-core-symbol head*) - expr (if (not= head head*) - (with-meta (cons head (rest expr)) - (meta expr)) - expr) - head-str (str head)] - (cond - (and (= (.charAt head-str 0) \.) - (> (count head-str) 1) - (not (= ".." head-str))) - (emit-special '. env - (list* '. - (second expr) - (symbol (subs head-str 1)) - (nnext expr))) - (contains? built-in-macros head) - (let [macro (built-in-macros head) - new-expr (apply macro expr {} (rest expr))] - (emit new-expr env)) - (and (> (count head-str) 1) - (str/ends-with? head-str ".")) - (emit (list* 'new (symbol (subs head-str 0 (dec (count head-str)))) (rest expr)) - env) - (special-form? head) (emit-special head env expr) - (infix-operator? head) (emit-infix head env expr) - (prefix-unary? head) (emit-prefix-unary head expr) - (suffix-unary? head) (emit-suffix-unary head expr) - :else (emit-special 'funcall env expr))) - (if (list? expr) - (emit-special 'funcall env expr) - (throw (new Exception (str "invalid form: " expr))))))) + (cond (symbol? (first expr)) + (let [head* (first expr) + head (strip-core-symbol head*) + expr (if (not= head head*) + (with-meta (cons head (rest expr)) + (meta expr)) + expr) + head-str (str head)] + (cond + (and (= (.charAt head-str 0) \.) + (> (count head-str) 1) + (not (= ".." head-str))) + (emit-special '. env + (list* '. + (second expr) + (symbol (subs head-str 1)) + (nnext expr))) + (contains? built-in-macros head) + (let [macro (built-in-macros head) + new-expr (apply macro expr {} (rest expr))] + (emit new-expr env)) + (and (> (count head-str) 1) + (str/ends-with? head-str ".")) + (emit (list* 'new (symbol (subs head-str 0 (dec (count head-str)))) (rest expr)) + env) + (special-form? head) (emit-special head env expr) + (infix-operator? head) (emit-infix head env expr) + (prefix-unary? head) (emit-prefix-unary head expr) + (suffix-unary? head) (emit-suffix-unary head expr) + :else (emit-special 'funcall env expr))) + (list? expr) + (emit-special 'funcall env expr) + :else + (throw (new Exception (str "invalid form: " expr)))))) #?(:cljs (derive PersistentVector ::vector)) @@ -781,9 +790,9 @@ break;}" body) *public-vars* public-vars] (let [transpiled (transpile-string* s) imports (when-let [core-vars (and (not elide-imports) - (seq @core-vars))] - (str (format "import { %s } from 'cherry-cljs/cljs.core.js'\n" - (str/join ", " core-vars)))) + (seq @core-vars))] + (str (format "import { %s } from 'cherry-cljs/cljs.core.js'\n" + (str/join ", " core-vars)))) exports (when-not elide-exports (when-let [vars (disj @public-vars "default$")] (when (seq vars) diff --git a/test/cherry/compiler_test.cljs b/test/cherry/compiler_test.cljs index 010f04c5..6b51dc82 100644 --- a/test/cherry/compiler_test.cljs +++ b/test/cherry/compiler_test.cljs @@ -362,5 +362,11 @@ (is (= [1 2 2] (js->clj x)))) (is (= 1 (jsv! "(aget #js [1 2 3] 0)")))) +(deftest keyword-call-test + (is (= :bar (jsv! '(:foo {:foo :bar})))) + (is (= :bar (jsv! '(let [x :foo] + (x {:foo :bar}))))) + (is (= :bar (jsv! '((keyword "foo") {:foo :bar}))))) + (defn init [] (cljs.test/run-tests 'cherry.compiler-test))