├── .gitignore ├── README.md ├── cljs_bootstrap.iml ├── index.html ├── project.clj ├── resources ├── cache │ └── cljs │ │ ├── core.cljc │ │ ├── core.cljs │ │ └── core.cljs.cache.aot.edn ├── html │ └── index.html └── js │ └── cljs │ ├── core$macros.cljc.cache.edn │ └── core.cljs ├── script ├── brepl.clj ├── browser.clj ├── build.clj ├── build_test.clj └── repl.clj └── src ├── browser └── cljs_bootstrap │ └── dev.cljs ├── clojure └── dotdot.clj ├── node └── cljs_bootstrap │ └── core.cljs └── user ├── cljs_bootstrap └── test.cljs └── hello_world ├── core.cljs └── macros.clj /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /classes 3 | /checkouts 4 | pom.xml 5 | pom.xml.asc 6 | *.jar 7 | *.class 8 | /.lein-* 9 | /.nrepl-port 10 | .hgignore 11 | .hg/ 12 | node_modules 13 | .cljs_node_repl 14 | .idea 15 | .repl* 16 | resources/js/cljs 17 | resources/js/goog 18 | resources/js/clojure 19 | resources/js/cljs_bootstrap 20 | out 21 | main.js -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # cljs-bootstrap 2 | 3 | Use ClojureScript to compile itself. 4 | 5 | ## Usage 6 | 7 | Install [ClojureScript](http://github.com/clojure/clojurescript) from master. 8 | Checkout the ClojureScript repo and build and install into your local Maven: 9 | 10 | ``` 11 | cd clojurescript 12 | ./script/build 13 | ``` 14 | 15 | Note the ClojureScript version number. Modify this repo's `project.clj` file to 16 | reflect the version number. 17 | 18 | Checkout my fork of [tools.reader](https://github.com/swannodette/tools.reader) 19 | from master and switch to the `cljs-bootstrap` branch. Install it into your 20 | local Maven: 21 | 22 | ``` 23 | cd tools.reader 24 | lein install 25 | ``` 26 | 27 | Install the NPM dependencies to get reasonable stack traces: 28 | 29 | ``` 30 | cd cljs-bootstrap 31 | lein npm install 32 | ``` 33 | 34 | Start the REPL: 35 | 36 | ``` 37 | lein trampoline run -m clojure.main script/repl.clj 38 | ``` 39 | 40 | Try the following at the REPL by loading the necessary namespaces: 41 | 42 | ```clj 43 | (require-macros '[cljs.env.macros :refer [ensure]]) 44 | (require '[cljs.analyzer :as ana] '[cljs.compiler :as c]) 45 | ``` 46 | 47 | Now you can eval. Note currently only trivial expressions work. Arbitrary 48 | source code requires macro support which has not yet landed in ClojureScript 49 | master: 50 | 51 | ```clj 52 | (js/eval 53 | (with-out-str 54 | (c/emit 55 | (ensure 56 | (ana/analyze-keyword 57 | (assoc (ana/empty-env) :context :expr) 58 | :foo))))) 59 | ``` 60 | 61 | ## Hacking 62 | 63 | Progress is constantly being made against master. If you are feeling 64 | adventurous the following will let you see the current state of things. In 65 | a *Clojure* REPL copy the `cljs/core.cljc` macros file and the `cljs/core.cljs` 66 | standard library file into `resources` (make sure you've created the 67 | `resources/cljs` parent directory). 68 | 69 | ```clj 70 | (require '[clojure.java.io :as io]) 71 | (spit "resources/cljs/core.cljc" (slurp (io/resource "cljs/core.cljc"))) 72 | (spit "resources/cljs/core.cljs" (slurp (io/resource "cljs/core.cljs"))) 73 | (spit "resources/cljs/core.cljs.cache.aot.edn" 74 | (slurp (io/resource "cljs/core.cljs.cache.aot.edn"))) 75 | ``` 76 | 77 | Start a *ClojureScript* REPL. First you must load the macros file at the REPL: 78 | 79 | ```clj 80 | (load-file "/full/path/to/resources/cljs/core.cljc") 81 | ``` 82 | 83 | Then load this project's namespace: 84 | 85 | ```clj 86 | (require 'cljs-bootstrap.core) 87 | ``` 88 | 89 | Switch into this namespace and you should be able to eval the comment snippets 90 | in the `src/cljs_bootstrap/core.cljs` source file. 91 | 92 | ## Compiling cljs.core in the browser and benchmarking 93 | 94 | After setting up, compile `cljs-bootstrap.dev` which contains the 95 | benchmarking code: 96 | 97 | lein run -m clojure.main script/browser.clj 98 | 99 | Then start a local server to view the files: 100 | 101 | python -m SimpleHTTPServer 8000 102 | 103 | Go to 104 | [http://localhost:8000/index.html](http://localhost:8000/index.html), 105 | where you'll see a button: `Compile Core!`. When you click it, the 106 | script we compiled earlier, `cljs-bootstrap.dev`, will fetch 107 | `cljs.core`, compile it, and then present you with how it took to 108 | compile (not to fetch). 109 | 110 | ## License 111 | 112 | Copyright © 2015 David Nolen, Rich Hickey & Contributors 113 | 114 | Distributed under the Eclipse Public License either version 1.0 or (at 115 | your option) any later version. 116 | -------------------------------------------------------------------------------- /cljs_bootstrap.iml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | -------------------------------------------------------------------------------- /index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 |

10 |     
11 | 
12 | 


--------------------------------------------------------------------------------
/project.clj:
--------------------------------------------------------------------------------
 1 | (defproject cljs-bootstrap "0.1.0-SNAPSHOT"
 2 |   :description "FIXME: write description"
 3 |   :url "http://example.com/FIXME"
 4 |   :license {:name "Eclipse Public License"
 5 |             :url "http://www.eclipse.org/legal/epl-v10.html"}
 6 |   :dependencies [[org.clojure/clojure "1.7.0"]
 7 |                  [org.clojure/clojurescript "0.0-3653"]
 8 |                  [org.clojure/tools.reader "0.10.0-SNAPSHOT"]
 9 |                  [org.clojure/core.async "0.1.346.0-17112a-alpha"]]
10 |   :source-paths ["src/clojure" "src/browser" "src/node" "src/user"]
11 |   :plugins [[lein-npm "0.5.0"]]
12 |   :node-dependencies [[source-map-support "0.3.1"]])
13 | 


--------------------------------------------------------------------------------
/resources/cache/cljs/core.cljc:
--------------------------------------------------------------------------------
   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 destructure 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? number? nil? instance? symbol? keyword? string? str get
  19 |                             make-array vector list hash-map array-map hash-set
  20 | 
  21 |                             aget aset
  22 |                             + - * / < <= > >= == zero? pos? neg? inc dec max min mod
  23 |                             byte char short int long float double
  24 |                             unchecked-byte unchecked-char unchecked-short unchecked-int
  25 |                             unchecked-long unchecked-float unchecked-double
  26 |                             unchecked-add unchecked-add-int unchecked-dec unchecked-dec-int
  27 |                             unchecked-divide unchecked-divide-int unchecked-inc unchecked-inc-int
  28 |                             unchecked-multiply unchecked-multiply-int unchecked-negate unchecked-negate-int
  29 |                             unchecked-subtract unchecked-subtract-int unchecked-remainder-int
  30 |                             unsigned-bit-shift-right
  31 | 
  32 |                             bit-and bit-and-not bit-clear bit-flip bit-not bit-or bit-set
  33 |                             bit-test bit-shift-left bit-shift-right bit-xor defmacro
  34 | 
  35 |                             cond-> cond->> as-> some-> some->>
  36 | 
  37 |                             if-some when-some test ns-interns ns-unmap var vswap! macroexpand-1 macroexpand
  38 |                             #?@(:cljs [alias assert-args coercive-not coercive-not= coercive-= coercive-boolean
  39 |                                        truth_ js-arguments js-delete js-in js-debugger exists? divide js-mod
  40 |                                        unsafe-bit-and bit-shift-right-zero-fill mask bitpos caching-hash
  41 |                                        defcurried rfn specify! js-this this-as implements? array js-obj
  42 |                                        simple-benchmark gen-apply-to js-str es6-iterable load-file* undefined?
  43 |                                        specify])])
  44 |   #?(:cljs (:require-macros [cljs.core :as core]))
  45 |   (:require clojure.walk
  46 |             clojure.set
  47 |             cljs.compiler
  48 |             [cljs.env :as env]
  49 |             #?(:cljs [cljs.core :as core])
  50 |             #?(:cljs [cljs.analyzer :as ana])))
  51 | 
  52 | #?(:clj (alias 'core 'clojure.core))
  53 | #?(:clj (alias 'ana 'cljs.analyzer))
  54 | 
  55 | #?(:clj
  56 |    (core/defmacro import-macros [ns [& vars]]
  57 |      (core/let [ns (find-ns ns)
  58 |                 vars (map #(ns-resolve ns %) vars)
  59 |                 syms (map
  60 |                        (core/fn [^clojure.lang.Var v]
  61 |                          (core/-> v .sym
  62 |                            (with-meta
  63 |                              (merge
  64 |                                {:macro true}
  65 |                                (update-in (select-keys (meta v) [:arglists :doc :file :line])
  66 |                                  [:arglists] (core/fn [arglists] `(quote ~arglists)))))))
  67 |                        vars)
  68 |                 defs (map
  69 |                        (core/fn [sym var]
  70 |                          (core/let [{:keys [arglists doc file line]} (meta sym)]
  71 |                            `(do
  72 |                               (def ~sym (deref ~var))
  73 |                               ;for AOT compilation
  74 |                               (alter-meta! (var ~sym) assoc
  75 |                                 :macro true
  76 |                                 :arglists ~arglists
  77 |                                 :doc ~doc
  78 |                                 :file ~file
  79 |                                 :line ~line))))
  80 |                        syms vars)]
  81 |        `(do ~@defs
  82 |             :imported))))
  83 | 
  84 | #?(:clj
  85 |    (import-macros clojure.core
  86 |      [-> ->> .. assert comment cond
  87 |       declare defn-
  88 |       doto
  89 |       extend-protocol fn for
  90 |       if-let if-not letfn
  91 |       memfn
  92 |       when when-first when-let when-not while
  93 |       cond-> cond->> as-> some-> some->>
  94 |       if-some when-some]))
  95 | 
  96 | #?(:cljs
  97 |    (core/defmacro ->
  98 |      "Threads the expr through the forms. Inserts x as the
  99 |      second item in the first form, making a list of it if it is not a
 100 |      list already. If there are more forms, inserts the first form as the
 101 |      second item in second form, etc."
 102 |      [x & forms]
 103 |      (core/loop [x x, forms forms]
 104 |        (if forms
 105 |          (core/let [form (first forms)
 106 |                     threaded (if (seq? form)
 107 |                                (with-meta `(~(first form) ~x ~@(next form)) (meta form))
 108 |                                (core/list form x))]
 109 |            (recur threaded (next forms)))
 110 |          x))))
 111 | 
 112 | #?(:cljs
 113 |    (core/defmacro ->>
 114 |      "Threads the expr through the forms. Inserts x as the
 115 |      last item in the first form, making a list of it if it is not a
 116 |      list already. If there are more forms, inserts the first form as the
 117 |      last item in second form, etc."
 118 |      [x & forms]
 119 |      (core/loop [x x, forms forms]
 120 |        (if forms
 121 |          (core/let [form (first forms)
 122 |                     threaded (if (seq? form)
 123 |                                (with-meta `(~(first form) ~@(next form) ~x) (meta form))
 124 |                                (core/list form x))]
 125 |            (recur threaded (next forms)))
 126 |          x))))
 127 | 
 128 | #?(:cljs
 129 |    (core/defmacro ..
 130 |      "form => fieldName-symbol or (instanceMethodName-symbol args*)
 131 | 
 132 |      Expands into a member access (.) of the first member on the first
 133 |      argument, followed by the next member on the result, etc. For
 134 |      instance:
 135 | 
 136 |      (.. System (getProperties) (get \"os.name\"))
 137 | 
 138 |      expands to:
 139 | 
 140 |      (. (. System (getProperties)) (get \"os.name\"))
 141 | 
 142 |      but is easier to write, read, and understand."
 143 |      ([x form] `(. ~x ~form))
 144 |      ([x form & more] `(.. (. ~x ~form) ~@more))))
 145 | 
 146 | #?(:cljs
 147 |    (core/defmacro comment
 148 |      "Ignores body, yields nil"
 149 |      [& body]))
 150 | 
 151 | #?(:cljs
 152 |    (core/defmacro cond
 153 |      "Takes a set of test/expr pairs. It evaluates each test one at a
 154 |      time.  If a test returns logical true, cond evaluates and returns
 155 |      the value of the corresponding expr and doesn't evaluate any of the
 156 |      other tests or exprs. (cond) returns nil."
 157 |      {:added "1.0"}
 158 |      [& clauses]
 159 |      (core/when clauses
 160 |        (core/list 'if (first clauses)
 161 |          (if (next clauses)
 162 |            (second clauses)
 163 |            (throw (js/Error. "cond requires an even number of forms")))
 164 |          (cons 'cljs.core/cond (next (next clauses)))))))
 165 | 
 166 | #?(:cljs
 167 |    (core/defmacro declare
 168 |      "defs the supplied var names with no bindings, useful for making forward declarations."
 169 |      [& names] `(do ~@(map #(core/list 'def (vary-meta % assoc :declared true)) names))))
 170 | 
 171 | #?(:cljs
 172 |    (core/defmacro doto
 173 |      "Evaluates x then calls all of the methods and functions with the
 174 |      value of x supplied at the front of the given arguments.  The forms
 175 |      are evaluated in order.  Returns x.
 176 | 
 177 |      (doto (new java.util.HashMap) (.put \"a\" 1) (.put \"b\" 2))"
 178 |      [x & forms]
 179 |      (core/let [gx (gensym)]
 180 |        `(let [~gx ~x]
 181 |           ~@(map (core/fn [f]
 182 |                    (if (seq? f)
 183 |                      `(~(first f) ~gx ~@(next f))
 184 |                      `(~f ~gx)))
 185 |               forms)
 186 |           ~gx))))
 187 | 
 188 | #?(:cljs
 189 |    (core/defn- parse-impls [specs]
 190 |      (core/loop [ret {} s specs]
 191 |        (if (seq s)
 192 |          (recur (assoc ret (first s) (take-while seq? (next s)))
 193 |            (drop-while seq? (next s)))
 194 |          ret))))
 195 | 
 196 | #?(:cljs
 197 |    (core/defn- emit-extend-protocol [p specs]
 198 |      (core/let [impls (parse-impls specs)]
 199 |        `(do
 200 |           ~@(map (core/fn [[t fs]]
 201 |                    `(extend-type ~t ~p ~@fs))
 202 |               impls)))))
 203 | 
 204 | #?(:cljs
 205 |    (core/defmacro extend-protocol
 206 |      "Useful when you want to provide several implementations of the same
 207 |      protocol all at once. Takes a single protocol and the implementation
 208 |      of that protocol for one or more types. Expands into calls to
 209 |      extend-type:
 210 | 
 211 |      (extend-protocol Protocol
 212 |        AType
 213 |          (foo [x] ...)
 214 |          (bar [x y] ...)
 215 |        BType
 216 |          (foo [x] ...)
 217 |          (bar [x y] ...)
 218 |        AClass
 219 |          (foo [x] ...)
 220 |          (bar [x y] ...)
 221 |        nil
 222 |          (foo [x] ...)
 223 |          (bar [x y] ...))
 224 | 
 225 |      expands into:
 226 | 
 227 |      (do
 228 |       (clojure.core/extend-type AType Protocol
 229 |         (foo [x] ...)
 230 |         (bar [x y] ...))
 231 |       (clojure.core/extend-type BType Protocol
 232 |         (foo [x] ...)
 233 |         (bar [x y] ...))
 234 |       (clojure.core/extend-type AClass Protocol
 235 |         (foo [x] ...)
 236 |         (bar [x y] ...))
 237 |       (clojure.core/extend-type nil Protocol
 238 |         (foo [x] ...)
 239 |         (bar [x y] ...)))"
 240 |      [p & specs]
 241 |      (emit-extend-protocol p specs)))
 242 | 
 243 | #?(:cljs
 244 |    (core/defn ^{:private true}
 245 |    maybe-destructured
 246 |      [params body]
 247 |      (if (every? core/symbol? params)
 248 |        (cons params body)
 249 |        (core/loop [params params
 250 |                    new-params (with-meta [] (meta params))
 251 |                    lets []]
 252 |          (if params
 253 |            (if (core/symbol? (first params))
 254 |              (recur (next params) (conj new-params (first params)) lets)
 255 |              (core/let [gparam (gensym "p__")]
 256 |                (recur (next params) (conj new-params gparam)
 257 |                  (core/-> lets (conj (first params)) (conj gparam)))))
 258 |            `(~new-params
 259 |               (let ~lets
 260 |                 ~@body)))))))
 261 | 
 262 | #?(:cljs
 263 |    (core/defmacro fn
 264 |      "params => positional-params* , or positional-params* & next-param
 265 |      positional-param => binding-form
 266 |      next-param => binding-form
 267 |      name => symbol
 268 | 
 269 |      Defines a function"
 270 |      {:forms '[(fn name? [params*] exprs*) (fn name? ([params*] exprs*) +)]}
 271 |      [& sigs]
 272 |      (core/let [name (if (core/symbol? (first sigs)) (first sigs) nil)
 273 |                 sigs (if name (next sigs) sigs)
 274 |                 sigs (if (vector? (first sigs))
 275 |                        (core/list sigs)
 276 |                        (if (seq? (first sigs))
 277 |                          sigs
 278 |                          ;; Assume single arity syntax
 279 |                          (throw (js/Error.
 280 |                                   (if (seq sigs)
 281 |                                     (core/str "Parameter declaration "
 282 |                                       (core/first sigs)
 283 |                                       " should be a vector")
 284 |                                     (core/str "Parameter declaration missing"))))))
 285 |                 psig (fn* [sig]
 286 |                        ;; Ensure correct type before destructuring sig
 287 |                        (core/when (not (seq? sig))
 288 |                          (throw (js/Error.
 289 |                                   (core/str "Invalid signature " sig
 290 |                                     " should be a list"))))
 291 |                        (core/let [[params & body] sig
 292 |                                   _ (core/when (not (vector? params))
 293 |                                       (throw (js/Error.
 294 |                                                (if (seq? (first sigs))
 295 |                                                  (core/str "Parameter declaration " params
 296 |                                                    " should be a vector")
 297 |                                                  (core/str "Invalid signature " sig
 298 |                                                    " should be a list")))))
 299 |                                   conds (core/when (core/and (next body) (map? (first body)))
 300 |                                           (first body))
 301 |                                   body (if conds (next body) body)
 302 |                                   conds (core/or conds (meta params))
 303 |                                   pre (:pre conds)
 304 |                                   post (:post conds)
 305 |                                   body (if post
 306 |                                          `((let [~'% ~(if (core/< 1 (count body))
 307 |                                                         `(do ~@body)
 308 |                                                         (first body))]
 309 |                                              ~@(map (fn* [c] `(assert ~c)) post)
 310 |                                              ~'%))
 311 |                                          body)
 312 |                                   body (if pre
 313 |                                          (concat (map (fn* [c] `(assert ~c)) pre)
 314 |                                            body)
 315 |                                          body)]
 316 |                          (maybe-destructured params body)))
 317 |                 new-sigs (map psig sigs)]
 318 |        (with-meta
 319 |          (if name
 320 |            (list* 'fn* name new-sigs)
 321 |            (cons 'fn* new-sigs))
 322 |          (meta &form)))))
 323 | 
 324 | #?(:cljs
 325 |    (core/defmacro defn-
 326 |      "same as defn, yielding non-public def"
 327 |      [name & decls]
 328 |      (list* `defn (with-meta name (assoc (meta name) :private true)) decls)))
 329 | 
 330 | #?(:cljs
 331 |    (core/defmacro if-let
 332 |      "bindings => binding-form test
 333 | 
 334 |      If test is true, evaluates then with binding-form bound to the value of
 335 |      test, if not, yields else"
 336 |      ([bindings then]
 337 |       `(if-let ~bindings ~then nil))
 338 |      ([bindings then else & oldform]
 339 |       (core/assert-args
 340 |         (vector? bindings) "a vector for its binding"
 341 |         (nil? oldform) "1 or 2 forms after binding vector"
 342 |         (= 2 (count bindings)) "exactly 2 forms in binding vector")
 343 |       (core/let [form (bindings 0) tst (bindings 1)]
 344 |         `(let [temp# ~tst]
 345 |            (if temp#
 346 |              (let [~form temp#]
 347 |                ~then)
 348 |              ~else))))))
 349 | 
 350 | #?(:cljs
 351 |    (core/defmacro if-not
 352 |      "Evaluates test. If logical false, evaluates and returns then expr,
 353 |      otherwise else expr, if supplied, else nil."
 354 |      ([test then] `(if-not ~test ~then nil))
 355 |      ([test then else]
 356 |       `(if (not ~test) ~then ~else))))
 357 | 
 358 | #?(:cljs
 359 |    (core/defmacro letfn
 360 |      "fnspec ==> (fname [params*] exprs) or (fname ([params*] exprs)+)
 361 | 
 362 |      Takes a vector of function specs and a body, and generates a set of
 363 |      bindings of functions to their names. All of the names are available
 364 |      in all of the definitions of the functions, as well as the body."
 365 |      {:forms '[(letfn [fnspecs*] exprs*)],
 366 |       :special-form true, :url nil}
 367 |      [fnspecs & body]
 368 |      `(letfn* ~(vec (interleave (map first fnspecs)
 369 |                       (map #(cons `fn %) fnspecs)))
 370 |         ~@body)))
 371 | 
 372 | #?(:cljs
 373 |    (core/defmacro memfn
 374 |      "Expands into code that creates a fn that expects to be passed an
 375 |      object and any args and calls the named instance method on the
 376 |      object passing the args. Use when you want to treat a Java method as
 377 |      a first-class fn. name may be type-hinted with the method receiver's
 378 |      type in order to avoid reflective calls."
 379 |      [name & args]
 380 |      (core/let [t (with-meta (gensym "target")
 381 |                (meta name))]
 382 |        `(fn [~t ~@args]
 383 |           (. ~t (~name ~@args))))))
 384 | 
 385 | #?(:cljs
 386 |    (core/defmacro when
 387 |      "Evaluates test. If logical true, evaluates body in an implicit do."
 388 |      [test & body]
 389 |      (core/list 'if test (cons 'do body))))
 390 | 
 391 | #?(:cljs
 392 |    (core/defmacro when-first
 393 |      "bindings => x xs
 394 | 
 395 |      Roughly the same as (when (seq xs) (let [x (first xs)] body)) but xs is evaluated only once"
 396 |      [bindings & body]
 397 |      (core/assert-args
 398 |        (vector? bindings) "a vector for its binding"
 399 |        (= 2 (count bindings)) "exactly 2 forms in binding vector")
 400 |      (core/let [[x xs] bindings]
 401 |        `(when-let [xs# (seq ~xs)]
 402 |           (let [~x (first xs#)]
 403 |             ~@body)))))
 404 | 
 405 | #?(:cljs
 406 |    (core/defmacro when-let
 407 |      "bindings => binding-form test
 408 | 
 409 |      When test is true, evaluates body with binding-form bound to the value of test"
 410 |      [bindings & body]
 411 |      (core/assert-args
 412 |        (vector? bindings) "a vector for its binding"
 413 |        (= 2 (count bindings)) "exactly 2 forms in binding vector")
 414 |      (core/let [form (bindings 0) tst (bindings 1)]
 415 |        `(let [temp# ~tst]
 416 |           (when temp#
 417 |             (let [~form temp#]
 418 |               ~@body))))))
 419 | 
 420 | #?(:cljs
 421 |    (core/defmacro when-not
 422 |      "Evaluates test. If logical false, evaluates body in an implicit do."
 423 |      [test & body]
 424 |      (core/list 'if test nil (cons 'do body))))
 425 | 
 426 | #?(:cljs
 427 |    (core/defmacro while
 428 |      "Repeatedly executes body while test expression is true. Presumes
 429 |      some side-effect will cause test to become false/nil. Returns nil"
 430 |      [test & body]
 431 |      `(loop []
 432 |         (when ~test
 433 |           ~@body
 434 |           (recur)))))
 435 | 
 436 | #?(:cljs
 437 |    (core/defmacro cond->
 438 |      "Takes an expression and a set of test/form pairs. Threads expr (via ->)
 439 |      through each form for which the corresponding test
 440 |      expression is true. Note that, unlike cond branching, cond-> threading does
 441 |      not short circuit after the first true test expression."
 442 |      [expr & clauses]
 443 |      (core/assert (even? (count clauses)))
 444 |      (core/let [g (gensym)
 445 |                 pstep (core/fn [[test step]] `(if ~test (-> ~g ~step) ~g))]
 446 |        `(let [~g ~expr
 447 |               ~@(interleave (repeat g) (map pstep (partition 2 clauses)))]
 448 |           ~g))))
 449 | 
 450 | #?(:cljs
 451 |    (core/defmacro cond->>
 452 |      "Takes an expression and a set of test/form pairs. Threads expr (via ->>)
 453 |      through each form for which the corresponding test expression
 454 |      is true.  Note that, unlike cond branching, cond->> threading does not short circuit
 455 |      after the first true test expression."
 456 |      [expr & clauses]
 457 |      (core/assert (even? (count clauses)))
 458 |      (core/let [g (gensym)
 459 |                 pstep (core/fn [[test step]] `(if ~test (->> ~g ~step) ~g))]
 460 |        `(let [~g ~expr
 461 |               ~@(interleave (repeat g) (map pstep (partition 2 clauses)))]
 462 |           ~g))))
 463 | 
 464 | #?(:cljs
 465 |    (core/defmacro as->
 466 |      "Binds name to expr, evaluates the first form in the lexical context
 467 |      of that binding, then binds name to that result, repeating for each
 468 |      successive form, returning the result of the last form."
 469 |      [expr name & forms]
 470 |      `(let [~name ~expr
 471 |             ~@(interleave (repeat name) forms)]
 472 |         ~name)))
 473 | 
 474 | #?(:cljs
 475 |    (core/defmacro some->
 476 |      "When expr is not nil, threads it into the first form (via ->),
 477 |      and when that result is not nil, through the next etc"
 478 |      [expr & forms]
 479 |      (core/let [g (gensym)
 480 |                 pstep (core/fn [step] `(if (nil? ~g) nil (-> ~g ~step)))]
 481 |        `(let [~g ~expr
 482 |               ~@(interleave (repeat g) (map pstep forms))]
 483 |           ~g))))
 484 | 
 485 | #?(:cljs
 486 |    (core/defmacro some->>
 487 |      "When expr is not nil, threads it into the first form (via ->>),
 488 |      and when that result is not nil, through the next etc"
 489 |      [expr & forms]
 490 |      (core/let [g (gensym)
 491 |                 pstep (core/fn [step] `(if (nil? ~g) nil (->> ~g ~step)))]
 492 |        `(let [~g ~expr
 493 |               ~@(interleave (repeat g) (map pstep forms))]
 494 |           ~g))))
 495 | 
 496 | #?(:cljs
 497 |    (core/defmacro if-some
 498 |      "bindings => binding-form test
 499 | 
 500 |       If test is not nil, evaluates then with binding-form bound to the
 501 |       value of test, if not, yields else"
 502 |      ([bindings then]
 503 |       `(if-some ~bindings ~then nil))
 504 |      ([bindings then else & oldform]
 505 |       (core/assert-args
 506 |         (vector? bindings) "a vector for its binding"
 507 |         (nil? oldform) "1 or 2 forms after binding vector"
 508 |         (= 2 (count bindings)) "exactly 2 forms in binding vector")
 509 |       (core/let [form (bindings 0) tst (bindings 1)]
 510 |         `(let [temp# ~tst]
 511 |            (if (nil? temp#)
 512 |              ~else
 513 |              (let [~form temp#]
 514 |                ~then)))))))
 515 | 
 516 | #?(:cljs
 517 |    (core/defmacro when-some
 518 |      "bindings => binding-form test
 519 | 
 520 |       When test is not nil, evaluates body with binding-form bound to the
 521 |       value of test"
 522 |      [bindings & body]
 523 |      (core/assert-args
 524 |        (vector? bindings) "a vector for its binding"
 525 |        (= 2 (count bindings)) "exactly 2 forms in binding vector")
 526 |      (core/let [form (bindings 0) tst (bindings 1)]
 527 |        `(let [temp# ~tst]
 528 |           (if (nil? temp#)
 529 |             nil
 530 |             (let [~form temp#]
 531 |               ~@body))))))
 532 | 
 533 | (core/defn- ^{:dynamic true} assert-valid-fdecl
 534 |   "A good fdecl looks like (([a] ...) ([a b] ...)) near the end of defn."
 535 |   [fdecl]
 536 |   (core/when (empty? fdecl)
 537 |     (throw
 538 |       #?(:clj  (IllegalArgumentException. "Parameter declaration missing")
 539 |          :cljs (js/Error. "Parameter declaration missing"))))
 540 |   (core/let [argdecls
 541 |              (map
 542 |                #(if (seq? %)
 543 |                  (first %)
 544 |                  (throw
 545 |                    #?(:clj (IllegalArgumentException.
 546 |                              (if (seq? (first fdecl))
 547 |                                (core/str "Invalid signature \""
 548 |                                  %
 549 |                                  "\" should be a list")
 550 |                                (core/str "Parameter declaration \""
 551 |                                  %
 552 |                                  "\" should be a vector")))
 553 |                       :cljs (js/Error.
 554 |                               (if (seq? (first fdecl))
 555 |                                 (core/str "Invalid signature \""
 556 |                                   %
 557 |                                   "\" should be a list")
 558 |                                 (core/str "Parameter declaration \""
 559 |                                   %
 560 |                                   "\" should be a vector"))))))
 561 |                fdecl)
 562 |              bad-args (seq (remove #(vector? %) argdecls))]
 563 |     (core/when bad-args
 564 |       (throw
 565 |         #?(:clj (IllegalArgumentException.
 566 |                   (core/str "Parameter declaration \"" (first bad-args)
 567 |                     "\" should be a vector"))
 568 |            :cljs (js/Error.
 569 |                    (core/str "Parameter declaration \"" (first bad-args)
 570 |                      "\" should be a vector")))))))
 571 | 
 572 | (def
 573 |   ^{:private true}
 574 |   sigs
 575 |   (core/fn [fdecl]
 576 |     (assert-valid-fdecl fdecl)
 577 |     (core/let [asig
 578 |                (core/fn [fdecl]
 579 |                  (core/let [arglist (first fdecl)
 580 |                             ;elide implicit macro args
 581 |                             arglist (if #?(:clj (clojure.lang.Util/equals '&form (first arglist))
 582 |                                            :cljs (= '&form (first arglist)))
 583 |                                       #?(:clj (clojure.lang.RT/subvec arglist 2 (clojure.lang.RT/count arglist))
 584 |                                          :cljs (subvec arglist 2 (count arglist)))
 585 |                                       arglist)
 586 |                             body (next fdecl)]
 587 |                    (if (map? (first body))
 588 |                      (if (next body)
 589 |                        (with-meta arglist (conj (if (meta arglist) (meta arglist) {}) (first body)))
 590 |                        arglist)
 591 |                      arglist)))]
 592 |       (if (seq? (first fdecl))
 593 |         (core/loop [ret [] fdecls fdecl]
 594 |           (if fdecls
 595 |             (recur (conj ret (asig (first fdecls))) (next fdecls))
 596 |             (seq ret)))
 597 |         (core/list (asig fdecl))))))
 598 | 
 599 | (core/defmacro defonce [x init]
 600 |   `(when-not (exists? ~x)
 601 |      (def ~x ~init)))
 602 | 
 603 | (core/defmacro ^{:private true} assert-args [fnname & pairs]
 604 |   #?(:clj `(do (when-not ~(first pairs)
 605 |                  (throw (IllegalArgumentException.
 606 |                           ~(core/str fnname " requires " (second pairs)))))
 607 |                ~(core/let [more (nnext pairs)]
 608 |                   (core/when more
 609 |                     (list* `assert-args fnname more))))
 610 |      :cljs `(do (when-not ~(first pairs)
 611 |                   (throw (js/Error.
 612 |                            ~(core/str fnname " requires " (second pairs)))))
 613 |                 ~(core/let [more (nnext pairs)]
 614 |                    (core/when more
 615 |                      (list* `assert-args fnname more))))))
 616 | 
 617 | (core/defn destructure [bindings]
 618 |   (core/let [bents (partition 2 bindings)
 619 |              pb (core/fn pb [bvec b v]
 620 |                   (core/let [pvec
 621 |                              (core/fn [bvec b val]
 622 |                                (core/let [gvec (gensym "vec__")]
 623 |                                  (core/loop [ret (core/-> bvec (conj gvec) (conj val))
 624 |                                              n 0
 625 |                                              bs b
 626 |                                              seen-rest? false]
 627 |                                    (if (seq bs)
 628 |                                      (core/let [firstb (first bs)]
 629 |                                        (core/cond
 630 |                                          (= firstb '&) (recur (pb ret (second bs) (core/list `nthnext gvec n))
 631 |                                                          n
 632 |                                                          (nnext bs)
 633 |                                                          true)
 634 |                                          (= firstb :as) (pb ret (second bs) gvec)
 635 |                                          :else (if seen-rest?
 636 |                                                  (throw
 637 |                                                    #?(:clj (new Exception "Unsupported binding form, only :as can follow & parameter")
 638 |                                                       :cljs (new js/Error "Unsupported binding form, only :as can follow & parameter")))
 639 |                                                  (recur (pb ret firstb (core/list `nth gvec n nil))
 640 |                                                    (core/inc n)
 641 |                                                    (next bs)
 642 |                                                    seen-rest?))))
 643 |                                      ret))))
 644 |                              pmap
 645 |                              (core/fn [bvec b v]
 646 |                                (core/let [gmap (gensym "map__")
 647 |                                           defaults (:or b)]
 648 |                                  (core/loop [ret (core/-> bvec (conj gmap) (conj v)
 649 |                                                    (conj gmap) (conj `(if (seq? ~gmap) (apply hash-map ~gmap) ~gmap))
 650 |                                                    ((core/fn [ret]
 651 |                                                       (if (:as b)
 652 |                                                         (conj ret (:as b) gmap)
 653 |                                                         ret))))
 654 |                                              bes (reduce
 655 |                                                    (core/fn [bes entry]
 656 |                                                      (reduce #(assoc %1 %2 ((val entry) %2))
 657 |                                                        (dissoc bes (key entry))
 658 |                                                        ((key entry) bes)))
 659 |                                                    (dissoc b :as :or)
 660 |                                                    {:keys #(if (core/keyword? %) % (keyword (core/str %))),
 661 |                                                     :strs core/str, :syms #(core/list `quote %)})]
 662 |                                    (if (seq bes)
 663 |                                      (core/let [bb (key (first bes))
 664 |                                                 bk (val (first bes))
 665 |                                                 has-default (contains? defaults bb)]
 666 |                                        (recur (pb ret bb (if has-default
 667 |                                                            (core/list `get gmap bk (defaults bb))
 668 |                                                            (core/list `get gmap bk)))
 669 |                                          (next bes)))
 670 |                                      ret))))]
 671 |                     (core/cond
 672 |                       (core/symbol? b) (core/-> bvec (conj (if (namespace b) (symbol (name b)) b)) (conj v))
 673 |                       (core/keyword? b) (core/-> bvec (conj (symbol (name b))) (conj v))
 674 |                       (vector? b) (pvec bvec b v)
 675 |                       (map? b) (pmap bvec b v)
 676 |                       :else (throw
 677 |                               #?(:clj (new Exception (core/str "Unsupported binding form: " b))
 678 |                                  :cljs (new js/Error (core/str "Unsupported binding form: " b)))))))
 679 |              process-entry (core/fn [bvec b] (pb bvec (first b) (second b)))]
 680 |     (if (every? core/symbol? (map first bents))
 681 |       bindings
 682 |       (core/if-let [kwbs (seq (filter #(core/keyword? (first %)) bents))]
 683 |         (throw
 684 |           #?(:clj (new Exception (core/str "Unsupported binding key: " (ffirst kwbs)))
 685 |              :cljs (new js/Error (core/str "Unsupported binding key: " (ffirst kwbs)))))
 686 |         (reduce process-entry [] bents)))))
 687 | 
 688 | (core/defmacro let
 689 |   "binding => binding-form init-expr
 690 | 
 691 |   Evaluates the exprs in a lexical context in which the symbols in
 692 |   the binding-forms are bound to their respective init-exprs or parts
 693 |   therein."
 694 |   [bindings & body]
 695 |   (assert-args
 696 |      (vector? bindings) "a vector for its binding"
 697 |      (even? (count bindings)) "an even number of forms in binding vector")
 698 |   `(let* ~(destructure bindings) ~@body))
 699 | 
 700 | (core/defmacro loop
 701 |   "Evaluates the exprs in a lexical context in which the symbols in
 702 |   the binding-forms are bound to their respective init-exprs or parts
 703 |   therein. Acts as a recur target."
 704 |   [bindings & body]
 705 |   (assert-args
 706 |     (vector? bindings) "a vector for its binding"
 707 |     (even? (count bindings)) "an even number of forms in binding vector")
 708 |   (core/let [db (destructure bindings)]
 709 |     (if (= db bindings)
 710 |       `(loop* ~bindings ~@body)
 711 |       (core/let [vs (take-nth 2 (drop 1 bindings))
 712 |                  bs (take-nth 2 bindings)
 713 |                  gs (map (core/fn [b] (if (core/symbol? b) b (gensym))) bs)
 714 |                  bfs (reduce (core/fn [ret [b v g]]
 715 |                                (if (core/symbol? b)
 716 |                                  (conj ret g v)
 717 |                                  (conj ret g v b g)))
 718 |                        [] (map core/vector bs vs gs))]
 719 |         `(let ~bfs
 720 |            (loop* ~(vec (interleave gs gs))
 721 |              (let ~(vec (interleave bs gs))
 722 |                ~@body)))))))
 723 | 
 724 | (def fast-path-protocols
 725 |   "protocol fqn -> [partition number, bit]"
 726 |   (zipmap (map #(symbol "cljs.core" (core/str %))
 727 |                '[IFn ICounted IEmptyableCollection ICollection IIndexed ASeq ISeq INext
 728 |                  ILookup IAssociative IMap IMapEntry ISet IStack IVector IDeref
 729 |                  IDerefWithTimeout IMeta IWithMeta IReduce IKVReduce IEquiv IHash
 730 |                  ISeqable ISequential IList IRecord IReversible ISorted IPrintWithWriter IWriter
 731 |                  IPrintWithWriter IPending IWatchable IEditableCollection ITransientCollection
 732 |                  ITransientAssociative ITransientMap ITransientVector ITransientSet
 733 |                  IMultiFn IChunkedSeq IChunkedNext IComparable INamed ICloneable IAtom
 734 |                  IReset ISwap])
 735 |           (iterate (core/fn [[p b]]
 736 |                      (if (core/== 2147483648 b)
 737 |                        [(core/inc p) 1]
 738 |                        [p (core/bit-shift-left b 1)]))
 739 |                    [0 1])))
 740 | 
 741 | (def fast-path-protocol-partitions-count
 742 |   "total number of partitions"
 743 |   (core/let [c (count fast-path-protocols)
 744 |              m (core/mod c 32)]
 745 |     (if (core/zero? m)
 746 |       (core/quot c 32)
 747 |       (core/inc (core/quot c 32)))))
 748 | 
 749 | (core/defmacro str [& xs]
 750 |   (core/let [strs (core/->> (repeat (count xs) "cljs.core.str(~{})")
 751 |                     (interpose ",")
 752 |                     (apply core/str))]
 753 |     (list* 'js* (core/str "[" strs "].join('')") xs)))
 754 | 
 755 | (core/defn- bool-expr [e]
 756 |   (vary-meta e assoc :tag 'boolean))
 757 | 
 758 | (core/defn- simple-test-expr? [env ast]
 759 |   (core/and
 760 |     (#{:var :invoke :constant :dot :js} (:op ast))
 761 |     ('#{boolean seq} (cljs.analyzer/infer-tag env ast))))
 762 | 
 763 | (core/defmacro and
 764 |   "Evaluates exprs one at a time, from left to right. If a form
 765 |   returns logical false (nil or false), and returns that value and
 766 |   doesn't evaluate any of the other expressions, otherwise it returns
 767 |   the value of the last expr. (and) returns true."
 768 |   ([] true)
 769 |   ([x] x)
 770 |   ([x & next]
 771 |    (core/let [forms (concat [x] next)]
 772 |      (if (every? #(simple-test-expr? &env %)
 773 |            (map #(cljs.analyzer/analyze &env %) forms))
 774 |        (core/let [and-str (core/->> (repeat (count forms) "(~{})")
 775 |                             (interpose " && ")
 776 |                             (apply core/str))]
 777 |          (bool-expr `(~'js* ~and-str ~@forms)))
 778 |        `(let [and# ~x]
 779 |           (if and# (and ~@next) and#))))))
 780 | 
 781 | (core/defmacro or
 782 |   "Evaluates exprs one at a time, from left to right. If a form
 783 |   returns a logical true value, or returns that value and doesn't
 784 |   evaluate any of the other expressions, otherwise it returns the
 785 |   value of the last expression. (or) returns nil."
 786 |   ([] nil)
 787 |   ([x] x)
 788 |   ([x & next]
 789 |    (core/let [forms (concat [x] next)]
 790 |      (if (every? #(simple-test-expr? &env %)
 791 |            (map #(cljs.analyzer/analyze &env %) forms))
 792 |        (core/let [or-str (core/->> (repeat (count forms) "(~{})")
 793 |                            (interpose " || ")
 794 |                            (apply core/str))]
 795 |          (bool-expr `(~'js* ~or-str ~@forms)))
 796 |        `(let [or# ~x]
 797 |           (if or# or# (or ~@next)))))))
 798 | 
 799 | (core/defmacro nil? [x]
 800 |   `(coercive-= ~x nil))
 801 | 
 802 | ;; internal - do not use.
 803 | (core/defmacro coercive-not [x]
 804 |   (bool-expr (core/list 'js* "(!~{})" x)))
 805 | 
 806 | ;; internal - do not use.
 807 | (core/defmacro coercive-not= [x y]
 808 |   (bool-expr (core/list 'js* "(~{} != ~{})" x y)))
 809 | 
 810 | ;; internal - do not use.
 811 | (core/defmacro coercive-= [x y]
 812 |   (bool-expr (core/list 'js* "(~{} == ~{})" x y)))
 813 | 
 814 | ;; internal - do not use.
 815 | (core/defmacro coercive-boolean [x]
 816 |   (with-meta (core/list 'js* "~{}" x)
 817 |     {:tag 'boolean}))
 818 | 
 819 | ;; internal - do not use.
 820 | (core/defmacro truth_ [x]
 821 |   (core/assert (core/symbol? x) "x is substituted twice")
 822 |   (core/list 'js* "(~{} != null && ~{} !== false)" x x))
 823 | 
 824 | ;; internal - do not use
 825 | (core/defmacro js-arguments []
 826 |   (core/list 'js* "arguments"))
 827 | 
 828 | (core/defmacro js-delete [obj key]
 829 |   (core/list 'js* "delete ~{}[~{}]" obj key))
 830 | 
 831 | (core/defmacro js-in [key obj]
 832 |   (core/list 'js* "~{} in ~{}" key obj))
 833 | 
 834 | (core/defmacro js-debugger
 835 |   "Emit JavaScript \"debugger;\" statement."
 836 |   []
 837 |   (core/list 'js* "debugger;"))
 838 | 
 839 | (core/defmacro true? [x]
 840 |   (bool-expr (core/list 'js* "~{} === true" x)))
 841 | 
 842 | (core/defmacro false? [x]
 843 |   (bool-expr (core/list 'js* "~{} === false" x)))
 844 | 
 845 | (core/defmacro string? [x]
 846 |   (bool-expr (core/list 'js* "typeof ~{} === 'string'" x)))
 847 | 
 848 | ;; TODO: x must be a symbol, not an arbitrary expression
 849 | (core/defmacro exists?
 850 |   "Return true if argument exists, analogous to usage of typeof operator
 851 |    in JavaScript."
 852 |   [x]
 853 |   (bool-expr
 854 |     (core/list 'js* "typeof ~{} !== 'undefined'"
 855 |       (vary-meta x assoc :cljs.analyzer/no-resolve true))))
 856 | 
 857 | (core/defmacro undefined?
 858 |   "Return true if argument is identical to the JavaScript undefined value."
 859 |   [x]
 860 |   (bool-expr (core/list 'js* "(void 0 === ~{})" x)))
 861 | 
 862 | (core/defmacro identical? [a b]
 863 |   (bool-expr (core/list 'js* "(~{} === ~{})" a b)))
 864 | 
 865 | (core/defmacro instance? [t o]
 866 |   ;; Google Closure warns about some references to RegExp, so
 867 |   ;; (instance? RegExp ...) needs to be inlined, but the expansion
 868 |   ;; should preserve the order of argument evaluation.
 869 |   (bool-expr (if (clojure.core/symbol? t)
 870 |                (core/list 'js* "(~{} instanceof ~{})" o t)
 871 |                `(let [t# ~t o# ~o]
 872 |                   (~'js* "(~{} instanceof ~{})" o# t#)))))
 873 | 
 874 | (core/defmacro number? [x]
 875 |   (bool-expr (core/list 'js* "typeof ~{} === 'number'" x)))
 876 | 
 877 | (core/defmacro symbol? [x]
 878 |   (bool-expr `(instance? Symbol ~x)))
 879 | 
 880 | (core/defmacro keyword? [x]
 881 |   (bool-expr `(instance? Keyword ~x)))
 882 | 
 883 | (core/defmacro aget
 884 |   ([a i]
 885 |    (core/list 'js* "(~{}[~{}])" a i))
 886 |   ([a i & idxs]
 887 |    (core/let [astr (apply core/str (repeat (count idxs) "[~{}]"))]
 888 |      `(~'js* ~(core/str "(~{}[~{}]" astr ")") ~a ~i ~@idxs))))
 889 | 
 890 | (core/defmacro aset
 891 |   ([a i v]
 892 |    (core/list 'js* "(~{}[~{}] = ~{})" a i v))
 893 |   ([a idx idx2 & idxv]
 894 |    (core/let [n    (core/dec (count idxv))
 895 |               astr (apply core/str (repeat n "[~{}]"))]
 896 |      `(~'js* ~(core/str "(~{}[~{}][~{}]" astr " = ~{})") ~a ~idx ~idx2 ~@idxv))))
 897 | 
 898 | (core/defmacro ^::ana/numeric +
 899 |   ([] 0)
 900 |   ([x] x)
 901 |   ([x y] (core/list 'js* "(~{} + ~{})" x y))
 902 |   ([x y & more] `(+ (+ ~x ~y) ~@more)))
 903 | 
 904 | (core/defmacro byte [x] x)
 905 | (core/defmacro short [x] x)
 906 | (core/defmacro float [x] x)
 907 | (core/defmacro double [x] x)
 908 | 
 909 | (core/defmacro unchecked-byte [x] x)
 910 | (core/defmacro unchecked-char [x] x)
 911 | (core/defmacro unchecked-short [x] x)
 912 | (core/defmacro unchecked-float [x] x)
 913 | (core/defmacro unchecked-double [x] x)
 914 | 
 915 | (core/defmacro ^::ana/numeric unchecked-add
 916 |   ([& xs] `(+ ~@xs)))
 917 | 
 918 | (core/defmacro ^::ana/numeric unchecked-add-int
 919 |   ([& xs] `(+ ~@xs)))
 920 | 
 921 | (core/defmacro ^::ana/numeric unchecked-dec
 922 |   ([x] `(dec ~x)))
 923 | 
 924 | (core/defmacro ^::ana/numeric unchecked-dec-int
 925 |   ([x] `(dec ~x)))
 926 | 
 927 | (core/defmacro ^::ana/numeric unchecked-divide-int
 928 |   ([& xs] `(/ ~@xs)))
 929 | 
 930 | (core/defmacro ^::ana/numeric unchecked-inc
 931 |   ([x] `(inc ~x)))
 932 | 
 933 | (core/defmacro ^::ana/numeric unchecked-inc-int
 934 |   ([x] `(inc ~x)))
 935 | 
 936 | (core/defmacro ^::ana/numeric unchecked-multiply
 937 |   ([& xs] `(* ~@xs)))
 938 | 
 939 | (core/defmacro ^::ana/numeric unchecked-multiply-int
 940 |   ([& xs] `(* ~@xs)))
 941 | 
 942 | (core/defmacro ^::ana/numeric unchecked-negate
 943 |   ([x] `(- ~x)))
 944 | 
 945 | (core/defmacro ^::ana/numeric unchecked-negate-int
 946 |   ([x] `(- ~x)))
 947 | 
 948 | (core/defmacro ^::ana/numeric unchecked-remainder-int
 949 |   ([x n] `(mod ~x ~n)))
 950 | 
 951 | (core/defmacro ^::ana/numeric unchecked-subtract
 952 |   ([& xs] `(- ~@xs)))
 953 | 
 954 | (core/defmacro ^::ana/numeric unchecked-subtract-int
 955 |   ([& xs] `(- ~@xs)))
 956 | 
 957 | (core/defmacro ^::ana/numeric -
 958 |   ([x] (core/list 'js* "(- ~{})" x))
 959 |   ([x y] (core/list 'js* "(~{} - ~{})" x y))
 960 |   ([x y & more] `(- (- ~x ~y) ~@more)))
 961 | 
 962 | (core/defmacro ^::ana/numeric *
 963 |   ([] 1)
 964 |   ([x] x)
 965 |   ([x y] (core/list 'js* "(~{} * ~{})" x y))
 966 |   ([x y & more] `(* (* ~x ~y) ~@more)))
 967 | 
 968 | (core/defmacro ^::ana/numeric /
 969 |   ([x] `(/ 1 ~x))
 970 |   ([x y] (core/list 'js* "(~{} / ~{})" x y))
 971 |   ([x y & more] `(/ (/ ~x ~y) ~@more)))
 972 | 
 973 | (core/defmacro ^::ana/numeric divide
 974 |   ([x] `(/ 1 ~x))
 975 |   ([x y] (core/list 'js* "(~{} / ~{})" x y))
 976 |   ([x y & more] `(/ (/ ~x ~y) ~@more)))
 977 | 
 978 | (core/defmacro ^::ana/numeric <
 979 |   ([x] true)
 980 |   ([x y] (bool-expr (core/list 'js* "(~{} < ~{})" x y)))
 981 |   ([x y & more] `(and (< ~x ~y) (< ~y ~@more))))
 982 | 
 983 | (core/defmacro ^::ana/numeric <=
 984 |   ([x] true)
 985 |   ([x y] (bool-expr (core/list 'js* "(~{} <= ~{})" x y)))
 986 |   ([x y & more] `(and (<= ~x ~y) (<= ~y ~@more))))
 987 | 
 988 | (core/defmacro ^::ana/numeric >
 989 |   ([x] true)
 990 |   ([x y] (bool-expr (core/list 'js* "(~{} > ~{})" x y)))
 991 |   ([x y & more] `(and (> ~x ~y) (> ~y ~@more))))
 992 | 
 993 | (core/defmacro ^::ana/numeric >=
 994 |   ([x] true)
 995 |   ([x y] (bool-expr (core/list 'js* "(~{} >= ~{})" x y)))
 996 |   ([x y & more] `(and (>= ~x ~y) (>= ~y ~@more))))
 997 | 
 998 | (core/defmacro ^::ana/numeric ==
 999 |   ([x] true)
1000 |   ([x y] (bool-expr (core/list 'js* "(~{} === ~{})" x y)))
1001 |   ([x y & more] `(and (== ~x ~y) (== ~y ~@more))))
1002 | 
1003 | (core/defmacro ^::ana/numeric dec [x]
1004 |   `(- ~x 1))
1005 | 
1006 | (core/defmacro ^::ana/numeric inc [x]
1007 |   `(+ ~x 1))
1008 | 
1009 | (core/defmacro ^::ana/numeric zero? [x]
1010 |   `(== ~x 0))
1011 | 
1012 | (core/defmacro ^::ana/numeric pos? [x]
1013 |   `(> ~x 0))
1014 | 
1015 | (core/defmacro ^::ana/numeric neg? [x]
1016 |   `(< ~x 0))
1017 | 
1018 | (core/defmacro ^::ana/numeric max
1019 |   ([x] x)
1020 |   ([x y] `(let [x# ~x, y# ~y]
1021 |             (~'js* "((~{} > ~{}) ? ~{} : ~{})" x# y# x# y#)))
1022 |   ([x y & more] `(max (max ~x ~y) ~@more)))
1023 | 
1024 | (core/defmacro ^::ana/numeric min
1025 |   ([x] x)
1026 |   ([x y] `(let [x# ~x, y# ~y]
1027 |             (~'js* "((~{} < ~{}) ? ~{} : ~{})" x# y# x# y#)))
1028 |   ([x y & more] `(min (min ~x ~y) ~@more)))
1029 | 
1030 | (core/defmacro ^::ana/numeric js-mod [num div]
1031 |   (core/list 'js* "(~{} % ~{})" num div))
1032 | 
1033 | (core/defmacro ^::ana/numeric bit-not [x]
1034 |   (core/list 'js* "(~ ~{})" x))
1035 | 
1036 | (core/defmacro ^::ana/numeric bit-and
1037 |   ([x y] (core/list 'js* "(~{} & ~{})" x y))
1038 |   ([x y & more] `(bit-and (bit-and ~x ~y) ~@more)))
1039 | 
1040 | ;; internal do not use
1041 | (core/defmacro ^::ana/numeric unsafe-bit-and
1042 |   ([x y] (bool-expr (core/list 'js* "(~{} & ~{})" x y)))
1043 |   ([x y & more] `(unsafe-bit-and (unsafe-bit-and ~x ~y) ~@more)))
1044 | 
1045 | (core/defmacro ^::ana/numeric bit-or
1046 |   ([x y] (core/list 'js* "(~{} | ~{})" x y))
1047 |   ([x y & more] `(bit-or (bit-or ~x ~y) ~@more)))
1048 | 
1049 | (core/defmacro ^::ana/numeric int [x]
1050 |   `(bit-or ~x 0))
1051 | 
1052 | (core/defmacro ^::ana/numeric bit-xor
1053 |   ([x y] (core/list 'js* "(~{} ^ ~{})" x y))
1054 |   ([x y & more] `(bit-xor (bit-xor ~x ~y) ~@more)))
1055 | 
1056 | (core/defmacro ^::ana/numeric bit-and-not
1057 |   ([x y] (core/list 'js* "(~{} & ~~{})" x y))
1058 |   ([x y & more] `(bit-and-not (bit-and-not ~x ~y) ~@more)))
1059 | 
1060 | (core/defmacro ^::ana/numeric bit-clear [x n]
1061 |   (core/list 'js* "(~{} & ~(1 << ~{}))" x n))
1062 | 
1063 | (core/defmacro ^::ana/numeric bit-flip [x n]
1064 |   (core/list 'js* "(~{} ^ (1 << ~{}))" x n))
1065 | 
1066 | (core/defmacro bit-test [x n]
1067 |   (bool-expr (core/list 'js* "((~{} & (1 << ~{})) != 0)" x n)))
1068 | 
1069 | (core/defmacro ^::ana/numeric bit-shift-left [x n]
1070 |   (core/list 'js* "(~{} << ~{})" x n))
1071 | 
1072 | (core/defmacro ^::ana/numeric bit-shift-right [x n]
1073 |   (core/list 'js* "(~{} >> ~{})" x n))
1074 | 
1075 | (core/defmacro ^::ana/numeric bit-shift-right-zero-fill [x n]
1076 |   (core/list 'js* "(~{} >>> ~{})" x n))
1077 | 
1078 | (core/defmacro ^::ana/numeric unsigned-bit-shift-right [x n]
1079 |   (core/list 'js* "(~{} >>> ~{})" x n))
1080 | 
1081 | (core/defmacro ^::ana/numeric bit-set [x n]
1082 |   (core/list 'js* "(~{} | (1 << ~{}))" x n))
1083 | 
1084 | ;; internal
1085 | (core/defmacro mask [hash shift]
1086 |   (core/list 'js* "((~{} >>> ~{}) & 0x01f)" hash shift))
1087 | 
1088 | ;; internal
1089 | (core/defmacro bitpos [hash shift]
1090 |   (core/list 'js* "(1 << ~{})" `(mask ~hash ~shift)))
1091 | 
1092 | ;; internal
1093 | (core/defmacro caching-hash [coll hash-fn hash-key]
1094 |   (core/assert (clojure.core/symbol? hash-key) "hash-key is substituted twice")
1095 |   `(let [h# ~hash-key]
1096 |      (if-not (nil? h#)
1097 |        h#
1098 |        (let [h# (~hash-fn ~coll)]
1099 |          (set! ~hash-key h#)
1100 |          h#))))
1101 | 
1102 | ;;; internal -- reducers-related macros
1103 | 
1104 | (core/defn- do-curried
1105 |   [name doc meta args body]
1106 |   (core/let [cargs (vec (butlast args))]
1107 |     `(defn ~name ~doc ~meta
1108 |        (~cargs (fn [x#] (~name ~@cargs x#)))
1109 |        (~args ~@body))))
1110 | 
1111 | (core/defmacro ^:private defcurried
1112 |   "Builds another arity of the fn that returns a fn awaiting the last
1113 |   param"
1114 |   [name doc meta args & body]
1115 |   (do-curried name doc meta args body))
1116 | 
1117 | (core/defn- do-rfn [f1 k fkv]
1118 |   `(fn
1119 |      ([] (~f1))
1120 |      ~(clojure.walk/postwalk
1121 |        #(if (sequential? %)
1122 |           ((if (vector? %) vec identity)
1123 |            (core/remove #{k} %))
1124 |           %)
1125 |        fkv)
1126 |      ~fkv))
1127 | 
1128 | (core/defmacro ^:private rfn
1129 |   "Builds 3-arity reducing fn given names of wrapped fn and key, and k/v impl."
1130 |   [[f1 k] fkv]
1131 |   (do-rfn f1 k fkv))
1132 | 
1133 | ;;; end of reducers macros
1134 | 
1135 | (core/defn- protocol-prefix [psym]
1136 |   (core/str (core/-> (core/str psym) (.replace \. \$) (.replace \/ \$)) "$"))
1137 | 
1138 | (def #^:private base-type
1139 |      {nil "null"
1140 |       'object "object"
1141 |       'string "string"
1142 |       'number "number"
1143 |       'array "array"
1144 |       'function "function"
1145 |       'boolean "boolean"
1146 |       'default "_"})
1147 | 
1148 | (def #^:private js-base-type
1149 |      {'js/Boolean "boolean"
1150 |       'js/String "string"
1151 |       'js/Array "array"
1152 |       'js/Object "object"
1153 |       'js/Number "number"
1154 |       'js/Function "function"})
1155 | 
1156 | (core/defmacro reify
1157 |   "reify is a macro with the following structure:
1158 | 
1159 |  (reify options* specs*)
1160 | 
1161 |   Currently there are no options.
1162 | 
1163 |   Each spec consists of the protocol name followed by zero
1164 |   or more method bodies:
1165 | 
1166 |   protocol
1167 |   (methodName [args+] body)*
1168 | 
1169 |   Methods should be supplied for all methods of the desired
1170 |   protocol(s). You can also define overrides for Object methods. Note that
1171 |   the first parameter must be supplied to correspond to the target object
1172 |   ('this' in JavaScript parlance). Note also that recur calls
1173 |   to the method head should *not* pass the target object, it will be supplied
1174 |   automatically and can not be substituted.
1175 | 
1176 |   recur works to method heads The method bodies of reify are lexical
1177 |   closures, and can refer to the surrounding local scope:
1178 | 
1179 |   (str (let [f \"foo\"]
1180 |        (reify Object
1181 |          (toString [this] f))))
1182 |   == \"foo\"
1183 | 
1184 |   (seq (let [f \"foo\"]
1185 |        (reify ISeqable
1186 |          (-seq [this] (-seq f)))))
1187 |   == (\\f \\o \\o))
1188 | 
1189 |   reify always implements IMeta and IWithMeta and transfers meta
1190 |   data of the form to the created object.
1191 | 
1192 |   (meta ^{:k :v} (reify Object (toString [this] \"foo\")))
1193 |   == {:k :v}"
1194 |   [& impls]
1195 |   (core/let [t        (with-meta (gensym "t") {:anonymous true})
1196 |              meta-sym (gensym "meta")
1197 |              this-sym (gensym "_")
1198 |              locals   (keys (:locals &env))
1199 |              ns       (core/-> &env :ns :name)
1200 |              munge    cljs.compiler/munge]
1201 |     `(do
1202 |        (when-not (exists? ~(symbol (core/str ns) (core/str t)))
1203 |          (deftype ~t [~@locals ~meta-sym]
1204 |            IWithMeta
1205 |            (~'-with-meta [~this-sym ~meta-sym]
1206 |              (new ~t ~@locals ~meta-sym))
1207 |            IMeta
1208 |            (~'-meta [~this-sym] ~meta-sym)
1209 |            ~@impls))
1210 |        (new ~t ~@locals ~(ana/elide-reader-meta (meta &form))))))
1211 | 
1212 | (core/defmacro specify!
1213 |   "Identical to reify but mutates its first argument."
1214 |   [expr & impls]
1215 |   (core/let [x (with-meta (gensym "x") {:extend :instance})]
1216 |     `(let [~x ~expr]
1217 |        (extend-type ~x ~@impls)
1218 |        ~x)))
1219 | 
1220 | (core/defmacro specify
1221 |   "Identical to specify but does not mutate its first argument. The first
1222 |   argument must be an ICloneable instance."
1223 |   [expr & impls]
1224 |   `(cljs.core/specify! (cljs.core/clone ~expr)
1225 |      ~@impls))
1226 | 
1227 | (core/defmacro ^:private js-this []
1228 |   (core/list 'js* "this"))
1229 | 
1230 | (core/defmacro this-as
1231 |   "Defines a scope where JavaScript's implicit \"this\" is bound to the name provided."
1232 |   [name & body]
1233 |   `(let [~name (js-this)]
1234 |      ~@body))
1235 | 
1236 | (core/defn- to-property [sym]
1237 |   (symbol (core/str "-" sym)))
1238 | 
1239 | (core/defn- warn-and-update-protocol [p type env]
1240 |   (core/when-not (= 'Object p)
1241 |     (core/if-let [var (cljs.analyzer/resolve-existing-var (dissoc env :locals) p)]
1242 |       (do
1243 |         (core/when-not (:protocol-symbol var)
1244 |           (cljs.analyzer/warning :invalid-protocol-symbol env {:protocol p}))
1245 |         (core/when (core/and (:protocol-deprecated cljs.analyzer/*cljs-warnings*)
1246 |                 (core/-> var :deprecated)
1247 |                 (not (core/-> p meta :deprecation-nowarn)))
1248 |           (cljs.analyzer/warning :protocol-deprecated env {:protocol p}))
1249 |         (core/when (:protocol-symbol var)
1250 |           (swap! env/*compiler* update-in [:cljs.analyzer/namespaces]
1251 |             (core/fn [ns]
1252 |               (update-in ns [(:ns var) :defs (symbol (name p)) :impls]
1253 |                 conj type)))))
1254 |       (core/when (:undeclared cljs.analyzer/*cljs-warnings*)
1255 |         (cljs.analyzer/warning :undeclared-protocol-symbol env {:protocol p})))))
1256 | 
1257 | (core/defn- resolve-var [env sym]
1258 |   (core/let [ret (core/-> (dissoc env :locals)
1259 |                    (cljs.analyzer/resolve-var sym)
1260 |                    :name)]
1261 |     (core/assert ret (core/str "Can't resolve: " sym))
1262 |     ret))
1263 | 
1264 | (core/defn- ->impl-map [impls]
1265 |   (core/loop [ret {} s impls]
1266 |     (if (seq s)
1267 |       (recur (assoc ret (first s) (take-while seq? (next s)))
1268 |         (drop-while seq? (next s)))
1269 |       ret)))
1270 | 
1271 | (core/defn- base-assign-impls [env resolve tsym type [p sigs]]
1272 |   (warn-and-update-protocol p tsym env)
1273 |   (core/let [psym       (resolve p)
1274 |              pfn-prefix (subs (core/str psym) 0
1275 |                           (clojure.core/inc (.indexOf (core/str psym) "/")))]
1276 |     (cons `(aset ~psym ~type true)
1277 |       (map (core/fn [[f & meths :as form]]
1278 |              `(aset ~(symbol (core/str pfn-prefix f))
1279 |                 ~type ~(with-meta `(fn ~@meths) (meta form))))
1280 |         sigs))))
1281 | 
1282 | (core/defmulti extend-prefix (core/fn [tsym sym] (core/-> tsym meta :extend)))
1283 | 
1284 | (core/defmethod extend-prefix :instance
1285 |   [tsym sym] `(.. ~tsym ~(to-property sym)))
1286 | 
1287 | (core/defmethod extend-prefix :default
1288 |   [tsym sym] `(.. ~tsym ~'-prototype ~(to-property sym)))
1289 | 
1290 | (core/defn- adapt-obj-params [type [[this & args :as sig] & body]]
1291 |   (core/list (vec args)
1292 |     (list* 'this-as (vary-meta this assoc :tag type) body)))
1293 | 
1294 | (core/defn- adapt-ifn-params [type [[this & args :as sig] & body]]
1295 |   (core/let [self-sym (with-meta 'self__ {:tag type})]
1296 |     `(~(vec (cons self-sym args))
1297 |        (this-as ~self-sym
1298 |          (let [~this ~self-sym]
1299 |            ~@body)))))
1300 | 
1301 | ;; for IFn invoke implementations, we need to drop first arg
1302 | (core/defn- adapt-ifn-invoke-params [type [[this & args :as sig] & body]]
1303 |   `(~(vec args)
1304 |      (this-as ~(vary-meta this assoc :tag type)
1305 |        ~@body)))
1306 | 
1307 | (core/defn- adapt-proto-params [type [[this & args :as sig] & body]]
1308 |   `(~(vec (cons (vary-meta this assoc :tag type) args))
1309 |      (this-as ~this
1310 |        ~@body)))
1311 | 
1312 | (core/defn- add-obj-methods [type type-sym sigs]
1313 |   (map (core/fn [[f & meths :as form]]
1314 |          (core/let [[f meths] (if (vector? (first meths))
1315 |                                 [f [(rest form)]]
1316 |                                 [f meths])]
1317 |            `(set! ~(extend-prefix type-sym f)
1318 |               ~(with-meta `(fn ~@(map #(adapt-obj-params type %) meths)) (meta form)))))
1319 |     sigs))
1320 | 
1321 | (core/defn- ifn-invoke-methods [type type-sym [f & meths :as form]]
1322 |   (map
1323 |     (core/fn [meth]
1324 |       (core/let [arity (count (first meth))]
1325 |         `(set! ~(extend-prefix type-sym (symbol (core/str "cljs$core$IFn$_invoke$arity$" arity)))
1326 |            ~(with-meta `(fn ~meth) (meta form)))))
1327 |     (map #(adapt-ifn-invoke-params type %) meths)))
1328 | 
1329 | (core/defn- add-ifn-methods [type type-sym [f & meths :as form]]
1330 |   (core/let [meths    (map #(adapt-ifn-params type %) meths)
1331 |              this-sym (with-meta 'self__ {:tag type})
1332 |              argsym   (gensym "args")]
1333 |     (concat
1334 |       [`(set! ~(extend-prefix type-sym 'call) ~(with-meta `(fn ~@meths) (meta form)))
1335 |        `(set! ~(extend-prefix type-sym 'apply)
1336 |           ~(with-meta
1337 |              `(fn ~[this-sym argsym]
1338 |                 (this-as ~this-sym
1339 |                   (.apply (.-call ~this-sym) ~this-sym
1340 |                     (.concat (array ~this-sym) (aclone ~argsym)))))
1341 |              (meta form)))]
1342 |       (ifn-invoke-methods type type-sym form))))
1343 | 
1344 | (core/defn- add-proto-methods* [pprefix type type-sym [f & meths :as form]]
1345 |   (core/let [pf (core/str pprefix f)]
1346 |     (if (vector? (first meths))
1347 |       ;; single method case
1348 |       (core/let [meth meths]
1349 |         [`(set! ~(extend-prefix type-sym (core/str pf "$arity$" (count (first meth))))
1350 |             ~(with-meta `(fn ~@(adapt-proto-params type meth)) (meta form)))])
1351 |       (map (core/fn [[sig & body :as meth]]
1352 |              `(set! ~(extend-prefix type-sym (core/str pf "$arity$" (count sig)))
1353 |                 ~(with-meta `(fn ~(adapt-proto-params type meth)) (meta form))))
1354 |         meths))))
1355 | 
1356 | (core/defn- proto-assign-impls [env resolve type-sym type [p sigs]]
1357 |   (warn-and-update-protocol p type env)
1358 |   (core/let [psym      (resolve p)
1359 |              pprefix   (protocol-prefix psym)
1360 |              skip-flag (set (core/-> type-sym meta :skip-protocol-flag))]
1361 |     (if (= p 'Object)
1362 |       (add-obj-methods type type-sym sigs)
1363 |       (concat
1364 |         (core/when-not (skip-flag psym)
1365 |           [`(set! ~(extend-prefix type-sym pprefix) true)])
1366 |         (mapcat
1367 |           (core/fn [sig]
1368 |             (if (= psym 'cljs.core/IFn)
1369 |               (add-ifn-methods type type-sym sig)
1370 |               (add-proto-methods* pprefix type type-sym sig)))
1371 |           sigs)))))
1372 | 
1373 | (core/defn- validate-impl-sigs [env p method]
1374 |   (core/when-not (= p 'Object)
1375 |     (core/let [var (ana/resolve-var (dissoc env :locals) p)
1376 |                minfo (core/-> var :protocol-info :methods)
1377 |                [fname sigs] (if (core/vector? (second method))
1378 |                               [(first method) [(second method)]]
1379 |                               [(first method) (map first (rest method))])
1380 |                decmeths (core/get minfo fname ::not-found)]
1381 |       (core/when (= decmeths ::not-found)
1382 |         (ana/warning :protocol-invalid-method env {:protocol p :fname fname :no-such-method true}))
1383 |       (core/loop [sigs sigs seen #{}]
1384 |         (core/when (seq sigs)
1385 |           (core/let [sig (first sigs)
1386 |                      c   (count sig)]
1387 |             (core/when (contains? seen c)
1388 |               (ana/warning :protocol-duped-method env {:protocol p :fname fname}))
1389 |             (core/when (core/and (not= decmeths ::not-found) (not (some #{c} (map count decmeths))))
1390 |               (ana/warning :protocol-invalid-method env {:protocol p :fname fname :invalid-arity c}))
1391 |             (recur (next sigs) (conj seen c))))))))
1392 | 
1393 | (core/defn- validate-impls [env impls]
1394 |   (core/loop [protos #{} impls impls]
1395 |     (core/when (seq impls)
1396 |       (core/let [proto   (first impls)
1397 |                  methods (take-while seq? (next impls))
1398 |                  impls   (drop-while seq? (next impls))]
1399 |         (core/when (contains? protos proto)
1400 |           (ana/warning :protocol-multiple-impls env {:protocol proto}))
1401 |         (core/loop [seen #{} methods methods]
1402 |           (core/when (seq methods)
1403 |             (core/let [[fname :as method] (first methods)]
1404 |               (core/when (contains? seen fname)
1405 |                 (ana/warning :extend-type-invalid-method-shape env
1406 |                   {:protocol proto :method fname}))
1407 |               (validate-impl-sigs env proto method)
1408 |               (recur (conj seen fname) (next methods)))))
1409 |         (recur (conj protos proto) impls)))))
1410 | 
1411 | (core/defmacro extend-type
1412 |   "Extend a type to a series of protocols. Useful when you are
1413 |    supplying the definitions explicitly inline. Propagates the
1414 |    type as a type hint on the first argument of all fns.
1415 | 
1416 |   (extend-type MyType
1417 |     ICounted
1418 |     (-count [c] ...)
1419 |     Foo
1420 |     (bar [x y] ...)
1421 |     (baz ([x] ...) ([x y & zs] ...))"
1422 |   [type-sym & impls]
1423 |   (core/let [env &env
1424 |              _ (validate-impls env impls)
1425 |              resolve (partial resolve-var env)
1426 |              impl-map (->impl-map impls)
1427 |              [type assign-impls] (core/if-let [type (base-type type-sym)]
1428 |                                    [type base-assign-impls]
1429 |                                    [(resolve type-sym) proto-assign-impls])]
1430 |     (core/when (core/and (:extending-base-js-type cljs.analyzer/*cljs-warnings*)
1431 |             (js-base-type type-sym))
1432 |       (cljs.analyzer/warning :extending-base-js-type env
1433 |         {:current-symbol type-sym :suggested-symbol (js-base-type type-sym)}))
1434 |     `(do ~@(mapcat #(assign-impls env resolve type-sym type %) impl-map))))
1435 | 
1436 | (core/defn- prepare-protocol-masks [env impls]
1437 |   (core/let [resolve  (partial resolve-var env)
1438 |              impl-map (->impl-map impls)
1439 |              fpp-pbs  (seq
1440 |                         (keep fast-path-protocols
1441 |                           (map resolve
1442 |                             (keys impl-map))))]
1443 |     (if fpp-pbs
1444 |       (core/let [fpps  (into #{}
1445 |                          (filter (partial contains? fast-path-protocols)
1446 |                            (map resolve (keys impl-map))))
1447 |                  parts (core/as-> (group-by first fpp-pbs) parts
1448 |                          (into {}
1449 |                            (map (juxt key (comp (partial map peek) val))
1450 |                              parts))
1451 |                          (into {}
1452 |                            (map (juxt key (comp (partial reduce core/bit-or) val))
1453 |                              parts)))]
1454 |         [fpps (reduce (core/fn [ps p] (update-in ps [p] (core/fnil identity 0)))
1455 |                 parts
1456 |                 (range fast-path-protocol-partitions-count))]))))
1457 | 
1458 | (core/defn- annotate-specs [annots v [f sigs]]
1459 |   (conj v
1460 |     (vary-meta (cons f (map #(cons (second %) (nnext %)) sigs))
1461 |       merge annots)))
1462 | 
1463 | (core/defn dt->et
1464 |   ([type specs fields]
1465 |    (dt->et type specs fields false))
1466 |   ([type specs fields inline]
1467 |    (core/let [annots {:cljs.analyzer/type type
1468 |                       :cljs.analyzer/protocol-impl true
1469 |                       :cljs.analyzer/protocol-inline inline}]
1470 |      (core/loop [ret [] specs specs]
1471 |        (if (seq specs)
1472 |          (core/let [p     (first specs)
1473 |                     ret   (core/-> (conj ret p)
1474 |                             (into (reduce (partial annotate-specs annots) []
1475 |                                     (group-by first (take-while seq? (next specs))))))
1476 |                     specs (drop-while seq? (next specs))]
1477 |            (recur ret specs))
1478 |          ret)))))
1479 | 
1480 | (core/defn- collect-protocols [impls env]
1481 |   (core/->> impls
1482 |       (filter core/symbol?)
1483 |       (map #(:name (cljs.analyzer/resolve-var (dissoc env :locals) %)))
1484 |       (into #{})))
1485 | 
1486 | (core/defn- build-positional-factory
1487 |   [rsym rname fields]
1488 |   (core/let [fn-name (with-meta (symbol (core/str '-> rsym))
1489 |                        (assoc (meta rsym) :factory :positional))
1490 |         field-values (if (core/-> rsym meta :internal-ctor) (conj fields nil nil nil) fields)]
1491 |     `(defn ~fn-name
1492 |        [~@fields]
1493 |        (new ~rname ~@field-values))))
1494 | 
1495 | (core/defn- validate-fields
1496 |   [case name fields]
1497 |   (core/when-not (vector? fields)
1498 |     (throw
1499 |       #?(:clj (AssertionError. (core/str case " " name ", no fields vector given."))
1500 |          :cljs (js/Error. (core/str case " " name ", no fields vector given."))))))
1501 | 
1502 | (core/defmacro deftype
1503 |   "(deftype name [fields*]  options* specs*)
1504 | 
1505 |   Currently there are no options.
1506 | 
1507 |   Each spec consists of a protocol or interface name followed by zero
1508 |   or more method bodies:
1509 | 
1510 |   protocol-or-Object
1511 |   (methodName [args*] body)*
1512 | 
1513 |   The type will have the (by default, immutable) fields named by
1514 |   fields, which can have type hints. Protocols and methods
1515 |   are optional. The only methods that can be supplied are those
1516 |   declared in the protocols/interfaces.  Note that method bodies are
1517 |   not closures, the local environment includes only the named fields,
1518 |   and those fields can be accessed directly. Fields can be qualified
1519 |   with the metadata :mutable true at which point (set! afield aval) will be
1520 |   supported in method bodies. Note well that mutable fields are extremely
1521 |   difficult to use correctly, and are present only to facilitate the building
1522 |   of higherlevel constructs, such as ClojureScript's reference types, in
1523 |   ClojureScript itself. They are for experts only - if the semantics and
1524 |   implications of :mutable are not immediately apparent to you, you should not
1525 |   be using them.
1526 | 
1527 |   Method definitions take the form:
1528 | 
1529 |   (methodname [args*] body)
1530 | 
1531 |   The argument and return types can be hinted on the arg and
1532 |   methodname symbols. If not supplied, they will be inferred, so type
1533 |   hints should be reserved for disambiguation.
1534 | 
1535 |   Methods should be supplied for all methods of the desired
1536 |   protocol(s). You can also define overrides for methods of Object. Note that
1537 |   a parameter must be supplied to correspond to the target object
1538 |   ('this' in JavaScript parlance). Note also that recur calls to the method
1539 |   head should *not* pass the target object, it will be supplied
1540 |   automatically and can not be substituted.
1541 | 
1542 |   In the method bodies, the (unqualified) name can be used to name the
1543 |   class (for calls to new, instance? etc).
1544 | 
1545 |   One constructor will be defined, taking the designated fields.  Note
1546 |   that the field names __meta and __extmap are currently reserved and
1547 |   should not be used when defining your own types.
1548 | 
1549 |   Given (deftype TypeName ...), a factory function called ->TypeName
1550 |   will be defined, taking positional parameters for the fields"
1551 |   [t fields & impls]
1552 |   (validate-fields "deftype" t fields)
1553 |   (core/let [env &env
1554 |              r (:name (cljs.analyzer/resolve-var (dissoc env :locals) t))
1555 |              [fpps pmasks] (prepare-protocol-masks env impls)
1556 |              protocols (collect-protocols impls env)
1557 |              t (vary-meta t assoc
1558 |                  :protocols protocols
1559 |                  :skip-protocol-flag fpps) ]
1560 |     `(do
1561 |        (deftype* ~t ~fields ~pmasks
1562 |          ~(if (seq impls)
1563 |             `(extend-type ~t ~@(dt->et t impls fields))))
1564 |        (set! (.-getBasis ~t) (fn [] '[~@fields]))
1565 |        (set! (.-cljs$lang$type ~t) true)
1566 |        (set! (.-cljs$lang$ctorStr ~t) ~(core/str r))
1567 |        (set! (.-cljs$lang$ctorPrWriter ~t) (fn [this# writer# opt#] (-write writer# ~(core/str r))))
1568 | 
1569 |        ~(build-positional-factory t r fields)
1570 |        ~t)))
1571 | 
1572 | (core/defn- emit-defrecord
1573 |   "Do not use this directly - use defrecord"
1574 |   [env tagname rname fields impls]
1575 |   (core/let [hinted-fields fields
1576 |              fields (vec (map #(with-meta % nil) fields))
1577 |              base-fields fields
1578 |              pr-open (core/str "#" (.getNamespace rname) "." (.getName rname) "{")
1579 |              fields (conj fields '__meta '__extmap (with-meta '__hash {:mutable true}))]
1580 |     (core/let [gs (gensym)
1581 |                ksym (gensym "k")
1582 |                impls (concat
1583 |                        impls
1584 |                        ['IRecord
1585 |                         'ICloneable
1586 |                         `(~'-clone [this#] (new ~tagname ~@fields))
1587 |                         'IHash
1588 |                         `(~'-hash [this#] (caching-hash this# ~'hash-imap ~'__hash))
1589 |                         'IEquiv
1590 |                         `(~'-equiv [this# other#]
1591 |                            (if (and other#
1592 |                                  (identical? (.-constructor this#)
1593 |                                    (.-constructor other#))
1594 |                                  (equiv-map this# other#))
1595 |                              true
1596 |                              false))
1597 |                         'IMeta
1598 |                         `(~'-meta [this#] ~'__meta)
1599 |                         'IWithMeta
1600 |                         `(~'-with-meta [this# ~gs] (new ~tagname ~@(replace {'__meta gs} fields)))
1601 |                         'ILookup
1602 |                         `(~'-lookup [this# k#] (-lookup this# k# nil))
1603 |                         `(~'-lookup [this# ~ksym else#]
1604 |                            (case ~ksym
1605 |                              ~@(mapcat (core/fn [f] [(keyword f) f]) base-fields)
1606 |                              (get ~'__extmap ~ksym else#)))
1607 |                         'ICounted
1608 |                         `(~'-count [this#] (+ ~(count base-fields) (count ~'__extmap)))
1609 |                         'ICollection
1610 |                         `(~'-conj [this# entry#]
1611 |                            (if (vector? entry#)
1612 |                              (-assoc this# (-nth entry# 0) (-nth entry# 1))
1613 |                              (reduce -conj
1614 |                                this#
1615 |                                entry#)))
1616 |                         'IAssociative
1617 |                         `(~'-assoc [this# k# ~gs]
1618 |                            (condp keyword-identical? k#
1619 |                              ~@(mapcat (core/fn [fld]
1620 |                                          [(keyword fld) (list* `new tagname (replace {fld gs '__hash nil} fields))])
1621 |                                  base-fields)
1622 |                              (new ~tagname ~@(remove #{'__extmap '__hash} fields) (assoc ~'__extmap k# ~gs) nil)))
1623 |                         'IMap
1624 |                         `(~'-dissoc [this# k#] (if (contains? #{~@(map keyword base-fields)} k#)
1625 |                                                  (dissoc (with-meta (into {} this#) ~'__meta) k#)
1626 |                                                  (new ~tagname ~@(remove #{'__extmap '__hash} fields)
1627 |                                                    (not-empty (dissoc ~'__extmap k#))
1628 |                                                    nil)))
1629 |                         'ISeqable
1630 |                         `(~'-seq [this#] (seq (concat [~@(map #(core/list `vector (keyword %) %) base-fields)]
1631 |                                                 ~'__extmap)))
1632 | 
1633 |                         'IPrintWithWriter
1634 |                         `(~'-pr-writer [this# writer# opts#]
1635 |                            (let [pr-pair# (fn [keyval#] (pr-sequential-writer writer# pr-writer "" " " "" opts# keyval#))]
1636 |                              (pr-sequential-writer
1637 |                                writer# pr-pair# ~pr-open ", " "}" opts#
1638 |                                (concat [~@(map #(core/list `vector (keyword %) %) base-fields)]
1639 |                                  ~'__extmap))))
1640 |                         ])
1641 |                [fpps pmasks] (prepare-protocol-masks env impls)
1642 |                protocols (collect-protocols impls env)
1643 |                tagname (vary-meta tagname assoc
1644 |                          :protocols protocols
1645 |                          :skip-protocol-flag fpps)]
1646 |       `(do
1647 |          (~'defrecord* ~tagname ~hinted-fields ~pmasks
1648 |            (extend-type ~tagname ~@(dt->et tagname impls fields true)))))))
1649 | 
1650 | (core/defn- build-map-factory [rsym rname fields]
1651 |   (core/let [fn-name (with-meta (symbol (core/str 'map-> rsym))
1652 |                        (assoc (meta rsym) :factory :map))
1653 |              ms (gensym)
1654 |              ks (map keyword fields)
1655 |              getters (map (core/fn [k] `(~k ~ms)) ks)]
1656 |     `(defn ~fn-name [~ms]
1657 |        (new ~rname ~@getters nil (dissoc ~ms ~@ks) nil))))
1658 | 
1659 | (core/defmacro defrecord
1660 |   "(defrecord name [fields*]  options* specs*)
1661 | 
1662 |   Currently there are no options.
1663 | 
1664 |   Each spec consists of a protocol or interface name followed by zero
1665 |   or more method bodies:
1666 | 
1667 |   protocol-or-Object
1668 |   (methodName [args*] body)*
1669 | 
1670 |   The record will have the (immutable) fields named by
1671 |   fields, which can have type hints. Protocols and methods
1672 |   are optional. The only methods that can be supplied are those
1673 |   declared in the protocols.  Note that method bodies are
1674 |   not closures, the local environment includes only the named fields,
1675 |   and those fields can be accessed directly.
1676 | 
1677 |   Method definitions take the form:
1678 | 
1679 |   (methodname [args*] body)
1680 | 
1681 |   The argument and return types can be hinted on the arg and
1682 |   methodname symbols. If not supplied, they will be inferred, so type
1683 |   hints should be reserved for disambiguation.
1684 | 
1685 |   Methods should be supplied for all methods of the desired
1686 |   protocol(s). You can also define overrides for
1687 |   methods of Object. Note that a parameter must be supplied to
1688 |   correspond to the target object ('this' in JavaScript parlance). Note also
1689 |   that recur calls to the method head should *not* pass the target object, it
1690 |   will be supplied automatically and can not be substituted.
1691 | 
1692 |   In the method bodies, the (unqualified) name can be used to name the
1693 |   class (for calls to new, instance? etc).
1694 | 
1695 |   The type will have implementations of several ClojureScript
1696 |   protocol generated automatically: IMeta/IWithMeta (metadata support) and
1697 |   IMap, etc.
1698 | 
1699 |   In addition, defrecord will define type-and-value-based =,
1700 |   and will define ClojureScript IHash and IEquiv.
1701 | 
1702 |   Two constructors will be defined, one taking the designated fields
1703 |   followed by a metadata map (nil for none) and an extension field
1704 |   map (nil for none), and one taking only the fields (using nil for
1705 |   meta and extension fields). Note that the field names __meta
1706 |   and __extmap are currently reserved and should not be used when
1707 |   defining your own records.
1708 | 
1709 |   Given (defrecord TypeName ...), two factory functions will be
1710 |   defined: ->TypeName, taking positional parameters for the fields,
1711 |   and map->TypeName, taking a map of keywords to field values."
1712 |   [rsym fields & impls]
1713 |   (validate-fields "defrecord" rsym fields)
1714 |   (core/let [rsym (vary-meta rsym assoc :internal-ctor true)
1715 |              r    (vary-meta
1716 |                     (:name (cljs.analyzer/resolve-var (dissoc &env :locals) rsym))
1717 |                     assoc :internal-ctor true)]
1718 |     `(let []
1719 |        ~(emit-defrecord &env rsym r fields impls)
1720 |        (set! (.-getBasis ~r) (fn [] '[~@fields]))
1721 |        (set! (.-cljs$lang$type ~r) true)
1722 |        (set! (.-cljs$lang$ctorPrSeq ~r) (fn [this#] (core/list ~(core/str r))))
1723 |        (set! (.-cljs$lang$ctorPrWriter ~r) (fn [this# writer#] (-write writer# ~(core/str r))))
1724 |        ~(build-positional-factory rsym r fields)
1725 |        ~(build-map-factory rsym r fields)
1726 |        ~r)))
1727 | 
1728 | (core/defmacro defprotocol
1729 |   "A protocol is a named set of named methods and their signatures:
1730 | 
1731 |   (defprotocol AProtocolName
1732 |     ;optional doc string
1733 |     \"A doc string for AProtocol abstraction\"
1734 | 
1735 |   ;method signatures
1736 |     (bar [this a b] \"bar docs\")
1737 |     (baz [this a] [this a b] [this a b c] \"baz docs\"))
1738 | 
1739 |   No implementations are provided. Docs can be specified for the
1740 |   protocol overall and for each method. The above yields a set of
1741 |   polymorphic functions and a protocol object. All are
1742 |   namespace-qualified by the ns enclosing the definition The resulting
1743 |   functions dispatch on the type of their first argument, which is
1744 |   required and corresponds to the implicit target object ('this' in
1745 |   JavaScript parlance). defprotocol is dynamic, has no special compile-time
1746 |   effect, and defines no new types.
1747 | 
1748 |   (defprotocol P
1749 |     (foo [this])
1750 |     (bar-me [this] [this y]))
1751 | 
1752 |   (deftype Foo [a b c]
1753 |     P
1754 |     (foo [this] a)
1755 |     (bar-me [this] b)
1756 |     (bar-me [this y] (+ c y)))
1757 | 
1758 |   (bar-me (Foo. 1 2 3) 42)
1759 |   => 45
1760 | 
1761 |   (foo
1762 |     (let [x 42]
1763 |       (reify P
1764 |         (foo [this] 17)
1765 |         (bar-me [this] x)
1766 |         (bar-me [this y] x))))
1767 |   => 17"
1768 |   [psym & doc+methods]
1769 |   (core/let [p (:name (cljs.analyzer/resolve-var (dissoc &env :locals) psym))
1770 |              [doc methods] (if (core/string? (first doc+methods))
1771 |                              [(first doc+methods) (next doc+methods)]
1772 |                              [nil doc+methods])
1773 |              psym (vary-meta psym assoc
1774 |                     :doc doc
1775 |                     :protocol-symbol true)
1776 |              ns-name (core/-> &env :ns :name)
1777 |              fqn (core/fn [n] (symbol (core/str ns-name "." n)))
1778 |              prefix (protocol-prefix p)
1779 |              _ (core/doseq [[mname & arities] methods]
1780 |                  (core/when (some #{0} (map count (filter vector? arities)))
1781 |                    (throw
1782 |                      #?(:clj (Exception.
1783 |                                (core/str "Invalid protocol, " psym
1784 |                                  " defines method " mname " with arity 0"))
1785 |                         :cljs (js/Error.
1786 |                                 (core/str "Invalid protocol, " psym
1787 |                                   " defines method " mname " with arity 0"))))))
1788 |              expand-sig (core/fn [fname slot sig]
1789 |                           `(~sig
1790 |                              (if (and ~(first sig) (. ~(first sig) ~(symbol (core/str "-" slot)))) ;; Property access needed here.
1791 |                                (. ~(first sig) ~slot ~@sig)
1792 |                                (let [x# (if (nil? ~(first sig)) nil ~(first sig))]
1793 |                                  ((or
1794 |                                     (aget ~(fqn fname) (goog/typeOf x#))
1795 |                                     (aget ~(fqn fname) "_")
1796 |                                     (throw (missing-protocol
1797 |                                              ~(core/str psym "." fname) ~(first sig))))
1798 |                                    ~@sig)))))
1799 |              psym   (vary-meta psym assoc-in [:protocol-info :methods]
1800 |                       (into {}
1801 |                         (map
1802 |                           (core/fn [[fname & sigs]]
1803 |                             (core/let [doc (core/as-> (last sigs) doc
1804 |                                              (core/when (core/string? doc) doc))
1805 |                                        sigs (take-while vector? sigs)]
1806 |                               [(vary-meta fname assoc :doc doc)
1807 |                                (vec sigs)]))
1808 |                           methods)))
1809 |              method (core/fn [[fname & sigs]]
1810 |                       (core/let [doc (core/as-> (last sigs) doc
1811 |                                        (core/when (core/string? doc) doc))
1812 |                                  sigs (take-while vector? sigs)
1813 |                                  slot (symbol (core/str prefix (name fname)))
1814 |                                  fname (vary-meta fname assoc
1815 |                                          :protocol p
1816 |                                          :doc doc)]
1817 |                         `(defn ~fname
1818 |                            ~@(map (core/fn [sig]
1819 |                                     (expand-sig fname
1820 |                                       (symbol (core/str slot "$arity$" (count sig)))
1821 |                                       sig))
1822 |                                sigs))))]
1823 |     `(do
1824 |        (set! ~'*unchecked-if* true)
1825 |        (def ~psym (js-obj))
1826 |        ~@(map method methods)
1827 |        (set! ~'*unchecked-if* false))))
1828 | 
1829 | (core/defmacro implements?
1830 |   "EXPERIMENTAL"
1831 |   [psym x]
1832 |   (core/let [p          (:name
1833 |                           (cljs.analyzer/resolve-var
1834 |                             (dissoc &env :locals) psym))
1835 |              prefix     (protocol-prefix p)
1836 |              xsym       (bool-expr (gensym))
1837 |              [part bit] (fast-path-protocols p)
1838 |              msym       (symbol
1839 |                           (core/str "-cljs$lang$protocol_mask$partition" part "$"))]
1840 |     `(let [~xsym ~x]
1841 |        (if ~xsym
1842 |          (let [bit# ~(if bit `(unsafe-bit-and (. ~xsym ~msym) ~bit))]
1843 |            (if (or bit#
1844 |                  ~(bool-expr `(. ~xsym ~(symbol (core/str "-" prefix)))))
1845 |              true
1846 |              false))
1847 |          false))))
1848 | 
1849 | (core/defmacro satisfies?
1850 |   "Returns true if x satisfies the protocol"
1851 |   [psym x]
1852 |   (core/let [p          (:name
1853 |                           (cljs.analyzer/resolve-var
1854 |                             (dissoc &env :locals) psym))
1855 |              prefix     (protocol-prefix p)
1856 |              xsym       (bool-expr (gensym))
1857 |              [part bit] (fast-path-protocols p)
1858 |              msym       (symbol
1859 |                           (core/str "-cljs$lang$protocol_mask$partition" part "$"))]
1860 |     `(let [~xsym ~x]
1861 |        (if ~xsym
1862 |          (let [bit# ~(if bit `(unsafe-bit-and (. ~xsym ~msym) ~bit))]
1863 |            (if (or bit#
1864 |                  ~(bool-expr `(. ~xsym ~(symbol (core/str "-" prefix)))))
1865 |              true
1866 |              (if (coercive-not (. ~xsym ~msym))
1867 |                (cljs.core/native-satisfies? ~psym ~xsym)
1868 |                false)))
1869 |          (cljs.core/native-satisfies? ~psym ~xsym)))))
1870 | 
1871 | (core/defmacro lazy-seq
1872 |   "Takes a body of expressions that returns an ISeq or nil, and yields
1873 |   a ISeqable object that will invoke the body only the first time seq
1874 |   is called, and will cache the result and return it on all subsequent
1875 |   seq calls."
1876 |   [& body]
1877 |   `(new cljs.core/LazySeq nil (fn [] ~@body) nil nil))
1878 | 
1879 | (core/defmacro delay
1880 |   "Takes a body of expressions and yields a Delay object that will
1881 |   invoke the body only the first time it is forced (with force or deref/@), and
1882 |   will cache the result and return it on all subsequent force
1883 |   calls."
1884 |   [& body]
1885 |   `(new cljs.core/Delay (fn [] ~@body) nil))
1886 | 
1887 | (core/defmacro with-redefs
1888 |   "binding => var-symbol temp-value-expr
1889 | 
1890 |   Temporarily redefines vars while executing the body.  The
1891 |   temp-value-exprs will be evaluated and each resulting value will
1892 |   replace in parallel the root value of its var.  After the body is
1893 |   executed, the root values of all the vars will be set back to their
1894 |   old values. Useful for mocking out functions during testing."
1895 |   [bindings & body]
1896 |   (core/let [names (take-nth 2 bindings)
1897 |              vals (take-nth 2 (drop 1 bindings))
1898 |              tempnames (map (comp gensym name) names)
1899 |              binds (map core/vector names vals)
1900 |              resets (reverse (map core/vector names tempnames))
1901 |              bind-value (core/fn [[k v]] (core/list 'set! k v))]
1902 |     `(let [~@(interleave tempnames names)]
1903 |        ~@(map bind-value binds)
1904 |        (try
1905 |          ~@body
1906 |          (finally
1907 |            ~@(map bind-value resets))))))
1908 | 
1909 | (core/defmacro binding
1910 |   "binding => var-symbol init-expr
1911 | 
1912 |   Creates new bindings for the (already-existing) vars, with the
1913 |   supplied initial values, executes the exprs in an implicit do, then
1914 |   re-establishes the bindings that existed before.  The new bindings
1915 |   are made in parallel (unlike let); all init-exprs are evaluated
1916 |   before the vars are bound to their new values."
1917 |   [bindings & body]
1918 |   (core/let [names (take-nth 2 bindings)]
1919 |     (cljs.analyzer/confirm-bindings &env names)
1920 |     `(with-redefs ~bindings ~@body)))
1921 | 
1922 | (core/defmacro condp
1923 |   "Takes a binary predicate, an expression, and a set of clauses.
1924 |   Each clause can take the form of either:
1925 | 
1926 |   test-expr result-expr
1927 | 
1928 |   test-expr :>> result-fn
1929 | 
1930 |   Note :>> is an ordinary keyword.
1931 | 
1932 |   For each clause, (pred test-expr expr) is evaluated. If it returns
1933 |   logical true, the clause is a match. If a binary clause matches, the
1934 |   result-expr is returned, if a ternary clause matches, its result-fn,
1935 |   which must be a unary function, is called with the result of the
1936 |   predicate as its argument, the result of that call being the return
1937 |   value of condp. A single default expression can follow the clauses,
1938 |   and its value will be returned if no clause matches. If no default
1939 |   expression is provided and no clause matches, an
1940 |   IllegalArgumentException is thrown."
1941 |   {:added "1.0"}
1942 | 
1943 |   [pred expr & clauses]
1944 |   (core/let [gpred (gensym "pred__")
1945 |              gexpr (gensym "expr__")
1946 |              emit (core/fn emit [pred expr args]
1947 |                     (core/let [[[a b c :as clause] more]
1948 |                                (split-at (if (= :>> (second args)) 3 2) args)
1949 |                                n (count clause)]
1950 |                       (core/cond
1951 |                         (= 0 n) `(throw (js/Error. (core/str "No matching clause: " ~expr)))
1952 |                         (= 1 n) a
1953 |                         (= 2 n) `(if (~pred ~a ~expr)
1954 |                                    ~b
1955 |                                    ~(emit pred expr more))
1956 |                         :else `(if-let [p# (~pred ~a ~expr)]
1957 |                                  (~c p#)
1958 |                                  ~(emit pred expr more)))))
1959 |              gres (gensym "res__")]
1960 |     `(let [~gpred ~pred
1961 |            ~gexpr ~expr]
1962 |        ~(emit gpred gexpr clauses))))
1963 | 
1964 | (core/defn- assoc-test [m test expr env]
1965 |   (if (contains? m test)
1966 |     (throw
1967 |       #?(:clj (clojure.core/IllegalArgumentException.
1968 |                 (core/str "Duplicate case test constant '"
1969 |                   test "'"
1970 |                   (core/when (:line env)
1971 |                     (core/str " on line " (:line env) " "
1972 |                       cljs.analyzer/*cljs-file*))))
1973 |          :cljs (js/Error.
1974 |                  (core/str "Duplicate case test constant '"
1975 |                    test "'"
1976 |                    (core/when (:line env)
1977 |                      (core/str " on line " (:line env) " "
1978 |                        cljs.analyzer/*cljs-file*))))))
1979 |     (assoc m test expr)))
1980 | 
1981 | (core/defn- const? [env x]
1982 |   (core/let [m (core/and (core/list? x)
1983 |                          (ana/resolve-var env (last x)))]
1984 |     (core/when m (core/get m :const))))
1985 | 
1986 | (core/defmacro case
1987 |   "Takes an expression, and a set of clauses.
1988 | 
1989 |   Each clause can take the form of either:
1990 | 
1991 |   test-constant result-expr
1992 | 
1993 |   (test-constant1 ... test-constantN)  result-expr
1994 | 
1995 |   The test-constants are not evaluated. They must be compile-time
1996 |   literals, and need not be quoted.  If the expression is equal to a
1997 |   test-constant, the corresponding result-expr is returned. A single
1998 |   default expression can follow the clauses, and its value will be
1999 |   returned if no clause matches. If no default expression is provided
2000 |   and no clause matches, an Error is thrown.
2001 | 
2002 |   Unlike cond and condp, case does a constant-time dispatch, the
2003 |   clauses are not considered sequentially.  All manner of constant
2004 |   expressions are acceptable in case, including numbers, strings,
2005 |   symbols, keywords, and (ClojureScript) composites thereof. Note that since
2006 |   lists are used to group multiple constants that map to the same
2007 |   expression, a vector can be used to match a list if needed. The
2008 |   test-constants need not be all of the same type."
2009 |   [e & clauses]
2010 |   (core/let [default (if (odd? (count clauses))
2011 |                        (last clauses)
2012 |                        `(throw
2013 |                           (js/Error.
2014 |                             (core/str "No matching clause: " ~e))))
2015 |              env     &env
2016 |              pairs   (reduce
2017 |                        (core/fn [m [test expr]]
2018 |                          (core/cond
2019 |                            (seq? test)
2020 |                            (reduce
2021 |                              (core/fn [m test]
2022 |                                (core/let [test (if (core/symbol? test)
2023 |                                                  (core/list 'quote test)
2024 |                                                  test)]
2025 |                                  (assoc-test m test expr env)))
2026 |                              m test)
2027 |                            (core/symbol? test)
2028 |                            (assoc-test m (core/list 'quote test) expr env)
2029 |                            :else
2030 |                            (assoc-test m test expr env)))
2031 |                      {} (partition 2 clauses))
2032 |              esym    (gensym)
2033 |              tests   (keys pairs)]
2034 |     (core/cond
2035 |       (every? (some-fn core/number? core/string? core/char? #(const? env %)) tests)
2036 |       (core/let [no-default (if (odd? (count clauses)) (butlast clauses) clauses)
2037 |                  tests      (mapv #(if (seq? %) (vec %) [%]) (take-nth 2 no-default))
2038 |                  thens      (vec (take-nth 2 (drop 1 no-default)))]
2039 |         `(let [~esym ~e] (case* ~esym ~tests ~thens ~default)))
2040 | 
2041 |       (every? core/keyword? tests)
2042 |       (core/let [tests (core/->> tests
2043 |                          (map #(.substring (core/str %) 1))
2044 |                          vec
2045 |                          (mapv #(if (seq? %) (vec %) [%])))
2046 |                  thens (vec (vals pairs))]
2047 |         `(let [~esym (if (keyword? ~e) (.-fqn ~e) nil)]
2048 |            (case* ~esym ~tests ~thens ~default)))
2049 |       
2050 |       ;; equality
2051 |       :else
2052 |       `(let [~esym ~e]
2053 |          (cond
2054 |            ~@(mapcat (core/fn [[m c]] `((cljs.core/= ~m ~esym) ~c)) pairs)
2055 |            :else ~default)))))
2056 | 
2057 | (core/defmacro assert
2058 |   "Evaluates expr and throws an exception if it does not evaluate to
2059 |   logical true."
2060 |   ([x]
2061 |      (core/when *assert*
2062 |        `(when-not ~x
2063 |           (throw (js/Error.
2064 |                   (cljs.core/str "Assert failed: " (cljs.core/pr-str '~x)))))))
2065 |   ([x message]
2066 |      (core/when *assert*
2067 |        `(when-not ~x
2068 |           (throw (js/Error.
2069 |                   (cljs.core/str "Assert failed: " ~message "\n" (cljs.core/pr-str '~x))))))))
2070 | 
2071 | (core/defmacro for
2072 |   "List comprehension. Takes a vector of one or more
2073 |    binding-form/collection-expr pairs, each followed by zero or more
2074 |    modifiers, and yields a lazy sequence of evaluations of expr.
2075 |    Collections are iterated in a nested fashion, rightmost fastest,
2076 |    and nested coll-exprs can refer to bindings created in prior
2077 |    binding-forms.  Supported modifiers are: :let [binding-form expr ...],
2078 |    :while test, :when test.
2079 | 
2080 |   (take 100 (for [x (range 100000000) y (range 1000000) :while (< y x)]  [x y]))"
2081 |   [seq-exprs body-expr]
2082 |   (assert-args for
2083 |     (vector? seq-exprs) "a vector for its binding"
2084 |     (even? (count seq-exprs)) "an even number of forms in binding vector")
2085 |   (core/let [to-groups (core/fn [seq-exprs]
2086 |                          (reduce (core/fn [groups [k v]]
2087 |                                    (if (core/keyword? k)
2088 |                                      (conj (pop groups) (conj (peek groups) [k v]))
2089 |                                      (conj groups [k v])))
2090 |                            [] (partition 2 seq-exprs)))
2091 |              err (core/fn [& msg] (throw (ex-info (apply core/str msg) {})))
2092 |              emit-bind (core/fn emit-bind [[[bind expr & mod-pairs]
2093 |                                        & [[_ next-expr] :as next-groups]]]
2094 |                          (core/let [giter (gensym "iter__")
2095 |                                     gxs (gensym "s__")
2096 |                                     do-mod (core/fn do-mod [[[k v :as pair] & etc]]
2097 |                                              (core/cond
2098 |                                                (= k :let) `(let ~v ~(do-mod etc))
2099 |                                                (= k :while) `(when ~v ~(do-mod etc))
2100 |                                                (= k :when) `(if ~v
2101 |                                                               ~(do-mod etc)
2102 |                                                               (recur (rest ~gxs)))
2103 |                                                (core/keyword? k) (err "Invalid 'for' keyword " k)
2104 |                                                next-groups
2105 |                                                `(let [iterys# ~(emit-bind next-groups)
2106 |                                                       fs# (seq (iterys# ~next-expr))]
2107 |                                                   (if fs#
2108 |                                                     (concat fs# (~giter (rest ~gxs)))
2109 |                                                     (recur (rest ~gxs))))
2110 |                                                :else `(cons ~body-expr
2111 |                                                         (~giter (rest ~gxs)))))]
2112 |                            (if next-groups
2113 |                              #_ "not the inner-most loop"
2114 |                              `(fn ~giter [~gxs]
2115 |                                 (lazy-seq
2116 |                                   (loop [~gxs ~gxs]
2117 |                                     (core/when-first [~bind ~gxs]
2118 |                                       ~(do-mod mod-pairs)))))
2119 |                              #_"inner-most loop"
2120 |                              (core/let [gi (gensym "i__")
2121 |                                         gb (gensym "b__")
2122 |                                         do-cmod (core/fn do-cmod [[[k v :as pair] & etc]]
2123 |                                                   (core/cond
2124 |                                                     (= k :let) `(let ~v ~(do-cmod etc))
2125 |                                                     (= k :while) `(when ~v ~(do-cmod etc))
2126 |                                                     (= k :when) `(if ~v
2127 |                                                                    ~(do-cmod etc)
2128 |                                                                    (recur
2129 |                                                                      (unchecked-inc ~gi)))
2130 |                                                     (core/keyword? k)
2131 |                                                     (err "Invalid 'for' keyword " k)
2132 |                                                     :else
2133 |                                                     `(do (chunk-append ~gb ~body-expr)
2134 |                                                          (recur (unchecked-inc ~gi)))))]
2135 |                                `(fn ~giter [~gxs]
2136 |                                   (lazy-seq
2137 |                                     (loop [~gxs ~gxs]
2138 |                                       (when-let [~gxs (seq ~gxs)]
2139 |                                         (if (chunked-seq? ~gxs)
2140 |                                           (let [c# ^not-native (chunk-first ~gxs)
2141 |                                                 size# (count c#)
2142 |                                                 ~gb (chunk-buffer size#)]
2143 |                                             (if (coercive-boolean
2144 |                                                   (loop [~gi 0]
2145 |                                                     (if (< ~gi size#)
2146 |                                                       (let [~bind (-nth c# ~gi)]
2147 |                                                         ~(do-cmod mod-pairs))
2148 |                                                       true)))
2149 |                                               (chunk-cons
2150 |                                                 (chunk ~gb)
2151 |                                                 (~giter (chunk-rest ~gxs)))
2152 |                                               (chunk-cons (chunk ~gb) nil)))
2153 |                                           (let [~bind (first ~gxs)]
2154 |                                             ~(do-mod mod-pairs)))))))))))]
2155 |     `(let [iter# ~(emit-bind (to-groups seq-exprs))]
2156 |        (iter# ~(second seq-exprs)))))
2157 | 
2158 | (core/defmacro doseq
2159 |   "Repeatedly executes body (presumably for side-effects) with
2160 |   bindings and filtering as provided by \"for\".  Does not retain
2161 |   the head of the sequence. Returns nil."
2162 |   [seq-exprs & body]
2163 |   (assert-args doseq
2164 |     (vector? seq-exprs) "a vector for its binding"
2165 |     (even? (count seq-exprs)) "an even number of forms in binding vector")
2166 |   (core/let [err (core/fn [& msg] (throw (ex-info (apply core/str msg) {})))
2167 |              step (core/fn step [recform exprs]
2168 |                     (core/if-not exprs
2169 |                       [true `(do ~@body)]
2170 |                       (core/let [k (first exprs)
2171 |                                  v (second exprs)
2172 | 
2173 |                                  seqsym (gensym "seq__")
2174 |                                  recform (if (core/keyword? k) recform `(recur (next ~seqsym) nil 0 0))
2175 |                                  steppair (step recform (nnext exprs))
2176 |                                  needrec (steppair 0)
2177 |                                  subform (steppair 1)]
2178 |                         (core/cond
2179 |                           (= k :let) [needrec `(let ~v ~subform)]
2180 |                           (= k :while) [false `(when ~v
2181 |                                                  ~subform
2182 |                                                  ~@(core/when needrec [recform]))]
2183 |                           (= k :when) [false `(if ~v
2184 |                                                 (do
2185 |                                                   ~subform
2186 |                                                   ~@(core/when needrec [recform]))
2187 |                                                 ~recform)]
2188 |                           (core/keyword? k) (err "Invalid 'doseq' keyword" k)
2189 |                           :else (core/let [chunksym (with-meta (gensym "chunk__")
2190 |                                                       {:tag 'not-native})
2191 |                                            countsym (gensym "count__")
2192 |                                            isym     (gensym "i__")
2193 |                                            recform-chunk  `(recur ~seqsym ~chunksym ~countsym (unchecked-inc ~isym))
2194 |                                            steppair-chunk (step recform-chunk (nnext exprs))
2195 |                                            subform-chunk  (steppair-chunk 1)]
2196 |                                   [true `(loop [~seqsym   (seq ~v)
2197 |                                                 ~chunksym nil
2198 |                                                 ~countsym 0
2199 |                                                 ~isym     0]
2200 |                                            (if (coercive-boolean (< ~isym ~countsym))
2201 |                                              (let [~k (-nth ~chunksym ~isym)]
2202 |                                                ~subform-chunk
2203 |                                                ~@(core/when needrec [recform-chunk]))
2204 |                                              (when-let [~seqsym (seq ~seqsym)]
2205 |                                                (if (chunked-seq? ~seqsym)
2206 |                                                  (let [c# (chunk-first ~seqsym)]
2207 |                                                    (recur (chunk-rest ~seqsym) c#
2208 |                                                      (count c#) 0))
2209 |                                                  (let [~k (first ~seqsym)]
2210 |                                                    ~subform
2211 |                                                    ~@(core/when needrec [recform]))))))])))))]
2212 |     (nth (step nil (seq seq-exprs)) 1)))
2213 | 
2214 | (core/defmacro array [& rest]
2215 |   (core/let [xs-str (core/->> (repeat "~{}")
2216 |                       (take (count rest))
2217 |                       (interpose ",")
2218 |                       (apply core/str))]
2219 |     (vary-meta
2220 |       (list* 'js* (core/str "[" xs-str "]") rest)
2221 |       assoc :tag 'array)))
2222 | 
2223 | (core/defmacro make-array
2224 |   [size]
2225 |   (vary-meta
2226 |     (if (core/number? size)
2227 |       `(array ~@(take size (repeat nil)))
2228 |       `(js/Array. ~size))
2229 |     assoc :tag 'array))
2230 | 
2231 | (core/defmacro list
2232 |   ([] '(.-EMPTY cljs.core/List))
2233 |   ([x & xs]
2234 |     `(-conj (list ~@xs) ~x)))
2235 | 
2236 | (core/defmacro vector
2237 |   ([] '(.-EMPTY cljs.core/PersistentVector))
2238 |   ([& xs]
2239 |    (core/let [cnt (count xs)]
2240 |      (if (core/< cnt 32)
2241 |        `(cljs.core/PersistentVector. nil ~cnt 5
2242 |           (.-EMPTY-NODE cljs.core/PersistentVector) (array ~@xs) nil)
2243 |        (vary-meta
2244 |          `(.fromArray cljs.core/PersistentVector (array ~@xs) true)
2245 |          assoc :tag 'cljs.core/PersistentVector)))))
2246 | 
2247 | (core/defmacro array-map
2248 |   ([] '(.-EMPTY cljs.core/PersistentArrayMap))
2249 |   ([& kvs]
2250 |    (core/let [keys (map first (partition 2 kvs))]
2251 |      (if (core/and (every? #(= (:op %) :constant)
2252 |                      (map #(cljs.analyzer/analyze &env %) keys))
2253 |            (= (count (into #{} keys)) (count keys)))
2254 |        `(cljs.core/PersistentArrayMap. nil ~(clojure.core// (count kvs) 2) (array ~@kvs) nil)
2255 |        `(.fromArray cljs.core/PersistentArrayMap (array ~@kvs) true false)))))
2256 | 
2257 | (core/defmacro hash-map
2258 |   ([] `(.-EMPTY cljs.core/PersistentHashMap))
2259 |   ([& kvs]
2260 |    (core/let [pairs (partition 2 kvs)
2261 |               ks    (map first pairs)
2262 |               vs    (map second pairs)]
2263 |      (vary-meta
2264 |        `(.fromArrays cljs.core/PersistentHashMap (array ~@ks) (array ~@vs))
2265 |        assoc :tag 'cljs.core/PersistentHashMap))))
2266 | 
2267 | (core/defmacro hash-set
2268 |   ([] `(.-EMPTY cljs.core/PersistentHashSet))
2269 |   ([& xs]
2270 |     (if (core/and (core/<= (count xs) 8)
2271 |                   (every? #(= (:op %) :constant)
2272 |                     (map #(cljs.analyzer/analyze &env %) xs))
2273 |                   (= (count (into #{} xs)) (count xs)))
2274 |       `(cljs.core/PersistentHashSet. nil
2275 |          (cljs.core/PersistentArrayMap. nil ~(count xs) (array ~@(interleave xs (repeat nil))) nil)
2276 |          nil)
2277 |       (vary-meta
2278 |         `(.fromArray cljs.core/PersistentHashSet (array ~@xs) true)
2279 |         assoc :tag 'cljs.core/PersistentHashSet))))
2280 | 
2281 | (core/defn- js-obj* [kvs]
2282 |   (core/let [kvs-str (core/->> (repeat "~{}:~{}")
2283 |                        (take (count kvs))
2284 |                        (interpose ",")
2285 |                        (apply core/str))]
2286 |     (vary-meta
2287 |       (list* 'js* (core/str "{" kvs-str "}") (apply concat kvs))
2288 |       assoc :tag 'object)))
2289 | 
2290 | (core/defmacro js-obj [& rest]
2291 |   (core/let [sym-or-str? (core/fn [x] (core/or (core/symbol? x) (core/string? x)))
2292 |              filter-on-keys (core/fn [f coll]
2293 |                               (core/->> coll
2294 |                                 (filter (core/fn [[k _]] (f k)))
2295 |                                 (into {})))
2296 |              kvs (into {} (map vec (partition 2 rest)))
2297 |              sym-pairs (filter-on-keys core/symbol? kvs)
2298 |              expr->local (zipmap
2299 |                            (filter (complement sym-or-str?) (keys kvs))
2300 |                            (repeatedly gensym))
2301 |              obj (gensym "obj")]
2302 |     `(let [~@(apply concat (clojure.set/map-invert expr->local))
2303 |            ~obj ~(js-obj* (filter-on-keys core/string? kvs))]
2304 |        ~@(map (core/fn [[k v]] `(aset ~obj ~k ~v)) sym-pairs)
2305 |        ~@(map (core/fn [[k v]] `(aset ~obj ~v ~(core/get kvs k))) expr->local)
2306 |        ~obj)))
2307 | 
2308 | (core/defmacro alength [a]
2309 |   (vary-meta
2310 |     (core/list 'js* "~{}.length" a)
2311 |     assoc :tag 'number))
2312 | 
2313 | (core/defmacro amap
2314 |   "Maps an expression across an array a, using an index named idx, and
2315 |   return value named ret, initialized to a clone of a, then setting
2316 |   each element of ret to the evaluation of expr, returning the new
2317 |   array ret."
2318 |   [a idx ret expr]
2319 |   `(let [a# ~a
2320 |          ~ret (aclone a#)]
2321 |      (loop  [~idx 0]
2322 |        (if (< ~idx  (alength a#))
2323 |          (do
2324 |            (aset ~ret ~idx ~expr)
2325 |            (recur (inc ~idx)))
2326 |          ~ret))))
2327 | 
2328 | (core/defmacro areduce
2329 |   "Reduces an expression across an array a, using an index named idx,
2330 |   and return value named ret, initialized to init, setting ret to the
2331 |   evaluation of expr at each step, returning ret."
2332 |   [a idx ret init expr]
2333 |   `(let [a# ~a]
2334 |      (loop  [~idx 0 ~ret ~init]
2335 |        (if (< ~idx  (alength a#))
2336 |          (recur (inc ~idx) ~expr)
2337 |          ~ret))))
2338 | 
2339 | (core/defmacro dotimes
2340 |   "bindings => name n
2341 | 
2342 |   Repeatedly executes body (presumably for side-effects) with name
2343 |   bound to integers from 0 through n-1."
2344 |   [bindings & body]
2345 |   (core/let [i (first bindings)
2346 |              n (second bindings)]
2347 |     `(let [n# ~n]
2348 |        (loop [~i 0]
2349 |          (when (< ~i n#)
2350 |            ~@body
2351 |            (recur (inc ~i)))))))
2352 | 
2353 | (core/defn- check-valid-options
2354 |   "Throws an exception if the given option map contains keys not listed
2355 |   as valid, else returns nil."
2356 |   [options & valid-keys]
2357 |   (core/when (seq (apply disj (apply core/hash-set (keys options)) valid-keys))
2358 |     (throw
2359 |       (apply core/str "Only these options are valid: "
2360 |         (first valid-keys)
2361 |         (map #(core/str ", " %) (rest valid-keys))))))
2362 | 
2363 | (core/defmacro defmulti
2364 |   "Creates a new multimethod with the associated dispatch function.
2365 |   The docstring and attribute-map are optional.
2366 | 
2367 |   Options are key-value pairs and may be one of:
2368 |     :default    the default dispatch value, defaults to :default
2369 |     :hierarchy  the isa? hierarchy to use for dispatching
2370 |                 defaults to the global hierarchy"
2371 |   [mm-name & options]
2372 |   (core/let [docstring   (if (core/string? (first options))
2373 |                            (first options)
2374 |                            nil)
2375 |              options     (if (core/string? (first options))
2376 |                            (next options)
2377 |                            options)
2378 |              m           (if (map? (first options))
2379 |                            (first options)
2380 |                            {})
2381 |              options     (if (map? (first options))
2382 |                            (next options)
2383 |                            options)
2384 |              dispatch-fn (first options)
2385 |              options     (next options)
2386 |              m           (if docstring
2387 |                            (assoc m :doc docstring)
2388 |                            m)
2389 |              m           (if (meta mm-name)
2390 |                            (conj (meta mm-name) m)
2391 |                            m)
2392 |              mm-ns (core/-> &env :ns :name core/str)]
2393 |     (core/when (= (count options) 1)
2394 |       (throw
2395 |         #?(:clj (Exception. "The syntax for defmulti has changed. Example: (defmulti name dispatch-fn :default dispatch-value)")
2396 |            :cljs (js/Error. "The syntax for defmulti has changed. Example: (defmulti name dispatch-fn :default dispatch-value)"))))
2397 |     (core/let [options (apply core/hash-map options)
2398 |                default (core/get options :default :default)]
2399 |       (check-valid-options options :default :hierarchy)
2400 |       `(defonce ~(with-meta mm-name m)
2401 |          (let [method-table# (atom {})
2402 |                prefer-table# (atom {})
2403 |                method-cache# (atom {})
2404 |                cached-hierarchy# (atom {})
2405 |                hierarchy# (get ~options :hierarchy (cljs.core/get-global-hierarchy))]
2406 |            (cljs.core/MultiFn. (cljs.core/symbol ~mm-ns ~(name mm-name)) ~dispatch-fn ~default hierarchy#
2407 |              method-table# prefer-table# method-cache# cached-hierarchy#))))))
2408 | 
2409 | (core/defmacro defmethod
2410 |   "Creates and installs a new method of multimethod associated with dispatch-value. "
2411 |   [multifn dispatch-val & fn-tail]
2412 |   `(-add-method ~(with-meta multifn {:tag 'cljs.core/MultiFn}) ~dispatch-val (fn ~@fn-tail)))
2413 | 
2414 | (core/defmacro time
2415 |   "Evaluates expr and prints the time it took. Returns the value of expr."
2416 |   [expr]
2417 |   `(let [start# (.getTime (js/Date.))
2418 |          ret# ~expr]
2419 |      (prn (core/str "Elapsed time: " (- (.getTime (js/Date.)) start#) " msecs"))
2420 |      ret#))
2421 | 
2422 | (core/defmacro simple-benchmark
2423 |   "Runs expr iterations times in the context of a let expression with
2424 |   the given bindings, then prints out the bindings and the expr
2425 |   followed by number of iterations and total time. The optional
2426 |   argument print-fn, defaulting to println, sets function used to
2427 |   print the result. expr's string representation will be produced
2428 |   using pr-str in any case."
2429 |   [bindings expr iterations & {:keys [print-fn] :or {print-fn 'println}}]
2430 |   (core/let [bs-str   (pr-str bindings)
2431 |              expr-str (pr-str expr)]
2432 |     `(let ~bindings
2433 |        (let [start#   (.getTime (js/Date.))
2434 |              ret#     (dotimes [_# ~iterations] ~expr)
2435 |              end#     (.getTime (js/Date.))
2436 |              elapsed# (- end# start#)]
2437 |          (~print-fn (str ~bs-str ", " ~expr-str ", "
2438 |                       ~iterations " runs, " elapsed# " msecs"))))))
2439 | 
2440 | (def cs (into [] (map (comp gensym core/str core/char) (range 97 118))))
2441 | 
2442 | (core/defn- gen-apply-to-helper
2443 |   ([] (gen-apply-to-helper 1))
2444 |   ([n]
2445 |    (core/let [prop (symbol (core/str "-cljs$core$IFn$_invoke$arity$" n))
2446 |               f (symbol (core/str "cljs$core$IFn$_invoke$arity$" n))]
2447 |      (if (core/<= n 20)
2448 |        `(let [~(cs (core/dec n)) (-first ~'args)
2449 |               ~'args (-rest ~'args)]
2450 |           (if (== ~'argc ~n)
2451 |             (if (. ~'f ~prop)
2452 |               (. ~'f (~f ~@(take n cs)))
2453 |               (~'f ~@(take n cs)))
2454 |             ~(gen-apply-to-helper (core/inc n))))
2455 |        `(throw (js/Error. "Only up to 20 arguments supported on functions"))))))
2456 | 
2457 | (core/defmacro gen-apply-to []
2458 |   `(do
2459 |      (set! ~'*unchecked-if* true)
2460 |      (defn ~'apply-to [~'f ~'argc ~'args]
2461 |        (let [~'args (seq ~'args)]
2462 |          (if (zero? ~'argc)
2463 |            (~'f)
2464 |            ~(gen-apply-to-helper))))
2465 |      (set! ~'*unchecked-if* false)))
2466 | 
2467 | (core/defmacro with-out-str
2468 |   "Evaluates exprs in a context in which *print-fn* is bound to .append
2469 |   on a fresh StringBuffer.  Returns the string created by any nested
2470 |   printing calls."
2471 |   [& body]
2472 |   `(let [sb# (goog.string.StringBuffer.)]
2473 |      (binding [cljs.core/*print-newline* true
2474 |                cljs.core/*print-fn* (fn [x#] (.append sb# x#))]
2475 |        ~@body)
2476 |      (cljs.core/str sb#)))
2477 | 
2478 | (core/defmacro lazy-cat
2479 |   "Expands to code which yields a lazy sequence of the concatenation
2480 |   of the supplied colls.  Each coll expr is not evaluated until it is
2481 |   needed. 
2482 | 
2483 |   (lazy-cat xs ys zs) === (concat (lazy-seq xs) (lazy-seq ys) (lazy-seq zs))"
2484 |   [& colls]
2485 |   `(concat ~@(map #(core/list `lazy-seq %) colls)))
2486 | 
2487 | (core/defmacro js-str [s]
2488 |   (core/list 'js* "''+~{}" s))
2489 | 
2490 | (core/defmacro es6-iterable [ty]
2491 |   `(aset (.-prototype ~ty) cljs.core/ITER_SYMBOL
2492 |      (fn []
2493 |        (this-as this#
2494 |          (cljs.core/es6-iterator this#)))))
2495 | 
2496 | (core/defmacro ns-interns
2497 |   "Returns a map of the intern mappings for the namespace."
2498 |   [[quote ns]]
2499 |   (core/assert (core/and (= quote 'quote) (core/symbol? ns))
2500 |     "Argument to ns-interns must be a quoted symbol")
2501 |   `(into {}
2502 |      [~@(map
2503 |           (core/fn [[sym _]]
2504 |             `[(symbol ~(name sym)) (var ~(symbol (name ns) (name sym)))])
2505 |           (get-in @env/*compiler* [:cljs.analyzer/namespaces ns :defs]))]))
2506 | 
2507 | (core/defmacro ns-unmap
2508 |   "Removes the mappings for the symbol from the namespace."
2509 |   [[quote0 ns] [quote1 sym]]
2510 |   (core/assert (core/and (= quote0 'quote) (core/symbol? ns)
2511 |                          (= quote1 'quote) (core/symbol? sym))
2512 |     "Arguments to ns-unmap must be quoted symbols")
2513 |   (swap! env/*compiler* update-in [::ana/namespaces ns :defs] dissoc sym)
2514 |   `(js-delete ~(cljs.compiler/munge ns) ~(cljs.compiler/munge (core/str sym))))
2515 | 
2516 | (core/defmacro vswap!
2517 |   "Non-atomically swaps the value of the volatile as if:
2518 |    (apply f current-value-of-vol args). Returns the value that
2519 |    was swapped in."
2520 |   [vol f & args]
2521 |   `(-vreset! ~vol (~f (-deref ~vol) ~@args)))
2522 | 
2523 | ;; INTERNAL - do not use, only for Node.js
2524 | (core/defmacro load-file* [f]
2525 |   `(. js/goog (~'nodeGlobalRequire ~f)))
2526 | 
2527 | (core/defmacro macroexpand-1
2528 |   "If form represents a macro form, returns its expansion,
2529 |   else returns form."
2530 |   [quoted]
2531 |   (core/assert (core/= (core/first quoted) 'quote)
2532 |     "Argument to macroexpand-1 must be quoted")
2533 |   (core/let [form (second quoted)]
2534 |     `(quote ~(ana/macroexpand-1 &env form))))
2535 | 
2536 | (core/defmacro macroexpand
2537 |   "Repeatedly calls macroexpand-1 on form until it no longer
2538 |   represents a macro form, then returns it.  Note neither
2539 |   macroexpand-1 nor macroexpand expand macros in subforms."
2540 |   [quoted]
2541 |   (core/assert (core/= (core/first quoted) 'quote)
2542 |     "Argument to macroexpand must be quoted")
2543 |   (core/let [form (second quoted)
2544 |              env &env]
2545 |     (core/loop [form form form' (ana/macroexpand-1 env form)]
2546 |       (core/if-not (core/identical? form form')
2547 |         (recur form' (ana/macroexpand-1 env form'))
2548 |         `(quote ~form')))))
2549 | 
2550 | (core/defn- multi-arity-fn? [fdecl]
2551 |   (core/< 1 (count fdecl)))
2552 | 
2553 | (core/defn- variadic-fn? [fdecl]
2554 |   (core/and (= 1 (count fdecl))
2555 |             (some '#{&} (ffirst fdecl))))
2556 | 
2557 | (core/defn- variadic-fn*
2558 |   ([sym method]
2559 |    (variadic-fn* sym method true))
2560 |   ([sym [arglist & body :as method] solo]
2561 |    (core/let [sig (remove '#{&} arglist)
2562 |               restarg (gensym "seq")]
2563 |      (core/letfn [(get-delegate []
2564 |                     'cljs$core$IFn$_invoke$arity$variadic)
2565 |                   (get-delegate-prop []
2566 |                     (symbol (core/str "-" (get-delegate))))
2567 |                   (param-bind [param]
2568 |                     `[~param (^::ana/no-resolve first ~restarg)
2569 |                       ~restarg (^::ana/no-resolve next ~restarg)])
2570 |                   (apply-to []
2571 |                     (if (core/< 1 (count sig))
2572 |                       (core/let [params (repeatedly (core/dec (count sig)) gensym)]
2573 |                         `(fn
2574 |                            ([~restarg]
2575 |                             (let [~@(mapcat param-bind params)]
2576 |                               (. ~sym (~(get-delegate) ~@params ~restarg))))))
2577 |                       `(fn
2578 |                          ([~restarg]
2579 |                           (. ~sym (~(get-delegate) (seq ~restarg)))))))]
2580 |        `(do
2581 |           (set! (. ~sym ~(get-delegate-prop))
2582 |             (fn (~(vec sig) ~@body)))
2583 |           ~@(core/when solo
2584 |               `[(set! (. ~sym ~'-cljs$lang$maxFixedArity)
2585 |                   ~(core/dec (count sig)))])
2586 |           (set! (. ~sym ~'-cljs$lang$applyTo)
2587 |             ~(apply-to)))))))
2588 | 
2589 | (core/defn- variadic-fn [name meta [[arglist & body :as method] :as fdecl]]
2590 |   (core/letfn [(dest-args [c]
2591 |                  (map (core/fn [n] `(aget (js-arguments) ~n))
2592 |                    (range c)))]
2593 |     (core/let [rname (symbol (core/str ana/*cljs-ns*) (core/str name))
2594 |                sig   (remove '#{&} arglist)
2595 |                c-1   (core/dec (count sig))
2596 |                meta  (assoc meta
2597 |                        :top-fn
2598 |                        {:variadic true
2599 |                         :max-fixed-arity c-1
2600 |                         :method-params [sig]
2601 |                         :arglists (core/list arglist)
2602 |                         :arglists-meta (doall (map meta [arglist]))})]
2603 |       `(do
2604 |          (def ~(with-meta name meta)
2605 |            (fn []
2606 |              (let [argseq# (when (< ~c-1 (alength (js-arguments)))
2607 |                              (new ^::ana/no-resolve cljs.core/IndexedSeq
2608 |                                (.call js/Array.prototype.slice
2609 |                                  (js-arguments) ~c-1) 0))]
2610 |                (. ~rname
2611 |                  (~'cljs$core$IFn$_invoke$arity$variadic ~@(dest-args c-1) argseq#)))))
2612 |          ~(variadic-fn* rname method)))))
2613 | 
2614 | (core/comment
2615 |   (require '[clojure.pprint :as pp])
2616 |   (pp/pprint (variadic-fn 'foo {} '(([& xs]))))
2617 |   (pp/pprint (variadic-fn 'foo {} '(([a & xs] xs))))
2618 |   (pp/pprint (variadic-fn 'foo {} '(([a b & xs] xs))))
2619 |   (pp/pprint (variadic-fn 'foo {} '(([a [b & cs] & xs] xs))))
2620 |   )
2621 | 
2622 | (core/defn- multi-arity-fn [name meta fdecl]
2623 |   (core/letfn [(dest-args [c]
2624 |                  (map (core/fn [n] `(aget (js-arguments) ~n))
2625 |                    (range c)))
2626 |                (fixed-arity [rname sig]
2627 |                  (core/let [c (count sig)]
2628 |                    [c `(. ~rname
2629 |                          (~(symbol
2630 |                              (core/str "cljs$core$IFn$_invoke$arity$" c))
2631 |                            ~@(dest-args c)))]))
2632 |                (fn-method [[sig & body :as method]]
2633 |                  (if (some '#{&} sig)
2634 |                    (variadic-fn* name method false)
2635 |                    `(set!
2636 |                       (. ~name
2637 |                         ~(symbol (core/str "-cljs$core$IFn$_invoke$arity$"
2638 |                                    (count sig))))
2639 |                       (fn ~method))))]
2640 |     (core/let [rname    (symbol (core/str ana/*cljs-ns*) (core/str name))
2641 |                arglists (map first fdecl)
2642 |                varsig?  #(some '#{&} %)
2643 |                variadic (boolean (some varsig? arglists))
2644 |                sigs     (remove varsig? arglists)
2645 |                maxfa    (apply core/max
2646 |                           (concat
2647 |                             (map count sigs)
2648 |                             [(core/- (count (first (filter varsig? arglists))) 2)]))
2649 |                meta     (assoc meta
2650 |                           :top-fn
2651 |                           {:variadic variadic
2652 |                            :max-fixed-arity maxfa
2653 |                            :method-params sigs
2654 |                            :arglists arglists
2655 |                            :arglists-meta (doall (map meta arglists))})]
2656 |       `(do
2657 |          (def ~(with-meta name meta)
2658 |            (fn []
2659 |              (case (alength (js-arguments))
2660 |                ~@(mapcat #(fixed-arity rname %) sigs)
2661 |                ~(if variadic
2662 |                   `(let [argseq# (new ^::ana/no-resolve cljs.core/IndexedSeq
2663 |                                    (.call js/Array.prototype.slice
2664 |                                      (js-arguments) ~maxfa) 0)]
2665 |                      (. ~rname
2666 |                        (~'cljs$core$IFn$_invoke$arity$variadic
2667 |                          ~@(dest-args maxfa)
2668 |                          argseq#)))
2669 |                   `(throw (js/Error.
2670 |                             (str "Invalid arity: "
2671 |                               (alength (js-arguments)))))))))
2672 |          ~@(map fn-method fdecl)
2673 |          ;; optimization properties
2674 |          (set! (. ~name ~'-cljs$lang$maxFixedArity) ~maxfa)))))
2675 | 
2676 | (core/comment
2677 |   (require '[clojure.pprint :as pp])
2678 |   (pp/pprint (multi-arity-fn 'foo {} '(([a]) ([a b]))))
2679 |   (pp/pprint (multi-arity-fn 'foo {} '(([a]) ([a & xs]))))
2680 |   (pp/pprint (multi-arity-fn 'foo {} '(([a]) ([a [b & cs] & xs]))))
2681 |   ;; CLJS-1216
2682 |   (pp/pprint (multi-arity-fn 'foo {} '(([a]) ([a b & xs]))))
2683 |   )
2684 | 
2685 | (def
2686 |   ^{:doc "Same as (def name (core/fn [params* ] exprs*)) or (def
2687 |     name (core/fn ([params* ] exprs*)+)) with any doc-string or attrs added
2688 |     to the var metadata. prepost-map defines a map with optional keys
2689 |     :pre and :post that contain collections of pre or post conditions."
2690 |     :arglists '([name doc-string? attr-map? [params*] prepost-map? body]
2691 |                  [name doc-string? attr-map? ([params*] prepost-map? body)+ attr-map?])}
2692 |   defn (core/fn defn [&form &env name & fdecl]
2693 |          ;; Note: Cannot delegate this check to def because of the call to (with-meta name ..)
2694 |          (if (core/instance? #?(:clj clojure.lang.Symbol :cljs Symbol) name)
2695 |            nil
2696 |            (throw
2697 |              #?(:clj (IllegalArgumentException. "First argument to defn must be a symbol")
2698 |                 :cljs (js/Error. "First argument to defn must be a symbol"))))
2699 |          (core/let [m (if (core/string? (first fdecl))
2700 |                         {:doc (first fdecl)}
2701 |                         {})
2702 |                     fdecl (if (core/string? (first fdecl))
2703 |                             (next fdecl)
2704 |                             fdecl)
2705 |                     m (if (map? (first fdecl))
2706 |                         (conj m (first fdecl))
2707 |                         m)
2708 |                     fdecl (if (map? (first fdecl))
2709 |                             (next fdecl)
2710 |                             fdecl)
2711 |                     fdecl (if (vector? (first fdecl))
2712 |                             (core/list fdecl)
2713 |                             fdecl)
2714 |                     m (if (map? (last fdecl))
2715 |                         (conj m (last fdecl))
2716 |                         m)
2717 |                     fdecl (if (map? (last fdecl))
2718 |                             (butlast fdecl)
2719 |                             fdecl)
2720 |                     m (conj {:arglists (core/list 'quote (sigs fdecl))} m)
2721 |                     ;; no support for :inline
2722 |                     ;m (core/let [inline (:inline m)
2723 |                     ;             ifn (first inline)
2724 |                     ;             iname (second inline)]
2725 |                     ;    ;; same as: (if (and (= 'fn ifn) (not (symbol? iname))) ...)
2726 |                     ;    (if (if #?(:clj (clojure.lang.Util/equiv 'fn ifn)
2727 |                     ;               :cljs (= 'fn ifn))
2728 |                     ;          (if #?(:clj (core/instance? clojure.lang.Symbol iname)
2729 |                     ;                 :cljs (core/instance? Symbol iname)) false true))
2730 |                     ;      ;; inserts the same fn name to the inline fn if it does not have one
2731 |                     ;      (assoc m
2732 |                     ;        :inline (cons ifn
2733 |                     ;                  (cons (clojure.lang.Symbol/intern
2734 |                     ;                          (.concat (.getName ^clojure.lang.Symbol name) "__inliner"))
2735 |                     ;                    (next inline))))
2736 |                     ;      m))
2737 |                     m (conj (if (meta name) (meta name) {}) m)]
2738 |            (core/cond
2739 |              (multi-arity-fn? fdecl)
2740 |              (multi-arity-fn name m fdecl)
2741 | 
2742 |              (variadic-fn? fdecl)
2743 |              (variadic-fn name m fdecl)
2744 | 
2745 |              :else
2746 |              (core/list 'def (with-meta name m)
2747 |               ;;todo - restore propagation of fn name
2748 |               ;;must figure out how to convey primitive hints to self calls first
2749 |               (cons `fn fdecl))))))
2750 | 
2751 | #?(:clj  (. (var defn) (setMacro))
2752 |    :cljs (set! (. defn -cljs$lang$macro) true))
2753 | 
2754 | (core/defn defmacro
2755 |   "Like defn, but the resulting function name is declared as a
2756 |   macro and will be used as a macro by the compiler when it is
2757 |   called."
2758 |   {:arglists '([name doc-string? attr-map? [params*] body]
2759 |                [name doc-string? attr-map? ([params*] body)+ attr-map?])
2760 |    :macro true}
2761 |   [&form &env name & args]
2762 |   (core/let [prefix (core/loop [p (core/list (vary-meta name assoc :macro true)) args args]
2763 |                       (core/let [f (first args)]
2764 |                         (if (core/string? f)
2765 |                           (recur (cons f p) (next args))
2766 |                           (if (map? f)
2767 |                             (recur (cons f p) (next args))
2768 |                             p))))
2769 |              fdecl (core/loop [fd args]
2770 |                      (if (core/string? (first fd))
2771 |                        (recur (next fd))
2772 |                        (if (map? (first fd))
2773 |                          (recur (next fd))
2774 |                          fd)))
2775 |              fdecl (if (vector? (first fdecl))
2776 |                      (core/list fdecl)
2777 |                      fdecl)
2778 |              add-implicit-args (core/fn [fd]
2779 |                                  (core/let [args (first fd)]
2780 |                                    (cons (vec (cons '&form (cons '&env args))) (next fd))))
2781 |              add-args (core/fn [acc ds]
2782 |                         (if (core/nil? ds)
2783 |                           acc
2784 |                           (core/let [d (first ds)]
2785 |                             (if (map? d)
2786 |                               (conj acc d)
2787 |                               (recur (conj acc (add-implicit-args d)) (next ds))))))
2788 |              fdecl (seq (add-args [] fdecl))
2789 |              decl (core/loop [p prefix d fdecl]
2790 |                     (if p
2791 |                       (recur (next p) (cons (first p) d))
2792 |                       d))]
2793 |     (core/list 'do
2794 |       (cons `defn decl)
2795 |       (core/list 'set! `(. ~name ~'-cljs$lang$macro) true))))
2796 | 


--------------------------------------------------------------------------------
/resources/html/index.html:
--------------------------------------------------------------------------------
 1 | 
 2 | 
 3 | 
 4 |     
 5 |     
 6 | 
 7 | 
 8 |     
9 | 10 | 11 | -------------------------------------------------------------------------------- /script/brepl.clj: -------------------------------------------------------------------------------- 1 | (require '[cljs.build.api :as b]) 2 | (require '[cljs.repl :as repl]) 3 | (require '[cljs.repl.browser :as browser]) 4 | 5 | (b/build (b/inputs "src/browser") 6 | {:main 'cljs-bootstrap.dev 7 | :asset-path "/js" 8 | :output-to "resources/js/main.js" 9 | :output-dir "resources/js" 10 | :verbose true 11 | :static-fns true}) 12 | 13 | (cljs.repl/repl 14 | (browser/repl-env 15 | :static-dir ["resources/html" "resources"]) 16 | :output-dir "resources/js" 17 | :asset-path "js" 18 | :static-fns true) -------------------------------------------------------------------------------- /script/browser.clj: -------------------------------------------------------------------------------- 1 | (require '[cljs.build.api :as b]) 2 | 3 | (b/build "src/browser" 4 | {:output-to "main.js" 5 | :optimizations :simple 6 | :static-fns true 7 | :optimize-constants true 8 | :pretty-print true 9 | :verbose true}) 10 | 11 | (System/exit 0) -------------------------------------------------------------------------------- /script/build.clj: -------------------------------------------------------------------------------- 1 | (require '[cljs.build.api :as b]) 2 | 3 | (b/build "src/node" 4 | {:output-to "main.js" 5 | :target :nodejs 6 | :optimizations :simple 7 | :cache-analysis true 8 | :static-fns true 9 | :optimize-constants true 10 | :verbose true}) 11 | 12 | (System/exit 0) -------------------------------------------------------------------------------- /script/build_test.clj: -------------------------------------------------------------------------------- 1 | (require '[cljs.build.api :as b]) 2 | 3 | (b/build "src/user" 4 | {:output-to "main.js" 5 | :optimizations :simple 6 | :pretty-print true 7 | :cache-analysis true 8 | :static-fns true 9 | :optimize-constants true 10 | :verbose true}) 11 | 12 | (System/exit 0) -------------------------------------------------------------------------------- /script/repl.clj: -------------------------------------------------------------------------------- 1 | (require '[cljs.repl :as repl]) 2 | (require '[cljs.repl.node :as node]) 3 | 4 | (repl/repl (node/repl-env) 5 | :static-fns true 6 | :verbose true) -------------------------------------------------------------------------------- /src/browser/cljs_bootstrap/dev.cljs: -------------------------------------------------------------------------------- 1 | (ns cljs-bootstrap.dev 2 | (:require-macros [cljs.env.macros :refer [ensure with-compiler-env]] 3 | [cljs.analyzer.macros :refer [no-warn]] 4 | [cljs.core.async.macros :refer [go]]) 5 | (:require [cljs.js :as cljs] 6 | [cljs.pprint :refer [pprint]] 7 | [cljs.tagged-literals :as tags] 8 | [cljs.tools.reader :as r] 9 | [cljs.tools.reader.reader-types :refer [string-push-back-reader]] 10 | [cljs.analyzer :as ana] 11 | [cljs.compiler :as c] 12 | [cljs.env :as env] 13 | [cljs.reader :as edn] 14 | [cljs.core.async :refer [>! relpath name) 76 | "." (cljs.core/name (get libs name)))] 77 | (.readFile fs path "utf-8" 78 | (fn [err src] 79 | (cb (if-not err 80 | {:lang :clj :source src} 81 | (.error js/console err)))))) 82 | (cb nil))) 83 | 84 | (comment 85 | (require-macros '[cljs.env.macros :as env]) 86 | (require '[cljs.pprint :as pp] 87 | '[cljs.env :as env] 88 | '[cljs.analyzer :as ana] 89 | '[cljs.compiler :as comp] 90 | '[cljs.source-map :as sm] 91 | '[goog.object :as gobj]) 92 | 93 | (cljs/eval st '(defn foo [a b] (+ a b)) 94 | {:eval cljs/js-eval} 95 | (fn [res] 96 | (println res))) 97 | 98 | (cljs/compile st "(defprotocol IFoo (foo [this]))" 99 | (fn [js-source] 100 | (println "Source:") 101 | (println js-source))) 102 | 103 | (cljs/eval-str st 104 | "(defn foo [a b] (+ a b)) 105 | (defn bar [c d] (+ c d))" 106 | nil 107 | {:eval cljs/js-eval} 108 | (fn [res] 109 | (println res))) 110 | 111 | (cljs/eval-str st "1" 112 | nil 113 | {:eval cljs/js-eval 114 | :context :expr} 115 | (fn [res] 116 | (println res))) 117 | 118 | (cljs/eval-str st "(def x 1)" 119 | nil 120 | {:eval cljs/js-eval 121 | :context :expr 122 | :def-emits-var true} 123 | (fn [res] 124 | (println res))) 125 | 126 | (cljs/eval st '(ns foo.bar) 127 | {:eval cljs/js-eval} 128 | (fn [res] 129 | (println res))) 130 | 131 | (cljs/compile st "(defn foo\n[a b]\n(+ a b))" 'cljs.foo 132 | {:verbose true :source-map true} 133 | (fn [js-source] 134 | (println "Source:") 135 | (println js-source))) 136 | 137 | (cljs/eval-str st 138 | "(ns foo.bar (:require [hello-world.core]))\n(hello-world.core/bar 3 4)" 139 | 'foo.bar 140 | {:verbose true 141 | :source-map true 142 | :eval cljs/js-eval 143 | :load node-load} 144 | (fn [ret] 145 | (println ret))) 146 | 147 | (cljs/eval-str st 148 | "(ns foo.bar (:require-macros [hello-world.macros :refer [mult]]))\n(mult 4 4)" 149 | 'foo.bar 150 | {:verbose true 151 | :source-map true 152 | :eval cljs/js-eval 153 | :load node-load} 154 | (fn [{:keys [error] :as res}] 155 | (if error 156 | (do 157 | (println error) 158 | (println (.. error -cause -stack))) 159 | (println res)))) 160 | 161 | (cljs/eval-str st 162 | "(ns woz.noz)\n\n(defn noz []\n (.log js/console \"foo\")\n (last [1 2 5]))" 163 | 'woz.noz 164 | {:verbose true 165 | :source-map true 166 | :eval cljs/js-eval 167 | :load node-load} 168 | (fn [{:keys [error] :as res}] 169 | (if error 170 | (do 171 | (println error) 172 | (println (.. error -cause -stack))) 173 | (println res)))) 174 | 175 | (cljs/eval-str st 176 | "(ns foo.bar)\n(map inc [1 2 3])" 177 | 'foo.bar 178 | {:verbose true 179 | :source-map true 180 | :eval cljs/js-eval 181 | :load node-load} 182 | (fn [{:keys [error] :as res}] 183 | (if error 184 | (do 185 | (println error) 186 | (println (.. error -cause -stack))) 187 | (println res)))) 188 | 189 | (cljs/eval-str st 190 | "(ns foo.bar)\n\n(defn baz [] (map ffirst [1 2 3]))\n" 191 | 'foo.bar 192 | {:verbose true 193 | :source-map true 194 | :eval cljs/js-eval} 195 | (fn [{:keys [error] :as res}] 196 | (if error 197 | (do 198 | (println error) 199 | (println (.. error -cause -stack))) 200 | (println res)))) 201 | 202 | ;; decode source map 203 | ;; 2 seconds under V8 (Node.js) 204 | (time 205 | (do 206 | (sm/decode (.parse js/JSON (:core-source-map-json @st))) 207 | nil)) 208 | 209 | (cljs/file->ns "cljs/core.cljs") 210 | 211 | ) -------------------------------------------------------------------------------- /src/clojure/dotdot.clj: -------------------------------------------------------------------------------- 1 | (ns dotdot 2 | (:require [clojure.java.io :as io] 3 | [cljs.env :as env] 4 | [cljs.analyzer :as ana] 5 | [cljs.compiler :as comp] 6 | [cljs.closure :as closure] 7 | [cljs.tagged-literals :as tags] 8 | [clojure.tools.reader :as r] 9 | [clojure.tools.reader.reader-types :refer [string-push-back-reader]])) 10 | 11 | (def cenv (env/default-compiler-env)) 12 | 13 | (comment 14 | (env/with-compiler-env cenv 15 | (let [src (io/resource "cljs/core.cljc")] 16 | (closure/compile src 17 | {:output-file (closure/src-file->target-file src) 18 | :force true 19 | :mode :interactive}))) 20 | 21 | (env/with-compiler-env cenv 22 | (comp/munge 23 | (ana/resolve-var {:ns {:name 'cljs.core$macros}} 24 | 'cljs.core$macros/..))) 25 | 26 | (def f (slurp (io/resource "cljs/core.cljs"))) 27 | 28 | (string? f) 29 | 30 | ;; ~42ms on work machine 31 | (time 32 | (let [rdr (string-push-back-reader f) 33 | eof (Object.)] 34 | (binding [*ns* (create-ns 'cljs.analyzer) 35 | r/*data-readers* tags/*cljs-data-readers*] 36 | (loop [] 37 | (let [x (r/read {:eof eof} rdr)] 38 | (when-not (identical? eof x) 39 | (recur))))))) 40 | 41 | ;; ~830ms 42 | (dotimes [_ 10] 43 | (time (ana/analyze-file "cljs/core.cljs"))) 44 | 45 | ;; 2.2s 46 | (dotimes [_ 10] 47 | (time 48 | (env/ensure 49 | (closure/compile-form-seq 50 | (ana/forms-seq* 51 | (io/reader (io/resource "cljs/core.cljs"))))))) 52 | ) 53 | -------------------------------------------------------------------------------- /src/node/cljs_bootstrap/core.cljs: -------------------------------------------------------------------------------- 1 | (ns cljs-bootstrap.core 2 | (:require-macros [cljs.core] 3 | [cljs.env.macros :refer [ensure with-compiler-env]] 4 | [cljs.analyzer.macros :refer [no-warn]]) 5 | (:require [cljs.pprint :refer [pprint]] 6 | [cljs.tagged-literals :as tags] 7 | [cljs.tools.reader :as r] 8 | [cljs.tools.reader.reader-types :refer [string-push-back-reader]] 9 | [cljs.analyzer :as ana] 10 | [cljs.compiler :as c] 11 | [cljs.js :as cljs] 12 | [cljs.env :as env] 13 | [cljs.reader :as edn] 14 | [cljs.nodejs :as nodejs])) 15 | 16 | (enable-console-print!) 17 | #_(set! *target* "nodejs") 18 | 19 | (def cenv (cljs/empty-state)) 20 | #_(def fs (js/require "fs")) 21 | #_(def core (.readFileSync fs "./out/cljs/core.cljs" "utf8")) 22 | 23 | ;; 3.7s in Node.js with :simple :optimizations 24 | (defn analyze-file [f] 25 | (let [rdr (string-push-back-reader f) 26 | eof (js-obj) 27 | env (ana/empty-env)] 28 | (binding [ana/*cljs-ns* 'cljs.user 29 | *ns* (create-ns 'cljs.core) 30 | r/*data-readers* tags/*cljs-data-readers*] 31 | (with-compiler-env cenv 32 | (loop [] 33 | (let [form (r/read {:eof eof} rdr)] 34 | (when-not (identical? eof form) 35 | (ana/analyze 36 | (assoc env :ns (ana/get-namespace ana/*cljs-ns*)) 37 | form) 38 | (recur)))))))) 39 | 40 | (defn eval [s] 41 | (let [rdr (string-push-back-reader s) 42 | eof (js-obj) 43 | env (ana/empty-env)] 44 | (binding [ana/*cljs-ns* 'cljs.user 45 | *ns* (create-ns 'cljs.user) 46 | r/*data-readers* tags/*cljs-data-readers*] 47 | (with-compiler-env cenv 48 | (loop [] 49 | (let [form (r/read {:eof eof} rdr)] 50 | (when-not (identical? eof form) 51 | (println 52 | (js/eval 53 | (with-out-str 54 | (c/emit 55 | (ana/analyze 56 | (assoc env :ns (ana/get-namespace ana/*cljs-ns*)) 57 | form))))) 58 | (recur)))))))) 59 | 60 | (defn -main [& args] 61 | (eval (first args))) 62 | 63 | (set! *main-cli-fn* -main) 64 | -------------------------------------------------------------------------------- /src/user/cljs_bootstrap/test.cljs: -------------------------------------------------------------------------------- 1 | (ns cljs-bootstrap.test 2 | (:require [cljs.js :as cljs])) 3 | 4 | (set! *target* "nodejs") 5 | (enable-console-print!) 6 | 7 | (def vm (js/require "vm")) 8 | (def fs (js/require "fs")) 9 | 10 | ;; ----------------------------------------------------------------------------- 11 | ;; Main 12 | 13 | (def st (cljs/empty-state)) 14 | 15 | (defn node-eval [{:keys [name source]}] 16 | (.runInThisContext vm source (str (munge name) ".js"))) 17 | 18 | (def libs 19 | {'hello-world.core :cljs 20 | 'hello-world.macros :clj}) 21 | 22 | (defn node-load [{:keys [name macros]} cb] 23 | (if (contains? libs name) 24 | (let [path (str "src/user/" (cljs/ns->relpath name) 25 | "." (cljs.core/name (get libs name)))] 26 | (.readFile fs path "utf-8" 27 | (fn [err src] 28 | (cb (if-not err 29 | {:lang :clj :source src} 30 | (.error js/console err)))))) 31 | (cb nil))) 32 | 33 | (comment 34 | (require-macros '[cljs.env.macros :as env]) 35 | (require '[cljs.pprint :as pp] 36 | '[cljs.env :as env] 37 | '[cljs.analyzer :as ana] 38 | '[cljs.compiler :as comp] 39 | '[cljs.source-map :as sm] 40 | '[goog.object :as gobj]) 41 | 42 | (cljs/eval st '(defn foo [a b] (+ a b)) 43 | {:eval cljs/js-eval} 44 | (fn [res] 45 | (println res))) 46 | 47 | (cljs/compile st "(defprotocol IFoo (foo [this]))" 48 | (fn [js-source] 49 | (println "Source:") 50 | (println js-source))) 51 | 52 | (cljs/eval-str st 53 | "(defn foo [a b] (+ a b)) 54 | (defn bar [c d] (+ c d))" 55 | nil 56 | {:eval cljs/js-eval} 57 | (fn [res] 58 | (println res))) 59 | 60 | (cljs/eval-str st "1" 61 | nil 62 | {:eval cljs/js-eval 63 | :context :expr} 64 | (fn [res] 65 | (println res))) 66 | 67 | (cljs/eval-str st "(def x 1)" 68 | nil 69 | {:eval cljs/js-eval 70 | :context :expr 71 | :def-emits-var true} 72 | (fn [res] 73 | (println res))) 74 | 75 | (cljs/eval st '(ns foo.bar) 76 | {:eval cljs/js-eval} 77 | (fn [res] 78 | (println res))) 79 | 80 | (cljs/compile st "(defn foo\n[a b]\n(+ a b))" 'cljs.foo 81 | {:verbose true :source-map true} 82 | (fn [js-source] 83 | (println "Source:") 84 | (println js-source))) 85 | 86 | (cljs/eval-str st 87 | "(ns foo.bar (:require [hello-world.core]))\n(hello-world.core/bar 3 4)" 88 | 'foo.bar 89 | {:verbose true 90 | :source-map true 91 | :eval node-eval 92 | :load node-load} 93 | (fn [ret] 94 | (println ret))) 95 | 96 | (cljs/eval-str st 97 | "(ns foo.bar (:require-macros [hello-world.macros :refer [mult]]))\n(mult 4 4)" 98 | 'foo.bar 99 | {:verbose true 100 | :source-map true 101 | :eval node-eval 102 | :load node-load} 103 | (fn [{:keys [error] :as res}] 104 | (if error 105 | (do 106 | (println error) 107 | (println (.. error -cause -stack))) 108 | (println res)))) 109 | 110 | (cljs/eval-str st 111 | "(ns foo.bar)\n(first [1 2 3])" 112 | 'foo.bar 113 | {:verbose true 114 | :source-map true 115 | :eval node-eval 116 | :load node-load} 117 | (fn [{:keys [error] :as res}] 118 | (if error 119 | (do 120 | (println error) 121 | (println (.. error -cause -stack))) 122 | (println res)))) 123 | 124 | (cljs/eval-str st 125 | "(ns foo.bar)\n(map inc [1 2 3])" 126 | 'foo.bar 127 | {:verbose true 128 | :source-map true 129 | :eval node-eval 130 | :load node-load} 131 | (fn [{:keys [error] :as res}] 132 | (if error 133 | (do 134 | (println error) 135 | (println (.. error -cause -stack))) 136 | (println res)))) 137 | 138 | ;; decode source map 139 | ;; 2 seconds under V8 (Node.js) 140 | (time 141 | (do 142 | (sm/decode (.parse js/JSON (:core-source-map-json @st))) 143 | nil)) 144 | 145 | (cljs/file->ns "cljs/core.cljs") 146 | 147 | ) -------------------------------------------------------------------------------- /src/user/hello_world/core.cljs: -------------------------------------------------------------------------------- 1 | (ns hello-world.core) 2 | 3 | (defn bar [c d] 4 | (* c d)) -------------------------------------------------------------------------------- /src/user/hello_world/macros.clj: -------------------------------------------------------------------------------- 1 | (ns hello-world.macros) 2 | 3 | (defmacro mult [a b] 4 | `(* ~a ~b)) --------------------------------------------------------------------------------