Skip to content
This repository was archived by the owner on Jan 2, 2023. It is now read-only.

Commit e1760c5

Browse files
borkdudeborkdude
committed
destructuring in let
1 parent 0c0b543 commit e1760c5

File tree

7 files changed

+184
-35
lines changed

7 files changed

+184
-35
lines changed

‎cherry/corpus/destructuring.cljs

Lines changed: 3 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -1,16 +1,9 @@
11
(ns destructuring)
22

33
;; TODO:
4-
(let [{:keys [a]} x]
5-
4+
(let [{:keys [a]} {:a 1}
5+
[b c d] [2 3 4]]
6+
(js/console.log a b c d)
67
)
78

8-
;; This currently transpiles as:
9-
10-
;; const {keys: [a]} = {a: 1};
11-
12-
;; What we probably want:
13-
14-
;; const _temp_object = x // the enti
15-
;; const a = ...
169

‎cherry/corpus/destructuring.mjs

Lines changed: 11 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,15 @@
1+
import { get, nth, vector, __destructure_map, keyword, arrayMap } from 'cherry-cljs/cljs.core.js'
2+
13
(function () {
2-
const {keys: [a]} = {a: 1};
4+
let map__1124, a, vec__1125, b, c, d;
5+
map__1124 = arrayMap(keyword("a"), 1);
6+
map__1124 = __destructure_map(map__1124);
7+
a = get(map__1124, keyword("a"));
8+
vec__1125 = vector(2, 3, 4);
9+
b = nth(vec__1125, 0, null);
10+
c = nth(vec__1125, 1, null);
11+
d = nth(vec__1125, 2, null);
312
return (function () {
4-
return null;
13+
return console.log(a, b, c, d);
514
})();
615
})();

‎cherry/corpus/no_core_vars.mjs

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,9 @@
1+
import { js_keys, js_obj, prn } from 'cherry-cljs/cljs.core.js'
2+
13
function foo () {
24
return (function () {
3-
return "hello";
5+
return js_obj("foo", "bar");
46
})();
57
};
6-
console.log(foo());
8+
prn(1);
9+
console.log(js_keys(foo()));

‎cherry/package.json

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@
22
"type": "module",
33
"name": "cherry-cljs",
44
"sideEffects": false,
5-
"version": "0.0.0-alpha.8",
5+
"version": "0.0.0-alpha.9",
66
"files": [
77
"cljs.core.js",
88
"lib/cljs_core.js"

‎cherry/resources/cherry/cljs.core.edn

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -447,4 +447,7 @@
447447
with-meta
448448
write-all
449449
zero?
450-
zipmap}}
450+
zipmap
451+
;; manually added:
452+
--destructure-map
453+
}}

‎cherry/src/cherry/internal/destructure.cljc

Lines changed: 129 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,129 @@
1+
(ns cherry.internal.destructure
2+
(:refer-clojure :exclude [destructure]))
3+
4+
(defn destructure [bindings]
5+
(let [bents (partition 2 bindings)
6+
pb (fn pb [bvec b v]
7+
(let [pvec
8+
(fn [bvec b val]
9+
(let [gvec (gensym "vec__")
10+
gseq (gensym "seq__")
11+
gfirst (gensym "first__")
12+
has-rest (some #{'&} b)]
13+
(loop [ret (let [ret (conj bvec gvec val)]
14+
(if has-rest
15+
(conj ret gseq (list `seq gvec))
16+
ret))
17+
n 0
18+
bs b
19+
seen-rest? false]
20+
(if (seq bs)
21+
(let [firstb (first bs)]
22+
(cond
23+
(= firstb '&) (recur (pb ret (second bs) gseq)
24+
n
25+
(nnext bs)
26+
true)
27+
(= firstb :as) (pb ret (second bs) gvec)
28+
:else (if seen-rest?
29+
(throw #?(:clj (new Exception "Unsupported binding form, only :as can follow & parameter")
30+
:cljs (new js/Error "Unsupported binding form, only :as can follow & parameter")))
31+
(recur (pb (if has-rest
32+
(conj ret
33+
gfirst `(first ~gseq)
34+
gseq `(next ~gseq))
35+
ret)
36+
firstb
37+
(if has-rest
38+
gfirst
39+
(list `nth gvec n nil)))
40+
(inc n)
41+
(next bs)
42+
seen-rest?))))
43+
ret))))
44+
pmap
45+
(fn [bvec b v]
46+
(let [gmap (gensym "map__")
47+
defaults (:or b)]
48+
(loop [ret (-> bvec (conj gmap) (conj v)
49+
(conj gmap) (conj (list 'cljs.core/--destructure-map gmap))
50+
((fn [ret]
51+
(if (:as b)
52+
(conj ret (:as b) gmap)
53+
ret))))
54+
bes (let [transforms
55+
(reduce
56+
(fn [transforms mk]
57+
(if (keyword? mk)
58+
(let [mkns (namespace mk)
59+
mkn (name mk)]
60+
(cond (= mkn "keys") (assoc transforms mk #(keyword (or mkns (namespace %)) (name %)))
61+
(= mkn "syms") (assoc transforms mk #(list `quote (symbol (or mkns (namespace %)) (name %))))
62+
(= mkn "strs") (assoc transforms mk str)
63+
:else transforms))
64+
transforms))
65+
{}
66+
(keys b))]
67+
(reduce
68+
(fn [bes entry]
69+
(reduce #(assoc %1 %2 ((val entry) %2))
70+
(dissoc bes (key entry))
71+
((key entry) bes)))
72+
(dissoc b :as :or)
73+
transforms))]
74+
(if (seq bes)
75+
(let [bb (key (first bes))
76+
bk (val (first bes))
77+
local (if #?(:clj (instance? clojure.lang.Named bb)
78+
:cljs (cljs.core/implements? INamed bb))
79+
(with-meta (symbol nil (name bb)) (meta bb))
80+
bb)
81+
bv (if (contains? defaults local)
82+
(list 'cljs.get gmap bk (defaults local))
83+
(list 'cljs.core/get gmap bk))]
84+
(recur
85+
(if (or (keyword? bb) (symbol? bb)) ;(ident? bb)
86+
(-> ret (conj local bv))
87+
(pb ret bb bv))
88+
(next bes)))
89+
ret))))]
90+
(cond
91+
(symbol? b) (-> bvec (conj (if (namespace b) (symbol (name b)) b)) (conj v))
92+
(keyword? b) (-> bvec (conj (symbol (name b))) (conj v))
93+
(vector? b) (pvec bvec b v)
94+
(map? b) (pmap bvec b v)
95+
:else (throw
96+
#?(:clj (new Exception (str "Unsupported binding form: " b))
97+
:cljs (new js/Error (str "Unsupported binding form: " b)))))))
98+
process-entry (fn [bvec b] (pb bvec (first b) (second b)))]
99+
(if (every? symbol? (map first bents))
100+
bindings
101+
(if-let [kwbs (seq (filter #(keyword? (first %)) bents))]
102+
(throw
103+
#?(:clj (new Exception (str "Unsupported binding key: " (ffirst kwbs)))
104+
:cljs (new js/Error (str "Unsupported binding key: " (ffirst kwbs)))))
105+
(reduce process-entry [] bents)))))
106+
107+
(defn maybe-destructured
108+
[params body]
109+
(if (every? symbol? params)
110+
(cons params body)
111+
(loop [params params
112+
new-params (with-meta [] (meta params))
113+
lets []]
114+
(if params
115+
(if (symbol? (first params))
116+
(recur (next params) (conj new-params (first params)) lets)
117+
(let [gparam (gensym "p__")]
118+
(recur (next params) (conj new-params gparam)
119+
(-> lets (conj (first params)) (conj gparam)))))
120+
`(~new-params
121+
(let ~lets
122+
~@body))))))
123+
124+
(defn core-let
125+
[bindings body]
126+
#_(assert-args let
127+
(vector? bindings) "a vector for its binding"
128+
(even? (count bindings)) "an even number of forms in binding vector")
129+
`(cljs.core/let* ~(destructure bindings) ~@body))

‎cherry/src/cherry/transpiler.clj

Lines changed: 31 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -28,6 +28,7 @@
2828
:doc "A library for generating javascript from Clojure."}
2929
cherry.transpiler
3030
(:require
31+
[cherry.internal.destructure :refer [core-let]]
3132
[clojure.edn :as edn]
3233
[clojure.java.io :as io]
3334
[clojure.string :as str]
@@ -99,7 +100,7 @@
99100
'return 'delete 'new 'do 'aget 'while 'doseq
100101
'inc! 'dec! 'dec 'inc 'defined? 'and 'or
101102
'? 'try 'break
102-
'await 'const 'defn 'let 'ns 'def]))
103+
'await 'const 'defn 'let 'let* 'ns 'def]))
103104

104105
(def core-config (edn/read-string (slurp (io/resource "cherry/cljs.core.edn"))))
105106

@@ -181,31 +182,42 @@
181182
(defn return [s]
182183
(format "return %s;" s))
183184

185+
(defmethod emit-special 'let* [type [_let bindings & more]]
186+
(let [partitioned (partition 2 bindings)]
187+
(wrap-iife
188+
(str
189+
(let [names (distinct (map (fn [[name _]]
190+
name)
191+
partitioned))]
192+
(statement (str "let " (str/join ", " names))))
193+
(apply str (interleave (map (fn [[name expr]]
194+
(str (emit name) " = " (emit expr)))
195+
partitioned)
196+
(repeat statement-separator)))
197+
(return (emit-do more)))
198+
{:async? *async*})))
199+
184200
(defmethod emit-special 'let [type [_let bindings & more]]
185-
(wrap-iife
186-
(str
187-
(apply str (interleave (map (fn [[name expr]]
188-
(str "const " (emit name) " = " (emit expr)))
189-
(partition 2 bindings))
190-
(repeat statement-separator)))
191-
(return (emit-do more)))
192-
{:async? *async*}))
201+
(emit (core-let bindings more))
202+
#_(prn (core-let bindings more)))
193203

194204
(defmethod emit-special 'ns [_ & _]
195205
;; TODO
196206
)
197207

198208
(defmethod emit-special 'funcall [_type [name & args]]
199-
(str (if (and (list? name) (= 'fn (first name))) ; function literal call
200-
(str "(" (emit name) ")")
201-
(let [name
202-
(if (contains? core-vars name)
203-
(let [name (symbol (munge name))]
204-
(swap! *imported-core-vars* conj name)
205-
name)
206-
name)]
207-
(emit name)))
208-
(comma-list (map emit args))))
209+
(if (= "cljs.core" (namespace name))
210+
(emit (list* (symbol (clojure.core/name name)) args))
211+
(str (if (and (list? name) (= 'fn (first name))) ; function literal call
212+
(str "(" (emit name) ")")
213+
(let [name
214+
(if (contains? core-vars name)
215+
(let [name (symbol (munge name))]
216+
(swap! *imported-core-vars* conj name)
217+
name)
218+
name)]
219+
(emit name)))
220+
(comma-list (map emit args)))))
209221

210222
(defmethod emit-special 'str [type [str & args]]
211223
(apply clojure.core/str (interpose " + " (map emit args))))

0 commit comments

Comments
 (0)