├── .gitignore
├── README.md
├── bin
    └── cljslua.clj
├── cljs
    ├── .config.clj
    ├── builtins.lua
    ├── core-lua-extra.cljs
    ├── core-lua-init.cljs
    ├── core-lua.cljs
    └── exec_server.lua
├── cljslua
├── epl-v10.html
├── project.clj
├── script
    ├── clojurescript_project_file.clj
    ├── init.sh
    ├── repl
    └── test
├── src
    └── cljs
    │   ├── cljsloader.clj
    │   └── lua
    │       ├── common.clj
    │       ├── compile.clj
    │       ├── compiler.clj
    │       ├── config.clj
    │       ├── core.clj
    │       └── repl.clj
└── test
    ├── cljs
        ├── macro_test.cljs
        └── macro_test
        │   └── macros.clj
    └── core_test.cljs


/.gitignore:
--------------------------------------------------------------------------------
1 | *~


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
 1 | Clojurescript-Lua
 2 | -----------------
 3 | 
 4 | Welcome, ClojureScript/Lua is a lisp language targeting Lua. It is using the ClojureScript compiler, and provides a different backend and ecosystem for the ClojureScript language.
 5 | 
 6 | The current version of ClojureScript/Lua is 0.1.0-ALPHA. It is in alpha stage, hence the name, and you should expect that a lot of things are not working yet !
 7 | 
 8 | ClojureScript/Lua should run on any posix system that has bash, lua and java installed.
 9 | 
10 | If you find any bug, don't hesitate to submit issues on github, especially if Cljs/Lua doesn't work at all on your computer, and you find a fix :)
11 | 
12 | Here is hello world in Cljs/Lua :
13 | 
14 | ~~~clojure
15 | (println "Hello, world !")
16 | ~~~
17 | 
18 | Distinctive traits of ClojureScript are :
19 | 
20 | - Lisp language (s-expression syntax, code is data, etc)
21 | - Functional (mostly)
22 | - Functional data structures with literal syntax 
23 | 
24 | ~~~clojure
25 | (def my-map {:john "doe" :jack "daniels"})
26 | (println (my-map :john)) ;; prints "doe"
27 | ~~~
28 | 
29 | ### Getting started
30 | 
31 | You need to have leiningen installed. This is the only prerequisite (with of course java & all). After that, you just need to grab yourself a copy of the repo, either via cloning it or downloading an archive.
32 | 
33 | ### Running the Cljs/Lua repl
34 | 
35 | To run the repl, you need to have Lua 5.1 installed, as well as a few dependencies:
36 | 
37 | - lua json library
38 | - lua bit ops library
39 | 
40 | The two are quite standard lua libs that should be available in your distribution's repositories.
41 | 
42 | To run the REPL, issue the following command
43 | 
44 | ~~~sh
45 | ./cljslua repl
46 | ~~~
47 | 
48 | On the first run, Cljs/Lua will install some components that it needs.
49 | 
50 | #### REPL options
51 | 
52 | By default, the repl shows the output of compiled Cljs commands. You can switch that off by calling the function
53 | 
54 | ~~~clojure
55 | (switch-verbose)
56 | ~~~
57 | 
58 | You can also switch off execution by calling
59 | 
60 | ~~~clojure
61 | (switch-exec)
62 | ~~~
63 | 
64 | ### Cljs/Lua compiler
65 | 
66 | Cljs/Lua has a **very** basic compiler that works the following way
67 | 
68 | ~~~sh
69 | ./cljslua compile <in-file> <out-file>
70 | ~~~
71 | 
72 | 1. You give it a in-file and an out-file.
73 | 2. It will compile *everything* to the out-file. That means, the content of the core library, of the compiled file, and of any dependencies.
74 | 3. It will search for required namespaces in subdirectories of the directory containing the in-file. File layout doesn't matter for the moment.
75 | 
76 | This is very basic, but yet functionnal. The compiler will be redesigned soon, but some thoughts need to be given to the general design of it first.
77 | 
78 | ### Running the lein repl
79 | 
80 | If you want to see how the compiler compiles out snippets of clojurescript :
81 | 
82 | ~~~sh
83 | $ lein repl
84 | ~~~
85 | 
86 | ~~~clojure
87 | REPL started; server listening on localhost port 31236
88 | cljs.lua.compiler=> (lua (defn add [a b] (+ a b)))
89 | "cljs.user.add = (function (a,b)
90 | return (a + b)
91 | end)"
92 | nil
93 | ~~~
94 | 


--------------------------------------------------------------------------------
/bin/cljslua.clj:
--------------------------------------------------------------------------------
 1 | (require '[cljs.lua.repl :as repl])
 2 | (require '[cljs.lua.config :as conf])
 3 | (require '[cljs.lua.compile :as comp])
 4 | (require '[cljs.lua.common :as com])
 5 | (require '[cljs.analyzer :as ana])
 6 | 
 7 | (def commands {"compile" comp/-main
 8 |                "repl"    repl/-main})
 9 | 
10 | (defn keywordize-args [args]
11 |   (for [arg args]
12 |     (if (.startsWith arg ":") (keyword (subs arg 1)) arg)))
13 | 
14 | (ana/with-core-macros "/cljs/lua/core"  
15 |   (let [args (keywordize-args *command-line-args*)
16 |         cmd-func (commands (first args))]
17 |     (conf/load-config)
18 |     (com/init-dirs)
19 |     (comp/compile-core)
20 |     (if cmd-func
21 |       (apply cmd-func (rest args))
22 |       (println "Unknown command : " (first args)))))


--------------------------------------------------------------------------------
/cljs/.config.clj:
--------------------------------------------------------------------------------
1 | {:repl {:lua-runtime "lua"}
2 | }


--------------------------------------------------------------------------------
/cljs/builtins.lua:
--------------------------------------------------------------------------------
  1 | --   Copyright (c) Rich Hickey. All rights reserved.
  2 | --   The use and distribution terms for this software are covered by the
  3 | --   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  4 | --   which can be found in the file epl-v10.html at the root of this distribution.
  5 | --   By using this software in any fashion, you are agreeing to be bound by
  6 | --   the terms of this license.
  7 | --   You must not remove this notice, or any other, from this software.
  8 | 
  9 | require("bit")
 10 | require("json")
 11 | 
 12 | builtins = {}
 13 | basic_types_prot_functions = {}
 14 | js = {}
 15 | builtins.functions_metatable = nil
 16 | 
 17 | function builtins.create_proto_table()
 18 |    local ptable = {}
 19 |    setmetatable(ptable, {__index=cljs.core.default_proto_table()})
 20 |    return ptable
 21 | end
 22 | 
 23 | function builtins.getnilproto()
 24 |    return (nil).proto_methods
 25 | end
 26 | 
 27 | function builtins.getbooleanproto()
 28 |    return (false).proto_methods
 29 | end
 30 | 
 31 | function builtins.getfunctionproto()
 32 |    return (function()end).proto_methods
 33 | end
 34 | 
 35 | function builtins.getstringproto()
 36 |    return ("").proto_methods
 37 | end
 38 | 
 39 | function builtins.getnumberproto()
 40 |    return (0).proto_methods
 41 | end
 42 | 
 43 | function newmt() 
 44 |    return {__index={proto_methods=builtins.create_proto_table()}, __call = builtins.IFnCall}
 45 | end
 46 | 
 47 | -- Metatables initialisation
 48 | function builtins.init_meta_tables()
 49 |    debug.setmetatable(0, newmt())
 50 |    debug.setmetatable(false, newmt())
 51 |    debug.setmetatable(nil, newmt())
 52 |    getmetatable(nil).__call = nil
 53 |    builtins.functions_metatable = newmt()
 54 |    debug.setmetatable(function()end, builtins.functions_metatable)
 55 |    getmetatable("").__index.proto_methods=builtins.create_proto_table()
 56 |    getmetatable("").__call = builtins.IFnCall
 57 | end
 58 | 
 59 | function builtins.create_object(...)
 60 |    local a = builtins.new_object()
 61 |    for i=1,select("#", ...), 2 do
 62 |       a[select(i, ...)] = select(i+1, ...)
 63 |    end
 64 |    return a
 65 | end
 66 | 
 67 | function builtins.new_object(...)
 68 |    local t = {...}
 69 |    setmetatable(t, newmt())
 70 |    return t
 71 | end
 72 | 
 73 | function builtins.create_func_object()
 74 |    local o = {}
 75 |    setmetatable(o, builtins.functions_metatable)
 76 |    return o
 77 | end
 78 | 
 79 | tern_box_val = nil
 80 | function box_tern(val)
 81 |    tern_box_val = val
 82 |    return true
 83 | end
 84 | 
 85 | function unbox_tern(val)
 86 |    return tern_box_val
 87 | end
 88 | 
 89 | function string:split(sep)
 90 |    local sep, fields = sep or ":", {}
 91 |    local pattern = string.format("([^%s]+)", sep)
 92 |    self:gsub(pattern, function(c) fields[#fields+1] = c end)
 93 |    return fields
 94 | end
 95 | 
 96 | function builtins.create_namespace(str)
 97 |    local ns_tables = str:split(".")
 98 |    local current_table = _G
 99 |    for i=1,#ns_tables do
100 |       if not current_table[ns_tables[i]] then
101 | 	 current_table[ns_tables[i]] = {}
102 |       end
103 |       current_table = current_table[ns_tables[i]]
104 |    end
105 | end
106 | 
107 | function builtins.array_copy(t)
108 |    local new_arr = builtins.array_init({}, 0)
109 |    for i=1,t.length do
110 |       builtins.array_insert(new_arr, t[i])
111 |    end
112 |    return new_arr
113 | end
114 | 
115 | function builtins.array_remove(arr, pos)
116 |    table.remove(arr, pos)
117 |    arr.length = arr.length - 1
118 | end
119 | 
120 | function builtins.array(...)
121 |    local t = {...}
122 |    return builtins.array_init(t, select("#", ...))
123 | end
124 | 
125 | function builtins.array_init(arr, len)
126 |    arr.proto_methods = cljs.core.Array.proto_methods
127 |    arr.constructor = cljs.core.Array
128 |    arr.length = len
129 |    setmetatable(arr, {__call=builtins.IFnCall})
130 |    return arr
131 | end
132 | 
133 | function builtins.array_len(arr)
134 |    return arr.length
135 | end
136 | 
137 | function builtins.array_get(arr, idx)
138 |    return arr[idx+1]
139 | end
140 | 
141 | function builtins.array_set(arr, idx, val)
142 |    arr[idx+1]=val
143 |    arr.length = math.max(arr.length, idx)
144 | end
145 | 
146 | function builtins.array_insert(arr, val)
147 |    arr[arr.length+1]=val
148 |    arr.length = arr.length + 1
149 | end
150 | 
151 | function builtins.type(x)
152 |    local t = type(x)
153 |    if t == "table" then
154 |       return x.constructor or "table"
155 |    elseif t == "cdata" then
156 |       return x.constructor or "cdata"
157 |    else
158 |       return t
159 |    end
160 | end
161 | 
162 | function builtins.keys (obj) 
163 |    local keys = builtins.array()
164 |    for k,v in pairs(obj) do builtins.array_insert(keys, k) end
165 |    return keys
166 | end
167 | 
168 | function builtins.getUid(x)
169 | end
170 | 
171 | string.HASHCODE_MAX_ = 0x100000000;
172 | 
173 | -- Hashcode function borrowed from google closure library
174 | function string.hashCode(str)
175 |    local result = 0
176 |    for i=1,#str do
177 |     result = 31 * result + str:byte(i);
178 |     -- Normalize to 4 byte range, 0 ... 2^32.
179 |     result = result % string.HASHCODE_MAX_;
180 |    end
181 |    return result
182 | end
183 | 
184 | js.Error = {}
185 | function js.Error.new(msg)
186 |    local inst = {}
187 |    inst.message = msg
188 |    inst.constructor = js.Error
189 |    return inst
190 | end
191 | 
192 | function builtins.tocomp(a)
193 |    if type(a) == "number" or type(a) == "string" then
194 |       return a
195 |    elseif a == true then
196 |       return 1
197 |    elseif a == false then
198 |       return 0
199 |    end
200 |    return 0
201 | end
202 | 
203 | function builtins.compare(a, b)
204 |    a = builtins.tocomp(a)
205 |    b = builtins.tocomp(b)
206 |    if a > b then
207 |       return 1 
208 |    elseif a < b then
209 |       return -1
210 |    else 
211 |       return 0
212 |    end
213 | end
214 | 
215 | function builtins.shuffle(arr, opt_randFn)
216 |   local randFn = opt_randFn or math.random
217 |   for i=#arr+1,1,-1 do
218 |     local j = math.floor(randFn() * (i + 1));
219 |     local tmp = arr[i];
220 |     arr[i] = arr[j];
221 |     arr[j] = tmp;
222 |   end
223 | end
224 | 
225 | function builtins.sort(t, comp)
226 |    local fncomp = nil
227 |    if comp then
228 |       fncomp = function(x, y) return comp(x, y) < 0 end
229 |    end
230 |    return table.sort(t, fncomp)
231 | end
232 | 
233 | function builtins.array_to_string(a)
234 |    local b = {}
235 |    for i=0,a.length do
236 |       if a[i] == nil then
237 | 	 b[i] = "nil"
238 |       else
239 | 	 b[i] = cljs.core.str(a[i])
240 |       end
241 |    end
242 |    return "<Array " .. table.concat(b, ", ") .. ">"
243 | end
244 | 
245 | 
246 | function builtins.array_slice (values,i1,i2)
247 |    local res = builtins.array()
248 |    local n = values.length
249 |    -- default values for range
250 |    i1 = i1 or 1
251 |    i2 = i2 or n
252 |    if i2 < 0 then
253 |       i2 = n + i2 + 1
254 |    elseif i2 > n then
255 |       i2 = n
256 |    end
257 |    if i1 < 1 or i1 > n then
258 |       return {}
259 |    end
260 |    for i = i1,i2 do
261 |       builtins.array_insert(res,values[i])
262 |    end
263 |    return res
264 | end
265 | 
266 | function builtins.get_func(func_obj)
267 |    return getmetatable(func_obj).__call
268 | end
269 | 
270 | function builtins.IFnCall(obj, ...)
271 |    local len = select("#", ...) + 1
272 |    local fn_name = "cljs__core__IFn___invoke__arity__" .. tostring(len)
273 |    return obj.proto_methods[fn_name](obj, ...)
274 | end
275 | 
276 | function builtins.mfn_call(self, ...)
277 |    local args = cljs.core.array_seq(builtins.array(...),0);
278 |    return self.proto_methods.cljs__core__IMultiFn___dispatch__arity__2(self,args)
279 | end
280 | 
281 | builtins.unpack = function(t)
282 |    return builtins.__unpack[t.length](t)
283 | end
284 | 
285 | builtins.__unpack = {}
286 | builtins.__unpack[0] = function (t)
287 | end
288 | builtins.__unpack[1] = function (t)
289 |    return t[1]
290 | end
291 | builtins.__unpack[2] = function (t)
292 |    return t[1], t[2]
293 | end
294 | builtins.__unpack[3] = function (t)
295 |    return t[1], t[2], t[3]
296 | end
297 | builtins.__unpack[4] = function (t)
298 |    return t[1], t[2], t[3], t[4]
299 | end
300 | builtins.__unpack[5] = function (t)
301 |    return t[1], t[2], t[3], t[4], t[5]
302 | end
303 | builtins.__unpack[6] = function (t)
304 |    return t[1], t[2], t[3], t[4], t[5], t[6]
305 | end
306 | builtins.__unpack[7] = function (t)
307 |    return t[1], t[2], t[3], t[4], t[5], t[6], t[7]
308 | end
309 | builtins.__unpack[8] = function (t)
310 |    return t[1], t[2], t[3], t[4], t[5], t[6], t[7], t[8]
311 | end
312 | builtins.__unpack[9] = function (t)
313 |    return t[1], t[2], t[3], t[4], t[5], t[6], t[7], t[9]
314 | end
315 | builtins.__unpack[10] = function (t)
316 |    return t[1], t[2], t[3], t[4], t[5], t[6], t[7], t[9], t[10]
317 | end
318 | builtins.__unpack[11] = function (t)
319 |    return t[1], t[2], t[3], t[4], t[5], t[6], t[7], t[9], t[10], t[11]
320 | end
321 | builtins.__unpack[12] = function (t)
322 |    return t[1], t[2], t[3], t[4], t[5], t[6], t[7], t[9], t[10], t[11], t[12]
323 | end
324 | builtins.__unpack[13] = function (t)
325 |    return t[1], t[2], t[3], t[4], t[5], t[6], t[7], t[9], t[10], t[11], t[12],t[13]
326 | end
327 | builtins.__unpack[14] = function (t)
328 |    return t[1], t[2], t[3], t[4], t[5], t[6], t[7], t[9], t[10], t[11], t[12],t[13], t[14]
329 | end
330 | builtins.__unpack[15] = function (t)
331 |    return t[1], t[2], t[3], t[4], t[5], t[6], t[7], t[9], t[10], t[11], t[12],t[13], t[15]
332 | end
333 | builtins.__unpack[16] = function (t)
334 |    return t[1], t[2], t[3], t[4], t[5], t[6], t[7], t[9], t[10], t[11], t[12],t[13], t[15], t[16]
335 | end
336 | builtins.__unpack[17] = function (t)
337 |    return t[1], t[2], t[3], t[4], t[5], t[6], t[7], t[9], t[10], t[11], t[12],t[13], t[15], t[16], t[17]
338 | end
339 | builtins.__unpack[18] = function (t)
340 |    return t[1], t[2], t[3], t[4], t[5], t[6], t[7], t[9], t[10], t[11], t[12],t[13], t[15], t[16], t[17], t[18]
341 | end
342 | builtins.__unpack[19] = function (t)
343 |    return t[1], t[2], t[3], t[4], t[5], t[6], t[7], t[9], t[10], t[11], t[12],t[13], t[15], t[16], t[17], t[18], t[19]
344 | end
345 | builtins.__unpack[20] = function (t)
346 |    return t[1], t[2], t[3], t[4], t[5], t[6], t[7], t[9], t[10], t[11], t[12],t[13], t[15], t[16], t[17], t[18], t[19], t[20]
347 | end
348 | builtins.__unpack[21] = function (t)
349 |    return t[1], t[2], t[3], t[4], t[5], t[6], t[7], t[9], t[10], t[11], t[12],t[13], t[15], t[16], t[17], t[18], t[19], t[20], t[21]
350 | end
351 | 
352 | builtins.type_instance_mt = {__call = builtins.IFnCall }
353 | 
354 | function builtins.require_ffi()
355 |    ffi = require("ffi")
356 | end


--------------------------------------------------------------------------------
/cljs/core-lua-extra.cljs:
--------------------------------------------------------------------------------
 1 | ;   Copyright (c) Rich Hickey. All rights reserved.
 2 | ;   The use and distribution terms for this software are covered by the
 3 | ;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
 4 | ;   which can be found in the file epl-v10.html at the root of this distribution.
 5 | ;   By using this software in any fashion, you are agreeing to be bound by
 6 | ;   the terms of this license.
 7 | ;   You must not remove this notice, or any other, from this software.
 8 | 
 9 | ;; IComparable
10 | (extend-protocol IComparable
11 |   Subvec
12 |   (-compare [x y] (compare-indexed x y)))


--------------------------------------------------------------------------------
/cljs/core-lua-init.cljs:
--------------------------------------------------------------------------------
 1 | ;   Copyright (c) Rich Hickey. All rights reserved.
 2 | ;   The use and distribution terms for this software are covered by the
 3 | ;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
 4 | ;   which can be found in the file epl-v10.html at the root of this distribution.
 5 | ;   By using this software in any fashion, you are agreeing to be bound by
 6 | ;   the terms of this license.
 7 | ;   You must not remove this notice, or any other, from this software.
 8 | 
 9 | (ns cljs.core)
10 | 
11 | (defprotocol Object (toString [x]))
12 | 
13 | ;; default type
14 | (deftype default [])
15 | (defn default-proto-table [] (.-proto-methods cljs.core.default))
16 | (builtins/init-meta-tables)
17 | 
18 | (defprotocol IStringBuffer (append [x str]))
19 | 
20 | (deftype StringBuffer []
21 |   Object
22 |   (toString [x] (table/concat x))
23 |   IStringBuffer
24 |   (append [x str] (builtins/array-insert x str) x))
25 | 
26 | (defn string-buffer []
27 |   (let [sb (StringBuffer.)]
28 |     (set! (.-length sb) 0)
29 |     sb))
30 | 
31 | (defprotocol INode
32 |   (inode-assoc [inode shift hash key val added-leaf?])
33 |   (inode-without [inode shift hash key])
34 |   (inode-lookup [inode shift hash key not-found])
35 |   (inode-find [inode shift hash key not-found])
36 |   (inode-seq [inode])
37 |   (ensure-editable [inode e])
38 |   (inode-assoc! [inode edit shift hash key val added-leaf?])
39 |   (inode-without! [inode edit shift hash key removed-leaf?])
40 |   (kv-reduce [inode f init]))
41 | 
42 | (defprotocol IHashCollisionNode
43 |   (ensure-editable-array [inode e count array]))
44 | 
45 | (defprotocol IBitmapIndexedNode
46 |   (edit-and-remove-pair [inode e bit i]))
47 | 
48 | (defprotocol ITransientHashMap
49 |   (tconj! [tcoll o])
50 |   (tassoc! [tcoll k v])  
51 |   (twithout! [tcoll k])
52 |   (tpersistent! [tcoll]))
53 | 
54 | (defprotocol IRBNode
55 |   (add-left [node ins])
56 |   (add-right [node ins])
57 |   (remove-left [node del])
58 |   (remove-right [node del])
59 |   (blacken [node])
60 |   (redden [node])
61 |   (-balance-left [node parent])
62 |   (-balance-right [node parent])
63 |   (nreplace [node key val left right])
64 |   (kv-reduce [node f init]))
65 | 
66 | (defprotocol IPersistentTreeMap
67 |   (entry-at [coll k]))
68 | 
69 | (defprotocol IString
70 |   (find-last [str substr]))


--------------------------------------------------------------------------------
/cljs/exec_server.lua:
--------------------------------------------------------------------------------
 1 | --   Copyright (c) Rich Hickey. All rights reserved.
 2 | --   The use and distribution terms for this software are covered by the
 3 | --   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
 4 | --   which can be found in the file epl-v10.html at the root of this distribution.
 5 | --   By using this software in any fashion, you are agreeing to be bound by
 6 | --   the terms of this license.
 7 | --   You must not remove this notice, or any other, from this software.
 8 | 
 9 | 
10 | require("json")
11 | require("io")
12 | require("cljs.builtins")
13 | 
14 | actions = {
15 |    exec = function (body)
16 |       local resp = {}
17 |       local func, error = loadstring(body)
18 |       if func then
19 | 	 local status, result = pcall(func)
20 |          io.flush()
21 | 	 resp.body = tostring(result)
22 | 	 if status then
23 |             if result and cljs and cljs.core and cljs.core.str then
24 |                resp.body = cljs.core.str(result)
25 |             end
26 | 	    resp.status = "OK"
27 | 	 else
28 | 	    resp.status = "ERROR"
29 | 	    if type(result) == "table" then
30 | 	       resp.body = result.message
31 | 	    end
32 | 	 end
33 |       else
34 | 	 resp.status = "ERROR"
35 |          resp.body = error
36 |       end
37 |       return resp
38 |    end
39 | }
40 | 
41 | function exec_server()
42 | 
43 |    local pipe_out_name = io.read()
44 |    local pipe_in_name = io.read()
45 |    local pipe_out = io.open(pipe_out_name, "w")
46 |    local pipe_in = io.open(pipe_in_name, "r")
47 | 
48 |    while true do
49 |       local a = pipe_in:read()
50 |       local request = json.decode(a)
51 |       pipe_out:write(json.encode(actions[request.action](request.body)) .. "\n")
52 |       pipe_out:flush()
53 |    end
54 | 
55 | end
56 | 
57 | exec_server()


--------------------------------------------------------------------------------
/cljslua:
--------------------------------------------------------------------------------
 1 | #! /bin/bash
 2 | 
 3 | DIR="$( cd "$( dirname "$0" )" && pwd )" 
 4 | 
 5 | CLJSC_CP=''
 6 | for next in $DIR/cljs $DIR/lib/* $DIR/src $DIR/libclojurescript.jar; do
 7 |     CLJSC_CP=$CLJSC_CP:$next
 8 | done
 9 | 
10 | if command -v rlwrap >/dev/null 2>&1; then
11 |     JCMD="rlwrap java"
12 | else
13 |     JCMD="java"
14 | fi
15 | 
16 | if [ ! -f "$DIR/.install" ]; then
17 |     echo "Installing necessary components for cljs-lua"
18 |     $DIR/script/init.sh
19 |     touch $DIR/.install
20 | fi
21 | 
22 | if test $# -eq 0
23 | then
24 |     echo "Usage: cljslua <command> args"
25 | else
26 |     if [ $1 == "compile" ]; then
27 | 	CLJSC_CP=$CLJSC_CP:$( dirname "$2")
28 |     fi
29 |     $JCMD -server -cp $CLJSC_CP clojure.main $DIR/bin/cljslua.clj $*
30 | fi
31 | 


--------------------------------------------------------------------------------
/epl-v10.html:
--------------------------------------------------------------------------------
  1 | <?xml version="1.0" encoding="ISO-8859-1" ?>
  2 | <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
  3 | <html xmlns="http://www.w3.org/1999/xhtml">
  4 | 
  5 | <head>
  6 | <meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1" />
  7 | <title>Eclipse Public License - Version 1.0</title>
  8 | <style type="text/css">
  9 |   body {
 10 |     size: 8.5in 11.0in;
 11 |     margin: 0.25in 0.5in 0.25in 0.5in;
 12 |     tab-interval: 0.5in;
 13 |     }
 14 |   p {  	
 15 |     margin-left: auto;
 16 |     margin-top:  0.5em;
 17 |     margin-bottom: 0.5em;
 18 |     }
 19 |   p.list {
 20 |   	margin-left: 0.5in;
 21 |     margin-top:  0.05em;
 22 |     margin-bottom: 0.05em;
 23 |     }
 24 |   </style>
 25 | 
 26 | </head>
 27 | 
 28 | <body lang="EN-US">
 29 | 
 30 | <p align=center><b>Eclipse Public License - v 1.0</b></p>
 31 | 
 32 | <p>THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE
 33 | PUBLIC LICENSE (&quot;AGREEMENT&quot;). ANY USE, REPRODUCTION OR
 34 | DISTRIBUTION OF THE PROGRAM CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS
 35 | AGREEMENT.</p>
 36 | 
 37 | <p><b>1. DEFINITIONS</b></p>
 38 | 
 39 | <p>&quot;Contribution&quot; means:</p>
 40 | 
 41 | <p class="list">a) in the case of the initial Contributor, the initial
 42 | code and documentation distributed under this Agreement, and</p>
 43 | <p class="list">b) in the case of each subsequent Contributor:</p>
 44 | <p class="list">i) changes to the Program, and</p>
 45 | <p class="list">ii) additions to the Program;</p>
 46 | <p class="list">where such changes and/or additions to the Program
 47 | originate from and are distributed by that particular Contributor. A
 48 | Contribution 'originates' from a Contributor if it was added to the
 49 | Program by such Contributor itself or anyone acting on such
 50 | Contributor's behalf. Contributions do not include additions to the
 51 | Program which: (i) are separate modules of software distributed in
 52 | conjunction with the Program under their own license agreement, and (ii)
 53 | are not derivative works of the Program.</p>
 54 | 
 55 | <p>&quot;Contributor&quot; means any person or entity that distributes
 56 | the Program.</p>
 57 | 
 58 | <p>&quot;Licensed Patents&quot; mean patent claims licensable by a
 59 | Contributor which are necessarily infringed by the use or sale of its
 60 | Contribution alone or when combined with the Program.</p>
 61 | 
 62 | <p>&quot;Program&quot; means the Contributions distributed in accordance
 63 | with this Agreement.</p>
 64 | 
 65 | <p>&quot;Recipient&quot; means anyone who receives the Program under
 66 | this Agreement, including all Contributors.</p>
 67 | 
 68 | <p><b>2. GRANT OF RIGHTS</b></p>
 69 | 
 70 | <p class="list">a) Subject to the terms of this Agreement, each
 71 | Contributor hereby grants Recipient a non-exclusive, worldwide,
 72 | royalty-free copyright license to reproduce, prepare derivative works
 73 | of, publicly display, publicly perform, distribute and sublicense the
 74 | Contribution of such Contributor, if any, and such derivative works, in
 75 | source code and object code form.</p>
 76 | 
 77 | <p class="list">b) Subject to the terms of this Agreement, each
 78 | Contributor hereby grants Recipient a non-exclusive, worldwide,
 79 | royalty-free patent license under Licensed Patents to make, use, sell,
 80 | offer to sell, import and otherwise transfer the Contribution of such
 81 | Contributor, if any, in source code and object code form. This patent
 82 | license shall apply to the combination of the Contribution and the
 83 | Program if, at the time the Contribution is added by the Contributor,
 84 | such addition of the Contribution causes such combination to be covered
 85 | by the Licensed Patents. The patent license shall not apply to any other
 86 | combinations which include the Contribution. No hardware per se is
 87 | licensed hereunder.</p>
 88 | 
 89 | <p class="list">c) Recipient understands that although each Contributor
 90 | grants the licenses to its Contributions set forth herein, no assurances
 91 | are provided by any Contributor that the Program does not infringe the
 92 | patent or other intellectual property rights of any other entity. Each
 93 | Contributor disclaims any liability to Recipient for claims brought by
 94 | any other entity based on infringement of intellectual property rights
 95 | or otherwise. As a condition to exercising the rights and licenses
 96 | granted hereunder, each Recipient hereby assumes sole responsibility to
 97 | secure any other intellectual property rights needed, if any. For
 98 | example, if a third party patent license is required to allow Recipient
 99 | to distribute the Program, it is Recipient's responsibility to acquire
100 | that license before distributing the Program.</p>
101 | 
102 | <p class="list">d) Each Contributor represents that to its knowledge it
103 | has sufficient copyright rights in its Contribution, if any, to grant
104 | the copyright license set forth in this Agreement.</p>
105 | 
106 | <p><b>3. REQUIREMENTS</b></p>
107 | 
108 | <p>A Contributor may choose to distribute the Program in object code
109 | form under its own license agreement, provided that:</p>
110 | 
111 | <p class="list">a) it complies with the terms and conditions of this
112 | Agreement; and</p>
113 | 
114 | <p class="list">b) its license agreement:</p>
115 | 
116 | <p class="list">i) effectively disclaims on behalf of all Contributors
117 | all warranties and conditions, express and implied, including warranties
118 | or conditions of title and non-infringement, and implied warranties or
119 | conditions of merchantability and fitness for a particular purpose;</p>
120 | 
121 | <p class="list">ii) effectively excludes on behalf of all Contributors
122 | all liability for damages, including direct, indirect, special,
123 | incidental and consequential damages, such as lost profits;</p>
124 | 
125 | <p class="list">iii) states that any provisions which differ from this
126 | Agreement are offered by that Contributor alone and not by any other
127 | party; and</p>
128 | 
129 | <p class="list">iv) states that source code for the Program is available
130 | from such Contributor, and informs licensees how to obtain it in a
131 | reasonable manner on or through a medium customarily used for software
132 | exchange.</p>
133 | 
134 | <p>When the Program is made available in source code form:</p>
135 | 
136 | <p class="list">a) it must be made available under this Agreement; and</p>
137 | 
138 | <p class="list">b) a copy of this Agreement must be included with each
139 | copy of the Program.</p>
140 | 
141 | <p>Contributors may not remove or alter any copyright notices contained
142 | within the Program.</p>
143 | 
144 | <p>Each Contributor must identify itself as the originator of its
145 | Contribution, if any, in a manner that reasonably allows subsequent
146 | Recipients to identify the originator of the Contribution.</p>
147 | 
148 | <p><b>4. COMMERCIAL DISTRIBUTION</b></p>
149 | 
150 | <p>Commercial distributors of software may accept certain
151 | responsibilities with respect to end users, business partners and the
152 | like. While this license is intended to facilitate the commercial use of
153 | the Program, the Contributor who includes the Program in a commercial
154 | product offering should do so in a manner which does not create
155 | potential liability for other Contributors. Therefore, if a Contributor
156 | includes the Program in a commercial product offering, such Contributor
157 | (&quot;Commercial Contributor&quot;) hereby agrees to defend and
158 | indemnify every other Contributor (&quot;Indemnified Contributor&quot;)
159 | against any losses, damages and costs (collectively &quot;Losses&quot;)
160 | arising from claims, lawsuits and other legal actions brought by a third
161 | party against the Indemnified Contributor to the extent caused by the
162 | acts or omissions of such Commercial Contributor in connection with its
163 | distribution of the Program in a commercial product offering. The
164 | obligations in this section do not apply to any claims or Losses
165 | relating to any actual or alleged intellectual property infringement. In
166 | order to qualify, an Indemnified Contributor must: a) promptly notify
167 | the Commercial Contributor in writing of such claim, and b) allow the
168 | Commercial Contributor to control, and cooperate with the Commercial
169 | Contributor in, the defense and any related settlement negotiations. The
170 | Indemnified Contributor may participate in any such claim at its own
171 | expense.</p>
172 | 
173 | <p>For example, a Contributor might include the Program in a commercial
174 | product offering, Product X. That Contributor is then a Commercial
175 | Contributor. If that Commercial Contributor then makes performance
176 | claims, or offers warranties related to Product X, those performance
177 | claims and warranties are such Commercial Contributor's responsibility
178 | alone. Under this section, the Commercial Contributor would have to
179 | defend claims against the other Contributors related to those
180 | performance claims and warranties, and if a court requires any other
181 | Contributor to pay any damages as a result, the Commercial Contributor
182 | must pay those damages.</p>
183 | 
184 | <p><b>5. NO WARRANTY</b></p>
185 | 
186 | <p>EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS
187 | PROVIDED ON AN &quot;AS IS&quot; BASIS, WITHOUT WARRANTIES OR CONDITIONS
188 | OF ANY KIND, EITHER EXPRESS OR IMPLIED INCLUDING, WITHOUT LIMITATION,
189 | ANY WARRANTIES OR CONDITIONS OF TITLE, NON-INFRINGEMENT, MERCHANTABILITY
190 | OR FITNESS FOR A PARTICULAR PURPOSE. Each Recipient is solely
191 | responsible for determining the appropriateness of using and
192 | distributing the Program and assumes all risks associated with its
193 | exercise of rights under this Agreement , including but not limited to
194 | the risks and costs of program errors, compliance with applicable laws,
195 | damage to or loss of data, programs or equipment, and unavailability or
196 | interruption of operations.</p>
197 | 
198 | <p><b>6. DISCLAIMER OF LIABILITY</b></p>
199 | 
200 | <p>EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT
201 | NOR ANY CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT,
202 | INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING
203 | WITHOUT LIMITATION LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF
204 | LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
205 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OR
206 | DISTRIBUTION OF THE PROGRAM OR THE EXERCISE OF ANY RIGHTS GRANTED
207 | HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.</p>
208 | 
209 | <p><b>7. GENERAL</b></p>
210 | 
211 | <p>If any provision of this Agreement is invalid or unenforceable under
212 | applicable law, it shall not affect the validity or enforceability of
213 | the remainder of the terms of this Agreement, and without further action
214 | by the parties hereto, such provision shall be reformed to the minimum
215 | extent necessary to make such provision valid and enforceable.</p>
216 | 
217 | <p>If Recipient institutes patent litigation against any entity
218 | (including a cross-claim or counterclaim in a lawsuit) alleging that the
219 | Program itself (excluding combinations of the Program with other
220 | software or hardware) infringes such Recipient's patent(s), then such
221 | Recipient's rights granted under Section 2(b) shall terminate as of the
222 | date such litigation is filed.</p>
223 | 
224 | <p>All Recipient's rights under this Agreement shall terminate if it
225 | fails to comply with any of the material terms or conditions of this
226 | Agreement and does not cure such failure in a reasonable period of time
227 | after becoming aware of such noncompliance. If all Recipient's rights
228 | under this Agreement terminate, Recipient agrees to cease use and
229 | distribution of the Program as soon as reasonably practicable. However,
230 | Recipient's obligations under this Agreement and any licenses granted by
231 | Recipient relating to the Program shall continue and survive.</p>
232 | 
233 | <p>Everyone is permitted to copy and distribute copies of this
234 | Agreement, but in order to avoid inconsistency the Agreement is
235 | copyrighted and may only be modified in the following manner. The
236 | Agreement Steward reserves the right to publish new versions (including
237 | revisions) of this Agreement from time to time. No one other than the
238 | Agreement Steward has the right to modify this Agreement. The Eclipse
239 | Foundation is the initial Agreement Steward. The Eclipse Foundation may
240 | assign the responsibility to serve as the Agreement Steward to a
241 | suitable separate entity. Each new version of the Agreement will be
242 | given a distinguishing version number. The Program (including
243 | Contributions) may always be distributed subject to the version of the
244 | Agreement under which it was received. In addition, after a new version
245 | of the Agreement is published, Contributor may elect to distribute the
246 | Program (including its Contributions) under the new version. Except as
247 | expressly stated in Sections 2(a) and 2(b) above, Recipient receives no
248 | rights or licenses to the intellectual property of any Contributor under
249 | this Agreement, whether expressly, by implication, estoppel or
250 | otherwise. All rights in the Program not expressly granted under this
251 | Agreement are reserved.</p>
252 | 
253 | <p>This Agreement is governed by the laws of the State of New York and
254 | the intellectual property laws of the United States of America. No party
255 | to this Agreement will bring a legal action under this Agreement more
256 | than one year after the cause of action arose. Each party waives its
257 | rights to a jury trial in any resulting litigation.</p>
258 | 
259 | </body>
260 | 
261 | </html>
262 | 


--------------------------------------------------------------------------------
/project.clj:
--------------------------------------------------------------------------------
 1 | (defproject clojurescript-lua "0.1.0"
 2 |   :dependencies [[org.clojure/clojure "1.4.0"]
 3 |                  [org.clojure/data.json "0.1.2"]]
 4 |   :plugins [[lein-swank "1.4.0"]
 5 |             [lein-pprint "1.1.1"]]
 6 |   :extra-classpath-dirs ["libclojurescript.jar"]
 7 |   :resources-path "cljs"
 8 |   :source-path "src"
 9 |   :main cljs.lua.compile
10 | )
11 | 


--------------------------------------------------------------------------------
/script/clojurescript_project_file.clj:
--------------------------------------------------------------------------------
 1 | (defproject libclojurescript "0.1.0"
 2 |   :dependencies [[org.clojure/clojure "1.4.0"]
 3 |                  [org.clojure/clojure-contrib "1.2.0"]]
 4 |   :plugins [[lein-swank "1.4.0"]
 5 |             [lein-pprint "1.1.1"]]
 6 |   :source-path "src/clj"
 7 |   :jar-name "libclojurescript.jar"
 8 |   :resources-path "src/cljs"
 9 | )
10 | 


--------------------------------------------------------------------------------
/script/init.sh:
--------------------------------------------------------------------------------
 1 | mkdir lib
 2 | 
 3 | echo "Getting Clojure ..."
 4 | wget http://repo1.maven.org/maven2/org/clojure/clojure/1.4.0/clojure-1.4.0.zip 2> /dev/null >&1
 5 | unzip -qu clojure-1.4.0.zip
 6 | mv clojure-1.4.0/clojure-1.4.0.jar lib/clojure.jar
 7 | rm clojure-1.4.0 -rf
 8 | echo "Getting data.json ..."
 9 | wget http://repo1.maven.org/maven2/org/clojure/data.json/0.1.3/data.json-0.1.3.jar 2> /dev/null >&1
10 | mv data.json-0.1.3.jar lib
11 | 
12 | echo "Getting ClojureScript ..."
13 | wget http://search.maven.org/remotecontent?filepath=org/clojure/clojurescript/0.0-1450/clojurescript-0.0-1450.jar -O libclojurescript.jar 2> /dev/null >&1
14 | 
15 | echo "Success !"
16 | 


--------------------------------------------------------------------------------
/script/repl:
--------------------------------------------------------------------------------
 1 | #!/bin/bash
 2 | 
 3 | DIR="$( cd "$( dirname "${BASH_SOURCE[0]}" )" && pwd )"
 4 | 
 5 | CLJSC_CP=''
 6 | for next in $DIR/../cljs $DIR/../lib/* $DIR/../src $DIR/../libclojurescript.jar; do
 7 |     CLJSC_CP=$CLJSC_CP:$next
 8 | done
 9 | 
10 | if command -v rlwrap >/dev/null 2>&1; then
11 |     JCMD="java"
12 | else
13 |     JCMD="java"
14 | fi
15 | 
16 | $JCMD -server -cp $CLJSC_CP clojure.main -e \
17 | "(require '[cljs.lua.repl :as repl])
18 | (repl/-main)"
19 | 


--------------------------------------------------------------------------------
/script/test:
--------------------------------------------------------------------------------
1 | #! /bin/bash
2 | 
3 | DIR="$( cd "$( dirname "${BASH_SOURCE[0]}" )" && pwd )"
4 | 
5 | $DIR/../bin/cljsc $DIR/../test/core_test.cljs > out.lua
6 | lua out.lua
7 | rm out.lua
8 | 


--------------------------------------------------------------------------------
/src/cljs/cljsloader.clj:
--------------------------------------------------------------------------------
 1 | ;   Copyright (c) Rich Hickey. All rights reserved.
 2 | ;   The use and distribution terms for this software are covered by the
 3 | ;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
 4 | ;   which can be found in the file epl-v10.html at the root of this distribution.
 5 | ;   By using this software in any fashion, you are agreeing to be bound by
 6 | ;   the terms of this license.
 7 | ;   You must not remove this notice, or any other, from this software.
 8 | 
 9 | (ns cljs.cljsloader
10 |   (:require [clojure.java.io :as io]))
11 | 
12 | (defn read-or-nil [rdr]
13 |   (try (read rdr) (catch RuntimeException e nil)))
14 | 
15 | (defn make-forms-seq
16 |   "Construct a lazy sequence of clojure forms from input f.
17 |    f can be anything that can be coerced to a reader"
18 |   [f]
19 |   (letfn [(forms-seq [rdr]
20 |             (let [form (read-or-nil rdr)]
21 |               (if (nil? form) []
22 |                   (lazy-seq (cons form (forms-seq rdr))))))]
23 |     (forms-seq (java.io.PushbackReader. (io/reader f)))))
24 | 
25 | (defn keep-form? [form]
26 |   (contains? #{'ns 'def 'defn 'deftype 'extend-type} (first form)))
27 | 
28 | (defn signature [form]
29 |   (if (= 'defn (first form))
30 |     `(def ~(second form))
31 |     (take 2 form)))
32 | 
33 | (defn make-override-map [forms-seq]
34 |   (apply hash-map (mapcat (fn [a] [(signature a) a]) forms-seq)))
35 | 
36 | (defn core-forms-seq
37 |   "Will load every form from core.cljs, except those who are defined in override-file
38 |    override-file can be anything that can be coerced to a reader by io/reader"
39 |   ([override-file & {:keys [replace-forms extra-file-before extra-file-after]}]
40 |      (let [core-forms (make-forms-seq (io/resource "cljs/core.cljs")) 
41 |            override-map (-> override-file make-forms-seq make-override-map)
42 |            replace-forms (or replace-forms {})
43 |            forms-override (for [form core-forms]
44 |                             (let [sig (signature form)]
45 |                               (cond
46 |                                (contains? override-map sig) (override-map sig)
47 |                                (contains? replace-forms sig) (override-map (replace-forms sig))
48 |                                 :else form)))
49 |            forms-filtered (remove nil? forms-override)]
50 |        (lazy-cat (if extra-file-before (make-forms-seq extra-file-before) [])
51 |                  forms-filtered
52 |                  (if extra-file-after (make-forms-seq extra-file-after) [])))))


--------------------------------------------------------------------------------
/src/cljs/lua/common.clj:
--------------------------------------------------------------------------------
 1 | ;   Copyright (c) Rich Hickey. All rights reserved.
 2 | ;   The use and distribution terms for this software are covered by the
 3 | ;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
 4 | ;   which can be found in the file epl-v10.html at the root of this distribution.
 5 | ;   By using this software in any fashion, you are agreeing to be bound by
 6 | ;   the terms of this license.
 7 | ;   You must not remove this notice, or any other, from this software.
 8 | 
 9 | 
10 | (ns cljs.lua.common
11 |   (:require [cljs.cljsloader :as cloader]
12 |             [clojure.java.io :as io]
13 |             [cljs.analyzer :as ana]))
14 | 
15 | (def replace-forms {'(extend-type js/Date) nil                   
16 |                     '(extend-type array) '(deftype Array)
17 |                     '(set! js/String.prototype.apply) nil
18 |                     '(extend-type js/String) nil
19 |                     '(deftype Keyword) nil
20 |                     '(set! cljs.core.MultiFn.prototype.call) nil
21 |                     '(set! cljs.core.MultiFn.prototype.apply) nil})
22 | 
23 | (def core-forms-seq
24 |   (cloader/core-forms-seq (io/resource "core-lua.cljs")
25 |                           :extra-file-before (io/resource "core-lua-init.cljs")
26 |                           :extra-file-after (io/resource "core-lua-extra.cljs")
27 |                           :replace-forms replace-forms))
28 | 
29 |  	  	
30 | (defn new-env
31 |   ([context] {:ns (@ana/namespaces ana/*cljs-ns*) :context context :locals {}})
32 |   ([] (new-env :return)))
33 | 
34 | (def file-sep java.io.File/separator)
35 | 
36 | (defn get-cljs-dir []
37 |   (str (System/getProperty "user.home") file-sep ".cljslua"))
38 | 
39 | (defn common-libs-path []
40 |   (str (get-cljs-dir) file-sep "libs"))
41 | 
42 | (defn init-dirs []
43 |   (.mkdirs (io/file (common-libs-path))))
44 | 
45 | (def core-lib-path (str (common-libs-path) file-sep "core.cljlib"))


--------------------------------------------------------------------------------
/src/cljs/lua/compile.clj:
--------------------------------------------------------------------------------
  1 | ;   Copyright (c) Rich Hickey. All rights reserved.
  2 | ;   The use and distribution terms for this software are covered by the
  3 | ;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  4 | ;   which can be found in the file epl-v10.html at the root of this distribution.
  5 | ;   By using this software in any fashion, you are agreeing to be bound by
  6 | ;   the terms of this license.
  7 | ;   You must not remove this notice, or any other, from this software.
  8 | 
  9 | (ns cljs.lua.compile
 10 |   (:require [clojure.java.io :as io]
 11 |             [cljs.lua.compiler :as comp]
 12 |             [cljs.analyzer :as ana]
 13 |             [cljs.cljsloader :as cloader]
 14 |             [cljs.lua.common :as com])
 15 |   (:import  [java.io PrintWriter File FileInputStream FileOutputStream]))
 16 | 
 17 | (def ^:dynamic *cljs-files*)
 18 | 
 19 | (defn emit-lib-header [ns]
 20 |   (println "-- CLJS/LUA " ns))
 21 | 
 22 | (defn files-in
 23 |   "Return a sequence of all files with given extension in the given directory."
 24 |   [ext dir]
 25 |   (filter #(let [name (.getName ^java.io.File %)]
 26 |              (and (.endsWith name (str "." ext))
 27 |                   (not= \. (first name))))
 28 |           (file-seq dir)))
 29 | 
 30 | (def cljs-files-in
 31 |   (partial files-in "cljs"))
 32 | 
 33 | (defn lib-ns [lib-file]
 34 |   (let [first-line (binding [*in* (clojure.java.io/reader lib-file)]
 35 |                      (read-line))]
 36 |     (if (.startsWith first-line "-- CLJS/LUA")
 37 |       (symbol (nth (.split first-line " ") 3)))))
 38 | 
 39 | (def lib-files-map
 40 |   (apply hash-map
 41 |          (mapcat (fn [f] [(lib-ns f) f])
 42 |                  (files-in "cljlib" (io/file (com/common-libs-path))))))
 43 | 
 44 | (defn ns-decl [file]
 45 |   (let [first-form
 46 |         (->> file
 47 |              cloader/make-forms-seq
 48 |              first
 49 |              (ana/analyze (ana/empty-env)))]
 50 |     (if (= :ns (:op first-form))
 51 |       first-form
 52 |       nil)))
 53 | 
 54 | (defn make-files-map [dir]
 55 |   (apply hash-map (mapcat (fn [f] [((ns-decl f) :name) f]) (cljs-files-in dir))))
 56 | 
 57 | (defn compile-seq [seq]
 58 |   (doseq [form seq]
 59 |     (comp/emit (ana/analyze (ana/empty-env) form))))
 60 | 
 61 | (defn compile-file [file optmap]
 62 |   (compile-seq (cloader/make-forms-seq file)))
 63 | 
 64 | (defn get-parent [file]
 65 |   (.getParentFile (io/file (.getCanonicalPath file))))
 66 | 
 67 | (defn compile-with-deps [file optmap]
 68 |   (let [nsdecl (ns-decl file)
 69 |         requires (nsdecl :requires)]
 70 |     (doseq [[ns-alias ns-name] requires]
 71 |       (if (*cljs-files* ns-name)
 72 |         (compile-with-deps (*cljs-files* ns-name) optmap)
 73 |         (if (lib-files-map ns-name)
 74 |           (println (slurp (lib-files-map ns-name)))
 75 |           (throw (Exception. (str "Dependency not found : " ns-name "!"))))))
 76 |     (compile-file file optmap)))
 77 | 
 78 | (defn compile-root-file [file {:keys [no-deps] :as optmap}]
 79 |   (binding [*cljs-files* (make-files-map (get-parent file))]
 80 |     (compile-with-deps file optmap)))
 81 | 
 82 | (defn -compile [file {:keys [no-deps as-lib] :as optmap}]
 83 |   (let [nsd (ns-decl file)]
 84 |     ;; Adding builtins
 85 |     (if-not no-deps (println (slurp (io/resource "builtins.lua"))))
 86 |     ;; Adding core.cljs
 87 |     (if-not no-deps (println (slurp com/core-lib-path)))
 88 |     (if as-lib (emit-lib-header (second (nsd :form))))
 89 |     ;; Compile main file and deps
 90 |     ((if (and nsd (not no-deps)) compile-root-file compile-file) file optmap)))
 91 | 
 92 | (defn remove-dots [s]
 93 |   (.replaceAll (str s) "\\." "_"))
 94 | 
 95 | (defn lib-file-name [src-file {:keys [as-lib]}]
 96 |   (let [nsd (ns-decl src-file)
 97 |         fname (if nsd
 98 |                 (remove-dots (comp/munge (second (nsd :form))))
 99 |                 (throw (Exception. "No ns decl")))]
100 |     (str (com/common-libs-path) com/file-sep fname ".cljlib")))
101 | 
102 | (defn mk-out-file [src-file {:keys [out-file as-lib] :as optmap}]
103 |   (let [o
104 |         (if out-file out-file
105 |             (if as-lib (lib-file-name src-file optmap) *out*))]
106 |     (println o)
107 |     (io/writer o)))
108 |   
109 | (defn -main [src-file & {:keys [out-file as-lib] :as optmap}]
110 |     (binding [ana/*cljs-ns* 'cljs.user
111 |               ana/*cljs-static-fns* true
112 |               comp/*ns-emit-require* false]
113 |       (let [src-file (io/file src-file)]
114 |         (if (.isDirectory src-file)
115 |           (println "Input must be a cljsc file !")
116 |           (binding [*out* (mk-out-file src-file optmap)]
117 |             (-compile src-file (if as-lib (assoc optmap :no-deps true) optmap)))))))
118 | 
119 | (defn compile-core []
120 |   (let [core-lib (io/file com/core-lib-path)]
121 |     (when-not (.exists core-lib)
122 |       (println "Compiling core ...")
123 |       (binding [ana/*cljs-ns* 'cljs.user
124 |                 ana/*cljs-static-fns* true
125 |                 comp/*ns-emit-require* false
126 |                 *out* (io/writer core-lib)]
127 |         (emit-lib-header 'cljs.core)
128 |         (compile-seq com/core-forms-seq)))))


--------------------------------------------------------------------------------
/src/cljs/lua/compiler.clj:
--------------------------------------------------------------------------------
  1 | ;   Copyright (c) Rich Hickey. All rights reserved.
  2 | ;   The use and distribution terms for this software are covered by the
  3 | ;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  4 | ;   which can be found in the file epl-v10.html at the root of this distribution.
  5 | ;   By using this software in any fashion, you are agreeing to be bound by
  6 | ;   the terms of this license.
  7 | ;   You must not remove this notice, or any other, from this software.
  8 | 
  9 | (ns cljs.lua.compiler
 10 |   (:refer-clojure :exclude [munge])
 11 |   (:require [cljs.analyzer :as ana]
 12 |             [clojure.java.io :as io]
 13 |             [clojure.string :as string]
 14 |             [clojure.pprint :as ppr]
 15 |             [cljs.tagged-literals :as tags])
 16 |   (:import java.lang.StringBuilder))
 17 | 
 18 | (def ^:dynamic *position* nil)
 19 | (def ^:dynamic *finalizer* nil)
 20 | (def ^:dynamic *loop-var* nil)
 21 | (def ^:dynamic *emit-comments* false)
 22 | (def ^:dynamic *def-name* nil)
 23 | (def ^:dynamic *def-symbol* nil)
 24 | (def ^:dynamic *ns-emit-require* true)
 25 | 
 26 | (defn in-expr? [env]
 27 |   (= :expr (:context env)))
 28 | 
 29 | (def lua-reserved
 30 |   #{"and" "break" "do" "else" "elseif" "end" "for"
 31 |     "function" "if" "local" "nil" "not" "or" "repeat" "return" "then"
 32 |     "until" "while" "bit"})
 33 | 
 34 | (def cljs-reserved-file-names #{"deps.cljs"})
 35 | 
 36 | (defn munge
 37 |   ([s] (munge s lua-reserved))
 38 |   ([s reserved]
 39 |     (let [ss (string/replace (str s) #"\/(.)" ".$1") ; Division is special
 40 |           ss (apply str (map #(if (reserved %) (str % "__") %)
 41 |                              (string/split ss #"(?<=\.)|(?=\.)")))
 42 |           ms (clojure.lang.Compiler/munge ss)]
 43 |       (if (symbol? s)
 44 |         (symbol ms)
 45 |         ms))))
 46 | 
 47 | (defn- comma-sep [xs]
 48 |   (interpose "," xs))
 49 | 
 50 | (defn- escape-char [^Character c]
 51 |   (let [cp (.hashCode c)]
 52 |     (case cp
 53 |       ;; Handle printable escapes before ASCII
 54 |       34 "\\\""
 55 |       92 "\\\\"
 56 |       ;; Handle non-printable escapes
 57 |       8 "\\b"
 58 |       12 "\\f"
 59 |       10 "\\n"
 60 |       13 "\\r"
 61 |       9 "\\t"
 62 |       (if (< 31 cp 127)
 63 |         c ; Print simple ASCII characters
 64 |         c )))) ; (format "\\u%04X" cp))))) ; Any other character is Unicode
 65 | 
 66 | 
 67 | (defn- escape-string [^CharSequence s]
 68 |   (let [sb (StringBuilder. (count s))]
 69 |     (doseq [c s]
 70 |       (.append sb (escape-char c)))
 71 |     (.toString sb)))
 72 | 
 73 | (defn- wrap-in-double-quotes [x]
 74 |   (str \" x \"))
 75 | 
 76 | (defmulti emit :op)
 77 | 
 78 | (defn emits [& xs]
 79 |   (doseq [x xs]
 80 |     (cond
 81 |       (nil? x) nil
 82 |       (map? x) (emit x)
 83 |       (seq? x) (apply emits x)
 84 |       (fn? x)  (x)
 85 |       :else (do
 86 |               (let [s (print-str x)]
 87 |                 (when *position*
 88 |                   (swap! *position* (fn [[line column]]
 89 |                                       [line (+ column (count s))])))
 90 |                 (print s)))))
 91 |   nil)
 92 | 
 93 | (defn ^String emit-str [expr]
 94 |   (with-out-str (emit expr)))
 95 | 
 96 | (defn emitln [& xs]
 97 |   (apply emits xs)
 98 |   ;; Prints column-aligned line number comments; good test of *position*.
 99 |   ;(when *position*
100 |   ;  (let [[line column] @*position*]
101 |   ;    (print (apply str (concat (repeat (- 120 column) \space) ["// " (inc line)])))))
102 |   (println)
103 |   (when *position*
104 |     (swap! *position* (fn [[line column]]
105 |                         [(inc line) 0])))
106 |   nil)
107 | 
108 | (defmulti emit-constant class)
109 | (defmethod emit-constant nil [x] (emits "nil"))
110 | (defmethod emit-constant Long [x] (emits x))
111 | (defmethod emit-constant Integer [x] (emits x)) ; reader puts Integers in metadata
112 | (defmethod emit-constant Double [x] (emits x))
113 | (defmethod emit-constant String [x]
114 |   (emits "(" (wrap-in-double-quotes (escape-string x)) ")"))
115 | (defmethod emit-constant Boolean [x] (emits (if x "true" "false")))
116 | (defmethod emit-constant Character [x]
117 |   (emits (wrap-in-double-quotes (escape-char x))))
118 | 
119 | (defmethod emit-constant java.util.regex.Pattern [x]
120 |   (let [[_ flags pattern] (re-find #"^(?:\(\?(x[idmsux]*)\))?(.*)" (str x))]
121 |     (emits \/ (.replaceAll (re-matcher #"/" pattern) "\\\\/") \/ flags)))
122 | 
123 | (defmethod emit-constant clojure.lang.Keyword [x]
124 |            (emits "(" \" "\\239\\183\\144" \'
125 |                   (if (namespace x)
126 |                     (str (namespace x) "/") "")
127 |                   (name x)
128 |                   \" ")"))
129 | 
130 | (defmethod emit-constant clojure.lang.Symbol [x]
131 |   (emits "(" \" "\\239\\183\\145" \'
132 |          (if (namespace x)
133 |            (str (namespace x) "/") "")
134 |          (name x)
135 |          \" ")"))
136 | 
137 | (defn- emit-meta-constant [x & body]
138 |   (if (meta x)
139 |     (do
140 |       (emits "cljs.core.with_meta(" body ",")
141 |       (emit-constant (meta x))
142 |       (emits ")"))
143 |     (emits body)))
144 | 
145 | (defmethod emit-constant clojure.lang.PersistentList$EmptyList [x]
146 |   (emit-meta-constant x "cljs.core.List.EMPTY"))
147 | 
148 | (defmethod emit-constant clojure.lang.PersistentList [x]
149 |   (emit-meta-constant x
150 |     (concat ["cljs.core.list("]
151 |             (comma-sep (map #(fn [] (emit-constant %)) x))
152 |             [")"])))
153 | 
154 | (defmethod emit-constant clojure.lang.Cons [x]
155 |   (emit-meta-constant x
156 |     (concat ["cljs.core.list("]
157 |             (comma-sep (map #(fn [] (emit-constant %)) x))
158 |             [")"])))
159 | 
160 | (defmethod emit-constant clojure.lang.IPersistentVector [x]
161 |   (emit-meta-constant x
162 |     (concat ["cljs.core.vec(builtins.array("]
163 |             (comma-sep (map #(fn [] (emit-constant %)) x))
164 |             ["))"])))
165 | 
166 | (defmethod emit-constant clojure.lang.IPersistentMap [x]
167 |   (emit-meta-constant x
168 |     (concat ["cljs.core.hash_map("]
169 |             (comma-sep (map #(fn [] (emit-constant %))
170 |                             (apply concat x)))
171 |             [")"])))
172 | 
173 | (defmethod emit-constant clojure.lang.PersistentHashSet [x]
174 |   (emit-meta-constant x
175 |     (concat ["cljs.core.set(builtins.array("]
176 |             (comma-sep (map #(fn [] (emit-constant %)) x))
177 |             ["))"])))
178 | 
179 | (defn emit-block
180 |   [context statements ret]
181 |   (when statements
182 |     (emits statements))
183 |   (emit ret))
184 | 
185 | (defmacro emit-wrap [env & body]
186 |   `(let [env# ~env]
187 |      (when (= :return (:context env#))
188 |        (emits "return "))
189 |      ~@body
190 |      (when-not (= :expr (:context env#)) (emitln ""))))
191 | 
192 | (defmacro when-emit-wrap [emit-wrap? env & body]
193 |   `(if ~emit-wrap?
194 |      (emit-wrap ~env ~@body)
195 |     ~@body))
196 | 
197 | (defmethod emit :no-op
198 |   [m] (emitln "do end"))
199 | 
200 | (defmethod emit :var
201 |   [{:keys [info env] :as arg}]
202 |   (let [n (:name info)
203 |         n (if (= (namespace n) "lua")
204 |             (name n)
205 |             n)
206 |         n (if (and *def-name* (= *def-name* (str n))) *def-symbol* n)]
207 |     (emit-wrap env (emits (munge n)))))
208 | 
209 | (defmethod emit :meta
210 |   [{:keys [expr meta env]}]
211 |   (emit-wrap env
212 |     (emits "cljs.core.with_meta(" expr "," meta ")")))
213 | 
214 | (def ^:private array-map-threshold 16)
215 | (def ^:private obj-map-threshold 32)
216 | 
217 | (defmethod emit :map
218 |   [{:keys [env simple-keys? keys vals]}]
219 |   (emit-wrap env
220 |     (cond
221 |       (zero? (count keys))
222 |       (emits "cljs.core.ObjMap.EMPTY")
223 | 
224 |       (and simple-keys? (<= (count keys) obj-map-threshold))
225 |       (emits "cljs.core.ObjMap.fromObject(builtins.array("
226 |              (comma-sep keys) ; keys
227 |              "),{"
228 |              (comma-sep (map (fn [k v]
229 |                                (with-out-str  (emits "[" k "]=" v)))
230 |                              keys vals)) ; js obj
231 |              "})")
232 | 
233 |       (<= (count keys) array-map-threshold)
234 |       (emits "cljs.core.PersistentArrayMap.fromArrays(builtins.array("
235 |              (comma-sep keys)
236 |              "),builtins.array("
237 |              (comma-sep vals)
238 |              "))")
239 | 
240 |       :else
241 |       (emits "cljs.core.PersistentHashMap.fromArrays(builtins.array("
242 |              (comma-sep keys)
243 |              "),builtins.array("
244 |              (comma-sep vals)
245 |              "))"))))
246 | 
247 | (defmethod emit :vector
248 |   [{:keys [items env]}]
249 |   (emit-wrap env
250 |     (if (empty? items)
251 |       (emits "cljs.core.PersistentVector.EMPTY")
252 |       (emits "cljs.core.PersistentVector.fromArray(builtins.array("
253 |              (comma-sep items) "), true)"))))
254 | 
255 | (defmethod emit :set
256 |   [{:keys [items env]}]
257 |   (emit-wrap env
258 |     (emits "cljs.core.set(builtins.array("
259 |            (comma-sep items) "))")))
260 | 
261 | (defmethod emit :constant
262 |   [{:keys [form env]}]
263 |   (when-not (= :statement (:context env))
264 |     (emit-wrap env (emit-constant form))))
265 | 
266 | (defn get-tag [e]
267 |   (or (-> e :tag)
268 |       (-> e :info :tag)))
269 | 
270 | (defn infer-tag [e]
271 |   (if-let [tag (get-tag e)]
272 |     tag
273 |     (case (:op e)
274 |       :let (infer-tag (:ret e))
275 |       :if (let [then-tag (infer-tag (:then e))
276 |                 else-tag (infer-tag (:else e))]
277 |             (when (= then-tag else-tag)
278 |               then-tag))
279 |       :constant (case (:form e)
280 |                   true 'boolean
281 |                   false 'boolean
282 |                   nil)
283 |       nil)))
284 | 
285 | (defn safe-test? [e]
286 |   (let [tag (infer-tag e)]
287 |     (or (#{'boolean 'seq} tag)
288 |         (when (= (:op e) :constant)
289 |           (let [form (:form e)]
290 |             (not (or (and (string? form) (= form ""))
291 |                      (and (number? form) (zero? form)))))))))
292 | 
293 | (defmethod emit :if
294 |   [{:keys [test then else env unchecked]}]
295 |   (let [checked (not (or unchecked (safe-test? test)))
296 |         test-str (str (when checked "cljs.core.truth_") "(" (emit-str test) ")")]
297 |     (if (in-expr? env)
298 |       (emits "unbox_tern(" test-str " and box_tern(" then ") or box_tern(" else "))")
299 |       (do
300 |         (emitln "if " test-str " then")
301 |         (emitln then " else ")
302 |         (emitln else " end")))))
303 | 
304 | (defmethod emit :throw
305 |   [{:keys [throw env]}]
306 |   (do
307 |     (when (in-expr? env) (emits "(function()"))
308 |     (emitln "error(" throw ")")
309 |     (when (in-expr? env) (emits ")()"))))
310 | 
311 | (defn emit-comment
312 |   "Emit a nicely formatted comment string."
313 |   [doc jsdoc]
314 | 
315 |   (when *emit-comments*
316 |     (let [docs (when doc [doc])
317 |           docs (if jsdoc (concat docs jsdoc) docs)
318 |           docs (remove nil? docs)]
319 |       (letfn [(print-comment-lines [e] (doseq [next-line (string/split-lines e)]
320 |                                          (emitln "  " (string/trim next-line))))]
321 |         (when (seq docs)
322 |           (emitln "--[")
323 |           (doseq [e docs]
324 |             (when e
325 |               (print-comment-lines e)))
326 |           (emitln "--]"))))))
327 | 
328 | (defmethod emit :def
329 |   [{:keys [name init env doc export]}]
330 |   (binding [*def-name* (clojure.core/name name)
331 |             *def-symbol* name]
332 |     (when init
333 |       (let [mname (munge name)]
334 |         (emit-comment doc (:jsdoc init))
335 |         (when (in-expr? env) (emits "function () "))
336 |         (emitln mname " = " init)
337 |         (when (in-expr? env) (emits "; return " mname))))))
338 | 
339 | (defn emit-apply-to
340 |   [{:keys [name params env]}]
341 |   (let [arglist (gensym "arglist__")
342 |         delegate-name (str (munge name) "__delegate")
343 |         params (map munge params)]
344 |     (emitln "(function (" arglist ")")
345 |     (doseq [[i param] (map-indexed vector (butlast params))]
346 |       (emits "local " param " = cljs.core.first(")
347 |       (dotimes [_ i] (emits "cljs.core.next("))
348 |       (emits arglist ")")
349 |       (dotimes [_ i] (emits ")"))
350 |       (emitln ""))
351 |     (if (< 1 (count params))
352 |       (do
353 |         (emits "local " (last params) " = cljs.core.rest(")
354 |         (dotimes [_ (- (count params) 2)] (emits "cljs.core.next("))
355 |         (emits arglist)
356 |         (dotimes [_ (- (count params) 2)] (emits ")"))
357 |         (emitln ")")
358 |         (emitln "return " delegate-name "(" (string/join ", " params) ")"))
359 |       (do
360 |         (emits "local " (last params) " = ")
361 |         (emits "cljs.core.seq(" arglist ")")
362 |         (emitln " ")
363 |         (emitln "return " delegate-name "(" (string/join ", " params) ")")))
364 |     (emits "end)")))
365 | 
366 | (defn emit-fn-method
367 |   ([emit-wrap? {:keys [gthis name variadic params statements ret env recurs max-fixed-arity]}]
368 |      (when-emit-wrap
369 |       emit-wrap? env
370 |       (binding [*loop-var* (if recurs (gensym "loop_var_fnm") *loop-var*)]        
371 |         (emitln "(function (" (comma-sep (map munge params)) ")")
372 |         (when gthis
373 |           (emitln "local " gthis " = " (munge (first params))))
374 |         (when recurs
375 |           (emitln "local " *loop-var* " = true")
376 |           (emitln "while " *loop-var* " do")
377 |           (emitln *loop-var* " = false"))
378 |         (emit-block :return statements ret)
379 |         (when recurs
380 |           (emitln "end"))
381 |         (emits "end)"))))
382 |   ([mp]
383 |      (emit-fn-method true mp)))
384 | 
385 | (defn emit-variadic-fn-method
386 |   ([emit-wrap? {:keys [gthis name variadic params statements ret env recurs max-fixed-arity] :as f}]
387 |      (when-emit-wrap
388 |       emit-wrap?
389 |       env
390 |       (let [name (or name (gensym))
391 |             mname (munge name)
392 |             params (map munge params)
393 |             delegate-name (str mname "__delegate")]
394 |         (emitln "(function () ")
395 |         (emitln "local " delegate-name " = function (" (comma-sep params) ")")        
396 |         (binding [*loop-var* (if recurs (gensym "loop_var_vfnm") *loop-var*)]
397 |           (when recurs
398 |             (emitln "local " *loop-var* " = true")
399 |             (emitln "while " *loop-var* " do")
400 |             (emitln *loop-var* " = false"))
401 |           (emit-block :return statements ret)
402 |           (when recurs
403 |             (emitln "end")))
404 |         
405 |         (emitln "end")
406 |         
407 |         (emitln "local " mname " = {}")
408 |         (emitln "local " mname "__func = function (_, " (comma-sep
409 |                                                          (if variadic
410 |                                                            (concat (butlast params) ["..."])
411 |                                                            params)) ")")
412 |         (when gthis
413 |           (emitln "local " gthis " = " (munge (first params))))
414 |         (when variadic
415 |           (emitln "local " (last params) " = cljs.core.array_seq(builtins.array(...),0);"))
416 |         
417 |         (emitln "return " delegate-name "(" (comma-sep params) ")")
418 |         (emitln "end")
419 |         
420 |         (emitln mname ".cljs__lang__maxFixedArity = " max-fixed-arity)
421 |         (emits mname ".cljs__lang__applyTo = ")
422 |         (emit-apply-to (assoc f :name name))
423 |         (emitln "")
424 |         (emitln mname ".cljs__lang__arity__variadic = " delegate-name)
425 |         (emitln "setmetatable(" mname ", {__call = " mname "__func , __index = builtins.functions_metatable.__index})")
426 |         (emitln "return " mname)
427 |         (emitln "end)()"))))
428 |   ([mp] (emit-variadic-fn-method true mp)))
429 | 
430 | (defmethod emit :fn
431 |   [{:keys [name env methods max-fixed-arity variadic recur-frames loop-lets]}]
432 |   ;;fn statements get erased, serve no purpose and can pollute scope if named
433 |   (when-not (= :statement (:context env))
434 |     (let [loop-locals (->> (concat (mapcat :names (filter #(and % @(:flag %)) recur-frames))
435 |                                    (mapcat :names loop-lets))
436 |                            (map munge)
437 |                            seq)
438 |           is-return (= :return (:context env))]
439 |       (when name
440 |         (when is-return (emits "return "))
441 |         (emitln "(function () ")
442 |         (emits "local " (munge name) ";" (munge name) " = "))
443 |       (when loop-locals
444 |         (when (= :return (:context env))
445 |           (emits "return "))
446 |         (emitln "((function (" (comma-sep loop-locals) ")")
447 |         (when-not (= :return (:context env))
448 |           (emits "return ")))
449 |       (if (= 1 (count methods))
450 |         (if variadic
451 |           (emit-variadic-fn-method (not name) (assoc (first methods) :name name))
452 |           (emit-fn-method (not name) (assoc (first methods) :name name)))
453 |         (let [has-name? (and name true)
454 |               name (or name (gensym))
455 |               mname (munge name)
456 |               maxparams (map munge (apply max-key count (map :params methods)))
457 |               mmap (into {}
458 |                      (map (fn [method]
459 |                             [(munge (symbol (str mname "__" (count (:params method)))))
460 |                              method])
461 |                           methods))
462 |               ms (sort-by #(-> % second :params count) (seq mmap))]
463 |           (when (and is-return (not has-name?))
464 |             (emits "return "))
465 |           (emitln "(function() ")
466 |           (emitln "local " mname " = {};")
467 |           
468 |           (doseq [[n meth] ms]
469 |             (emits "local " n " = ")
470 |             (if (:variadic meth)
471 |               (emit-variadic-fn-method (not name) meth)
472 |               (emit-fn-method (not name) meth))
473 |             (emitln ""))
474 |           (emitln "local " mname "__func = function(_, ...)")
475 |           (when variadic
476 |             (emitln "local " (last maxparams) " = var_args;"))
477 |           
478 |           (let [args-num (gensym "args_num")
479 |                 dispatch-cond (fn [n meth]
480 |                                 (str args-num " == " (count (:params meth))))
481 |                 call-meth (fn [n meth] (emitln "return " n "(...)"))]
482 |             
483 |             (emitln "local " args-num " = select('#', ...)")
484 |             (let [[n meth] (first ms)]              
485 |               (emits "if " (dispatch-cond n meth) " then ")
486 |               (call-meth n meth))
487 |             
488 |             (doseq [[n meth] (rest ms)]
489 |               (if (:variadic meth)
490 |                 (emitln "else")
491 |                 (do (emits "elseif " (dispatch-cond n meth) " then ")))
492 |               (call-meth n meth))
493 |             (emitln "end")
494 |             (emitln "throw('Invalid arity: ' + #" args-num ")")
495 |             (emitln "end"))            
496 |           
497 |           (when variadic
498 |             (emitln mname ".cljs__lang__maxFixedArity = " max-fixed-arity ";")
499 |             (emitln mname ".cljs__lang__applyTo = " (some #(let [[n m] %] (when (:variadic m) n)) ms) ".cljs__lang__applyTo"))
500 |           (when has-name?
501 |             (doseq [[n meth] ms]
502 |               (let [c (count (:params meth))]
503 |                 (if (:variadic meth)
504 |                   (emitln mname ".cljs__lang__arity__variadic = " n ".cljs__lang__arity__variadic")
505 |                   (emitln mname ".cljs__lang__arity__" c " = " n)))))
506 |           
507 |           (emitln "local __metatable = {__call= " mname "__func, __index = builtins.functions_metatable.__index}")
508 |           (emitln "setmetatable(" mname ", __metatable)")
509 | 
510 |           (emitln "return " mname)
511 |           (emitln "end)()")))
512 |       (when loop-locals
513 |         (emitln "end)(" (comma-sep loop-locals) "))"))
514 |       (when name
515 |         (emitln "")
516 |         (emitln "return " (munge name))
517 |         (emits "end)()")))))
518 | 
519 | (defmethod emit :do
520 |   [{:keys [statements ret env]}]
521 |   (do
522 |     (when (and statements (in-expr? env)) (emitln "(function ()"))
523 |     (emit-block (:context env) statements ret)
524 |     (when (and statements (in-expr? env)) (emits "end)()"))))
525 | 
526 | ;; TODO
527 | (defmethod emit :try*
528 |   [{:keys [env try catch name finally]}]
529 |   (let [context (:context env)
530 |         subcontext (if (= :expr context) :return context)
531 |         finally-sym (gensym "finally_func")
532 |         success-sym (gensym "success")
533 |         name (if name name (gensym "exception"))]
534 |       
535 |       (when (in-expr? env)  (emits "(function ()"))
536 |       
537 |       ;; Finalizer func
538 |       (when finally
539 |         (let [{:keys [statements ret]} finally]
540 |           (assert (not= :constant (:op ret)) "finally block cannot contain constant")
541 |           (emitln "local function " finally-sym "()")
542 |           (emit-block subcontext statements ret)
543 |           (emitln "end")))
544 |       
545 |       ;; Try block
546 |       (emitln success-sym ", " name " = pcall(function()")
547 |       (let [{:keys [statements ret]} try
548 |             newret (assoc-in ret [:env :context] :return)]
549 |         (emit-block subcontext statements newret))
550 |       (emitln "end)")
551 |       
552 |         ;; Catch block
553 |       (let [finalize-call (when finally (str finally-sym "()"))]
554 |         (emitln "if " success-sym " == false then")
555 |         (emitln "local success, catch_res = pcall(function() ")
556 |         (if (and name catch)
557 |           (let [{:keys [statements ret]} catch
558 |                 newret (assoc-in ret [:env :context] :return)]
559 |             (emit-block subcontext statements newret))
560 |           (emitln finalize-call (when finalize-call ";") "error(" name ")"))
561 |         (emitln "end)")
562 |         (emitln finalize-call)
563 |         (emitln "if success == false then error(catch_res) else return catch_res end")
564 |         (emitln "else")
565 |         (emitln finalize-call)
566 |           (when (or (in-expr? env) (= :return context)) (emitln "return " name))
567 |           (emitln "end"))
568 |       
569 |       (when (= :expr context) (emits "end)()"))))
570 | 
571 | (defmethod emit :let
572 |   [{:keys [bindings statements ret env loop]}]
573 |   (let [context (:context env)]
574 |     (binding [*loop-var* (if loop (gensym "loop_var_l") *loop-var*)]
575 |       (when (= :expr context) (emitln "(function ()"))
576 |       (doseq [{:keys [name init]} bindings]
577 |         (emitln "local " (munge name) " = " init))
578 |       (when loop
579 |         (emitln "local " *loop-var* " = true")
580 |         (emitln "while " *loop-var* " do")
581 |         (emitln *loop-var* " = false"))
582 |       (emit-block (if (= :expr context) :return context) statements ret)
583 |       (when loop
584 |         (emitln "end"))
585 |                                         ;(emits "}")
586 |       (when (= :expr context) (emits "end)()")))))
587 | 
588 | (defmethod emit :recur
589 |   [{:keys [frame exprs env]}]
590 |   (let [temps (vec (take (count exprs) (repeatedly gensym)))
591 |         names (:names frame)]
592 |     (emitln "do")
593 |     (emitln *loop-var* " = true ")
594 |     (dotimes [i (count exprs)]
595 |       (emitln "local " (temps i) " = " (exprs i)))
596 |     (dotimes [i (count exprs)]
597 |       (emitln (munge (names i)) " = " (temps i)))
598 |     (emitln "end")))
599 | 
600 | (defmethod emit :letfn
601 |   [{:keys [bindings statements ret env]}]
602 |   (let [context (:context env)]
603 |     (when (= :expr context) (emitln "(function ()"))
604 |     (doseq [{:keys [name init]} bindings]
605 |       (emitln "local " (munge name) " = " init))
606 |     (emit-block (if (= :expr context) :return context) statements ret)
607 |     (when (= :expr context) (emitln "end)()"))))
608 | 
609 | (defn protocol-prefix [psym]
610 |   (str (-> (str psym) (.replaceAll "-" "_") (.replaceAll "\\." "__") (.replaceAll "/" "__")) "__"))
611 | 
612 | (defmethod emit :invoke
613 |   [{:keys [f args env] :as expr}]
614 |   (let [info (:info f)
615 |         fn? (and ana/*cljs-static-fns*
616 |                  (not (:dynamic info))
617 |                  (:fn-var info))
618 |         protocol (:protocol info)        
619 |         proto? (let [tag (infer-tag (first (:args expr)))]
620 |                  (and protocol tag
621 |                       (or ana/*cljs-static-fns*
622 |                           (:protocol-inline env))
623 |                       (or (= protocol tag)
624 |                           (when-let [ps (:protocols (ana/resolve-existing-var (dissoc env :locals) tag))]
625 |                             (ps protocol)))))
626 |         opt-not? (and (= (:name info) 'cljs.core/not)
627 |                       (= (infer-tag (first (:args expr))) 'boolean))
628 |         ns (:ns info)
629 |         lua? (= ns 'lua)
630 |         constant-dest? (= (:op (first args)) :constant)
631 |         keyword? (and (= (-> f :op) :constant)
632 |                       (keyword? (-> f :form)))
633 |         [f variadic-invoke]
634 |         (if fn?
635 |           (let [arity (count args)
636 |                 variadic? (:variadic info)
637 |                 mps (:method-params info)
638 |                 mfa (:max-fixed-arity info)]
639 |             (cond
640 |              ;; if only one method, no renaming needed
641 |              (and (not variadic?)
642 |                   (= (count mps) 1))
643 |              [f nil]
644 | 
645 |              ;; direct dispatch to variadic case
646 |              (and variadic? (> arity mfa))
647 |              [(update-in f [:info :name]
648 |                              (fn [name] (symbol (str (munge name) ".cljs__lang__arity__variadic"))))
649 |               {:max-fixed-arity mfa}]
650 | 
651 |              ;; direct dispatch to specific arity case
652 |              :else
653 |              (let [arities (map count mps)]
654 |                (if (some #{arity} arities)
655 |                  [(update-in f [:info :name]
656 |                              (fn [name] (symbol (str (munge name) ".cljs__lang__arity__" arity)))) nil]
657 |                  [f nil]))))
658 |           [f nil])]
659 |     (emit-wrap env
660 |       (cond
661 |        opt-not?
662 |        (emits "not (" (first args) ")")
663 | 
664 |        protocol
665 |        (let [pimpl (str (protocol-prefix protocol)
666 |                         (munge (name (:name info))) "__arity__" (count args))]
667 |          (emits (when constant-dest? "(") (first args) (when constant-dest? ")") ".proto_methods." pimpl "(" (comma-sep args) ")"))
668 | 
669 |        keyword?
670 |        (emits "(" f ")(" (comma-sep args) ")")
671 |        
672 |        variadic-invoke
673 |        (let [mfa (:max-fixed-arity variadic-invoke)]
674 |         (emits f "(" (comma-sep (take mfa args))
675 |                (when-not (zero? mfa) ",")
676 |                "cljs.core.array_seq(builtins.array(" (comma-sep (drop mfa args)) "), 0))"))
677 |        
678 |        (or fn? lua?)
679 |        (emits f "(" (comma-sep args)  ")")
680 |        
681 |        :else
682 | ;       (if (and ana/*cljs-static-fns* (= (:op f) :var))
683 | ;         (let [fprop (str ".cljs__lang__arity__" (count args))]
684 | ;           (emits f fprop "(" (comma-sep args) ")"))
685 | ;           (emits "(" f fprop " ? " f fprop "(" (comma-sep args) ") : " f "(" (comma-sep args) "))"))
686 |          (emits f "(" (comma-sep args) ")")))))
687 | 
688 | (defmethod emit :new
689 |   [{:keys [ctor args env]}]
690 |   (emit-wrap env
691 |              (emits "(" ctor ".new("
692 |                     (comma-sep args)
693 |                     "))")))
694 | 
695 | (defmethod emit :set!
696 |   [{:keys [target val env]}]
697 |   (when (in-expr? env) (emitln "(function ()"))
698 |   (emitln target " = " val)
699 |   (when (in-expr? env) (emitln "return " target ) (emitln " end)()")))
700 | 
701 | (defmethod emit :ns
702 |   [{:keys [name requires uses requires-macros env]}]
703 |   (emitln "builtins.create_namespace('" (munge name) "')")
704 |   (comment (when-not (= name 'cljs.core)
705 |              (emitln "require 'cljs.core'")))
706 |   (when *ns-emit-require*
707 |     (doseq [lib (into (vals requires) (distinct (vals uses)))]
708 |       (emitln "require '" (munge lib) "'"))))
709 | 
710 | (defmethod emit :deftype*
711 |   [{:keys [t fields pmasks] :as info}]
712 |   (let [fields (map munge fields)]
713 |     (emitln "")
714 |     (emitln "--[[")
715 |     (emitln "-- @constructor")
716 |     (emitln "--]]")
717 |     (emitln (munge t) " = {}")
718 |     (emitln (munge t) ".proto_methods = " (if (= (name t) "default")
719 |                                             "{}"
720 |                                             "builtins.create_proto_table()"))
721 |     (emitln (munge t) ".new = (function (" (comma-sep fields) ")")
722 |     (emitln "local instance = {}")
723 |     (emitln "instance.proto_methods = " (munge t) ".proto_methods")
724 |     (emitln "instance.constructor = " (munge t))
725 |     (doseq [fld fields]
726 |       (emitln "instance." fld " = " fld))
727 |     (emitln "setmetatable(instance, builtins.type_instance_mt)")
728 |     (comment (doseq [[pno pmask] pmasks]
729 |                (emitln "instance.cljs__lang__protocol_mask__partition" pno "__ = " pmask)))
730 |     (emitln "return instance")
731 |     (emitln "end)")))
732 | 
733 | (defmethod emit :defrecord*
734 |   [{:keys [t fields pmasks]}]
735 |   (let [fields (concat (map munge fields) '[__meta __extmap])]
736 |     (emitln (munge t) " = {}")
737 |     (emitln (munge t) ".proto_methods = builtins.create_proto_table()")
738 |     (emitln (munge t) ".new = (function (" (comma-sep fields) ")")
739 |     (emitln "local instance = {}")
740 |     (emitln "instance.proto_methods = " (munge t) ".proto_methods")
741 |     (emitln "instance.constructor = " (munge t))
742 |     (doseq [fld fields]
743 |       (emitln "instance." fld " = " fld ";"))
744 |     (doseq [[pno pmask] pmasks]
745 |       (emitln "instance.cljs__lang__protocol_mask__partition" pno "__ = " pmask))
746 |     (emitln "setmetatable(instance, builtins.type_instance_mt)")
747 |     (emitln "return instance")
748 |     (emitln "end)")))
749 | 
750 | (defmethod emit :dot
751 |   [{:keys [target field method args env]}]
752 |   (emit-wrap env
753 |              (if field
754 |                (emits target "." (munge field #{}))
755 |                (emits target "." (munge method #{}) "("
756 |                       (comma-sep args)
757 |                       ")"))))
758 | 
759 | (defmethod emit :js
760 |   [{:keys [env code segs args]}]
761 |   (emit-wrap env
762 |              (if code
763 |                (emits code)
764 |                (emits (interleave (concat segs (repeat nil))
765 |                                   (concat args [nil]))))))
766 | 
767 | (defmacro lua [form]
768 |   `(ana/with-core-macros "/cljs/lua/core"
769 |      (binding [ana/*cljs-static-fns* true]
770 |        (emit (ana/analyze {:ns (@ana/namespaces 'cljs.user) :context :return :locals {}} '~form)))))
771 | 
772 | (defmacro pprint-form [form]
773 |   `(ana/with-core-macros "/cljs/lua/core"
774 |      (binding [ana/*cljs-static-fns* true
775 |                ana/*cljs-ns* 'cljs.user]
776 |        (ppr/pprint (ana/analyze {:ns (@ana/namespaces 'cljs.user) :context :return :locals {}} '~form)))))
777 | 


--------------------------------------------------------------------------------
/src/cljs/lua/config.clj:
--------------------------------------------------------------------------------
 1 | ;   Copyright (c) Rich Hickey. All rights reserved.
 2 | ;   The use and distribution terms for this software are covered by the
 3 | ;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
 4 | ;   which can be found in the file epl-v10.html at the root of this distribution.
 5 | ;   By using this software in any fashion, you are agreeing to be bound by
 6 | ;   the terms of this license.
 7 | ;   You must not remove this notice, or any other, from this software.
 8 | 
 9 | (ns cljs.lua.config
10 |   (:require [clojure.java.io :as io]
11 |             [cljs.cljsloader :as cloader]))
12 | 
13 | (def config-map (atom {}))
14 | 
15 | (defn load-config []
16 |   (let [user-dir (System/getProperty "user.home")
17 |         sep java.io.File/separator
18 |         user-config (try (io/reader (str user-dir sep ".cljslua" sep ".config.clj"))
19 |                          (catch Exception e
20 |                            (io/reader (io/resource ".config.clj"))))]
21 |     (reset! config-map (first (cloader/make-forms-seq user-config)))))
22 | 
23 | (defn get [& ks]
24 |   (get-in @config-map ks))
25 |                                    


--------------------------------------------------------------------------------
/src/cljs/lua/core.clj:
--------------------------------------------------------------------------------
   1 | ;   Copyright (c) Rich Hickey. All rights reserved.
   2 | ;   The use and distribution terms for this software are covered by the
   3 | ;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
   4 | ;   which can be found in the file epl-v10.html at the root of this distribution.
   5 | ;   By using this software in any fashion, you are agreeing to be bound by
   6 | ;   the terms of this license.
   7 | ;   You must not remove this notice, or any other, from this software.
   8 | 
   9 | (ns cljs.core
  10 |   (:refer-clojure :exclude [-> ->> .. amap and areduce alength aclone assert binding bound-fn case comment cond condp
  11 |                             declare definline definterface defmethod defmulti defn defn- defonce
  12 |                             defprotocol defrecord defstruct deftype delay doseq dosync dotimes doto
  13 |                             extend-protocol extend-type fn for future gen-class gen-interface
  14 |                             if-let if-not import io! lazy-cat lazy-seq let letfn locking loop
  15 |                             memfn ns or proxy proxy-super pvalues refer-clojure reify sync time
  16 |                             when when-first when-let when-not while with-bindings with-in-str
  17 |                             with-loading-context with-local-vars with-open with-out-str with-precision with-redefs
  18 |                             satisfies? identical? true? false? nil? str get
  19 | 
  20 |                             aget aset
  21 |                             + - * / < <= > >= == zero? pos? neg? inc dec max min mod
  22 |                             bit-and bit-and-not bit-clear bit-flip bit-not bit-or bit-set
  23 |                             bit-test bit-shift-left bit-shift-right bit-xor])
  24 |   (:require clojure.walk))
  25 | 
  26 | (alias 'core 'clojure.core)
  27 | 
  28 | (defmacro import-macros [ns [& vars]]
  29 |   (core/let [ns (find-ns ns)
  30 |              vars (map #(ns-resolve ns %) vars)
  31 |              syms (map (core/fn [^clojure.lang.Var v] (core/-> v .sym (with-meta {:macro true}))) vars)
  32 |              defs (map (core/fn [sym var]
  33 |                                 `(def ~sym (deref ~var))) syms vars)]
  34 |             `(do ~@defs
  35 |                  :imported)))
  36 | 
  37 | (import-macros clojure.core
  38 |  [-> ->> ..  and assert comment cond
  39 |   declare defn defn-
  40 |   doto
  41 |   extend-protocol fn for
  42 |   if-let if-not let letfn loop
  43 |   or
  44 |   when when-first when-let when-not while])
  45 | 
  46 | (def fast-path-protocols
  47 |   "protocol fqn -> [partition number, bit]"
  48 |   (zipmap (map #(symbol "cljs.core" (core/str %))
  49 |                '[IFn ICounted IEmptyableCollection ICollection IIndexed ASeq ISeq INext
  50 |                  ILookup IAssociative IMap IMapEntry ISet IStack IVector IDeref
  51 |                  IDerefWithTimeout IMeta IWithMeta IReduce IKVReduce IEquiv IHash
  52 |                  ISeqable ISequential IList IRecord IReversible ISorted IPrintable
  53 |                  IPending IWatchable IEditableCollection ITransientCollection
  54 |                  ITransientAssociative ITransientMap ITransientVector ITransientSet
  55 |                  IMultiFn])
  56 |           (iterate (fn [[p b]]
  57 |                      (if (core/== 2147483648 b)
  58 |                        [(core/inc p) 1]
  59 |                        [p (core/bit-shift-left b 1)]))
  60 |                    [0 1])))
  61 | 
  62 | (def fast-path-protocol-partitions-count
  63 |   "total number of partitions"
  64 |   (let [c (count fast-path-protocols)
  65 |         m (core/mod c 32)]
  66 |     (if (core/zero? m)
  67 |       (core/quot c 32)
  68 |       (core/inc (core/quot c 32)))))
  69 | 
  70 | (defmacro str [& xs]
  71 |   (let [strs (->> (repeat (count xs) "cljs.core.str(~{})")
  72 |                   (interpose ",")
  73 |                   (apply core/str))]
  74 |    (concat (list 'js* (core/str "table.concat({" strs "})")) xs)))
  75 | 
  76 | (defn bool-expr [e]
  77 |   (vary-meta e assoc :tag 'boolean))
  78 | 
  79 | (defmacro nil? [x]
  80 |   `(coercive-= (lua/type ~x) "nil"))
  81 | 
  82 | ;; internal - do not use.
  83 | (defmacro coercive-not [x]
  84 |   (bool-expr (list 'js* "(not ~{})" x)))
  85 | 
  86 | ;; internal - do not use.
  87 | (defmacro coercive-not= [x y]
  88 |   (bool-expr (list 'js* "(~{} ~= ~{})" x y)))
  89 | 
  90 | ;; internal - do not use.
  91 | (defmacro coercive-= [x y]
  92 |   (bool-expr (list 'js* "(~{} == ~{})" x y)))
  93 | 
  94 | (defmacro true? [x]
  95 |   (bool-expr (list 'js* "~{} == true" x)))
  96 | 
  97 | (defmacro false? [x]
  98 |   (bool-expr (list 'js* "~{} == false" x)))
  99 | 
 100 | (defmacro undefined? [x]
 101 |   (bool-expr (list 'js* "(nil == ~{})" x)))
 102 | 
 103 | (defmacro identical? [a b]
 104 |   (bool-expr (list 'js* "(~{} == ~{})" a b)))
 105 | 
 106 | (defmacro aget
 107 |   ([a i]
 108 |      (list 'js* "(builtins.array_get(~{}, ~{}))" a i))
 109 |   ([a i & idxs]
 110 |      (throw (Exception. "NIY"))))
 111 | 
 112 | (defmacro aset [a i v]
 113 |   `(do
 114 |      ~(list 'js* "builtins.array_set(~{}, ~{}, ~{})" a i v)
 115 |      nil))
 116 | 
 117 | (defmacro agetg
 118 |   ([a i]
 119 |      (list 'js* "(~{}[~{}])" a i))
 120 |   ([a i & idxs]
 121 |      (let [astr (apply core/str (repeat (count idxs) "[~{}]"))]
 122 |       `(~'js* ~(core/str "(~{}[~{}]" astr ")") ~a ~i ~@idxs))))
 123 | 
 124 | (defmacro asetg [a i v]
 125 |   (list 'js* "~{}[~{}] = ~{}" a i v))
 126 | 
 127 | (defmacro +
 128 |   ([] 0)
 129 |   ([x] x)
 130 |   ([x y] (list 'js* "(~{} + ~{})" x y))
 131 |   ([x y & more] `(+ (+ ~x ~y) ~@more)))
 132 | 
 133 | (defmacro strcat
 134 |   ([x] x)
 135 |   ([x y] (list 'js* "(~{} .. ~{})" x y))
 136 |   ([x y & more] `(strcat (strcat ~x ~y) ~@more)))
 137 | 
 138 | (defmacro -
 139 |   ([x] (list 'js* "(- ~{})" x))
 140 |   ([x y] (list 'js* "(~{} - ~{})" x y))
 141 |   ([x y & more] `(- (- ~x ~y) ~@more)))
 142 | 
 143 | (defmacro *
 144 |   ([] 1)
 145 |   ([x] x)
 146 |   ([x y] (list 'js* "(~{} * ~{})" x y))
 147 |   ([x y & more] `(* (* ~x ~y) ~@more)))
 148 | 
 149 | (defmacro /
 150 |   ([x] `(/ 1 ~x))
 151 |   ([x y] (list 'js* "(~{} / ~{})" x y))
 152 |   ([x y & more] `(/ (/ ~x ~y) ~@more)))
 153 | 
 154 | (defmacro <
 155 |   ([x] true)
 156 |   ([x y] (bool-expr (list 'js* "(~{} < ~{})" x y)))
 157 |   ([x y & more] `(and (< ~x ~y) (< ~y ~@more))))
 158 | 
 159 | (defmacro <=
 160 |   ([x] true)
 161 |   ([x y] (bool-expr (list 'js* "(~{} <= ~{})" x y)))
 162 |   ([x y & more] `(and (<= ~x ~y) (<= ~y ~@more))))
 163 | 
 164 | (defmacro >
 165 |   ([x] true)
 166 |   ([x y] (bool-expr (list 'js* "(~{} > ~{})" x y)))
 167 |   ([x y & more] `(and (> ~x ~y) (> ~y ~@more))))
 168 | 
 169 | (defmacro >=
 170 |   ([x] true)
 171 |   ([x y] (bool-expr (list 'js* "(~{} >= ~{})" x y)))
 172 |   ([x y & more] `(and (>= ~x ~y) (>= ~y ~@more))))
 173 | 
 174 | (defmacro ==
 175 |   ([x] true)
 176 |   ([x y] (bool-expr (list 'js* "(~{} == ~{})" x y)))
 177 |   ([x y & more] `(and (== ~x ~y) (== ~y ~@more))))
 178 | 
 179 | (defmacro dec [x]
 180 |   `(- ~x 1))
 181 | 
 182 | (defmacro inc [x]
 183 |   `(+ ~x 1))
 184 | 
 185 | (defmacro zero? [x]
 186 |   `(== ~x 0))
 187 | 
 188 | (defmacro pos? [x]
 189 |   `(> ~x 0))
 190 | 
 191 | (defmacro neg? [x]
 192 |   `(< ~x 0))
 193 | 
 194 | (defmacro max
 195 |   ([x] x)
 196 |   ([x y] `(math/max ~x ~y))
 197 |   ([x y & more] `(math/max ~x ~y ~@more)))
 198 | 
 199 | (defmacro min
 200 |   ([x] x)
 201 |   ([x y] `(math/min ~x ~y))
 202 |   ([x y & more] `(math/min ~x ~y ~@more)))
 203 | 
 204 | (defmacro mod [num div]
 205 |   (list 'js* "(math.fmod(~{}, ~{}))" num div))
 206 | 
 207 | (defmacro bit-not [x]
 208 |   (list 'js* "(bit.bnot(~{}))" x))
 209 | 
 210 | (defmacro bit-and
 211 |   ([x y] (list 'js* "(bit.band(~{}, ~{}))" x y))
 212 |   ([x y & more] `(bit-and (bit-and ~x ~y) ~@more)))
 213 | 
 214 | ;; internal do not use
 215 | (defmacro unsafe-bit-and
 216 |   ([x y] (bool-expr (list 'js* "(bit.band(~{}, ~{}))" x y)))
 217 |   ([x y & more] `(unsafe-bit-and (unsafe-bit-and ~x ~y) ~@more)))
 218 | 
 219 | (defmacro bit-or
 220 |   ([x y] (list 'js* "(bit.bor(~{}, ~{}))" x y))
 221 |   ([x y & more] `(bit-or (bit-or ~x ~y) ~@more)))
 222 | 
 223 | (defmacro bit-xor
 224 |   ([x y] (list 'js* "(bit.bxor(~{}, ~{}))" x y))
 225 |   ([x y & more] `(bit-xor (bit-xor ~x ~y) ~@more)))
 226 | 
 227 | (defmacro bit-and-not
 228 |   ([x y] (list 'js* "(bit.band(~{}, bit.bnot(~{})))" x y))
 229 |   ([x y & more] `(bit-and-not (bit-and-not ~x ~y) ~@more)))
 230 | 
 231 | (defmacro bit-clear [x n]
 232 |   (list 'js* "(bit.band(~{}, bit.bnot(bit.lshift(1, ~{}))))" x n))
 233 | 
 234 | (defmacro bit-flip [x n]
 235 |   (list 'js* "(bit.bxor(~{}, bit.lshift(1, ~{})))" x n))
 236 | 
 237 | (defmacro bit-test [x n]
 238 |   (list 'js* "(bit.band(~{}, bit.lshift(1, ~{})) ~= 0)" x n))
 239 | 
 240 | (defmacro bit-shift-left [x n]
 241 |   (list 'js* "bit.lshift(~{}, ~{})" x n))
 242 | 
 243 | (defmacro bit-shift-right [x n]
 244 |   (list 'js* "bit.arshift(~{}, ~{})" x n))
 245 | 
 246 | (defmacro bit-shift-right-zero-fill [x n]
 247 |   (list 'js* "bit.rshift(~{}, ~{})" x n))
 248 | 
 249 | (defmacro bit-set [x n]
 250 |   (list 'js* "bit.bor(~{}, bit.lshift(1, ~{}))" x n))
 251 | 
 252 | ;; internal
 253 | (defmacro mask [hash shift]
 254 |   (list 'js* "bit.band(bit.rshift(~{}, ~{}), 0x01f)" hash shift))
 255 | 
 256 | ;; internal
 257 | (defmacro bitpos [hash shift]
 258 |   (list 'js* "bit.lshift(1, ~{})" `(mask ~hash ~shift)))
 259 | 
 260 | ;; internal
 261 | (defmacro caching-hash [coll hash-fn hash-key]
 262 |   `(let [h# ~hash-key]
 263 |      (if-not (nil? h#)
 264 |        h#
 265 |        (let [h# (~hash-fn ~coll)]
 266 |          (set! ~hash-key h#)
 267 |          h#))))
 268 | 
 269 | (defmacro get
 270 |   ([coll k]
 271 |      `(-lookup ~coll ~k nil))
 272 |   ([coll k not-found]
 273 |      `(-lookup ~coll ~k ~not-found)))
 274 | 
 275 | ;;; internal -- reducers-related macros
 276 | 
 277 | (defn- do-curried
 278 |   [name doc meta args body]
 279 |   (let [cargs (vec (butlast args))]
 280 |     `(defn ~name ~doc ~meta
 281 |        (~cargs (fn [x#] (~name ~@cargs x#)))
 282 |        (~args ~@body))))
 283 | 
 284 | (defmacro ^:private defcurried
 285 |   "Builds another arity of the fn that returns a fn awaiting the last
 286 |   param"
 287 |   [name doc meta args & body]
 288 |   (do-curried name doc meta args body))
 289 | 
 290 | (defn- do-rfn [f1 k fkv]
 291 |   `(fn
 292 |      ([] (~f1))
 293 |      ~(clojure.walk/postwalk
 294 |        #(if (sequential? %)
 295 |           ((if (vector? %) vec identity)
 296 |            (core/remove #{k} %))
 297 |           %)
 298 |        fkv)
 299 |      ~fkv))
 300 | 
 301 | (defmacro ^:private rfn
 302 |   "Builds 3-arity reducing fn given names of wrapped fn and key, and k/v impl."
 303 |   [[f1 k] fkv]
 304 |   (do-rfn f1 k fkv))
 305 | 
 306 | ;;; end of reducers macros
 307 | 
 308 | (defn protocol-prefix [psym]
 309 |   (core/str (-> (core/str psym) (.replaceAll "\\." "__") (.replaceAll "/" "__")) "__"))
 310 | 
 311 | (def #^:private base-type
 312 |      {nil "nil"
 313 |       'string "string"
 314 |       'number "number"
 315 |       'table "table"
 316 |       'function "function"
 317 |       'boolean "boolean"})
 318 | 
 319 | (defmacro reify [& impls]
 320 |   (let [t      (gensym "t")
 321 |         meta-sym (gensym "meta")
 322 |         this-sym (gensym "_")
 323 |         locals (keys (:locals &env))
 324 |         ns     (-> &env :ns :name)
 325 |         munge  cljs.lua.compiler/munge
 326 |         ns-t   (list 'js* (core/str (munge ns) "." (munge t)))]
 327 |     `(do
 328 |        (when (undefined? ~ns-t)
 329 |          (deftype ~t [~@locals ~meta-sym]
 330 |            IWithMeta
 331 |            (~'-with-meta [~this-sym ~meta-sym]
 332 |              (new ~t ~@locals ~meta-sym))
 333 |            IMeta
 334 |            (~'-meta [~this-sym] ~meta-sym)
 335 |            ~@impls))
 336 |        (new ~t ~@locals nil))))
 337 | 
 338 | (defmacro this-as
 339 |   "Defines a scope where JavaScript's implicit \"this\" is bound to the name provided."
 340 |   [name & body]
 341 |   `(let [~name (~'js* "this")]
 342 |      ~@body))
 343 | 
 344 | (defn to-property [sym]
 345 |   (symbol (core/str "-" sym)))
 346 | 
 347 | (def prot-functions-table 'lua/basic_types_prot_functions)
 348 | 
 349 | (defn basic-type-method [method]
 350 |   `(.. ~prot-functions-table ~(to-property method)))
 351 | 
 352 | ;; Extend type definition
 353 | 
 354 | (defn form->fn
 355 |   "Transform a form of the type ([args] body) into (fn [this args] body)"
 356 |   [[args body]]
 357 |   `(fn ~args ~body))
 358 | 
 359 | (defn get-type-method
 360 |   [tsym method]
 361 |   `(.. ~tsym -proto_methods ~(to-property method)))
 362 | 
 363 | (defn forms->fns
 364 |    [type-sym named-forms]
 365 |    (map (fn [[name & methods :as form]]
 366 |           `(set! ~(get-type-method type-sym name) ~(with-meta `(fn ~methods) (meta form))))
 367 |         named-forms))
 368 | 
 369 | (defmacro extend-type [tsym & impls]
 370 |   (let [resolve #(let [ret (:name (cljs.analyzer/resolve-var (dissoc &env :locals) %))]
 371 |                    (assert ret (core/str "Can't resolve: " %))
 372 |                    ret)
 373 |         impl-map (loop [ret {} s impls]
 374 |                    (if (seq s)
 375 |                      (recur (assoc ret (first s) (take-while seq? (next s)))
 376 |                             (drop-while seq? (next s)))
 377 |                      ret))
 378 |         warn-if-not-protocol #(when-not (= 'Object %)
 379 |                                 (if cljs.analyzer/*cljs-warn-on-undeclared*
 380 |                                   (if-let [var (cljs.analyzer/resolve-existing-var (dissoc &env :locals) %)]
 381 |                                     (when-not (:protocol-symbol var)
 382 |                                       (cljs.analyzer/warning &env
 383 |                                         (core/str "WARNING: Symbol " % " is not a protocol")))
 384 |                                     (cljs.analyzer/warning &env
 385 |                                       (core/str "WARNING: Can't resolve protocol symbol " %)))))
 386 |         skip-flag (set (-> tsym meta :skip-protocol-flag))
 387 |         base-type (base-type tsym)
 388 |         t (if base-type tsym (resolve tsym))
 389 |         tstr (if (= 'nil tsym) "nil" tsym)
 390 |         prototype-prefix (fn [sym]
 391 |                            `(.. ~@(if base-type
 392 |                                    `((~(symbol (clojure.core/str "builtins/get" tstr "proto"))))
 393 |                                    `(~tsym -proto_methods)) ~(to-property sym)))
 394 |         
 395 |         assign-impls (fn [[p sigs]]
 396 |                        (warn-if-not-protocol p)
 397 |                        (let [psym (resolve p)
 398 |                              pprefix (protocol-prefix psym)]
 399 |                          (concat [`(asetg ~psym ~(if base-type
 400 |                                                    (clojure.core/str tstr) t) true)]
 401 |                                  (when-not (skip-flag psym)
 402 |                                    [`(set! ~(prototype-prefix pprefix) true)])
 403 |                                  (mapcat (fn [[f & meths :as form]]                                               
 404 |                                            (let [pf (core/str pprefix f)
 405 |                                                  adapt-params (fn [[[targ & args :as sig] & body]]
 406 |                                                                 (cons (vec (cons (vary-meta targ assoc :tag t) args))
 407 |                                                                       body))]
 408 |                                              (if (vector? (first meths))
 409 |                                                [`(set! ~(prototype-prefix (core/str pf "__arity__" (count (first meths))))
 410 |                                                        ~(with-meta `(fn ~@(adapt-params meths)) (meta form)))]
 411 |                                                (map (fn [[sig & body :as meth]]
 412 |                                                       `(set! ~(prototype-prefix (core/str pf "__arity__" (count sig)))
 413 |                                                              ~(with-meta `(fn ~(adapt-params meth)) (meta form))))
 414 |                                                     meths))))
 415 |                                          sigs))))]
 416 |     `(do ~@(mapcat assign-impls impl-map))))
 417 | 
 418 | 
 419 | (defn- prepare-protocol-masks [env t impls]
 420 |   (let [resolve #(let [ret (:name (cljs.analyzer/resolve-var (dissoc env :locals) %))]
 421 |                    (assert ret (core/str "Can't resolve: " %))
 422 |                    ret)
 423 |         impl-map (loop [ret {} s impls]
 424 |                    (if (seq s)
 425 |                      (recur (assoc ret (first s) (take-while seq? (next s)))
 426 |                             (drop-while seq? (next s)))
 427 |                      ret))]
 428 |     (if-let [fpp-pbs (seq (keep fast-path-protocols
 429 |                                 (map resolve
 430 |                                      (keys impl-map))))]
 431 |       (let [fpps (into #{} (filter (partial contains? fast-path-protocols)
 432 |                                    (map resolve
 433 |                                         (keys impl-map))))
 434 |             fpp-partitions (group-by first fpp-pbs)
 435 |             fpp-partitions (into {} (map (juxt key (comp (partial map peek) val))
 436 |                                          fpp-partitions))
 437 |             fpp-partitions (into {} (map (juxt key (comp (partial reduce core/bit-or) val))
 438 |                                          fpp-partitions))]
 439 |         [fpps
 440 |          (reduce (fn [ps p]
 441 |                    (update-in ps [p] (fnil identity 0)))
 442 |                  fpp-partitions
 443 |                  (range fast-path-protocol-partitions-count))]))))
 444 | 
 445 | (defn dt->et
 446 |   ([specs fields] (dt->et specs fields false))
 447 |   ([specs fields inline]
 448 |      (loop [ret [] s specs]
 449 |        (if (seq s)
 450 |          (recur (-> ret
 451 |                     (conj (first s))
 452 |                     (into
 453 |                       (reduce (fn [v [f sigs]]
 454 |                                 (conj v (vary-meta (cons f (map #(cons (second %) (nnext %)) sigs))
 455 |                                                    assoc :cljs.analyzer/fields fields
 456 |                                                          :protocol-impl true
 457 |                                                          :protocol-inline inline)))
 458 |                               []
 459 |                               (group-by first (take-while seq? (next s))))))
 460 |                 (drop-while seq? (next s)))
 461 |          ret))))
 462 | 
 463 | (defn collect-protocols [impls env]
 464 |   (->> impls
 465 |       (filter symbol?)
 466 |       (map #(:name (cljs.analyzer/resolve-var (dissoc env :locals) %)))
 467 |       (into #{})))
 468 | 
 469 | (defmacro deftype [t fields & impls]
 470 |   (let [r (:name (cljs.analyzer/resolve-var (dissoc &env :locals) t))
 471 |         [fpps pmasks] (prepare-protocol-masks &env t impls)
 472 |         protocols (collect-protocols impls &env)
 473 |         t (vary-meta t assoc
 474 |             :protocols protocols
 475 |             :skip-protocol-flag fpps) ]
 476 |     (if (seq impls)
 477 |       `(do
 478 |          (deftype* ~t ~fields ~pmasks)
 479 |          (set! (.-cljs__lang__type ~t) true)
 480 |          (set! (.-cljs__lang__ctorPrSeq ~t) (fn [this#] (list ~(core/str r))))
 481 |          (extend-type ~t ~@(dt->et impls fields true))
 482 |          nil)
 483 |       `(do
 484 |          (deftype* ~t ~fields ~pmasks)
 485 |          (set! (.-cljs__lang__type ~t) true)
 486 |          (set! (.-cljs__lang__ctorPrSeq ~t) (fn [this#] (list ~(core/str r))))
 487 |          nil))))
 488 | 
 489 | (defn- emit-defrecord
 490 |   "Do not use this directly - use defrecord"
 491 |   [env tagname rname fields impls]
 492 |   (let [hinted-fields fields
 493 |         fields (vec (map #(with-meta % nil) fields))
 494 |         base-fields fields
 495 |         fields (conj fields '__meta '__extmap (with-meta '__hash {:mutable true}))]
 496 |     (let [gs (gensym)
 497 |           ksym (gensym "k")
 498 |           impls (concat
 499 |                  impls
 500 |                  ['IRecord
 501 |                   'IHash
 502 |                   `(~'-hash [this#] (caching-hash this# ~'hash-imap ~'__hash))
 503 |                   'IEquiv
 504 |                   `(~'-equiv [this# other#]
 505 |                              (if (and other#
 506 |                                       (identical? (.-constructor this#)
 507 |                                                   (.-constructor other#))
 508 |                                       (equiv-map this# other#))
 509 |                                true
 510 |                                false))
 511 |                   'IMeta
 512 |                   `(~'-meta [this#] ~'__meta)
 513 |                   'IWithMeta
 514 |                   `(~'-with-meta [this# ~gs] (new ~tagname ~@(replace {'__meta gs} fields)))
 515 |                   'ILookup
 516 |                   `(~'-lookup [this# k#] (-lookup this# k# nil))
 517 |                   `(~'-lookup [this# ~ksym else#]
 518 |                               (cond
 519 |                                ~@(mapcat (fn [f] [`(identical? ~ksym ~(keyword f)) f]) base-fields)
 520 |                                :else (get ~'__extmap ~ksym else#)))
 521 |                   'ICounted
 522 |                   `(~'-count [this#] (+ ~(count base-fields) (count ~'__extmap)))
 523 |                   'ICollection
 524 |                   `(~'-conj [this# entry#]
 525 |                             (if (vector? entry#)
 526 |                               (-assoc this# (-nth entry# 0) (-nth entry# 1))
 527 |                               (reduce -conj
 528 |                                       this#
 529 |                                       entry#)))
 530 |                   'IAssociative
 531 |                   `(~'-assoc [this# k# ~gs]
 532 |                              (condp identical? k#
 533 |                                ~@(mapcat (fn [fld]
 534 |                                            [(keyword fld) (list* `new tagname (replace {fld gs '__hash nil} fields))])
 535 |                                          base-fields)
 536 |                                (new ~tagname ~@(remove #{'__extmap '__hash} fields) (assoc ~'__extmap k# ~gs) nil)))
 537 |                   'IMap
 538 |                   `(~'-dissoc [this# k#] (if (contains? #{~@(map keyword base-fields)} k#)
 539 |                                            (dissoc (with-meta (into {} this#) ~'__meta) k#)
 540 |                                            (new ~tagname ~@(remove #{'__extmap} fields) 
 541 |                                                 (not-empty (dissoc ~'__extmap k#))
 542 |                                                 nil)))
 543 |                   'ISeqable
 544 |                   `(~'-seq [this#] (seq (concat [~@(map #(list `vector (keyword %) %) base-fields)] 
 545 |                                                 ~'__extmap)))
 546 |                   'IPrintable
 547 |                   `(~'-pr-seq [this# opts#]
 548 |                               (let [pr-pair# (fn [keyval#] (pr-sequential pr-seq "" " " "" opts# keyval#))]
 549 |                                 (pr-sequential
 550 |                                  pr-pair# (core/str "#" ~(name rname) "{") ", " "}" opts#
 551 |                                  (concat [~@(map #(list `vector (keyword %) %) base-fields)] 
 552 |                                          ~'__extmap))))
 553 |                   ])
 554 |           [fpps pmasks] (prepare-protocol-masks env tagname impls)
 555 |           protocols (collect-protocols impls env)
 556 |           tagname (vary-meta tagname assoc
 557 |                     :protocols protocols
 558 |                     :skip-protocol-flag fpps)]
 559 |       `(do
 560 |          (~'defrecord* ~tagname ~hinted-fields ~pmasks)
 561 |          (extend-type ~tagname ~@(dt->et impls fields true))))))
 562 | 
 563 | (defn- build-positional-factory
 564 |   [rsym rname fields]
 565 |   (let [fn-name (symbol (core/str '-> rsym))]
 566 |     `(defn ~fn-name
 567 |        [~@fields]
 568 |        (new ~rname ~@fields))))
 569 | 
 570 | (defn- build-map-factory
 571 |   [rsym rname fields]
 572 |   (let [fn-name (symbol (core/str 'map-> rsym))
 573 | 	ms (gensym)
 574 | 	ks (map keyword fields)
 575 | 	getters (map (fn [k] `(~k ~ms)) ks)]
 576 |     `(defn ~fn-name
 577 |        [~ms]
 578 |        (new ~rname ~@getters nil (dissoc ~ms ~@ks)))))
 579 | 
 580 | (defmacro defrecord [rsym fields & impls]
 581 |   (let [r (:name (cljs.analyzer/resolve-var (dissoc &env :locals) rsym))]
 582 |     `(let []
 583 |        ~(emit-defrecord &env rsym r fields impls)
 584 |        (set! (.-cljs__lang__type ~r) true)
 585 |        (set! (.-cljs__lang__ctorPrSeq ~r) (fn [this#] (list ~(core/str r))))
 586 |        ~(build-positional-factory rsym r fields)
 587 |        ~(build-map-factory rsym r fields)
 588 |        )))
 589 | 
 590 | (defmacro not-primitive? [o]
 591 |   `(and (identical? (lua/type ~o) "table") (not (identical? (builtins/type ~o) "table"))))
 592 | 
 593 | (defmacro defprotocol [psym & doc+methods]
 594 |   (let [p (:name (cljs.analyzer/resolve-var (dissoc &env :locals) psym))
 595 |         psym (vary-meta psym assoc :protocol-symbol true)
 596 |         ns-name (-> &env :ns :name)
 597 |         fqn (fn [n] (symbol (core/str ns-name "." n)))
 598 |         prefix (protocol-prefix p)
 599 |         methods (if (core/string? (first doc+methods)) (next doc+methods) doc+methods)
 600 |         expand-sig (fn [fname slot sig]
 601 |                      `(~sig
 602 |                        (if (.. ~(first sig) -proto_methods ~(symbol (core/str "-" slot)))
 603 |                         (.. ~(first sig) -proto_methods (~slot ~@sig))
 604 |                         (throw (missing-protocol
 605 |                                 ~(core/str psym "." fname) ~(first sig))))))
 606 |         method (fn [[fname & sigs]]
 607 |                  (let [sigs (take-while vector? sigs)
 608 |                        slot (symbol (core/str prefix (name fname)))
 609 |                        fname (vary-meta fname assoc :protocol p)]
 610 |                    `(do
 611 |                       (set! ~(basic-type-method fname) (~'js* "{}"))
 612 |                       (defn ~fname ~@(map (fn [sig]
 613 |                                             (expand-sig fname
 614 |                                                         (symbol (core/str slot "__arity__" (count sig)))
 615 |                                                         sig))
 616 |                                           sigs)))))]
 617 |     `(do
 618 |        (set! ~'*unchecked-if* true)
 619 |        (def ~psym (~'js* "{}"))
 620 |        ~@(map method methods)
 621 |        (set! ~'*unchecked-if* false)
 622 |        nil)))
 623 | 
 624 | #_(defmacro satisfies?
 625 |     "Returns true if x satisfies the protocol"
 626 |     [psym x]
 627 |     (let [p (:name (cljs.analyzer/resolve-var (dissoc &env :locals) psym))
 628 |           prefix (protocol-prefix p)
 629 |           xsym (bool-expr (gensym))
 630 |           [part bit] (fast-path-protocols p)
 631 |           msym (symbol (core/str "-cljs__lang__protocol_mask__partition" part "__"))]
 632 |       `(let [~xsym ~x]
 633 |          (if ~xsym
 634 |            (if (or ~(if bit `(unsafe-bit-and (. ~xsym ~msym) ~bit))
 635 |                    ~(bool-expr (get-type-method xsym prefix)))
 636 |              true
 637 |              (if (coercive-not (. ~xsym ~msym))
 638 |                (cljs.core/type_satisfies_ ~psym ~xsym)
 639 |                false))
 640 |            (cljs.core/type_satisfies_ ~psym ~xsym)))))
 641 | 
 642 | (defmacro satisfies?
 643 |   "Returns true if x satisfies the protocol"
 644 |   [psym x]
 645 |   `(or (agetg ~psym (builtins/type ~x)) false))
 646 | 
 647 | (defmacro lazy-seq [& body]
 648 |   `(new cljs.core/LazySeq nil false (fn [] ~@body) nil))
 649 | 
 650 | (defmacro delay [& body]
 651 |   "Takes a body of expressions and yields a Delay object that will
 652 |   invoke the body only the first time it is forced (with force or deref/@), and
 653 |   will cache the result and return it on all subsequent force
 654 |   calls."
 655 |   `(new cljs.core/Delay (atom {:done false, :value nil}) (fn [] ~@body)))
 656 | 
 657 | (defmacro binding
 658 |   "binding => var-symbol init-expr
 659 | 
 660 |   Creates new bindings for the (already-existing) vars, with the
 661 |   supplied initial values, executes the exprs in an implicit do, then
 662 |   re-establishes the bindings that existed before.  The new bindings
 663 |   are made in parallel (unlike let); all init-exprs are evaluated
 664 |   before the vars are bound to their new values."
 665 |   [bindings & body]
 666 |   (let [names (take-nth 2 bindings)
 667 |         vals (take-nth 2 (drop 1 bindings))
 668 |         tempnames (map (comp gensym name) names)
 669 |         binds (map vector names vals)
 670 |         resets (reverse (map vector names tempnames))]
 671 |     (cljs.analyzer/confirm-bindings &env names)
 672 |     `(let [~@(interleave tempnames names)]
 673 |        (try
 674 |         ~@(map
 675 |            (fn [[k v]] (list 'set! k v))
 676 |            binds)
 677 |         ~@body
 678 |         (finally
 679 |          ~@(map
 680 |             (fn [[k v]] (list 'set! k v))
 681 |             resets))))))
 682 | 
 683 | (defmacro condp
 684 |   "Takes a binary predicate, an expression, and a set of clauses.
 685 |   Each clause can take the form of either:
 686 | 
 687 |   test-expr result-expr
 688 | 
 689 |   test-expr :>> result-fn
 690 | 
 691 |   Note :>> is an ordinary keyword.
 692 | 
 693 |   For each clause, (pred test-expr expr) is evaluated. If it returns
 694 |   logical true, the clause is a match. If a binary clause matches, the
 695 |   result-expr is returned, if a ternary clause matches, its result-fn,
 696 |   which must be a unary function, is called with the result of the
 697 |   predicate as its argument, the result of that call being the return
 698 |   value of condp. A single default expression can follow the clauses,
 699 |   and its value will be returned if no clause matches. If no default
 700 |   expression is provided and no clause matches, an
 701 |   IllegalArgumentException is thrown."
 702 |   {:added "1.0"}
 703 | 
 704 |   [pred expr & clauses]
 705 |   (let [gpred (gensym "pred__")
 706 |         gexpr (gensym "expr__")
 707 |         emit (fn emit [pred expr args]
 708 |                (let [[[a b c :as clause] more]
 709 |                        (split-at (if (= :>> (second args)) 3 2) args)
 710 |                        n (count clause)]
 711 |                  (cond
 712 |                   (= 0 n) `(throw (js/Error. (core/str "No matching clause: " ~expr)))
 713 |                   (= 1 n) a
 714 |                   (= 2 n) `(if (~pred ~a ~expr)
 715 |                              ~b
 716 |                              ~(emit pred expr more))
 717 |                   :else `(if-let [p# (~pred ~a ~expr)]
 718 |                            (~c p#)
 719 |                            ~(emit pred expr more)))))
 720 |         gres (gensym "res__")]
 721 |     `(let [~gpred ~pred
 722 |            ~gexpr ~expr]
 723 |        ~(emit gpred gexpr clauses))))
 724 | 
 725 | (defmacro case [e & clauses]
 726 |   (let [default (if (odd? (count clauses))
 727 |                   (last clauses)
 728 |                   `(throw (js/Error. (core/str "No matching clause: " ~e))))
 729 |         assoc-test (fn assoc-test [m test expr]
 730 |                          (if (contains? m test)
 731 |                            (throw (clojure.core/IllegalArgumentException.
 732 |                                    (core/str "Duplicate case test constant '"
 733 |                                              test "'"
 734 |                                              (when (:line &env)
 735 |                                                (core/str " on line " (:line &env) " "
 736 |                                                          cljs.analyzer/*cljs-file*)))))
 737 |                            (assoc m test expr)))
 738 |         pairs (reduce (fn [m [test expr]]
 739 |                         (if (seq? test)
 740 |                           (reduce #(assoc-test %1 %2 expr) m test)
 741 |                           (assoc-test m test expr)))
 742 |                       {} (partition 2 clauses))
 743 |         esym (gensym)]
 744 |    `(let [~esym ~e]
 745 |       (cond
 746 |         ~@(mapcat (fn [[m c]] `((cljs.core/= ~m ~esym) ~c)) pairs)
 747 |         :else ~default))))
 748 | 
 749 | (defmacro try
 750 |   "(try expr* catch-clause* finally-clause?)
 751 | 
 752 |    Special Form
 753 | 
 754 |    catch-clause => (catch protoname name expr*)
 755 |    finally-clause => (finally expr*)
 756 | 
 757 |   Catches and handles JavaScript exceptions."
 758 |   [& forms]
 759 |   (let [catch? #(and (list? %) (= (first %) 'catch))
 760 |         [body catches] (split-with (complement catch?) forms)
 761 |         [catches fin] (split-with catch? catches)
 762 |         e (gensym "e")]
 763 |     (assert (every? #(clojure.core/> (count %) 2) catches) "catch block must specify a prototype and a name")
 764 |     (if (seq catches)
 765 |       `(~'try*
 766 |         ~@body
 767 |         (catch ~e
 768 |             (cond
 769 |              ~@(mapcat
 770 |                 (fn [[_ type name & cb]]
 771 |                   `[(instance? ~type ~e) (let [~name ~e] ~@cb)])
 772 |                 catches)
 773 |              :else (throw ~e)))
 774 |         ~@fin)
 775 |       `(~'try*
 776 |         ~@body
 777 |         ~@fin))))
 778 | 
 779 | (defmacro assert
 780 |   "Evaluates expr and throws an exception if it does not evaluate to
 781 |   logical true."
 782 |   ([x]
 783 |      (when *assert*
 784 |        `(if ~x
 785 |           (println "Assert pass : " (cljs.core/pr-str '~x))
 786 |           (throw (js/Error.
 787 |                   (cljs.core/str "Assert failed: " (cljs.core/pr-str '~x)))))))
 788 |   ([x message]
 789 |      (when *assert*
 790 |        `(when-not ~x
 791 |           (throw (js/Error.
 792 |                   (cljs.core/str "Assert failed: " ~message "\n" (cljs.core/pr-str '~x))))))))
 793 | 
 794 | (defmacro ^{:private true} assert-args [fnname & pairs]
 795 |   `(do (when-not ~(first pairs)
 796 |          (throw (IllegalArgumentException.
 797 |                   ~(core/str fnname " requires " (second pairs)))))
 798 |      ~(let [more (nnext pairs)]
 799 |         (when more
 800 |           (list* `assert-args fnname more)))))
 801 | 
 802 | (defmacro for
 803 |   "List comprehension. Takes a vector of one or more
 804 |    binding-form/collection-expr pairs, each followed by zero or more
 805 |    modifiers, and yields a lazy sequence of evaluations of expr.
 806 |    Collections are iterated in a nested fashion, rightmost fastest,
 807 |    and nested coll-exprs can refer to bindings created in prior
 808 |    binding-forms.  Supported modifiers are: :let [binding-form expr ...],
 809 |    :while test, :when test.
 810 | 
 811 |   (take 100 (for [x (range 100000000) y (range 1000000) :while (< y x)]  [x y]))"
 812 |   [seq-exprs body-expr]
 813 |   (assert-args for
 814 |      (vector? seq-exprs) "a vector for its binding"
 815 |      (even? (count seq-exprs)) "an even number of forms in binding vector")
 816 |   (let [to-groups (fn [seq-exprs]
 817 |                     (reduce (fn [groups [k v]]
 818 |                               (if (keyword? k)
 819 |                                 (conj (pop groups) (conj (peek groups) [k v]))
 820 |                                 (conj groups [k v])))
 821 |                             [] (partition 2 seq-exprs)))
 822 |         err (fn [& msg] (throw (apply core/str msg)))
 823 |         emit-bind (fn emit-bind [[[bind expr & mod-pairs]
 824 |                                   & [[_ next-expr] :as next-groups]]]
 825 |                     (let [giter (gensym "iter__")
 826 |                           gxs (gensym "s__")
 827 |                           do-mod (fn do-mod [[[k v :as pair] & etc]]
 828 |                                    (cond
 829 |                                      (= k :let) `(let ~v ~(do-mod etc))
 830 |                                      (= k :while) `(when ~v ~(do-mod etc))
 831 |                                      (= k :when) `(if ~v
 832 |                                                     ~(do-mod etc)
 833 |                                                     (recur (rest ~gxs)))
 834 |                                      (keyword? k) (err "Invalid 'for' keyword " k)
 835 |                                      next-groups
 836 |                                       `(let [iterys# ~(emit-bind next-groups)
 837 |                                              fs# (seq (iterys# ~next-expr))]
 838 |                                          (if fs#
 839 |                                            (concat fs# (~giter (rest ~gxs)))
 840 |                                            (recur (rest ~gxs))))
 841 |                                      :else `(cons ~body-expr
 842 |                                                   (~giter (rest ~gxs)))))]
 843 |                       `(fn ~giter [~gxs]
 844 |                          (lazy-seq
 845 |                            (loop [~gxs ~gxs]
 846 |                              (when-first [~bind ~gxs]
 847 |                                ~(do-mod mod-pairs)))))))]
 848 |     `(let [iter# ~(emit-bind (to-groups seq-exprs))]
 849 |        (iter# ~(second seq-exprs)))))
 850 | 
 851 | (defmacro doseq
 852 |   "Repeatedly executes body (presumably for side-effects) with
 853 |   bindings and filtering as provided by \"for\".  Does not retain
 854 |   the head of the sequence. Returns nil."
 855 |   [seq-exprs & body]
 856 |   (assert-args doseq
 857 |      (vector? seq-exprs) "a vector for its binding"
 858 |      (even? (count seq-exprs)) "an even number of forms in binding vector")
 859 |   (let [step (fn step [recform exprs]
 860 |                (if-not exprs
 861 |                  [true `(do ~@body)]
 862 |                  (let [k (first exprs)
 863 |                        v (second exprs)
 864 |                        
 865 |                        seqsym (when-not (keyword? k) (gensym))
 866 |                        recform (if (keyword? k) recform `(recur (first ~seqsym) ~seqsym))
 867 |                        steppair (step recform (nnext exprs))
 868 |                        needrec (steppair 0)
 869 |                        subform (steppair 1)]
 870 |                    (cond
 871 |                      (= k :let) [needrec `(let ~v ~subform)]
 872 |                      (= k :while) [false `(when ~v
 873 |                                             ~subform
 874 |                                             ~@(when needrec [recform]))]
 875 |                      (= k :when) [false `(if ~v
 876 |                                            (do
 877 |                                              ~subform
 878 |                                              ~@(when needrec [recform]))
 879 |                                            ~recform)]
 880 |                      :else [true `(let [~seqsym (seq ~v)]
 881 |                                     (when ~seqsym
 882 |                                       (loop [~k (first ~seqsym) ~seqsym ~seqsym]
 883 |                                        ~subform
 884 |                                        (when-let [~seqsym (next ~seqsym)]
 885 |                                         ~@(when needrec [recform])))))]))))]
 886 |     (nth (step nil (seq seq-exprs)) 1)))
 887 | 
 888 | (defmacro array [& rest]
 889 |   (let [xs-str (->> (repeat "~{}")
 890 |                     (take (count rest))
 891 |                     (interpose ",")
 892 |                     (apply core/str))]
 893 |    (concat
 894 |     (list 'js* (core/str "(builtins.array_init({" xs-str "}, " (count rest) "))"))
 895 |     rest)))
 896 | 
 897 | (defmacro js-obj [& rest]
 898 |   (let [kvs-str (->> (repeat "[~{}]=~{}")
 899 |                      (take (quot (count rest) 2))
 900 |                      (interpose ",")
 901 |                      (apply core/str))]
 902 |     (concat
 903 |      (list 'js* (core/str "({" kvs-str "})"))
 904 |      rest)))
 905 | 
 906 | (defmacro alength [a]
 907 |   (list 'js* "(~{}).length" a))
 908 | 
 909 | (defmacro aclone [a]
 910 |   (list 'js* "builtins.array_copy(~{})" a))
 911 | 
 912 | (defmacro amap
 913 |   "Maps an expression across an array a, using an index named idx, and
 914 |   return value named ret, initialized to a clone of a, then setting 
 915 |   each element of ret to the evaluation of expr, returning the new 
 916 |   array ret."
 917 |   [a idx ret expr]
 918 |   `(let [a# ~a
 919 |          ~ret (aclone a#)]
 920 |      (loop  [~idx 0]
 921 |        (if (< ~idx  (alength a#))
 922 |          (do
 923 |            (aset ~ret ~idx ~expr)
 924 |            (recur (inc ~idx)))
 925 |          ~ret))))
 926 | 
 927 | (defmacro areduce
 928 |   "Reduces an expression across an array a, using an index named idx,
 929 |   and return value named ret, initialized to init, setting ret to the 
 930 |   evaluation of expr at each step, returning ret."
 931 |   [a idx ret init expr]
 932 |   `(let [a# ~a]
 933 |      (loop  [~idx 0 ~ret ~init]
 934 |        (if (< ~idx  (alength a#))
 935 |          (recur (inc ~idx) ~expr)
 936 |          ~ret))))
 937 | 
 938 | (defmacro dotimes
 939 |   "bindings => name n
 940 | 
 941 |   Repeatedly executes body (presumably for side-effects) with name
 942 |   bound to integers from 0 through n-1."
 943 |   [bindings & body]
 944 |   (let [i (first bindings)
 945 |         n (second bindings)]
 946 |     `(let [n# ~n]
 947 |        (loop [~i 0]
 948 |          (when (< ~i n#)
 949 |            ~@body
 950 |            (recur (inc ~i)))))))
 951 | 
 952 | (defn ^:private check-valid-options
 953 |   "Throws an exception if the given option map contains keys not listed
 954 |   as valid, else returns nil."
 955 |   [options & valid-keys]
 956 |   (when (seq (apply disj (apply hash-set (keys options)) valid-keys))
 957 |     (throw
 958 |      (apply core/str "Only these options are valid: "
 959 | 	    (first valid-keys)
 960 | 	    (map #(core/str ", " %) (rest valid-keys))))))
 961 | 
 962 | (defmacro defmulti
 963 |   "Creates a new multimethod with the associated dispatch function.
 964 |   The docstring and attribute-map are optional.
 965 | 
 966 |   Options are key-value pairs and may be one of:
 967 |     :default    the default dispatch value, defaults to :default
 968 |     :hierarchy  the isa? hierarchy to use for dispatching
 969 |                 defaults to the global hierarchy"
 970 |   [mm-name & options]
 971 |   (let [docstring   (if (core/string? (first options))
 972 |                       (first options)
 973 |                       nil)
 974 |         options     (if (core/string? (first options))
 975 |                       (next options)
 976 |                       options)
 977 |         m           (if (map? (first options))
 978 |                       (first options)
 979 |                       {})
 980 |         options     (if (map? (first options))
 981 |                       (next options)
 982 |                       options)
 983 |         dispatch-fn (first options)
 984 |         options     (next options)
 985 |         m           (if docstring
 986 |                       (assoc m :doc docstring)
 987 |                       m)
 988 |         m           (if (meta mm-name)
 989 |                       (conj (meta mm-name) m)
 990 |                       m)]
 991 |     (when (= (count options) 1)
 992 |       (throw "The syntax for defmulti has changed. Example: (defmulti name dispatch-fn :default dispatch-value)"))
 993 |     (let [options   (apply hash-map options)
 994 |           default   (core/get options :default :default)]
 995 |       (check-valid-options options :default :hierarchy)
 996 |       `(def ~(with-meta mm-name m)
 997 |          (let [method-table# (atom {})
 998 |                prefer-table# (atom {})
 999 |                method-cache# (atom {})
1000 |                cached-hierarchy# (atom {})
1001 |                hierarchy# (get ~options :hierarchy cljs.core/global-hierarchy)
1002 |                mfn# (cljs.core/MultiFn. ~(name mm-name) ~dispatch-fn ~default hierarchy# method-table# prefer-table# method-cache# cached-hierarchy#)]
1003 |            (lua/setmetatable mfn# (js-obj "__call" builtins/mfn-call))
1004 |            mfn#)))))
1005 | 
1006 | (defmacro defmethod
1007 |   "Creates and installs a new method of multimethod associated with dispatch-value. "
1008 |   [multifn dispatch-val & fn-tail]
1009 |   `(-add-method ~(with-meta multifn {:tag 'cljs.core/MultiFn}) ~dispatch-val (fn ~@fn-tail)))
1010 | 
1011 | (defmacro time
1012 |   "Evaluates expr and prints the time it took. Returns the value of expr."
1013 |   [expr]
1014 |   `(let [start# (socket/gettime)
1015 |          ret# ~expr]
1016 |      (lua/print (core/str "Elapsed time: " (* 1000 (- (socket/gettime) start#)) " msecs"))
1017 |      ret#))
1018 | 
1019 | (defmacro lua-require [lib]
1020 |   `(do
1021 |      (lua/require ~lib)
1022 |      nil))
1023 | 
1024 | (defmacro simple-benchmark
1025 |   "Runs expr iterations times in the context of a let expression with
1026 |   the given bindings, then prints out the bindings and the expr
1027 |   followed by number of iterations and total time. The optional
1028 |   argument print-fn, defaulting to println, sets function used to
1029 |   print the result. expr's string representation will be produced
1030 |   using pr-str in any case."
1031 |   [bindings expr iterations & {:keys [print-fn] :or {print-fn 'println}}]
1032 |   (let [bs-str   (pr-str bindings)
1033 |         expr-str (pr-str expr)]
1034 |     `(let ~bindings
1035 |        (let [start#   (.getTime (js/Date.))
1036 |              ret#     (dotimes [_# ~iterations] ~expr)
1037 |              end#     (.getTime (js/Date.))
1038 |              elapsed# (- end# start#)]
1039 |          (~print-fn (str ~bs-str ", " ~expr-str ", "
1040 |                          ~iterations " runs, " elapsed# " msecs"))))))
1041 | 
1042 | (def cs (into [] (map (comp symbol core/str char) (range 97 118))))
1043 | 
1044 | (defn gen-apply-to-helper
1045 |   ([] (gen-apply-to-helper 1))
1046 |   ([n]
1047 |      (let [prop (symbol (core/str "-cljs__lang__arity__" n))
1048 |            f (symbol (core/str "cljs__lang__arity__" n))]
1049 |        (if (core/<= n 20)
1050 |          `(let [~(cs (core/dec n)) (-first ~'args)
1051 |                 ~'args (-rest ~'args)]
1052 |             (if (core/== ~'argc ~n)
1053 |               (if (. ~'f ~prop)
1054 |                 (. ~'f (~f ~@(take n cs)))
1055 |                 (~'f ~@(take n cs)))
1056 |               ~(gen-apply-to-helper (core/inc n))))
1057 |          `(throw (js/Error. "Only up to 20 arguments supported on functions"))))))
1058 | 
1059 | (defmacro gen-apply-to []
1060 |   `(do
1061 |      (set! ~'*unchecked-if* true)
1062 |      (defn ~'apply-to [~'f ~'argc ~'args]
1063 |        (let [~'args (seq ~'args)]
1064 |          (if (zero? ~'argc)
1065 |            (~'f)
1066 |            ~(gen-apply-to-helper))))
1067 |      (set! ~'*unchecked-if* false)))
1068 | 
1069 | (defmacro lua-string? [x]
1070 |   `(identical? (lua/type ~x) "string"))
1071 | 
1072 | (defmacro kw-or-sym? [x]
1073 |   `(and (identical? (string/byte ~x 1) 239)
1074 |         (identical? (string/byte ~x 2) 183)))
1075 | 
1076 | (defmacro length-op [a]  
1077 |   (list 'js* "#(~{})" a))
1078 | 
1079 | (defmacro type? [a]
1080 |   `(boolean (.-cljs__lang__type ~a)))
1081 | 
1082 | (defn make-C-struct-from-fields [typename fields]
1083 |   (clojure.core/let [fields-map (clojure.core/apply clojure.core/hash-map fields)]
1084 |     (clojure.core/str "typedef struct { "
1085 |          (clojure.core/apply clojure.core/str (clojure.core/for [[name type] fields-map] (clojure.core/str type " " name "; ")))
1086 |          "} " typename)))
1087 | 
1088 | (defn make-param-vect [fields]
1089 |   (clojure.core/vec (clojure.core/for [i (clojure.core/remove clojure.core/odd? (clojure.core/range (clojure.core/count fields)))] (fields i))))
1090 | 
1091 | (defmacro defnative [t fields & impls]
1092 |   (let [r (:name (cljs.analyzer/resolve-var (dissoc &env :locals) t))
1093 |         [fpps pmasks] (prepare-protocol-masks &env t impls)
1094 |         protocols (collect-protocols impls &env)
1095 |         t (vary-meta t assoc
1096 |             :protocols protocols
1097 |             :skip-protocol-flag fpps)
1098 |         tname (munge t)]
1099 |     (if (seq impls)
1100 |       `(do
1101 |          (builtins/require-ffi)
1102 |          (def ~t (js-obj))
1103 |          (ffi/cdef ~(make-C-struct-from-fields tname fields))
1104 |          (set! (.-proto-methods ~t) (builtins/create-proto-table))
1105 |          (set! (.--mt ~t) (js-obj "__index" (js-obj "proto_methods" (.-proto-methods ~t)
1106 |                                                     "constructor" ~t)
1107 |                                   "__call" builtins/IFnCall))
1108 |          (asetg (.. ~t --mt -__index) "constructor" ~t)
1109 |          (set! (.-c-cons ~t) (ffi/metatype ~(clojure.core/str tname) (.--mt ~t)))
1110 |          (set! (.-new ~t) (fn ~(make-param-vect fields)
1111 |                             (let [inst# (.c-cons ~t ~@(make-param-vect fields))]
1112 |                               inst#)))
1113 |          (set! (.-cljs__lang__type ~t) true)
1114 |          (set! (.-cljs__lang__ctorPrSeq ~t) (fn [this#] (list ~(core/str r))))
1115 |          (extend-type ~t ~@(dt->et impls fields true))
1116 |          nil)
1117 |       `(do
1118 |          (builtins/require-ffi)
1119 |          (def ~t (js-obj))
1120 |          (ffi/cdef ~(make-C-struct-from-fields tname fields))
1121 |          (set! (.-proto-methods ~t) (builtins/create-proto-table))
1122 |          (set! (.--mt ~t) (js-obj "__index" (js-obj "proto_methods" (.-proto-methods ~t))
1123 |                                   "__call" builtins/IFnCall))
1124 |          (asetg (.. ~t --mt -__index) "constructor" ~t)
1125 |          (set! (.-c-cons ~t) (ffi/metatype ~(clojure.core/str tname) (.--mt ~t)))
1126 |          (set! (.-new ~t) (fn ~(make-param-vect fields)
1127 |                             (let [inst# (.c-cons ~t ~@(make-param-vect fields))]
1128 |                               inst#)))
1129 |          (set! (.. ~t -m-cljs__lang__type ~t) true)
1130 |          (set! (.-cljs__lang__ctorPrSeq ~t) (fn [this#] (list ~(core/str r))))
1131 |          nil))))
1132 | 
1133 | (defmacro cdata? [obj]
1134 |   `(identical? (lua/type ~obj) "cdata"))
1135 | 
1136 | (defmacro cdef [def-string]
1137 |   `(ffi/cdef ~def-string))
1138 | 
1139 | (defmacro ccall [fn-name & args]
1140 |   `(.. ffi/C (~fn-name ~@args)))


--------------------------------------------------------------------------------
/src/cljs/lua/repl.clj:
--------------------------------------------------------------------------------
  1 | ;   Copyright (c) Rich Hickey. All rights reserved.
  2 | ;   The use and distribution terms for this software are covered by the
  3 | ;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  4 | ;   which can be found in the file epl-v10.html at the root of this distribution.
  5 | ;   By using this software in any fashion, you are agreeing to be bound by
  6 | ;   the terms of this license.
  7 | ;   You must not remove this notice, or any other, from this software.
  8 | 
  9 | (ns cljs.lua.repl
 10 |   (:require [clojure.java.io :as io]
 11 |             [cljs.lua.compiler :as comp]
 12 |             [cljs.analyzer :as ana]
 13 |             [cljs.cljsloader :as cloader]
 14 |             [clojure.data.json :as json]
 15 |             [cljs.lua.common :as com]
 16 |             [cljs.lua.config :as conf])
 17 |   (:import  [java.io PrintWriter File FileInputStream FileOutputStream]))
 18 | 
 19 | (def ^:dynamic *lua-interp* nil)
 20 | (def ^:dynamic *repl-verbose* true)
 21 | (def ^:dynamic *repl-exec* true)
 22 | (def ^:dynamic *repl-show-result* true)
 23 | (def ^:dynamic *error-fatal?* false)
 24 | (def next-core-form (atom 0))
 25 | 
 26 | (def nenv (partial com/new-env :return))
 27 | 
 28 | (defn eval-core-forms [eval-fn n]
 29 |   (let [current-ns ana/*cljs-ns*]
 30 |     (binding [*repl-verbose* false] (eval-fn (nenv) '(ns cljs.core)))
 31 |     (doseq [form (if (= n -1)
 32 |                    com/core-forms-seq
 33 |                    (take n (drop @next-core-form com/core-forms-seq)))]
 34 |       (eval-fn (nenv) form))
 35 |     (binding [*repl-verbose* false] (eval-fn (nenv) (list 'ns current-ns)))
 36 |     (swap! next-core-form + n)))
 37 | 
 38 | (def special-fns
 39 |   {'switch-verbose (fn [_] (set! *repl-verbose* (not *repl-verbose*)))
 40 |    'switch-exec (fn [_] (set! *repl-exec* (not *repl-exec*)))
 41 |    'eval-core-forms eval-core-forms})
 42 | 
 43 | (def special-fns-set (set (keys special-fns)))
 44 | 
 45 | (defn create-named-pipe [pfx]
 46 |   (let [pipe-path (-> (str "cljs_lua_" pfx "_")
 47 |                       (File/createTempFile ".fifo")
 48 |                       .getCanonicalPath)]
 49 |     (.waitFor (.exec (Runtime/getRuntime) (str "rm " pipe-path)))
 50 |     (.waitFor (.exec (Runtime/getRuntime) (str "mkfifo " pipe-path)))
 51 |     (File. pipe-path)))
 52 | 
 53 | (defn -main [& args]
 54 |   (println "Cljs/Lua repl")    
 55 |   (binding [ana/*cljs-ns* 'cljs.user
 56 |             ana/*cljs-static-fns* true
 57 |             *repl-verbose* false
 58 |             *repl-exec* true
 59 |             *lua-interp* (conf/get :repl :lua-runtime)]
 60 |     (let [;; Lua subprocess
 61 |           pb (ProcessBuilder. [*lua-interp* "cljs/exec_server.lua"])
 62 |           lua-process (.start pb)
 63 |           
 64 |           ;; Read lua stdout
 65 |           rdr (io/reader (.getInputStream lua-process))
 66 | 
 67 |           ;; Named pipes to communicate with lua subproc
 68 |           pipe-in (create-named-pipe "ltj") 
 69 |           pipe-out (create-named-pipe "jtl")
 70 |           pipe-rdr (future (io/reader pipe-in))
 71 |           pipe-wr (future (io/writer pipe-out))
 72 | 
 73 |           ;; Function to analyze a form, emit lua code,
 74 |           ;; pass it to the lua subproc, and get back the result
 75 |           eval-form (fn [env form]
 76 |                       (let [lua-code (with-out-str (comp/emit (ana/analyze env form)))]
 77 |                         (when *repl-verbose*
 78 |                           (println "---- LUA CODE ----")
 79 |                           (println lua-code))
 80 |                         (when *repl-exec*
 81 |                           (binding [*out* @pipe-wr]
 82 |                             (println (json/json-str {:action :exec :body lua-code})))
 83 |                           (let [resp (json/read-json (.readLine @pipe-rdr))]
 84 |                             (if (= (:status resp) "OK")
 85 |                               (when *repl-show-result* (println (:body resp)))
 86 |                               (do
 87 |                                 (println "ERROR : " (:body resp))
 88 |                                 (when *error-fatal?*
 89 |                                   (println lua-code)
 90 |                                   )))))))]
 91 | 
 92 |       ;; Redirect everything from subprocess stdout to own stdout
 93 |       (.start (Thread. (fn [] (while true (let [l (.readLine rdr)] (when l (println l)))))))
 94 | 
 95 |       (try (do
 96 |              (.exitValue lua-process)
 97 |              (println "Lua subprocess has exited prematurely, verify you have lua installed, and required libraries : lua-json and lua-bitops")
 98 |              (System/exit 0))
 99 |            (catch Exception e))
100 | 
101 |       ;; Send it the two pipes names
102 |       (binding [*out* (PrintWriter. (.getOutputStream lua-process))]
103 |         (println (.getCanonicalPath pipe-in))
104 |         (println (.getCanonicalPath pipe-out)))
105 | 
106 |       ;; Eval core.cljs forms
107 |       (binding [*repl-verbose* false
108 |                 *repl-show-result* false
109 |                 *error-fatal?* true]
110 |         (eval-core-forms eval-form -1))
111 |       
112 |       ;; Eval common ns forms
113 |       (eval-form (nenv) '(ns cljs.user))
114 |       
115 |       ;; Repl loop
116 |       (while true
117 |         (.print System/out (str ana/*cljs-ns* " > "))
118 |         (.flush (System/out))
119 |         (let [env (nenv)
120 |               form (read)
121 |               special-fn? (and (seq? form) (contains? special-fns-set (first form)))]
122 |           (if special-fn?
123 |             (println (apply (special-fns (first form)) eval-form (rest form)))
124 |             (try (eval-form env form)
125 |                  (catch Exception e
126 |                    (.printStackTrace e))
127 |                  (catch AssertionError a
128 |                    (.printStackTrace a)))))))))


--------------------------------------------------------------------------------
/test/cljs/macro_test.cljs:
--------------------------------------------------------------------------------
1 | (ns cljs.macro-test
2 |   (:refer-clojure :exclude [==])
3 |   (:use-macros [cljs.macro-test.macros :only [==]]))
4 | 
5 | (defn test-macros []
6 |   (assert (= (== 1 1) 2)))


--------------------------------------------------------------------------------
/test/cljs/macro_test/macros.clj:
--------------------------------------------------------------------------------
1 | (ns cljs.macro-test.macros
2 |   (:refer-clojure :exclude [==]))
3 | 
4 | (defmacro == [a b]
5 |   `(+ ~a ~b))


--------------------------------------------------------------------------------
/test/core_test.cljs:
--------------------------------------------------------------------------------
   1 | (ns cljs.core-test
   2 |   (:require [cljs.macro-test :as macro-test]))
   3 | 
   4 | (defn test-stuff []
   5 |   ;; js primitives
   6 |   (let [keys #(vec (js-keys %))]
   7 |     (assert (= [] (keys (js-obj)) (keys (apply js-obj []))))
   8 |     (assert (= ["x"] (keys (js-obj "x" "y")) (keys (apply js-obj ["x" "y"])))))
   9 | 
  10 |   ;; -equiv
  11 |   (assert (= 1))
  12 |   (assert (= 1 1))
  13 |   (assert (= 1 1 1))
  14 |   (assert (= 1 1 1 1))
  15 |   (assert (not (= 1 2)))
  16 |   (assert (not (= 1 2 1)))
  17 |   (assert (not (= 1 1 2)))
  18 |   (assert (not (= 1 1 2 1)))
  19 |   (assert (not (= 1 1 1 2)))
  20 |   
  21 |   ;; arithmetic
  22 |   (assert (= (+) 0))
  23 |   (assert (= (apply + []) 0))
  24 |   (assert (= (+ 1) 1))
  25 |   (assert (= (apply + [1]) 1))
  26 |   (assert (= (+ 1 1) 2))
  27 |   (assert (= (apply + [1 1]) 2))
  28 |   (assert (= (+ 1 2 3) 6))
  29 |   (assert (= (apply + [1 2 3]) 6))
  30 | 
  31 |   (assert (= (- 1) -1))
  32 |   (assert (= (apply - [1]) -1))
  33 |   (assert (= (- 1 1) 0))
  34 |   (assert (= (apply - [1 1]) 0))
  35 |   (assert (= (- 3 2 1) 0))
  36 |   (assert (= (apply - [3 2 1]) 0))
  37 | 
  38 |   (assert (= (*) 1))
  39 |   (assert (= (apply * []) 1))
  40 |   (assert (= (* 2) 2))
  41 |   (assert (= (apply * [2]) 2))
  42 |   (assert (= (* 2 3) 6))
  43 |   (assert (= (apply * [2 3]) 6))
  44 | 
  45 |   (assert (= (/ 2) 0.5))
  46 |   (assert (= (apply / [2]) 0.5))
  47 |   (assert (= (/ 6 2) 3))
  48 |   (assert (= (apply / [6 2]) 3))
  49 |   (assert (= (/ 6 3 2) 1))
  50 |   (assert (= (apply / [6 3 2]) 1))
  51 | 
  52 |   (assert (= (< 1) true))
  53 |   (assert (= (apply < [1]) true))
  54 |   (assert (= (< 1 2) true))
  55 |   (assert (= (apply < [1 2]) true))
  56 |   (assert (= (< 1 1) false))
  57 |   (assert (= (apply < [1 1]) false))
  58 |   (assert (= (< 2 1) false))
  59 |   (assert (= (apply < [2 1]) false))
  60 |   (assert (= (< 1 2 3) true))
  61 |   (assert (= (apply < [1 2 3]) true))
  62 |   (assert (= (< 1 1 3) false))
  63 |   (assert (= (apply < [1 1 3]) false))
  64 |   (assert (= (< 3 1 1) false))
  65 |   (assert (= (apply < [3 1 1]) false))
  66 | 
  67 |   (assert (= (<= 1) true))
  68 |   (assert (= (apply <= [1]) true))
  69 |   (assert (= (<= 1 1) true))
  70 |   (assert (= (apply <= [1 1]) true))
  71 |   (assert (= (<= 1 2) true))
  72 |   (assert (= (apply <= [1 2]) true))
  73 |   (assert (= (<= 2 1) false))
  74 |   (assert (= (apply <= [2 1]) false))
  75 |   (assert (= (<= 1 2 3) true))
  76 |   (assert (= (apply <= [1 2 3]) true))
  77 |   (assert (= (<= 1 1 3) true))
  78 |   (assert (= (apply <= [1 1 3]) true))
  79 |   (assert (= (<= 3 1 1) false))
  80 |   (assert (= (apply <= [3 1 1]) false))
  81 | 
  82 |   (assert (= (> 1) true))
  83 |   (assert (= (apply > [1]) true))
  84 |   (assert (= (> 2 1) true))
  85 |   (assert (= (apply > [2 1]) true))
  86 |   (assert (= (> 1 1) false))
  87 |   (assert (= (apply > [1 1]) false))
  88 |   (assert (= (> 1 2) false))
  89 |   (assert (= (apply > [1 2]) false))
  90 |   (assert (= (> 3 2 1) true))
  91 |   (assert (= (apply > [3 2 1]) true))
  92 |   (assert (= (> 3 1 1) false))
  93 |   (assert (= (apply > [3 1 1]) false))
  94 |   (assert (= (> 1 1 3) false))
  95 |   (assert (= (apply > [1 1 3]) false))
  96 | 
  97 |   (assert (= (>= 1) true))
  98 |   (assert (= (apply >= [1]) true))
  99 |   (assert (= (>= 2 1) true))
 100 |   (assert (= (apply >= [2 1]) true))
 101 |   (assert (= (>= 1 1) true))
 102 |   (assert (= (apply >= [1 1]) true))
 103 |   (assert (= (>= 1 2) false))
 104 |   (assert (= (apply >= [1 2]) false))
 105 |   (assert (= (>= 3 2 1) true))
 106 |   (assert (= (apply >= [3 2 1]) true))
 107 |   (assert (= (>= 3 1 1) true))
 108 |   (assert (= (apply >= [3 1 1]) true))
 109 |   (assert (= (>= 3 1 2) false))
 110 |   (assert (= (apply >= [3 1 2]) false))
 111 |   (assert (= (>= 1 1 3) false))
 112 |   (assert (= (apply >= [1 1 3]) false))
 113 | 
 114 |   (assert (= (dec 1) 0))
 115 |   (assert (= (apply dec [1]) 0))
 116 |   (assert (= (inc 0) 1))
 117 |   (assert (= (apply inc [0]) 1))
 118 | 
 119 |   (assert (= (zero? 0) true))
 120 |   (assert (= (apply zero? [0]) true))
 121 |   (assert (= (zero? 1) false))
 122 |   (assert (= (apply zero? [1]) false))
 123 |   (assert (= (zero? -11) false))
 124 |   (assert (= (apply zero? [-11]) false))
 125 |   (assert (= (pos? 0) false))
 126 |   (assert (= (apply pos? [0]) false))
 127 |   (assert (= (pos? 1) true))
 128 |   (assert (= (apply pos? [1]) true))
 129 |   (assert (= (pos? -1) false))
 130 |   (assert (= (apply pos? [-1]) false))
 131 |   (assert (= (neg? -1) true))
 132 |   (assert (= (apply neg? [-1]) true))
 133 | 
 134 |   (assert (= (max 1) 1))
 135 |   (assert (= (apply max [1]) 1))
 136 |   (assert (= (max 1 2) 2))
 137 |   (assert (= (apply max [1 2]) 2))
 138 |   (assert (= (max 2 1) 2))
 139 |   (assert (= (apply max [2 1]) 2))
 140 |   (assert (= (max 1 2 3) 3))
 141 |   (assert (= (apply max [1 2 3]) 3))
 142 |   (assert (= (max 1 3 2) 3))
 143 |   (assert (= (apply max [1 3 2]) 3))
 144 | 
 145 |   (assert (= (min 1) 1))
 146 |   (assert (= (apply min [1]) 1))
 147 |   (assert (= (min 1 2) 1))
 148 |   (assert (= (apply min [1 2]) 1))
 149 |   (assert (= (min 2 1) 1))
 150 |   (assert (= (apply min [2 1]) 1))
 151 |   (assert (= (min 1 2 3) 1))
 152 |   (assert (= (apply min [1 2 3]) 1))
 153 |   (assert (= (min 2 1 3) 1))
 154 |   (assert (= (apply min [3 1 3]) 1))
 155 | 
 156 |   (assert (= (mod 4 2) 0))
 157 |   (assert (= (apply mod [4 2]) 0))
 158 |   (assert (= (mod 3 2) 1))
 159 |   (assert (= (apply mod [3 2]) 1))
 160 | 
 161 |   (assert (= [4 3 2 1 0] (loop [i 0 j ()]
 162 |                  (if (< i 5)
 163 |                    (recur (inc i) (conj j (fn [] i)))
 164 |                    (map #(%) j)))))
 165 | 
 166 |   (assert (= [[1 1] [1 2] [1 3] [2 1] [2 2] [2 3]]
 167 |              (map #(%) (for [i [1 2] j [1 2 3]] (fn [] [i j])))))
 168 | 
 169 |   (assert (= 42 (int 42.5)))
 170 |   (assert (integer? (int 42.5)))
 171 | 
 172 |   (assert (= 42 (long 42.5)))
 173 |   (assert (integer? (long 42.5)))
 174 | 
 175 |   (assert (= -1 (int -1.5)))
 176 |   (assert (= -9 (long -9.8)))
 177 | 
 178 |   (assert (= 2 (:b {:a 1 :b 2})))
 179 |   (assert (= 2 ('b '{:a 1 b 2})))
 180 |   (assert (= 2 ({:a 1 :b 2} :b)))
 181 |   (assert (= 2 ({1 1 2 2} 2)))
 182 |   (assert (= 2 (#{1 2 3} 2)))
 183 | 
 184 |   (assert (= 1 (apply :a '[{:a 1 a 2}])))
 185 |   (assert (= 1 (apply 'a '[{a 1 :b 2}])))
 186 |   (assert (= 1 (apply {:a 1} [:a])))
 187 |   (assert (= 2 (apply {:a 1} [:b 2])))
 188 | 
 189 |   (assert (= "baz" (name 'foo/bar/baz)))
 190 |   (assert (= "foo/bar" (namespace 'foo/bar/baz)))
 191 |   (assert (= "baz" (name :foo/bar/baz)))
 192 |   ;(assert (= "foo/bar" (namespace :foo/bar/baz)))
 193 | 
 194 |   ; str
 195 |   (assert (= ":hello" (str :hello)))
 196 |   (assert (= "hello" (str 'hello)))
 197 |   (assert (= "hello:world" (str "hello" :world)))
 198 |   (assert (= ":helloworld" (str :hello 'world)))
 199 | 
 200 |   (assert (= {:a :b} (get {[1 2 3] {:a :b}, 4 5} [1 2 3])))
 201 |   (assert (= :a (nth [:a :b :c :d] 0)))
 202 |   (assert (= :a (nth [:a :b :c :d] 0.1)) )
 203 |   (assert (not (= {:a :b :c nil} {:a :b :d nil})))
 204 |   (assert (= (list 3 2 1) [3 2 1]))
 205 |   (assert (= [3 2 1] (seq (array 3 2 1))))
 206 |   (assert (= 9 (reduce + (next (seq (array 1 2 3 4))))))
 207 |   (assert (= () (rest nil)))
 208 |   (assert (= () (rest ())))
 209 |   (assert (= () (rest [1])))
 210 |   (assert (= () (rest (array 1))))
 211 |   (assert (= {"x" "y"} (meta ^{"x" "y"} [])))
 212 |   (assert (= {:a :b} (dissoc {:a :b :c :d} :c)))
 213 |   (assert (= (hash-map :foo 5)
 214 |              (assoc (cljs.core.ObjMap. nil (array) (js-obj) 0 0) :foo 5)))
 215 | 
 216 |   (assert (= "\"asdf\"" (pr-str "asdf")))
 217 | 
 218 |   (assert (= "\"asdf\"\n" (prn-str "asdf")))
 219 |   (assert (= "[1 true {:a 2, :b 42} #<Array [3, 4]>]\n"
 220 |              (prn-str [1 true {:a 2 :b 42} (array 3 4)])))
 221 | 
 222 |   (assert (= "asdf" (print-str "asdf")))
 223 |   (assert (= "asdf\n" (println-str "asdf")))
 224 | 
 225 |   ;;this fails in v8 - why?
 226 |   ;(assert (= "symbol\"'string" (pr-str (str 'symbol \" \' "string"))))
 227 | 
 228 |   (assert (not (= "one" "two")))
 229 |   (assert (= 3 (-count "abc")))
 230 |   (assert (= 4 (-count (array 1 2 3 4))))
 231 |   (assert (= "c" (-nth "abc" 2)))
 232 |   (assert (= "quux" (-nth "abc" 3 "quux")))
 233 |   (assert (= 1 (-nth (array 1 2 3 4) 0)))
 234 |   (assert (= "val" (-nth (array 1 2 3 4) 4 "val")))
 235 |   (assert (= "b" (-lookup "abc" 1)))
 236 |   (assert (= "harriet" (-lookup "abcd" 4 "harriet")))
 237 |   (assert (= 4 (-lookup (array 1 2 3 4) 3)))
 238 |   (assert (= "zot" (-lookup (array 1 2 3 4) 4 "zot")))
 239 |   (assert (= 10 (-reduce (array 1 2 3 4) +)))
 240 |   (assert (= 20 (-reduce (array 1 2 3 4) + 10)))
 241 |   (assert (= "cabd" (let
 242 |                         [jumble (fn [a b] (str (apply str (reverse (str a))) b))]
 243 |                       (-reduce "abcd" jumble))))
 244 |   (assert (= "cafrogbd" (let
 245 |                             [jumble (fn [a b] (str (apply str (reverse (str a))) b))]
 246 |                           (-reduce "abcd" jumble "frog"))))
 247 |   (assert (= [0 0 1 0 1]
 248 |                [(bit-and 1 0)
 249 |                 (bit-and 0 0)
 250 |                 (bit-and 1 1)
 251 |                 (bit-and 42 1)
 252 |                 (bit-and 41 1)]))
 253 |   (assert (= [1 0 1 43 41]
 254 |                [(bit-or 1 0)
 255 |                 (bit-or 0 0)
 256 |                 (bit-or 1 1)
 257 |                 (bit-or 42 1)
 258 |                 (bit-or 41 1)]))
 259 |   (assert (= [1 0 0 42 40]
 260 |                [(bit-and-not 1 0)
 261 |                 (bit-and-not 0 0)
 262 |                 (bit-and-not 1 1)
 263 |                 (bit-and-not 42 1)
 264 |                 (bit-and-not 41 1)]))
 265 |   (assert (= [0 2 968 16649 0]
 266 |                [(bit-clear 1 0)
 267 |                 (bit-clear 2 0)
 268 |                 (bit-clear 1000 5)
 269 |                 (bit-clear 16713 6)
 270 |                 (bit-clear 1024 10)]))
 271 |   (assert (= [0 0 992 18761 0]
 272 |                [(bit-flip 1 0)
 273 |                 (bit-flip 2 1)
 274 |                 (bit-flip 1000 3)
 275 |                 (bit-flip 16713 11)
 276 |                 (bit-flip 1024 10)]))
 277 |   (assert (= [-2 -3 999 -16714 -1025]
 278 |                [(bit-not 1)
 279 |                 (bit-not 2)
 280 |                 (bit-not -1000)
 281 |                 (bit-not 16713)
 282 |                 (bit-not 1024)]))
 283 |   (assert (= [1 2 1000 18761 1024]
 284 |                [(bit-set 1 0)
 285 |                 (bit-set 2 1)
 286 |                 (bit-set 1000 3)
 287 |                 (bit-set 16713 11)
 288 |                 (bit-set 1024 10)]))
 289 |   (assert (= [true true true false true]
 290 |                [(bit-test 1 0)
 291 |                 (bit-test 2 1)
 292 |                 (bit-test 1000 3)
 293 |                 (bit-test 16713 11)
 294 |                 (bit-test 1024 10)]))
 295 |   (assert (= [true false true false false false]
 296 |              [(true? true)
 297 |               (true? false)
 298 |               (false? false)
 299 |               (false? true)
 300 |               (true? js/undefined)
 301 |               (false? js/undefined)]))
 302 | 
 303 |   ;; apply
 304 |   (assert (= 0 (apply + nil)))
 305 |   (assert (= 0 (apply + (list))))
 306 |   (assert (= 1 (apply + (list 1))))
 307 |   (assert (= 3 (apply + 1 (list 2))))
 308 |   (assert (= 7 (apply + 1 2 (list 4))))
 309 |   (assert (= 15 (apply + 1 2 4 (list 8))))
 310 |   (assert (= 31 (apply + 1 2 4 8 (list 16))))
 311 |   (assert (= 63 (apply + 1 2 4 8 16 (list 32))))
 312 |   (assert (= 127 (apply + 1 2 4 8 16 (list 32 64))))
 313 |   #_(assert (= 4950 (apply + (take 100 (iterate inc 0)))))
 314 |   (assert (= () (apply list [])))
 315 |   (assert (= [1 2 3] (apply list [1 2 3])))
 316 |   (assert (= 6 (apply apply [+ [1 2 3]])))
 317 |   ;; apply with infinite sequence
 318 |   (assert (= 3 (apply (fn [& args]
 319 |                         (+ (nth args 0)
 320 |                            (nth args 1)
 321 |                            (nth args 2)))
 322 |                       (iterate inc 0))))
 323 |   (assert (= [0 1 2 3 4] (take 5 (apply (fn [& m] m) (iterate inc 0)))))
 324 |   (assert (= [1 2 3 4 5] (take 5 (apply (fn [x & m] m) (iterate inc 0)))))
 325 |   (assert (= [2 3 4 5 6] (take 5 (apply (fn [x y & m] m) (iterate inc 0)))))
 326 |   (assert (= [3 4 5 6 7] (take 5 (apply (fn [x y z & m] m) (iterate inc 0)))))
 327 |   (assert (= [4 5 6 7 8] (take 5 (apply (fn [x y z a & m] m) (iterate inc 0)))))
 328 |   (assert (= [5 6 7 8 9] (take 5 (apply (fn [x y z a b & m] m) (iterate inc 0)))))
 329 | 
 330 |   ;; apply arity tests
 331 |   (let [single-arity-non-variadic (fn [x y z] [z y x])
 332 |         multiple-arity-non-variadic (fn ([x] x) ([x y] [y x]) ([x y z] [z y x]))
 333 |         single-arity-variadic-fixedargs (fn [x y & more] [more y x])
 334 |         single-arity-variadic-nofixedargs (fn [& more] more)
 335 |         multiple-arity-variadic (fn ([x] x) ([x y] [y x]) ([x y & more] [more y x]))]
 336 |     (assert (= [3 2 1] (apply single-arity-non-variadic [1 2 3])))
 337 |     (assert (= [3 2 1] (apply single-arity-non-variadic 1 [2 3])))
 338 |     (assert (= [3 2 1] (apply single-arity-non-variadic 1 2 [3])))
 339 |     (assert (= 42 (apply multiple-arity-non-variadic [42])))
 340 |     (assert (= [2 1] (apply multiple-arity-non-variadic [1 2])))
 341 |     (assert (= [2 1] (apply multiple-arity-non-variadic 1 [2])))
 342 |     (assert (= [3 2 1] (apply multiple-arity-non-variadic [1 2 3])))
 343 |     (assert (= [3 2 1] (apply multiple-arity-non-variadic 1 [2 3])))
 344 |     (assert (= [3 2 1] (apply multiple-arity-non-variadic 1 2 [3])))
 345 |     (assert (= [[3 4 5] 2 1] (apply single-arity-variadic-fixedargs [1 2 3 4 5])))
 346 |     (assert (= [[3 4 5] 2 1] (apply single-arity-variadic-fixedargs 1 [2 3 4 5])))
 347 |     (assert (= [[3 4 5] 2 1] (apply single-arity-variadic-fixedargs 1 2 [3 4 5])))
 348 |     (assert (= [[3 4 5] 2 1] (apply single-arity-variadic-fixedargs 1 2 3 [4 5])))
 349 |     (assert (= [[3 4 5] 2 1] (apply single-arity-variadic-fixedargs 1 2 3 4 [5])))
 350 |     (assert (= [3 4 5] (take 3 (first (apply single-arity-variadic-fixedargs (iterate inc 1))))))
 351 |     (assert (= [2 1] (rest (apply single-arity-variadic-fixedargs (iterate inc 1)))))
 352 |     (assert (= [1 2 3 4 5] (apply single-arity-variadic-nofixedargs [1 2 3 4 5])))
 353 |     (assert (= [1 2 3 4 5] (apply single-arity-variadic-nofixedargs 1 [2 3 4 5])))
 354 |     (assert (= [1 2 3 4 5] (apply single-arity-variadic-nofixedargs 1 2 [3 4 5])))
 355 |     (assert (= [1 2 3 4 5] (apply single-arity-variadic-nofixedargs 1 2 3 [4 5])))
 356 |     (assert (= [1 2 3 4 5] (apply single-arity-variadic-nofixedargs 1 2 3 4 [5])))
 357 |     (assert (= [1 2 3 4 5] (take 5 (apply single-arity-variadic-nofixedargs (iterate inc 1)))))
 358 |     (assert (= 42 (apply multiple-arity-variadic [42])))
 359 |     (assert (= [2 1] (apply multiple-arity-variadic [1 2])))
 360 |     (assert (= [2 1] (apply multiple-arity-variadic 1 [2])))
 361 |     (assert (= [[3 4 5] 2 1] (apply multiple-arity-variadic [1 2 3 4 5])))
 362 |     (assert (= [[3 4 5] 2 1] (apply multiple-arity-variadic 1 [2 3 4 5])))
 363 |     (assert (= [[3 4 5] 2 1] (apply multiple-arity-variadic 1 2 [3 4 5])))
 364 |     (assert (= [[3 4 5] 2 1] (apply multiple-arity-variadic 1 2 3 [4 5])))
 365 |     (assert (= [[3 4 5] 2 1] (apply multiple-arity-variadic 1 2 3 4 [5])))
 366 |     (assert (= [3 4 5] (take 3 (first (apply multiple-arity-variadic (iterate inc 1))))))
 367 |     (assert (= [2 1] (rest (apply multiple-arity-variadic (iterate inc 1))))))
 368 |   
 369 |   (let [a (atom 0)]
 370 |     (assert (= 0 (deref a)))
 371 |     (assert (= 1 (swap! a inc)))
 372 |     (assert (= false (compare-and-set! a 0 42)))
 373 |     (assert (= true (compare-and-set! a 1 7)))
 374 |     (assert (nil? (meta a)))
 375 |     (assert (nil? (get-validator a))))
 376 |   
 377 |   (let [a (atom 0)]
 378 |     (assert (= 1 (swap! a + 1)))
 379 |     (assert (= 4 (swap! a + 1 2)))
 380 |     (assert (= 10 (swap! a + 1 2 3)))
 381 |     (assert (= 20 (swap! a + 1 2 3 4))))
 382 |   
 383 |   (let [a (atom [1] :validator coll? :meta {:a 1})]
 384 |     (assert (= coll? (get-validator a)))
 385 |     (assert (= {:a 1} (meta a)))
 386 |     (alter-meta! a assoc :b 2)
 387 |     (assert (= {:a 1 :b 2} (meta a))))
 388 |   
 389 |   (assert (nil? (empty nil)))
 390 | 
 391 |   (let [e-lazy-seq (empty (with-meta (lazy-seq (cons :a nil)) {:b :c}))]
 392 |     (assert (seq? e-lazy-seq))
 393 |     (assert (empty? e-lazy-seq))
 394 |     (assert (= {:b :c} (meta e-lazy-seq))))  
 395 |   (let [e-list (empty '^{:b :c} (1 2 3))]
 396 |     (assert (seq? e-list))
 397 |     (assert (empty? e-list)))  
 398 |   (let [e-elist (empty '^{:b :c} ())]
 399 |     (assert (seq? e-elist))
 400 |     (assert (empty? e-elist))
 401 |     (assert (= :c (get (meta e-elist) :b))))
 402 |   (let [e-cons (empty (with-meta (cons :a nil) {:b :c}))]
 403 |     (assert (seq? e-cons))
 404 |     (assert (empty? e-cons))
 405 |     (assert (= {:b :c} (meta e-cons))))
 406 |   (let [e-vec (empty ^{:b :c} [:a :d :g])]
 407 |     (assert (vector? e-vec))
 408 |     (assert (empty? e-vec))
 409 |     (assert (= {:b :c} (meta e-vec))))
 410 |   (let [e-omap (empty ^{:b :c} {:a :d :g :h})]
 411 |     (assert (map? e-omap))
 412 |     (assert (empty? e-omap))
 413 |     (assert (= {:b :c} (meta e-omap))))
 414 |   (let [e-hmap (empty ^{:b :c} {[1 2] :d :g :h})]
 415 |     (assert (map? e-hmap))
 416 |     (assert (empty? e-hmap))
 417 |     (assert (= {:b :c} (meta e-hmap))))
 418 | 
 419 |   ;;this fails in v8 advanced mode - what's e?
 420 |   #_(let [a (atom nil)]
 421 |     (assert (= 1 (try* 1)))
 422 |     (assert (= 2 (try* 1 (throw 3) (catch e 2))))
 423 |     (assert (= 3 (try* 1 (throw 3) (catch e e))))
 424 |     (assert (= 1 (try* 1 (finally (reset! a 42)))))
 425 |     (assert (= 42 (deref a))))
 426 | 
 427 |   (let [a (atom nil)]
 428 |     (assert (= 1 (try 1)))
 429 |     (assert (= 2 (try 1 (throw (js/Error.)) (catch js/Error e 2))))
 430 |     (assert (= 2 (try 1 (throw (js/Error.)) (catch js/Error e 1 2))))
 431 |     (assert (= 1 (try 1 (finally (reset! a 42)))))
 432 |     (assert (= 42 (deref a))))
 433 | 
 434 |   (assert (= [3] (nthnext [1 2 3] 2)))
 435 |   (let [v [1 2 3]]
 436 |     (assert (= v (for [e v] e)))
 437 |     (assert (= [[1 1] [2 4] [3 9]] (for [e v :let [m (* e e)]] [e m])))
 438 |     (assert (= [1 2] (for [e v :while (< e 3)] e)))
 439 |     (assert (= [3] (for [e v :when (> e 2)] e)))
 440 |     (assert (= [[1 1] [2 4]] (for [e v :while (< e 3) :let [m (* e e)]] [e m]))))
 441 |   (assert (not= 1 2))
 442 |   (assert (not (not= 1 1)))
 443 |   (assert (not (not-empty [])))
 444 |   (assert (boolean (not-empty [1 2 3])))
 445 |   (assert (= "joel" (min-key count "joel" "tom servo" "crooooooooow")))
 446 |   (assert (= "crooooooooow" (max-key count "joel" "tom servo" "crooooooooow")))
 447 |   (assert (= (partition-all 4 [1 2 3 4 5 6 7 8 9])
 448 |              [[1 2 3 4] [5 6 7 8] [9]]))
 449 |   (assert (= (partition-all 4 2 [1 2 3 4 5 6 7 8 9])
 450 |              [[1 2 3 4] [3 4 5 6] [5 6 7 8] [7 8 9] [9]]))
 451 |   (assert (= [true true] (take-while true? [true true 2 3 4])))
 452 |   (assert (= [[true true] [false false false] [true true]]
 453 |              (partition-by true? [true true false false false true true])))
 454 |   (assert (= [0 2 4 6 8 10] (take-nth 2 [0 1 2 3 4 5 6 7 8 9 10])))
 455 |   (let [a10 (partial + 10)
 456 |         a20 (partial + 10 10)
 457 |         a21 (partial + 10 10 1)
 458 |         a22 (partial + 10 5  4 3)
 459 |         a23 (partial + 10 5  4 3 1)]
 460 |     (assert (= 110 (a10 100)))
 461 |     (assert (= 120 (a20 100)))
 462 |     (assert (= 121 (a21 100)))
 463 |     (assert (= 122 (a22 100)))
 464 |     (assert (= 123 (a23 100))))
 465 | 
 466 |   (let [n2 (comp first rest)
 467 |         n3 (comp first rest rest)
 468 |         n4 (comp first rest rest rest)
 469 |         n5 (comp first rest rest rest rest)
 470 |         n6 (comp first rest rest rest rest rest)]
 471 |     (assert (= 2 (n2 [1 2 3 4 5 6 7])))
 472 |     (assert (= 3 (n3 [1 2 3 4 5 6 7])))
 473 |     (assert (= 4 (n4 [1 2 3 4 5 6 7])))
 474 |     (assert (= 5 (n5 [1 2 3 4 5 6 7])))
 475 |     (assert (= 6 (n6 [1 2 3 4 5 6 7]))))
 476 | 
 477 |   (let [sf (some-fn number? keyword? symbol?)]
 478 |     (assert (sf :foo 1))
 479 |     (assert (sf :foo))
 480 |     (assert (sf 'bar 1))
 481 |     (assert (not (sf [] ()))))
 482 |   (let [ep (every-pred number? zero?)]
 483 |     (assert (ep 0 0 0))
 484 |     (assert (not (ep 1 2 3 0))))
 485 |   (assert ((complement number?) :foo))
 486 |   (assert (= [1 [2 3] [1 2 3]] ((juxt first rest seq) [1 2 3])))
 487 |   (assert (= 5 (max 1 2 3 4 5)))
 488 |   (assert (= 5 (max 5 4 3 2 1)))
 489 |   (assert (= 5.5 (max 1 2 3 4 5 5.5)))
 490 |   (assert (= 1 (min 5 4 3 2 1)))
 491 |   (assert (= 1 (min 1 2 3 4 5)))
 492 |   (assert (= 0.5 (min 5 4 3 0.5 2 1)))
 493 |   (let [x (array 1 2 3)]
 494 |     (set! (.-foo x) :hello)
 495 |     (assert (= (.-foo x) :hello)))
 496 | 
 497 |   (assert (set []))
 498 |   (assert (= #{} (set [])))
 499 |   (assert (= #{} (hash-set)))
 500 |   (assert (identical? cljs.core.PersistentHashSet (type (hash-set))))
 501 | 
 502 |   (assert (= #{"foo"} (set ["foo"])))
 503 |   (assert (= #{"foo"} (hash-set "foo")))
 504 |   (assert (= #{1 2 3} #{1 3 2}))
 505 |   (assert (= #{#{1 2 3} [4 5 6] {7 8} 9 10}
 506 |              #{10 9 [4 5 6] {7 8} #{1 2 3}}))
 507 |   (assert (not (= #{nil [] {} 0 #{}} #{})))
 508 |   (assert (= (count #{nil [] {} 0 #{}}) 5))
 509 |   (assert (= (conj #{1} 1) #{1}))
 510 |   (assert (= (conj #{1} 2) #{2 1}))
 511 |   (assert (= #{} (-empty #{1 2 3 4})))
 512 |   (assert (= (reduce + #{1 2 3 4 5}) 15))
 513 |   (assert (= 4 (get #{1 2 3 4} 4)))
 514 |   (assert (contains? #{1 2 3 4} 4))
 515 |   (assert (contains? #{[] nil 0 {} #{}} {}))
 516 |   (assert (contains? #{[1 2 3]} [1 2 3]))
 517 |   (assert (not (contains? (-disjoin #{1 2 3} 3) 3)))
 518 |   (assert (neg? -1))
 519 |   (assert (not (neg? 1)))
 520 |   (assert (neg? -1.765))
 521 |   (assert (not (neg? 0)))
 522 |   (assert (= [true false true false true false true false]
 523 |              (map integer?
 524 |                   [1 1.00001 0x7e7 [] (- 88 1001991881) :foo 0 "0"])))
 525 |   (assert (= [true false true false true false]
 526 |              (map odd? [1 2 3 4 -1 0])))
 527 |   (assert (= [true false true false true true]
 528 |              (map even? [2 3 4 5 -2 0])))
 529 |   (assert (contains? {:a 1 :b 2} :a))
 530 |   (assert (not (contains? {:a 1 :b 2} :z)))
 531 |   (assert (contains? [5 6 7] 1))
 532 |   (assert (contains? [5 6 7] 2))
 533 |   (assert (not (contains? [5 6 7] 3)))
 534 |   (assert (contains? (to-array [5 6 7]) 1))
 535 |   (assert (contains? (to-array [5 6 7]) 2))
 536 |   (assert (not (contains? (to-array [5 6 7]) 3)))
 537 |   (assert (not (contains? nil 42)))
 538 |   (assert (contains? "f" 0))
 539 |   (assert (not (contains? "f" 55)))
 540 |   (assert (distinct? 1 2 3))
 541 |   (assert (not (distinct? 1 2 3 1)))
 542 | 
 543 |   ;; distinct
 544 |   (assert (= (distinct ()) ()))
 545 |   (assert (= (distinct '(1)) '(1)))
 546 |   (assert (= (distinct '(1 2 3 1 1 1)) '(1 2 3)))
 547 |   (assert (= (distinct [1 1 1 2]) '(1 2)))
 548 |   (assert (= (distinct [1 2 1 2]) '(1 2)))
 549 |   (assert (= (distinct "a") ["a"]))
 550 |   (assert (= (distinct "abcabab") ["a" "b" "c"]))
 551 |   (assert (= (distinct ["abc" "abc"]) ["abc"]))
 552 |   (assert (= (distinct [nil nil]) [nil]))
 553 |   (assert (= (distinct [0.0 0.0]) [0.0]))
 554 |   (assert (= (distinct ['sym 'sym]) '[sym]))
 555 |   (assert (= (distinct [:kw :kw]) [:kw]))
 556 |   (assert (= (distinct [42 42]) [42]))
 557 |   (assert (= (distinct [[] []]) [[]]))
 558 |   (assert (= (distinct ['(1 2) '(1 2)]) '[(1 2)]))
 559 |   (assert (= (distinct [() ()]) [()]))
 560 |   (assert (= (distinct [[1 2] [1 2]]) [[1 2]]))
 561 |   (assert (= (distinct [{:a 1 :b 2} {:a 1 :b 2}]) [{:a 1 :b 2}]))
 562 |   (assert (= (distinct [{} {}]) [{}]))
 563 |   (assert (= (distinct [#{1 2} #{1 2}]) [#{1 2}]))
 564 |   (assert (= (distinct [#{} #{}]) [#{}]))
 565 | 
 566 |   ;;regexps
 567 | 
 568 |   ;; destructuring
 569 |   (assert (= [2 1] (let [[a b] [1 2]] [b a])))
 570 |   (assert (= #{1 2} (let [[a b] [1 2]] #{a b})))
 571 |   (assert (= [1 2] (let [{a :a b :b} {:a 1 :b 2}] [a b])))
 572 |   (assert (= [1 2] (let [{:keys [a b]} {:a 1 :b 2}] [a b])))
 573 |   (assert (= [1 2 [1 2]] (let [[a b :as v] [1 2]] [a b v])))
 574 |   (assert (= [1 42] (let [{:keys [a b] :or {b 42}} {:a 1}] [a b])))
 575 |   (assert (= [1 nil] (let [{:keys [a b] :or {c 42}} {:a 1}] [a b])))
 576 |   (assert (= [2 1] (let [[a b] '(1 2)] [b a])))
 577 |   (assert (= {1 2} (let [[a b] [1 2]] {a b})))
 578 |   (assert (= [2 1] (let [[a b] (seq [1 2])] [b a])))
 579 | 
 580 |   ;; update-in
 581 |   (assert (= {:foo {:bar {:baz 1}}}
 582 |              (update-in {:foo {:bar {:baz 0}}} [:foo :bar :baz] inc)))
 583 |   (assert (= {:foo 1 :bar 2 :baz 10}
 584 |              (update-in {:foo 1 :bar 2 :baz 3} [:baz] + 7)))
 585 |   (assert (= [{:foo 1, :bar 2} {:foo 1, :bar 3}]
 586 |                (update-in [{:foo 1 :bar 2}, {:foo 1 :bar 2}] [1 :bar] inc)))
 587 |   (assert (= [{:foo {:bar 2}} {:foo {:bar 3}}]
 588 |                (update-in [{:foo {:bar 2}}, {:foo {:bar 2}}] [1 :foo :bar] inc)))
 589 | 
 590 |   ;; assoc-in
 591 |   (assert (= {:foo {:bar {:baz 100}}}
 592 |              (assoc-in {:foo {:bar {:baz 0}}} [:foo :bar :baz] 100)))
 593 |   (assert (= {:foo 1 :bar 2 :baz 100}
 594 |              (assoc-in {:foo 1 :bar 2 :baz 3} [:baz] 100)))
 595 |   (assert (= [{:foo [{:bar 2} {:baz 3}]} {:foo [{:bar 2} {:baz 100}]}]
 596 |              (assoc-in [{:foo [{:bar 2} {:baz 3}]}, {:foo [{:bar 2} {:baz 3}]}]
 597 |                        [1 :foo 1 :baz] 100)))
 598 |   (assert (= [{:foo 1, :bar 2} {:foo 1, :bar 100}]
 599 |              (assoc-in [{:foo 1 :bar 2}, {:foo 1 :bar 2}] [1 :bar] 100)))
 600 | 
 601 |   ;; get-in
 602 |   (assert (= 1 (get-in {:foo 1 :bar 2} [:foo])))
 603 |   (assert (= 2 (get-in {:foo {:bar 2}} [:foo :bar])))
 604 |   (assert (= 1 (get-in [{:foo 1}, {:foo 2}] [0 :foo])))
 605 |   (assert (= 4 (get-in [{:foo 1 :bar [{:baz 1}, {:buzz 2}]}, {:foo 3 :bar [{:baz 3}, {:buzz 4}]}]
 606 |                        [1 :bar 1 :buzz])))
 607 | 
 608 |   ;; arrays
 609 |   (let [a (to-array [1 2 3])]
 610 |     (assert (= [10 20 30] (seq (amap a i ret (* 10 (aget a i))))))
 611 |     (assert (= 6 (areduce a i ret 0 (+ ret (aget a i)))))
 612 |     (assert (= (seq a) (seq (to-array [1 2 3]))))
 613 |     (aset a 0 42)
 614 |     (assert (not= (seq a) (seq (to-array [1 2 3]))))
 615 |     (assert (not= a (aclone a))))
 616 | 
 617 |   #_(let [a (array (array 1 2 3) (array 4 5 6))]
 618 |       (assert (= (aget a 0 1) 2))
 619 |       (assert (= (apply aget a [0 1]) 2))
 620 |       (assert (= (aget a 1 1) 5))
 621 |       (assert (= (apply aget a [1 1]) 5)))
 622 | 
 623 |   ;; sort
 624 |   (assert (= [1 2 3 4 5] (sort [5 3 1 4 2])))
 625 |   (assert (= [1 2 3 4 5] (sort < [5 3 1 4 2])))
 626 |   (assert (= [5 4 3 2 1] (sort > [5 3 1 4 2])))
 627 | 
 628 |   ;; sort-by
 629 |   (assert (= ["a" [ 1 2] "foo"] (sort-by count ["foo" "a" [1 2]])))
 630 |   (assert (= ["foo" [1 2] "a"] (sort-by count > ["foo" "a" [1 2]])))
 631 | 
 632 |   ;; shuffle
 633 |   (let [coll [1 2 3 4 5 6 7 8 9 10]
 634 |         ; while it is technically possible for this test to fail with a false negative,
 635 |         ; it's _extraordinarily_ unlikely.
 636 |         shuffles (filter #(not= coll %) (take 100 (iterate shuffle coll)))]
 637 |     (assert (not (empty? shuffles))))
 638 | 
 639 |   ;; js->clj
 640 | 
 641 |   ;; last
 642 |   (assert (= nil (last nil)))
 643 |   (assert (= 3 (last [1 2 3])))
 644 | 
 645 |   ;; dotimes
 646 |   (let [s (atom [])]
 647 |     (dotimes [n 5]
 648 |       (swap! s conj n))
 649 |     (assert (= [0 1 2 3 4] @s)))
 650 | 
 651 |   ;; doseq
 652 |   (let [v [1 2 3 4 5]
 653 |         s (atom ())]
 654 |     (doseq [n v] (swap! s conj n))
 655 |     (assert (= @s (reverse v))))
 656 | 
 657 |   ;; delay
 658 |   (let [a (atom 0)
 659 |         d (delay (swap! a inc))]
 660 |     (assert (false? (realized? d)))
 661 |     (assert (zero? @a)) ;; delay hasn't triggered yet
 662 |     (assert (= 1 @d)) ;; trigger it
 663 |     (assert (= 1 @a)) ;; make sure side effect has happened
 664 |     (assert (true? (realized? d)))
 665 |     (assert (= 1 @d)) ;; body doesn't happen again
 666 |     (assert (= 1 @a)) ;; atom hasn't changed either
 667 |     (assert (= (force d) @d))
 668 |     (assert (= 1 (force 1)))) ;; you can safely force non-delays
 669 | 
 670 |   ;; assoc
 671 |   (assert (= {1 2 3 4} (assoc {} 1 2 3 4)))
 672 |   (assert (= {1 2} (assoc {} 1 2)))
 673 |   (assert (= [42 2] (assoc [1 2] 0 42)))
 674 | 
 675 |   ;; dissoc
 676 |   (assert (= {} (dissoc {1 2 3 4} 1 3)))
 677 |   (assert (= {1 2} (dissoc {1 2 3 4} 3)))
 678 | 
 679 |   ;; disj
 680 |   (assert (= #{1 2 3} (disj #{1 2 3})))
 681 |   (assert (= #{1 2} (disj #{1 2 3} 3)))
 682 |   (assert (= #{1} (disj #{1 2 3} 2 3)))
 683 | 
 684 |   ;; memoize
 685 |   (let [f (memoize (fn [] (rand)))]
 686 |     (f)
 687 |     (assert (= (f) (f))))
 688 | 
 689 |   ;; find
 690 |   (assert (= (find {} :a) nil))
 691 |   (assert (= (find {:a 1} :a) [:a 1]))
 692 |   (assert (= (find {:a 1} :b) nil))
 693 |   (assert (= (find {:a 1 :b 2} :a) [:a 1]))
 694 |   (assert (= (find {:a 1 :b 2} :b) [:b 2]))
 695 |   (assert (= (find {:a 1 :b 2} :c) nil))
 696 |   (assert (= (find {} nil) nil))
 697 |   (assert (= (find {:a 1} nil) nil))
 698 |   (assert (= (find {:a 1 :b 2} nil) nil))
 699 |   (assert (= (find [1 2 3] 0) [0 1]))
 700 | 
 701 |   ;; mod,quot,rem
 702 |   (assert (= (quot 4 2) 2))
 703 |   (assert (= (quot 3 2) 1))
 704 |   (assert (= (quot 6 4) 1))
 705 |   (assert (= (quot 0 5) 0))
 706 |   (assert (= (quot 42 5) 8))
 707 |   (assert (= (quot 42 -5) -8))
 708 |   (assert (= (quot -42 -5) 8))
 709 |   (assert (= (quot 9 3) 3))
 710 |   (assert (= (quot 9 -3) -3))
 711 |   (assert (= (quot -9 3) -3))
 712 |   (assert (= (quot 2 -5) 0))
 713 |   (assert (= (quot -2 5) 0))
 714 |   (assert (= (quot 0 3) 0))
 715 |   (assert (= (quot 0 -3) 0))
 716 | 
 717 |   (assert (= (mod 4 2) 0))
 718 |   (assert (= (mod 3 2) 1))
 719 |   (assert (= (mod 6 4) 2))
 720 |   (assert (= (mod 0 5) 0))
 721 |   (assert (= (mod 4.5 2.0) 0.5))
 722 |   (assert (= (mod 42 5) 2))
 723 |   (assert (= (mod 9 3) 0))
 724 |   (assert (= (mod 9 -3) 0))
 725 |   (assert (= (mod -9 3) 0))
 726 |   (assert (= (mod -9 -3) 0))
 727 |   (assert (= (mod 0 3) 0))
 728 |   (assert (= (mod 3216478362187432 432143214) 120355456))
 729 | 
 730 |   (assert (= (rem 4 2) 0))
 731 |   (assert (= (rem 0 5) 0))
 732 |   (assert (= (rem 4.5 2.0) 0.5))
 733 |   (assert (= (rem 42 5) 2))
 734 |   (assert (= (rem 2 5) 2))
 735 |   (assert (= (rem 2 -5) 2))
 736 |   (assert (= (rem 0 3) 0))
 737 | 
 738 |   ;; range
 739 |   (assert (= (range 10) (list 0 1 2 3 4 5 6 7 8 9)))
 740 |   (assert (= (range 10 20) (list 10 11 12 13 14 15 16 17 18 19)))
 741 |   (assert (= (range 10 20 2) (list 10 12 14 16 18)))
 742 |   (assert (= (take 20 (range)) (list 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19)))
 743 | 
 744 |   ;; group-by
 745 |   (let [d (group-by second {:a 1 :b 2 :c 1 :d 4 :e 1 :f 2})]
 746 |     (assert (= 3 (count (get d 1))))
 747 |     (assert (= 2 (count (get d 2))))
 748 |     (assert (= 1 (count (get d 4)))))
 749 | 
 750 |   (assert (= {1 2 3 4 5 6} (merge {1 2} {3 4} {5 6})))
 751 |   (assert (= {1 2 3 4} (merge {1 2} {3 4} nil)))
 752 | 
 753 |   ;; frequencies
 754 |   (assert (= {:a 3 :b 2} (frequencies [:a :b :a :b :a])))
 755 | 
 756 |   ;; reductions
 757 |   (assert (= [1 3 6 10 15] (reductions + [1 2 3 4 5])))
 758 | 
 759 |   ;; keep
 760 |   (assert (= [1 3 5 7 9] (keep #(if (odd? %) %) [1 2 3 4 5 6 7 8 9 10])))
 761 |   (assert (= [2 4 6 8 10] (keep #(if (even? %) %) [1 2 3 4 5 6 7 8 9 10])))
 762 | 
 763 |   ;; keep-indexed
 764 |   (assert (= [1 3 5 7 9] (keep-indexed #(if (odd? %1) %2) [0 1 2 3 4 5 6 7 8 9 10])))
 765 |   (assert (= [2 4 5] (keep-indexed #(if (pos? %2) %1) [-9 0 29 -7 45 3 -8])))
 766 | 
 767 |   ;; map-indexed
 768 |   (assert (= [[0 :a] [1 :b] [2 :c]] (map-indexed #(vector % %2) [:a :b :c])))
 769 | 
 770 |   ;; merge-with
 771 |   (assert (= '{"Foo" ("foo" "FOO" "fOo"), "Bar" ("bar" "BAR" "BAr"), "Baz" ["baz"], "Qux" ["qux" "quux"]}
 772 |              (merge-with concat
 773 |                   {"Foo" ["foo" "FOO"]
 774 |                    "Bar" ["bar" "BAR"]
 775 |                    "Baz" ["baz"]}
 776 |                   {"Foo" ["fOo"]
 777 |                    "Bar" ["BAr"]
 778 |                    "Qux" ["qux" "quux"]})))
 779 |   (assert (= {:a 111, :b 102, :c 13}
 780 |              (merge-with +
 781 |                          {:a 1 :b 2 :c 3}
 782 |                          {:a 10 :c 10}
 783 |                          {:a 100 :b 100})))
 784 | 
 785 |   (assert (= {:a 3, :b 102, :c 13}
 786 |              (apply merge-with [+
 787 |                                 {:a 1 :b 100}
 788 |                                 {:a 1 :b 2 :c 3}
 789 |                                 {:a 1 :c 10}])))
 790 | 
 791 |   (assert (= '[a c e] (replace '[a b c d e] [0 2 4])))
 792 |   (assert (= [:one :zero :two :zero]
 793 |              (replace {0 :zero 1 :one 2 :two} '(1 0 2 0))))
 794 | 
 795 |   ;; split-at
 796 |   (assert (= [[1 2] [3 4 5]] (split-at 2 [1 2 3 4 5])))
 797 | 
 798 |   ;; split-with
 799 |   (assert (= [[1 2 3] [4 5]] (split-with (partial >= 3) [1 2 3 4 5])))
 800 | 
 801 |   ;; trampoline
 802 |   (assert (= 10000 (trampoline (fn f [n] (if (>= n 10000) n #(f (inc n)))) 0)))
 803 | 
 804 |   ;; vary-meta
 805 |   (assert (= {:a 1} (meta (vary-meta [] assoc :a 1))))
 806 |   (assert (= {:a 1 :b 2} (meta (vary-meta (with-meta [] {:b 2}) assoc :a 1))))
 807 | 
 808 |   ;; multi-methods
 809 |   (swap! global-hierarchy make-hierarchy)
 810 | 
 811 |   ;; hierarchy tests
 812 |   (derive ::rect ::shape)
 813 |   (derive ::square ::rect)
 814 | 
 815 |   (assert (= #{:user/shape} (parents ::rect)))
 816 |   (assert (= #{:user/rect :user/shape} (ancestors ::square)))
 817 |   (assert (= #{:user/rect :user/square} (descendants ::shape)))
 818 |   (assert (true? (isa? 42 42)))
 819 |   (assert (true? (isa? ::square ::shape)))
 820 | 
 821 |   (derive cljs.core.ObjMap ::collection)
 822 |   (derive cljs.core.PersistentHashSet ::collection)
 823 |   (assert (true? (isa? cljs.core.ObjMap ::collection)))
 824 |   (assert (true? (isa? cljs.core.PersistentHashSet ::collection)))
 825 |   (assert (false? (isa? cljs.core.IndexedSeq ::collection)))
 826 |   ;; ?? (isa? String Object)
 827 |   (assert (true? (isa? [::square ::rect] [::shape ::shape])))
 828 |   ;; ?? (ancestors java.util.ArrayList)
 829 | 
 830 |   ;; ?? isa? based dispatch tests
 831 | 
 832 |   ;; prefer-method test
 833 |   (defmulti bar (fn [x y] [x y]))
 834 |   (defmethod bar [::rect ::shape] [x y] :rect-shape)
 835 |   (defmethod bar [::shape ::rect] [x y] :shape-rect)
 836 | 
 837 |   ;;(bar ::rect ::rect)
 838 |   ;; -> java.lang.IllegalArgumentException:
 839 |   ;;  Multiple methods match dispatch value:
 840 |   ;;  [:user/rect :user/rect] -> [:user/rect :user/shape]
 841 |   ;;  and [:user/shape :user/rect],
 842 |   ;;  and neither is preferred
 843 | 
 844 |   (assert (zero? (count (prefers bar))))
 845 |   (prefer-method bar [::rect ::shape] [::shape ::rect])
 846 |   (assert (= 1 (count (prefers bar))))
 847 |   (assert (= :rect-shape (bar ::rect ::rect)))
 848 |   (assert (= :rect-shape (apply (-get-method bar [::rect ::shape]) [::rect ::shape])))
 849 | 
 850 |   ;; nested data structures tests
 851 |   (defmulti nested-dispatch (fn [m] (-> m :a :b)))
 852 |   (defmethod nested-dispatch :c [m] :nested-a)
 853 |   (defmethod nested-dispatch :default [m] :nested-default)
 854 |   (assert (= :nested-a (nested-dispatch {:a {:b :c}})))
 855 | 
 856 |   (defmulti nested-dispatch2 ffirst)
 857 |   (defmethod nested-dispatch2 :a [m] :nested-a)
 858 |   (defmethod nested-dispatch2 :default [m] :nested-default)
 859 |   (assert (= :nested-a (nested-dispatch2 [[:a :b]])))
 860 | 
 861 |   ;; general tests
 862 |   (defmulti foo1 (fn [& args] (first args)))
 863 |   (defmethod foo1 :a [& args] :a-return)
 864 |   (defmethod foo1 :default [& args] :default-return)
 865 |   (assert (= :a-return (foo1 :a)))
 866 |   (assert (= :default-return (foo1 1)))
 867 | 
 868 |   (defmulti area :Shape)
 869 |   (defn rect [wd ht] {:Shape :Rect :wd wd :ht ht})
 870 |   (defn circle [radius] {:Shape :Circle :radius radius})
 871 |   (defmethod area :Rect [r]
 872 |     (* (:wd r) (:ht r)))
 873 |   (defmethod area :Circle [c]
 874 |     (*  Math/PI (* (:radius c) (:radius c))))
 875 |   (defmethod area :default [x] :oops)
 876 |   (def r (rect 4 13))
 877 |   (def c (circle 12))
 878 |   (assert (= 52 (area r)))
 879 |   (assert (= :oops (area {})))
 880 | 
 881 |   ;; remove method tests
 882 |   (assert (= 2 (count (methods bar))))
 883 |   (remove-method bar [::rect ::shape])
 884 |   (assert (= 1 (count (methods bar))))
 885 |   (remove-all-methods bar)
 886 |   (assert (zero? (count (methods bar))))
 887 | 
 888 |   ;; test apply
 889 |   (defmulti apply-multi-test (fn ([_] 0) ([_ _] 0) ([_ _ _] 0)))
 890 |   (defmethod apply-multi-test 0
 891 |     ([x] :one)
 892 |     ([x y] :two)
 893 |     ([x y & r] [:three r]))
 894 |   (assert (= [:three '(2)] (apply apply-multi-test [0 1 2])))
 895 | 
 896 |   ;; Range
 897 |   (assert (= (range 0 10 3) (list 0 3 6 9)))
 898 |   (assert (= (count (range 0 10 3)) 4))
 899 |   (assert (= (range 0 -10 -3) (list 0 -3 -6 -9)))
 900 |   (assert (= (count (range 0 -10 -3)) 4))
 901 |   (assert (= (range -10 10 3) (list -10 -7 -4 -1 2 5 8)))
 902 |   (assert (= (count (range -10 10 3)) 7))
 903 |   (assert (= (range 0 1 1) (list 0)))
 904 |   (assert (= (range 0 -3 -1) (list 0 -1 -2)))
 905 |   (assert (= (range 3 0 -1) (list 3 2 1)))
 906 |   (assert (= (range 0 10 -1) (list)))
 907 |   (assert (= (range 0 1 0) (list)))
 908 |   (assert (= (range 10 0 1) (list)))
 909 |   (assert (= (range 0 0 0) (list)))
 910 |   (assert (= (count (range 0 10 -1)) 0))
 911 |   (assert (= (count (range 0 1 0)) 0))
 912 |   (assert (= (count (range 10 0 1)) 0))
 913 |   (assert (= (count (range 0 0 0)) 0))
 914 |   (assert (= (take 3 (range 1 0 0)) (list 1 1 1)))
 915 |   (assert (= (take 3 (range 3 1 0)) (list 3 3 3)))
 916 | 
 917 |   ;; PersistentVector
 918 |   (let [pv (vec (range 97))]
 919 |     (assert (= (nth pv 96) 96))
 920 |     (assert (= (nth pv 97 nil) nil))
 921 |     (assert (= (pv 96) 96)))
 922 | 
 923 |   (let [pv (vec (range 33))]
 924 |     (assert (= pv
 925 |                (-> pv
 926 |                    pop
 927 |                    pop
 928 |                    (conj 31)
 929 |                    (conj 32)))))
 930 |   
 931 |   (let [stack1 (pop (vec (range 97)))
 932 |         stack2 (pop stack1)]
 933 |     (assert (= 95 (peek stack1)))
 934 |     (assert (= 94 (peek stack2))))
 935 | 
 936 |   ;; subvec
 937 |   (let [v (vec (range 10))
 938 |         s (subvec v 2 8)]
 939 |     (assert (= s
 940 |                (-> v
 941 |                    (subvec 2)
 942 |                    (subvec 0 6))
 943 |                (->> v
 944 |                     (drop 2)
 945 |                     (take 6))))
 946 |     (assert (= 6 (count s)))
 947 |     (assert (= [2 3 4 5 6] (pop s)))
 948 |     (assert (= 7 (peek s)))
 949 |     (assert (= [2 3 4 5 6 7 1]
 950 |                (assoc s 6 1)
 951 |                (conj s 1)))
 952 |     (assert (= 27 (reduce + s)))
 953 |     (assert (= s (vec s))) ; pour into plain vector
 954 |     (let [m {:x 1}] (assert (= m (meta (with-meta s m))))))
 955 | 
 956 |   ;; TransientVector
 957 |   (let [v1 (vec (range 15 48))
 958 |         v2 (vec (range 40 57))
 959 |         v1 (persistent! (assoc! (conj! (pop! (transient v1)) :foo) 0 :quux))
 960 |         v2 (persistent! (assoc! (conj! (transient v2) :bar) 0 :quux))
 961 |         v  (into v1 v2)]
 962 |     (assert (= v (vec (concat [:quux] (range 16 47) [:foo]
 963 |                               [:quux] (range 41 57) [:bar])))))
 964 |   (loop [v  (transient [])
 965 |          xs (range 100)]
 966 |     (if-let [x (first xs)]
 967 |       (recur
 968 |        (condp #(%1 (mod %2 3)) x
 969 |          #{0 2} (conj! v x)
 970 |          #{1}   (assoc! v (count v) x))
 971 |        (next xs))
 972 |       (assert (= (vec (range 100)) (persistent! v)))))
 973 | 
 974 |   ;; PersistentHashMap & TransientHashMap
 975 |   (loop [m1 cljs.core.PersistentHashMap/EMPTY
 976 |          m2 (transient cljs.core.PersistentHashMap/EMPTY)
 977 |          i 0]
 978 |     (if (< i 100)
 979 |       (recur (assoc m1 i i) (assoc! m2 i i) (inc i))
 980 |       (let [m2 (persistent! m2)]
 981 |         (assert (= (count m1) 100))
 982 |         (assert (= (count m2) 100))
 983 |         (assert (= m1 m2))
 984 |         (loop [i 0]
 985 |           (if (< i 100)
 986 |             (do (assert (= (m1 i) i))
 987 |                 (assert (= (m2 i) i))
 988 |                 (assert (= (get m1 i) i))
 989 |                 (assert (= (get m2 i) i))
 990 |                 (assert (contains? m1 i))
 991 |                 (assert (contains? m2 i))
 992 |                 (recur (inc i)))))
 993 |         (assert (= (map vector (range 100) (range 100)) (sort-by first (seq m1))))
 994 |         (assert (= (map vector (range 100) (range 100)) (sort-by first (seq m2))))
 995 |         (assert (not (contains? (dissoc m1 3) 3))))))
 996 |   (let [m (-> (->> (interleave (range 10) (range 10))
 997 |                    (apply assoc cljs.core.PersistentHashMap/EMPTY))
 998 |               (dissoc 3 5 7))]
 999 |     (assert (= (count m) 7))
1000 |     (assert (= m {0 0 1 1 2 2 4 4 6 6 8 8 9 9})))
1001 |   (let [m (-> (->> (interleave (range 10) (range 10))
1002 |                    (apply assoc cljs.core.PersistentHashMap/EMPTY))
1003 |               (conj [:foo 1]))]
1004 |     (assert (= (count m) 11))
1005 |     (assert (= m {0 0 1 1 2 2 3 3 4 4 5 5 6 6 7 7 8 8 9 9 :foo 1})))
1006 |   (let [m (-> (->> (interleave (range 10) (range 10))
1007 |                    (apply assoc cljs.core.PersistentHashMap/EMPTY)
1008 |                    transient)
1009 |               (conj! [:foo 1])
1010 |               persistent!)]
1011 |     (assert (= (count m) 11))
1012 |     (assert (= m {0 0 1 1 2 2 3 3 4 4 5 5 6 6 7 7 8 8 9 9 :foo 1})))
1013 |   (let [tm (->> (interleave (range 10) (range 10))
1014 |                 (apply assoc cljs.core.PersistentHashMap/EMPTY)
1015 |                 transient)]
1016 |     (loop [tm tm ks [3 5 7]]
1017 |       (if-let [k (first ks)]
1018 |         (recur (dissoc! tm k) (next ks))
1019 |         (let [m (persistent! tm)]
1020 |           (assert (= (count m) 7))
1021 |           (assert (= m {0 0 1 1 2 2 4 4 6 6 8 8 9 9}))))))
1022 |   (let [tm (-> (->> (interleave (range 10) (range 10))
1023 |                     (apply assoc cljs.core.PersistentHashMap/EMPTY))
1024 |                (dissoc 3 5 7)
1025 |                transient)]
1026 |     (doseq [k [0 1 2 4 6 8 9]]
1027 |       (assert (= k (get tm k))))
1028 |     (let [m (persistent! tm)]
1029 |       (assert (= 2 (try (dissoc! tm 1) 1 (catch js/Error e 2))))
1030 |       (assert (= 2 (try (assoc! tm 10 10) 1 (catch js/Error e 2))))
1031 |       (assert (= 2 (try (persistent! tm) 1 (catch js/Error e 2))))
1032 |       (assert (= 2 (try (count tm) 1 (catch js/Error e 2))))
1033 |       (assert (= m {0 0 1 1 2 2 4 4 6 6 8 8 9 9}))))
1034 |   (deftype FixedHash [h v]
1035 |     IHash
1036 |     (-hash [this] h)
1037 |     IEquiv
1038 |     (-equiv [this other]
1039 |       (and (instance? FixedHash other) (= v (.-v other)))))
1040 |   (def fixed-hash-foo (FixedHash. 0 :foo))
1041 |   (def fixed-hash-bar (FixedHash. 0 :bar))
1042 |   (let [m (assoc cljs.core.PersistentHashMap/EMPTY
1043 |             fixed-hash-foo 1
1044 |             fixed-hash-bar 2)]
1045 |     (assert (= (get m fixed-hash-foo) 1))
1046 |     (assert (= (get m fixed-hash-bar) 2))
1047 |     (assert (= (count m) 2))
1048 |     (let [m (dissoc m fixed-hash-foo)]
1049 |       (assert (= (get m fixed-hash-bar) 2))
1050 |       (assert (not (contains? m fixed-hash-foo)))
1051 |       (assert (= (count m) 1))))
1052 |   (let [m (into cljs.core.PersistentHashMap/EMPTY ; make sure we're testing
1053 |                 (zipmap (range 100) (range 100))) ; the correct map type
1054 |         m (assoc m fixed-hash-foo 1 fixed-hash-bar 2)]
1055 |     (assert (= (count m) 102))
1056 |     (assert (= (get m fixed-hash-foo) 1))
1057 |     (assert (= (get m fixed-hash-bar) 2))
1058 |     (let [m (dissoc m 3 5 7 fixed-hash-foo)]
1059 |       (assert (= (get m fixed-hash-bar) 2))
1060 |       (assert (not (contains? m fixed-hash-foo)))
1061 |       (assert (= (count m) 98))))
1062 |   (let [m (into cljs.core.PersistentHashMap/EMPTY ; make sure we're testing
1063 |                 (zipmap (range 100) (range 100))) ; the correct map type
1064 |         m (transient m)
1065 |         m (assoc! m fixed-hash-foo 1)
1066 |         m (assoc! m fixed-hash-bar 2)
1067 |         m (persistent! m)]
1068 |     (assert (= (count m) 102))
1069 |     (assert (= (get m fixed-hash-foo) 1))
1070 |     (assert (= (get m fixed-hash-bar) 2))
1071 |     (let [m (dissoc m 3 5 7 fixed-hash-foo)]
1072 |       (assert (= (get m fixed-hash-bar) 2))
1073 |       (assert (not (contains? m fixed-hash-foo)))
1074 |       (assert (= (count m) 98))))
1075 | 
1076 |   ;; PersistentArrayMap & TransientArrayMap
1077 |   (def array-map-conversion-threshold
1078 |     cljs.core.PersistentArrayMap/HASHMAP_THRESHOLD)
1079 |   (loop [m1 cljs.core.PersistentArrayMap/EMPTY
1080 |          m2 (transient cljs.core.PersistentArrayMap/EMPTY)
1081 |          i 0]
1082 |     (if (< i array-map-conversion-threshold)
1083 |       (recur (assoc m1 i i) (assoc! m2 i i) (inc i))
1084 |       (let [m2 (persistent! m2)]
1085 |         (assert (= (count m1) array-map-conversion-threshold))
1086 |         (assert (= (count m2) array-map-conversion-threshold))
1087 |         (assert (= m1 m2))
1088 |         (loop [i 0]
1089 |           (if (< i array-map-conversion-threshold)
1090 |             (do (assert (= (m1 i) i))
1091 |                 (assert (= (m2 i) i))
1092 |                 (assert (= (get m1 i) i))
1093 |                 (assert (= (get m2 i) i))
1094 |                 (assert (contains? m1 i))
1095 |                 (assert (contains? m2 i))
1096 |                 (recur (inc i)))))
1097 |         (assert (= (map vector
1098 |                         (range array-map-conversion-threshold)
1099 |                         (range array-map-conversion-threshold))
1100 |                    (sort-by first (seq m1))))
1101 |         (assert (= (map vector
1102 |                         (range array-map-conversion-threshold)
1103 |                         (range array-map-conversion-threshold))
1104 |                    (sort-by first (seq m2))))
1105 |         (assert (not (contains? (dissoc m1 3) 3))))))
1106 |   (let [m (-> (->> (interleave (range 10) (range 10))
1107 |                    (apply assoc cljs.core.PersistentArrayMap/EMPTY))
1108 |               (dissoc 3 5 7))]
1109 |     (assert (= (count m) 7))
1110 |     (assert (= m {0 0 1 1 2 2 4 4 6 6 8 8 9 9})))
1111 |   (let [m (-> (->> (interleave (range 10) (range 10))
1112 |                    (apply assoc cljs.core.PersistentArrayMap/EMPTY))
1113 |               (conj [:foo 1]))]
1114 |     (assert (= (count m) 11))
1115 |     (assert (= m {0 0 1 1 2 2 3 3 4 4 5 5 6 6 7 7 8 8 9 9 :foo 1})))
1116 |   (let [m (-> (->> (interleave (range 10) (range 10))
1117 |                    (apply assoc cljs.core.PersistentArrayMap/EMPTY)
1118 |                    transient)
1119 |               (conj! [:foo 1])
1120 |               persistent!)]
1121 |     (assert (= (count m) 11))
1122 |     (assert (= m {0 0 1 1 2 2 3 3 4 4 5 5 6 6 7 7 8 8 9 9 :foo 1})))
1123 |   (let [tm (->> (interleave (range 10) (range 10))
1124 |                 (apply assoc cljs.core.PersistentArrayMap/EMPTY)
1125 |                 transient)]
1126 |     (loop [tm tm ks [3 5 7]]
1127 |       (if-let [k (first ks)]
1128 |         (recur (dissoc! tm k) (next ks))
1129 |         (let [m (persistent! tm)]
1130 |           (assert (= (count m) 7))
1131 |           (assert (= m {0 0 1 1 2 2 4 4 6 6 8 8 9 9}))))))
1132 |   (let [tm (-> (->> (interleave (range 10) (range 10))
1133 |                     (apply assoc cljs.core.PersistentArrayMap/EMPTY))
1134 |                (dissoc 3 5 7)
1135 |                transient)]
1136 |     (doseq [k [0 1 2 4 6 8 9]]
1137 |       (assert (= k (get tm k))))
1138 |     (let [m (persistent! tm)]
1139 |       (assert (= 2 (try (dissoc! tm 1) 1 (catch js/Error e 2))))
1140 |       (assert (= 2 (try (assoc! tm 10 10) 1 (catch js/Error e 2))))
1141 |       (assert (= 2 (try (persistent! tm) 1 (catch js/Error e 2))))
1142 |       (assert (= 2 (try (count tm) 1 (catch js/Error e 2))))
1143 |       (assert (= m {0 0 1 1 2 2 4 4 6 6 8 8 9 9}))))
1144 |   (let [m (apply assoc cljs.core.PersistentArrayMap/EMPTY
1145 |                  (interleave (range (* 2 array-map-conversion-threshold))
1146 |                              (range (* 2 array-map-conversion-threshold))))]
1147 |     (assert (= (count m) (* 2 array-map-conversion-threshold)))
1148 |     (assert (= (m array-map-conversion-threshold) array-map-conversion-threshold))
1149 |     (assert (= m (into cljs.core.PersistentHashMap/EMPTY
1150 |                        (map #(vector % %)
1151 |                             (range (* 2 array-map-conversion-threshold)))))))
1152 | 
1153 |   ;; literal maps
1154 |   (loop [m1 {} m2 {} i 0]
1155 |     (if (< i 100)
1156 |       (recur (assoc m1 i i) (assoc m2 (str "foo" i) i) (inc i))
1157 |       (do (assert (= m1 (into cljs.core.PersistentHashMap/EMPTY
1158 |                               (map vector (range 100) (range 100)))))
1159 |           (assert (= m2 (into cljs.core.PersistentHashMap/EMPTY
1160 |                               (map vector
1161 |                                    (map (partial str "foo") (range 100))
1162 |                                    (range 100)))))
1163 |           (assert (= (count m1) 100))
1164 |           (assert (= (count m2) 100)))))
1165 | 
1166 |   ;; TransientHashSet
1167 |   (loop [s (transient #{})
1168 |          i 0]
1169 |     (if (< i 100)
1170 |       (recur (conj! s i) (inc i))
1171 |       (loop [s s i 0]
1172 |         (if (< i 100)
1173 |           (if (zero? (mod i 3))
1174 |             (recur (disj! s i) (inc i))
1175 |             (recur s (inc i)))
1176 |           (let [s (persistent! s)]
1177 |             (assert (= s (loop [s #{} xs (remove #(zero? (mod % 3)) (range 100))]
1178 |                            (if-let [x (first xs)]
1179 |                              (recur (conj s x) (next xs))
1180 |                              s))))
1181 |             (assert (= s (set (remove #(zero? (mod % 3)) (range 100))))))))))
1182 | 
1183 |   ;; PersistentTreeMap
1184 |   (let [m1 (sorted-map)
1185 |         c2 (comp - compare)
1186 |         m2 (sorted-map-by c2)]
1187 |     (assert (identical? cljs.core.PersistentTreeMap (type m1)))
1188 |     (assert (identical? cljs.core.PersistentTreeMap (type m2)))
1189 |     (assert (identical? compare (.-comp m1)))
1190 |     (assert (identical? c2 (.-comp m2)))
1191 |     (assert (zero? (count m1)))
1192 |     (assert (zero? (count m2)))
1193 |     (let [m1 (assoc m1 :foo 1 :bar 2 :quux 3)
1194 |           m2 (assoc m2 :foo 1 :bar 2 :quux 3)]
1195 |       (assert (= (count m1) 3))
1196 |       (assert (= (count m2) 3))
1197 |       (assert (= (seq m1) (list [:bar 2] [:foo 1] [:quux 3])))
1198 |       (assert (= (seq m2) (list [:quux 3] [:foo 1] [:bar 2])))
1199 |       (assert (= (seq m1) (rseq m2)))
1200 |       (assert (= (seq m2) (rseq m1)))
1201 |       (assert (= (conj m1 [:wibble 4]) {:foo 1 :bar 2 :quux 3 :wibble 4}))
1202 |       (assert (= (count (conj m1 [:wibble 4])) 4))
1203 |       (assert (= (conj m2 [:wibble 4]) {:foo 1 :bar 2 :quux 3 :wibble 4}))
1204 |       (assert (= (count (conj m2 [:wibble 4])) 4))
1205 |       (assert (= (map key (assoc m1 nil 4)) (list nil :bar :foo :quux)))
1206 |       (assert (= (map key (assoc m2 nil 4)) (list :quux :foo :bar nil)))))
1207 |   (let [m (->> [[0 10] [20 30] [10 20] [50 60] [30 40] [40 50]]
1208 |                (mapcat (partial apply range))
1209 |                (mapcat #(list % %))
1210 |                (apply sorted-map))
1211 |         s1 (map #(vector % %) (range 60))
1212 |         s2 (map #(vector % %) (range 59 -1 -1))]
1213 |     (assert (= (count m) 60))
1214 |     (assert (= (seq m) s1))
1215 |     (assert (= (rseq m) s2)))
1216 |   (let [m (sorted-map :foo 1 :bar 2 :quux 3)]
1217 |     (assert (= (dissoc m :foo) (hash-map :bar 2 :quux 3)))
1218 |     (assert (= (count (dissoc m :foo)) 2))
1219 |     (assert (= (hash m) (hash (hash-map :foo 1 :bar 2 :quux 3))))
1220 |     (assert (= (subseq m < :foo)  (list [:bar 2])))
1221 |     (assert (= (subseq m <= :foo) (list [:bar 2] [:foo 1])))
1222 |     (assert (= (subseq m > :foo)  (list [:quux 3])))
1223 |     (assert (= (subseq m >= :foo) (list [:foo 1] [:quux 3])))
1224 |     (assert (= (map #(reduce (fn [_ x] x) %) m) (list 2 1 3)))
1225 |     (assert (= (map #(reduce (fn [x _] x) 7 %) m) (list 7 7 7))))
1226 | 
1227 |   ;; PersistentTreeSet
1228 |   (let [s1 (sorted-set)
1229 |         c2 (comp - compare)
1230 |         s2 (sorted-set-by c2)]
1231 |     (assert (identical? cljs.core.PersistentTreeSet (type s1)))
1232 |     (assert (identical? cljs.core.PersistentTreeSet (type s2)))
1233 |     (assert (identical? compare (-comparator s1)))
1234 |     (assert (identical? c2 (-comparator s2)))
1235 |     (assert (zero? (count s1)))
1236 |     (assert (zero? (count s2)))
1237 |     (let [s1 (conj s1 1 2 3)
1238 |           s2 (conj s2 1 2 3)]
1239 |       (assert (= (hash s1) (hash s2)))
1240 |       (assert (= (hash s1) (hash #{1 2 3})))
1241 |       (assert (= (seq s1)  (list 1 2 3)))
1242 |       (assert (= (rseq s1) (list 3 2 1)))
1243 |       (assert (= (seq s2)  (list 3 2 1)))
1244 |       (assert (= (rseq s2) (list 1 2 3)))
1245 |       (assert (= (count s1) 3))
1246 |       (assert (= (count s2) 3))
1247 | 
1248 |       (let [s1 (disj s1 2)
1249 |             s2 (disj s2 2)]
1250 |            (assert (= (seq s1)  (list 1 3)))
1251 |            (assert (= (rseq s1) (list 3 1)))
1252 |            (assert (= (seq s2)  (list 3 1)))
1253 |            (assert (= (rseq s2) (list 1 3)))
1254 |            (assert (= (count s1) 2))
1255 |            (assert (= (count s2) 2)))))
1256 | 
1257 |   ;; defrecord
1258 |   (defrecord Person [firstname lastname])
1259 |   (def fred (Person. "Fred" "Mertz"))
1260 |   (assert (= (:firstname fred) "Fred"))
1261 |   (def fred-too (Person. "Fred" "Mertz"))
1262 |   (assert (= fred fred-too))
1263 |   (assert (false? (= fred nil)))
1264 |   (assert (false? (= nil fred)))
1265 | 
1266 |   (def ethel (Person. "Ethel" "Mertz" {:married true} {:husband :fred}))
1267 |   (assert (= (meta ethel) {:married true}))
1268 |   (def ethel-too (Person. "Ethel" "Mertz" {:married true} {:husband :fred}))
1269 |   (assert (= ethel ethel-too))
1270 | 
1271 |   (assert (= (map->Person {:firstname "Fred" :lastname "Mertz"}) fred))
1272 |   (assert (= (->Person "Fred" "Mertz") fred))
1273 | 
1274 |   (assert (= (count fred) 2))
1275 |   (assert (= (count ethel) 3))
1276 | 
1277 |   (defrecord A [])
1278 |   (assert (= {:foo 'bar} (meta (with-meta (A.) {:foo 'bar}))))
1279 |   (assert (= 'bar (:foo (assoc (A.) :foo 'bar))))
1280 | 
1281 |   ;; ObjMap
1282 |   (let [ks (map (partial str "foo") (range 500))
1283 |         m  (apply obj-map (interleave ks (range 500)))]
1284 |     (assert (instance? cljs.core.ObjMap m))
1285 |     (assert (= 500 (count m)))
1286 |     (assert (= 123 (m "foo123"))))
1287 | 
1288 |   ;; dot
1289 | #_(  (let [s "abc"]
1290 |     (assert (= 3 (.-length s)))
1291 |     (assert (= 3 (. s -length)))
1292 |     (assert (= 3 (. (str 138) -length)))
1293 |     (assert (= 3 (. "abc" -length)))
1294 |     (assert (= "bc" (.substring s 1)))
1295 |     (assert (= "bc" (.substring "abc" 1)))
1296 |     (assert (= "bc" ((memfn substring start) s 1)))
1297 |     (assert (= "bc" (. s substring 1)))
1298 |     (assert (= "bc" (. s (substring 1))))
1299 |     (assert (= "bc" (. s (substring 1 3))))
1300 |     (assert (= "bc" (.substring s 1 3)))
1301 |     (assert (= "ABC" (. s (toUpperCase))))
1302 |     (assert (= "ABC" (. "abc" (toUpperCase))))
1303 |     (assert (= "ABC" ((memfn toUpperCase) s)))
1304 |     (assert (= "BC" (. (. s (toUpperCase)) substring 1)))
1305 |     (assert (= 2 (.-length (. (. s (toUpperCase)) substring 1))))))
1306 | 
1307 |   (assert (= (conj fred {:wife :ethel :friend :ricky})
1308 |              (map->Person {:firstname "Fred" :lastname "Mertz" :wife :ethel :friend :ricky})))
1309 |   (assert (= (conj fred {:lastname "Flintstone"})
1310 |              (map->Person {:firstname "Fred" :lastname "Flintstone"})))
1311 |   (assert (= (assoc fred :lastname "Flintstone")
1312 |              (map->Person {:firstname "Fred" :lastname "Flintstone"})))
1313 |   (assert (= (assoc fred :wife :ethel)
1314 |              (map->Person {:firstname "Fred" :lastname "Mertz" :wife :ethel})))
1315 |   (assert (= (dissoc ethel :husband)
1316 |              (map->Person {:firstname "Ethel" :lastname "Mertz"})))
1317 | 
1318 |   (defrecord A [x])
1319 |   (defrecord B [x])
1320 |   (assert (not= (A. nil) (B. nil)))
1321 | 
1322 |   (defprotocol IFoo (foo [this]))
1323 |   (assert (= (meta (with-meta (reify IFoo (foo [this] :foo)) {:foo :bar}))
1324 |              {:foo :bar}))
1325 | 
1326 |   (defmulti foo2 identity)
1327 |   (defmethod foo2 0 [x] x)
1328 |   (assert (= foo2 (ffirst {foo2 1})))
1329 | 
1330 |   (defprotocol IMutate
1331 |     (mutate [this]))
1332 | 
1333 |   (deftype Mutate [^:mutable a]
1334 |     IMutate
1335 |     (mutate [_]
1336 |       (set! a 'foo)))
1337 | 
1338 |   ;; IFn
1339 |   (deftype FnLike []
1340 |     IFn
1341 |     (-invoke [_] :a)
1342 |     (-invoke [_ a] :b)
1343 |     (-invoke [_ a b] :c))
1344 | 
1345 |   (assert (= :a ((FnLike.))))
1346 |   (assert (= :b ((FnLike.) 1)))
1347 |   (assert (= :c ((FnLike.) 1 2)))
1348 | 
1349 |   (assert (= [:b :b :b] (map (FnLike.) [0 0 0])))
1350 | 
1351 |   (deftype FnLikeB [a]
1352 |     IFn
1353 |     (-invoke [_] a))
1354 | 
1355 |   (assert (= 1 ((FnLikeB. 1))))
1356 | 
1357 |   ;; hashing bug in many JS runtimes CLJ-118
1358 |   (let [g #{(conj #{:2} :alt)}
1359 |         h #{#{:2 :alt}}]
1360 |     (assert (= g h)))
1361 |   (assert (= (hash {:a 1 :b 2})
1362 |              (hash {:b 2 :a 1})))
1363 |   (assert (= (hash (hash-map :a 1 :b 2))
1364 |              (hash (hash-map :b 2 :a 1))))
1365 |   (assert (= (hash {:start 133 :end 134})
1366 |              (hash (apply hash-map [:start 133 :end 134]))))
1367 | 
1368 |   (defprotocol IHasFirst
1369 |     (-get-first [this]))
1370 | 
1371 |   (defprotocol IFindsFirst
1372 |     (-find-first [this other]))
1373 | 
1374 |   (deftype First [xs]
1375 |     ISeqable
1376 |     (-seq [this] (seq xs))
1377 |     IIndexed
1378 |     (-nth [this i] (nth xs i))
1379 |     (-nth [this i not-found] (nth xs i not-found))
1380 |     IFn
1381 |     (-invoke [[x]] x)
1382 |     (-invoke [this x] this)
1383 |     Object
1384 |     (toString [[x]] (str x))
1385 |     IHasFirst
1386 |     (-get-first [[x]] x)
1387 |     IFindsFirst
1388 |     (-find-first [_ [x]] x))
1389 | 
1390 |   (let [fv (First. [1 2 3])
1391 |         fs (First. "asdf")]
1392 |     (assert (= (fv) 1))
1393 |     (assert (= (fs) \a))
1394 |     (assert (= (str fs) \a))
1395 |     (assert (= (-get-first fv) 1))
1396 |     (assert (= (-get-first fs) \a))
1397 |     (assert (= (-find-first fv [1]) 1))
1398 |     (assert (identical? (fv 1) fv)))
1399 | 
1400 |   (deftype DestructuringWithLocals [a]
1401 |     IFindsFirst
1402 |     (-find-first [_ [x y]]
1403 |       [x y a]))
1404 | 
1405 |   (let [t (DestructuringWithLocals. 1)]
1406 |     (assert (= [2 3 1] (-find-first t [2 3]))))
1407 | 
1408 |   (let [x 1]
1409 |     (assert (= (case x 1 :one) :one)))
1410 |   (let [x 1]
1411 |     (assert (= (case x 2 :two :default) :default)))
1412 |   (let [x 1]
1413 |     (assert (= (try
1414 |                  (case x 3 :three)
1415 |                  (catch js/Error e
1416 |                      :fail))
1417 |                :fail)))
1418 |   (let [x 1]
1419 |     (assert (= (case x
1420 |                  (1 2 3) :ok
1421 |                  :fail)
1422 |                :ok)))
1423 | 
1424 |   (let [x [:a :b]]
1425 |     (assert (= (case x
1426 |                  [:a :b] :ok)
1427 |                :ok)))
1428 | 
1429 |   ;; IComparable
1430 |   (assert (=  0 (compare false false)))
1431 |   (assert (= -1 (compare false true)))
1432 |   (assert (=  1 (compare true  false)))
1433 | 
1434 |   (assert (= -1 (compare  0  1)))
1435 |   (assert (= -1 (compare -1  1)))
1436 |   (assert (=  0 (compare  1  1)))
1437 |   (assert (=  1 (compare  1  0)))
1438 |   (assert (=  1 (compare  1 -1)))
1439 | 
1440 |   (assert (=  0 (compare "cljs" "cljs")))
1441 |   (assert (=  0 (compare :cljs :cljs)))
1442 |   (assert (=  0 (compare 'cljs 'cljs)))
1443 |   (assert (= -1 (compare "a" "b")))
1444 |   (assert (= -1 (compare :a :b)))
1445 |   (assert (= -1 (compare 'a 'b)))
1446 |   ;; cases involving ns
1447 |   (assert (= -1 (compare :b/a :c/a)))
1448 |   #_(assert (= -1 (compare :c :a/b)))
1449 |   #_(assert (=  1 (compare :a/b :c)))
1450 |   (assert (= -1 (compare 'b/a 'c/a)))
1451 |   #_(assert (= -1 (compare 'c 'a/b)))
1452 |   #_(assert (=  1 (compare 'a/b 'c)))
1453 | 
1454 |   ;; This is different from clj. clj gives -2 next 3 tests
1455 |   (assert (= -1 (compare "a" "c")))
1456 |   (assert (= -1 (compare :a :c)))
1457 |   (assert (= -1 (compare 'a 'c)))
1458 | 
1459 |   (assert (= -1 (compare [1 2] [1 1 1])))
1460 |   (assert (= -1 (compare [1 2] [1 2 1])))
1461 |   (assert (= -1 (compare [1 1] [1 2])))
1462 |   (assert (=  0 (compare [1 2] [1 2])))
1463 |   (assert (=  1 (compare [1 2] [1 1])))
1464 |   (assert (=  1 (compare [1 1 1] [1 2])))
1465 |   (assert (=  1 (compare [1 1 2] [1 1 1])))
1466 | 
1467 |   (assert (= -1 (compare (subvec [1 2 3] 1) (subvec [1 2 4] 1))))
1468 |   (assert (=  0 (compare (subvec [1 2 3] 1) (subvec [1 2 3] 1))))
1469 |   (assert (=  1 (compare (subvec [1 2 4] 1) (subvec [1 2 3] 1))))
1470 | 
1471 |   ;; RSeq
1472 | 
1473 |   (assert (= '(3 2 1) (reverse (seq (array 1 2 3)))))
1474 |   (assert (= '(3 2 1) (reverse [1 2 3])))
1475 |   (assert (= '(4 3 2 1) (cons 4 (reverse [1 2 3]))))
1476 |   (assert (= 6 (reduce + (reverse [1 2 3]))))
1477 |   (assert (= '(4 3 2) (map inc (reverse [1 2 3]))))
1478 |   (assert (= '(4 2) (filter even? (reverse [1 2 3 4]))))
1479 | 
1480 |   ;; Chunked Sequences
1481 | 
1482 |   (assert (= 6 (reduce + (array-chunk (array 1 2 3)))))
1483 |   (assert (instance? ChunkedSeq (seq [1 2 3])))
1484 |   (assert (= '(1 2 3) (seq [1 2 3])))
1485 |   (assert (= '(2 3 4) (map inc [1 2 3])))
1486 |   (assert (= '(2) (filter even? [1 2 3])))
1487 |   (assert (= '(1 3) (filter odd? [1 2 3])))
1488 |   (assert (= '(1 2 3) (concat [1] [2] [3])))
1489 | 
1490 |   ;; INext
1491 | 
1492 |   (assert (= nil (next nil)))
1493 |   (assert (= nil (next (seq (array 1)))))
1494 |   (assert (= '(2 3) (next (seq (array 1 2 3)))))
1495 |   (assert (= nil (next (reverse (seq (array 1))))))
1496 |   (assert (= '(2 1) (next (reverse (seq (array 1 2 3))))))
1497 |   (assert (= nil (next (cons 1 nil))))
1498 |   (assert (= '(2 3) (next (cons 1 (cons 2 (cons 3 nil))))))
1499 |   (assert (= nil (next (lazy-seq (cons 1 nil)))))
1500 |   (assert (= '(2 3) (next (lazy-seq
1501 |                              (cons 1
1502 |                                (lazy-seq
1503 |                                  (cons 2
1504 |                                    (lazy-seq (cons 3 nil)))))))))
1505 |   (assert (= nil (next (list 1))))
1506 |   (assert (= '(2 3) (next (list 1 2 3))))
1507 |   (assert (= nil (next [1])))
1508 |   (assert (= '(2 3) (next [1 2 3])))
1509 |   (assert (= nil (next (range 1 2))))
1510 |   (assert (= '(2 3) (next (range 1 4))))
1511 | 
1512 |   ;; UUID
1513 | 
1514 |   (assert (= (UUID. "550e8400-e29b-41d4-a716-446655440000")
1515 |              (UUID. "550e8400-e29b-41d4-a716-446655440000")))
1516 | 
1517 |   (assert (not (identical? (UUID. "550e8400-e29b-41d4-a716-446655440000")
1518 |                            (UUID. "550e8400-e29b-41d4-a716-446655440000"))))
1519 | 
1520 |   (assert (= 42 (get {(UUID. "550e8400-e29b-41d4-a716-446655440000") 42}
1521 |                      (UUID. "550e8400-e29b-41d4-a716-446655440000")
1522 |                      :not-at-all-found)))
1523 | 
1524 |   (assert (= :not-at-all-found
1525 |              (get {(UUID. "550e8400-e29b-41d4-a716-446655440000") 42}
1526 |                   (UUID. "666e8400-e29b-41d4-a716-446655440000")
1527 |                   :not-at-all-found)))
1528 |   :ok
1529 |   )
1530 | 
1531 | (test-stuff)
1532 | (macro-test/test-macros)
1533 | 
1534 | (defn a [b c] (+ b c))
1535 | 


--------------------------------------------------------------------------------