├── test ├── cljs │ ├── cljs │ │ ├── ns_test │ │ │ ├── bar.cljs │ │ │ └── foo.cljs │ │ ├── keyword_other.cljs │ │ ├── import_test │ │ │ └── foo.cljs │ │ ├── binding_test_other_ns.cljs │ │ ├── macro_test │ │ │ └── macros.clj │ │ ├── macro_test.cljs │ │ ├── keyword_test.cljs │ │ ├── top-level.cljs │ │ ├── binding_test.cljs │ │ ├── ns_test.cljs │ │ ├── import_test.cljs │ │ ├── reducers_test.cljs │ │ ├── letfn_test.cljs │ │ └── reader_test.cljs │ ├── test_runner.cljs │ └── clojure │ │ ├── data_test.cljs │ │ └── string_test.cljs └── cljscm │ ├── cljscm │ ├── ns_test │ │ ├── bar.cljscm │ │ └── foo.cljscm │ ├── binding_test_other_ns.cljscm │ ├── import_test │ │ └── foo.cljscm │ ├── macro_test │ │ └── macros.clj │ ├── macro_test.cljscm │ ├── binding_test.cljscm │ ├── top-level.cljscm │ ├── import_test.cljscm │ ├── ns_test.cljscm │ ├── letfn_test.cljscm │ └── reader_test.cljscm │ ├── foo │ └── ns_shadow_test.cljs │ ├── test_runner.cljscm │ └── clojure │ ├── data_test.cljs │ └── string_test.cljs ├── script ├── clean ├── repl ├── repl.bat ├── browser-repl ├── repljs ├── repljs.bat ├── test-compile ├── benchmark ├── test ├── compile ├── build ├── closure-library-release │ ├── make-closure-library-jars.sh │ ├── google-closure-library.pom.template │ └── google-closure-library-third-party.pom.template └── bootstrap ├── samples └── repl │ ├── run-clojure-repl │ ├── project.clj │ └── src │ ├── build.clj │ └── clojure-repl.scm ├── .gitignore ├── devnotes ├── testing ├── bcrepl.org ├── day2.org ├── README.org ├── todo.org ├── talk.org ├── day1.org └── corelib.org ├── project.clj ├── Clojurescript.iml ├── bin ├── cljsc ├── cljsc.bat └── cljsc.clj ├── src ├── clj │ └── cljscm │ │ ├── conditional.clj │ │ ├── tagged_literals.clj │ │ ├── repl │ │ ├── reflect.clj │ │ ├── server.clj │ │ ├── rhino.clj │ │ └── browser.clj │ │ └── repl.clj └── cljscm │ ├── cljscm │ ├── polymorphic-apply.scm │ └── source-at.scm │ └── clojure │ ├── reflect.cljscm │ ├── browser │ ├── event.cljscm │ ├── repl.cljscm │ ├── dom.cljscm │ └── net.cljscm │ ├── walk.cljscm │ ├── data.cljscm │ ├── string.cljscm │ ├── set.cljscm │ ├── core │ └── reducers.cljscm │ └── zip.cljscm ├── README.md ├── pom.template.xml └── benchmark └── cljs └── benchmark_runner.cljs /test/cljs/cljs/ns_test/bar.cljs: -------------------------------------------------------------------------------- 1 | (ns cljs.ns-test.bar) 2 | 3 | (defn quux [] 123) 4 | -------------------------------------------------------------------------------- /script/clean: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | rm -rf closure 4 | rm -rf compilation 5 | rm -f lib/goog.jar -------------------------------------------------------------------------------- /test/cljscm/cljscm/ns_test/bar.cljscm: -------------------------------------------------------------------------------- 1 | (ns cljscm.ns-test.bar) 2 | 3 | (defn quux [] 123) 4 | -------------------------------------------------------------------------------- /samples/repl/run-clojure-repl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env sh 2 | gsc -e "(include \"src/clojure-repl.scm\")" - -------------------------------------------------------------------------------- /test/cljs/cljs/keyword_other.cljs: -------------------------------------------------------------------------------- 1 | (ns cljs.keyword-other) 2 | 3 | (defn foo [a b] 4 | (+ a b)) 5 | -------------------------------------------------------------------------------- /test/cljscm/cljscm/binding_test_other_ns.cljscm: -------------------------------------------------------------------------------- 1 | (ns cljscm.binding-test-other-ns) 2 | 3 | (def ^:dynamic *foo* 1) -------------------------------------------------------------------------------- /test/cljs/cljs/import_test/foo.cljs: -------------------------------------------------------------------------------- 1 | (ns cljs.import-test.foo) 2 | 3 | (defrecord Bar [x]) 4 | 5 | (deftype Quux [x]) 6 | -------------------------------------------------------------------------------- /test/cljs/cljs/binding_test_other_ns.cljs: -------------------------------------------------------------------------------- 1 | (ns cljs.binding-test-other-ns) 2 | 3 | (def ^:dynamic *foo* 1) 4 | 5 | (def bar 10) 6 | -------------------------------------------------------------------------------- /test/cljscm/cljscm/import_test/foo.cljscm: -------------------------------------------------------------------------------- 1 | (ns cljscm.import-test.foo) 2 | 3 | (defrecord Bar [x]) 4 | 5 | (deftype Quux [x]) 6 | -------------------------------------------------------------------------------- /test/cljs/cljs/macro_test/macros.clj: -------------------------------------------------------------------------------- 1 | (ns cljs.macro-test.macros 2 | (:refer-clojure :exclude [==])) 3 | 4 | (defmacro == [a b] 5 | `(+ ~a ~b)) -------------------------------------------------------------------------------- /test/cljscm/cljscm/macro_test/macros.clj: -------------------------------------------------------------------------------- 1 | (ns cljscm.macro-test.macros 2 | (:refer-clojure :exclude [==])) 3 | 4 | (defmacro == [a b] 5 | `(+ ~a ~b)) -------------------------------------------------------------------------------- /test/cljscm/cljscm/ns_test/foo.cljscm: -------------------------------------------------------------------------------- 1 | (ns cljscm.ns-test.foo) 2 | 3 | (defn baz [] 123) 4 | 5 | (def kw ::foo) 6 | 7 | (assert (= (str kw) ":cljscm.ns-test.foo/foo")) 8 | -------------------------------------------------------------------------------- /test/cljs/cljs/macro_test.cljs: -------------------------------------------------------------------------------- 1 | (ns cljs.macro-test 2 | (:refer-clojure :exclude [==]) 3 | (:use-macros [cljs.macro-test.macros :only [==]])) 4 | 5 | (defn test-macros [] 6 | (assert (= (== 1 1) 2))) -------------------------------------------------------------------------------- /test/cljscm/foo/ns_shadow_test.cljs: -------------------------------------------------------------------------------- 1 | (ns foo.ns-shadow-test) 2 | 3 | (defn bar [] 1) 4 | 5 | (defn quux [foo] 6 | (+ (foo.ns-shadow-test/bar) foo)) 7 | 8 | (defn test-shadow [] 9 | (assert (= (quux 2) 3))) -------------------------------------------------------------------------------- /test/cljscm/cljscm/macro_test.cljscm: -------------------------------------------------------------------------------- 1 | (ns cljscm.macro-test 2 | (:refer-clojure :exclude [==]) 3 | (:use-macros [cljscm.macro-test.macros :only [==]])) 4 | 5 | (defn test-macros [] 6 | (assert (= (== 1 1) 2))) -------------------------------------------------------------------------------- /test/cljscm/cljscm/binding_test.cljscm: -------------------------------------------------------------------------------- 1 | (ns cljscm.binding-test 2 | (:require [cljscm.binding-test-other-ns :as o])) 3 | 4 | (defn test-binding [] 5 | (binding [o/*foo* 2] 6 | (assert (= o/*foo* 2))) 7 | (assert (= o/*foo* 1))) -------------------------------------------------------------------------------- /test/cljs/cljs/keyword_test.cljs: -------------------------------------------------------------------------------- 1 | (ns cljs.keyword-test 2 | (:require [cljs.keyword-other :as other])) 3 | 4 | (defn test-keyword [] 5 | (assert (= ::bar :cljs.keyword-test/bar)) 6 | (assert (= ::other/foo :cljs.keyword-other/foo))) 7 | -------------------------------------------------------------------------------- /test/cljs/cljs/ns_test/foo.cljs: -------------------------------------------------------------------------------- 1 | (ns cljs.ns-test.foo) 2 | 3 | (defn baz [] 123) 4 | 5 | (def kw ::foo) 6 | (def qkw '::foo) 7 | 8 | (assert (= (str kw) ":cljs.ns-test.foo/foo")) 9 | (assert (= (str qkw) ":cljs.ns-test.foo/foo")) 10 | -------------------------------------------------------------------------------- /test/cljs/cljs/top-level.cljs: -------------------------------------------------------------------------------- 1 | (ns cljs.top-level) 2 | 3 | (let [foo 1] 4 | (defn bar [] 5 | foo)) 6 | 7 | (let [foo 2] 8 | (defn baz [] 9 | foo)) 10 | 11 | (defn test [] 12 | (assert (= (bar) 1)) 13 | (assert (= (baz) 2))) -------------------------------------------------------------------------------- /test/cljscm/cljscm/top-level.cljscm: -------------------------------------------------------------------------------- 1 | (ns cljscm.top-level) 2 | 3 | (let [foo 1] 4 | (defn bar [] 5 | foo)) 6 | 7 | (let [foo 2] 8 | (defn baz [] 9 | foo)) 10 | 11 | (defn test [] 12 | (assert (= (bar) 1)) 13 | (assert (= (baz) 2))) -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /pom.xml 2 | *jar 3 | /lib 4 | closure 5 | /core.js 6 | /coreadvanced.js 7 | /coresimple.js 8 | /out 9 | /scratch 10 | /samples/*/scm 11 | target/ 12 | .repl 13 | .lein-deps-sum 14 | .lein-repl-history 15 | *.swp 16 | *.zip 17 | *.o* 18 | clojurescript_release_* 19 | closure-release-* 20 | -------------------------------------------------------------------------------- /script/repl: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | if [ "$CLOJURESCRIPT_HOME" = "" ]; then 4 | CLOJURESCRIPT_HOME="`dirname $0`/.." 5 | fi 6 | 7 | CLJSC_CP='' 8 | for next in lib/*: src/clj: src/cljs: test/cljs; do 9 | CLJSC_CP="${CLJSC_CP}${CLOJURESCRIPT_HOME}/${next}" 10 | done 11 | 12 | java -server -cp "$CLJSC_CP" clojure.main 13 | 14 | -------------------------------------------------------------------------------- /devnotes/testing: -------------------------------------------------------------------------------- 1 | Definitely a work-in-progress. 2 | 3 | To run tests before you commit: 4 | 5 | script/test 6 | 7 | To add tests: 8 | 9 | * Create test fiels in the test/cljs directory. 10 | * Write fns that throw an exception on failure. 11 | * Call those fns from test/cljs/cljs/test_runner.cljs 12 | 13 | 14 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject ca.takeoutweight/clojure-scheme "0.1.0-SNAPSHOT" 2 | :description "Clojure to Gambit Scheme Compiler" 3 | :source-paths ["src/clj", "src/cljscm", "test/cljscm"] 4 | :profiles {:dev {:plugins [[lein-swank "1.4.5"] 5 | [lein-pprint "1.0.0"]]}} 6 | :dependencies [[org.clojure/clojure "1.5.0"]]) -------------------------------------------------------------------------------- /test/cljs/cljs/binding_test.cljs: -------------------------------------------------------------------------------- 1 | (ns cljs.binding-test 2 | (:require [cljs.binding-test-other-ns :as o])) 3 | 4 | (defn test-binding [] 5 | (binding [o/*foo* 2] 6 | (assert (= o/*foo* 2))) 7 | (assert (= o/*foo* 1))) 8 | 9 | (defn test-with-redefs [] 10 | (with-redefs [o/bar 2] 11 | (assert (= o/bar 2))) 12 | (assert (= o/bar 10))) 13 | -------------------------------------------------------------------------------- /test/cljs/cljs/ns_test.cljs: -------------------------------------------------------------------------------- 1 | (ns cljs.ns-test 2 | (:refer-clojure :exclude [+]) 3 | (:require [cljs.ns-test.foo :refer [baz]]) 4 | (:use [cljs.ns-test.bar :only [quux]])) 5 | 6 | (def + -) 7 | 8 | (defn test-ns [] 9 | (assert (= 4 (clojure.core/+ 2 1 1))) 10 | (assert (= 0 (cljs.ns-test/+ 2 1 1))) 11 | (assert (= 0 (+ 2 1 1))) 12 | (assert (= 123 (baz))) 13 | (assert (= 123 (quux))) 14 | :ok) 15 | -------------------------------------------------------------------------------- /samples/repl/project.clj: -------------------------------------------------------------------------------- 1 | (defproject ca.takeoutweight/cljscm-sample-repl "0.1.0-SNAPSHOT" 2 | :description "" 3 | :profiles {:dev {:plugins [[lein-swank "1.4.5"] 4 | [lein-pprint "1.0.0"]]}} 5 | :dependencies [[org.clojure/clojure "1.5.0"] 6 | [ca.takeoutweight/clojure-scheme "0.1.0-SNAPSHOT"] 7 | [org.apache.commons/commons-io "1.3.2"]] 8 | :main build) 9 | -------------------------------------------------------------------------------- /script/repl.bat: -------------------------------------------------------------------------------- 1 | @echo off 2 | setLocal EnableDelayedExpansion 3 | 4 | if "%CLOJURESCRIPT_HOME%" == "" set CLOJURESCRIPT_HOME=%~dp0..\ 5 | 6 | set CLASSPATH=%CLOJURESCRIPT_HOME%src\clj;%CLOJURESCRIPT_HOME%src\cljs" 7 | for /R "%CLOJURESCRIPT_HOME%\lib" %%a in (*.jar) do ( 8 | set CLASSPATH=!CLASSPATH!;%%a 9 | ) 10 | set CLASSPATH=!CLASSPATH!" 11 | 12 | java -server -cp "%CLASSPATH%" clojure.main 13 | 14 | -------------------------------------------------------------------------------- /test/cljs/cljs/import_test.cljs: -------------------------------------------------------------------------------- 1 | (ns cljs.import-test 2 | (:import goog.math.Long 3 | cljs.import-test.foo.Bar 4 | cljs.import-test.foo.Quux)) 5 | 6 | (defn test-import [] 7 | (assert (fn? Long)) 8 | (assert (.equals (Long. 4 6) (.add (Long. 1 2) (Long. 3 4)))) 9 | (assert (= "12" (str (Long/fromInt 12)))) 10 | (assert (= 12 (.-x (Bar. 12)))) 11 | (assert (= 12 (.-x (Quux. 12))))) 12 | -------------------------------------------------------------------------------- /test/cljscm/cljscm/import_test.cljscm: -------------------------------------------------------------------------------- 1 | (ns cljscm.import-test 2 | (:import goog.math.Long 3 | cljscm.import-test.foo.Bar 4 | cljscm.import-test.foo.Quux)) 5 | 6 | (defn test-import [] 7 | (assert (fn? Long)) 8 | (assert (.equals (Long. 4 6) (.add (Long. 1 2) (Long. 3 4)))) 9 | (assert (= "12" (Long/fromInt 12))) 10 | (assert (= 12 (.-x (Bar. 12)))) 11 | (assert (= 12 (.-x (Quux. 12))))) 12 | -------------------------------------------------------------------------------- /test/cljscm/cljscm/ns_test.cljscm: -------------------------------------------------------------------------------- 1 | (ns cljscm.ns-test 2 | (:refer-clojure :exclude [+]) 3 | (:require [cljscm.ns-test.foo :refer [baz]]) 4 | (:use [cljscm.ns-test.bar :only [quux]])) 5 | 6 | (def + -) 7 | 8 | (defn test-ns [] 9 | (assert (= 4 (clojure.core/+ 2 1 1))) 10 | (assert (= 0 (cljscm.ns-test/+ 2 1 1))) 11 | (assert (= 0 (+ 2 1 1))) 12 | (assert (= 123 (baz))) 13 | (assert (= 123 (quux))) 14 | :ok) 15 | -------------------------------------------------------------------------------- /script/browser-repl: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | if [ "$CLOJURESCRIPT_HOME" = "" ]; then 4 | CLOJURESCRIPT_HOME="`dirname $0`/.." 5 | fi 6 | 7 | CLJSC_CP='' 8 | for next in lib/*: src/clj: src/cljs: test/cljs; do 9 | CLJSC_CP=$CLJSC_CP$CLOJURESCRIPT_HOME'/'$next 10 | done 11 | 12 | java -server -cp $CLJSC_CP clojure.main -e " 13 | (require '[cljs.repl :as r]) 14 | (require '[cljs.repl.browser :as b]) 15 | (r/repl (b/repl-env)) 16 | " 17 | -------------------------------------------------------------------------------- /script/repljs: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | if [ "$CLOJURESCRIPT_HOME" = "" ]; then 4 | CLOJURESCRIPT_HOME="`dirname $0`/.." 5 | fi 6 | 7 | CLJSC_CP='' 8 | for next in lib/*: src/clj: src/cljs: test/cljs; do 9 | CLJSC_CP="${CLJSC_CP}${CLOJURESCRIPT_HOME}/${next}" 10 | done 11 | 12 | java -server -cp "$CLJSC_CP" clojure.main -e \ 13 | "(require '[cljs.repl :as repl]) 14 | (require '[cljs.repl.rhino :as rhino]) 15 | (repl/repl (rhino/repl-env) :warn-on-undeclared true)" 16 | -------------------------------------------------------------------------------- /Clojurescript.iml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | -------------------------------------------------------------------------------- /test/cljs/cljs/reducers_test.cljs: -------------------------------------------------------------------------------- 1 | (ns cljs.reducers-test 2 | (:require 3 | [clojure.core.reducers :as r])) 4 | 5 | (defn test-builtin-impls [] 6 | (assert (= 0 (r/fold + nil))) 7 | (assert (= [1 2 3 4] (seq (r/reduce r/append! (r/cat) [1 2 3 4])))) 8 | (assert (= 10 (r/reduce + (array 1 2 3 4)))) 9 | (assert (= 11 (r/reduce + 1 (array 1 2 3 4)))) 10 | (assert (= 10 (r/reduce + (list 1 2 3 4)))) 11 | (assert (= 11 (r/reduce + 1 (list 1 2 3 4))))) 12 | 13 | (defn test-all [] 14 | (test-builtin-impls)) 15 | -------------------------------------------------------------------------------- /test/cljs/cljs/letfn_test.cljs: -------------------------------------------------------------------------------- 1 | (ns cljs.letfn-test) 2 | 3 | (defn test-letfn [] 4 | (letfn [(ev? [x] 5 | (if (zero? x) 6 | true 7 | (od? (dec x)))) 8 | (od? [x] 9 | (if (zero? x) 10 | false 11 | (ev? (dec x))))] 12 | (assert (ev? 0)) 13 | (assert (ev? 10)) 14 | (assert (not (ev? 1))) 15 | (assert (not (ev? 11))) 16 | (assert (not (od? 0))) 17 | (assert (not (od? 10))) 18 | (assert (od? 1)) 19 | (assert (od? 11)))) 20 | -------------------------------------------------------------------------------- /test/cljscm/cljscm/letfn_test.cljscm: -------------------------------------------------------------------------------- 1 | (ns cljscm.letfn-test) 2 | 3 | (defn test-letfn [] 4 | (letfn [(ev? [x] 5 | (if (zero? x) 6 | true 7 | (od? (dec x)))) 8 | (od? [x] 9 | (if (zero? x) 10 | false 11 | (ev? (dec x))))] 12 | (assert (ev? 0)) 13 | (assert (ev? 10)) 14 | (assert (not (ev? 1))) 15 | (assert (not (ev? 11))) 16 | (assert (not (od? 0))) 17 | (assert (not (od? 10))) 18 | (assert (od? 1)) 19 | (assert (od? 11)))) 20 | -------------------------------------------------------------------------------- /script/repljs.bat: -------------------------------------------------------------------------------- 1 | @echo off 2 | setLocal EnableDelayedExpansion 3 | 4 | if "%CLOJURESCRIPT_HOME%" == "" set CLOJURESCRIPT_HOME=%~dp0..\ 5 | 6 | set CLASSPATH=%CLOJURESCRIPT_HOME%src\clj;%CLOJURESCRIPT_HOME%src\cljs" 7 | for /R "%CLOJURESCRIPT_HOME%\lib" %%a in (*.jar) do ( 8 | set CLASSPATH=!CLASSPATH!;%%a 9 | ) 10 | set CLASSPATH=!CLASSPATH!" 11 | 12 | set REPL_CLJ="(require '[cljs.repl :as repl])(require '[cljs.repl.rhino :as rhino])(repl/repl (rhino/repl-env))" 13 | 14 | java -server -cp "%CLASSPATH%" clojure.main -e %REPL_CLJ% 15 | -------------------------------------------------------------------------------- /bin/cljsc: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | # Compile a single cljs file or a directory of cljs files into a 4 | # single JavaScript file. 5 | 6 | if [ "$CLOJURESCRIPT_HOME" = "" ]; then 7 | CLOJURESCRIPT_HOME="`dirname $0`/.." 8 | fi 9 | 10 | CLJSC_CP='' 11 | for next in lib/*: src/clj: src/cljs: test/cljs; do 12 | CLJSC_CP="${CLJSC_CP}${CLOJURESCRIPT_HOME}/${next}" 13 | done 14 | 15 | if test "$#" -eq 0 16 | then 17 | echo 'Usage: cljsc ' 18 | echo ' cljsc "{:optimizations :advanced}"' 19 | else 20 | java -server -cp "$CLJSC_CP" clojure.main "$CLOJURESCRIPT_HOME/bin/cljsc.clj" "$@" 21 | fi 22 | -------------------------------------------------------------------------------- /bin/cljsc.bat: -------------------------------------------------------------------------------- 1 | 2 | @echo off 3 | setLocal EnableDelayedExpansion 4 | 5 | if "%CLOJURESCRIPT_HOME%" == "" set CLOJURESCRIPT_HOME=%~dp0..\ 6 | 7 | set CLASSPATH=%CLOJURESCRIPT_HOME%src\clj;%CLOJURESCRIPT_HOME%src\cljs" 8 | for /R "%CLOJURESCRIPT_HOME%\lib" %%a in (*.jar) do ( 9 | set CLASSPATH=!CLASSPATH!;%%a 10 | ) 11 | set CLASSPATH=!CLASSPATH!" 12 | 13 | if (%1) == () ( 14 | echo Usage: "cljsc > out.js" 15 | echo "cljsc {:optimiztions :advanced} > out.js" 16 | ) else ( 17 | java -server -cp "%CLASSPATH%" clojure.main "%CLOJURESCRIPT_HOME%\bin\cljsc.clj" %* 18 | ) 19 | -------------------------------------------------------------------------------- /script/test-compile: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | echo "Generating sample javascript" 4 | mkdir compilation 5 | 6 | cat >compilation/test.js < out/core-benchmark.js 7 | bin/cljsc benchmark "{:optimizations :advanced}" >out/core-advanced-benchmark.js 8 | 9 | if [ "$V8_HOME" = "" ]; then 10 | echo "V8_HOME not set, skipping V8 benchmarks" 11 | else 12 | echo "Benchmarking with V8" 13 | "${V8_HOME}/d8" out/core-advanced-benchmark.js 14 | # TODO: figure out path problem when not in advanced mode 15 | # "${V8_HOME}/d8" out/core-benchmark.js 16 | fi 17 | 18 | if [ "$SPIDERMONKEY_HOME" = "" ]; then 19 | echo "SPIDERMONKEY_HOME not set, skipping SpiderMonkey benchmarks" 20 | else 21 | echo "Benchmarking with SpiderMonkey" 22 | "${SPIDERMONKEY_HOME}/js" -m -n -a -f out/core-advanced-benchmark.js 23 | fi 24 | 25 | if [ "$JSC_HOME" = "" ]; then 26 | echo "JSC_HOME not set, skipping JavaScriptCore benchmarks" 27 | else 28 | echo "Benchmarking with JavaScriptCore" 29 | "${JSC_HOME}/jsc" -f out/core-advanced-benchmark.js 30 | fi 31 | -------------------------------------------------------------------------------- /src/clj/cljscm/tagged_literals.clj: -------------------------------------------------------------------------------- 1 | (ns cljscm.tagged-literals 2 | (:require [clojure.instant :as inst])) 3 | 4 | (defn read-queue 5 | [form] 6 | (assert (vector? form) "Queue literal expects a vector for its elements.") 7 | (list 'cljscm.core/into 'cljscm.core.PersistentQueue/EMPTY form)) 8 | 9 | (defn read-uuid 10 | [form] 11 | (assert (string? form) "UUID literal expects a string as its representation.") 12 | (try 13 | (let [uuid (java.util.UUID/fromString form)] 14 | (list (symbol "UUID.") form)) 15 | (catch Throwable e 16 | (throw (RuntimeException. (.getMessage e)))))) 17 | 18 | (defn read-inst 19 | [form] 20 | (assert (string? form) "Instance literal expects a string for its timestamp.") 21 | (try 22 | (let [^java.util.Date d (inst/read-instant-date form)] 23 | (list (symbol "js/Date.") (.getTime d))) 24 | (catch Throwable e 25 | (throw (RuntimeException. (.getMessage e)))))) 26 | 27 | (def ^:dynamic *cljs-data-readers* 28 | {'queue read-queue 29 | 'uuid read-uuid 30 | 'inst read-inst}) 31 | -------------------------------------------------------------------------------- /script/test: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | rm -rf out 4 | mkdir -p out 5 | 6 | possible=3 7 | ran=0 8 | 9 | #bin/cljsc test >out/core-test.js 10 | bin/cljsc test "{:optimizations :advanced}" >out/core-advanced-test.js 11 | 12 | if [ "$V8_HOME" = "" ]; then 13 | echo "V8_HOME not set, skipping V8 tests" 14 | else 15 | echo "Testing with V8" 16 | "${V8_HOME}/d8" out/core-advanced-test.js 17 | # TODO: figure out path problem when not in advanced mode 18 | # "${V8_HOME}/d8" out/core-test.js 19 | ran=$[ran+1] 20 | fi 21 | 22 | if [ "$SPIDERMONKEY_HOME" = "" ]; then 23 | echo "SPIDERMONKEY_HOME not set, skipping SpiderMonkey tests" 24 | else 25 | echo "Testing with SpiderMonkey" 26 | ${SPIDERMONKEY_HOME}/js -m -n -a -f out/core-advanced-test.js 27 | ran=$[ran+1] 28 | fi 29 | 30 | if [ "$JSC_HOME" = "" ]; then 31 | echo "JSC_HOME not set, skipping JavaScriptCore tests" 32 | else 33 | echo "Testing with JavaScriptCore" 34 | "${JSC_HOME}/jsc" -f out/core-advanced-test.js 35 | ran=$[ran+1] 36 | fi 37 | 38 | echo "Tested with $ran out of $possible possible js targets" 39 | -------------------------------------------------------------------------------- /bin/cljsc.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | (require '[cljs.closure :as closure]) 10 | 11 | (defn transform-cl-args 12 | [args] 13 | (let [source (first args) 14 | opts-string (apply str (interpose " " (rest args))) 15 | options (when (> (count opts-string) 1) 16 | (try (read-string opts-string) 17 | (catch Exception e (println e))))] 18 | {:source source :options (merge {:output-to :print} options)})) 19 | 20 | (let [args (transform-cl-args *command-line-args*)] 21 | (closure/build (:source args) (:options args)) 22 | (.flush *out*) 23 | (shutdown-agents) 24 | (System/exit 0)) 25 | -------------------------------------------------------------------------------- /devnotes/day2.org: -------------------------------------------------------------------------------- 1 | * ClojureScript Day #2 2 | * Welcome Thortech! 3 | ** Eric, Frank and Tom 4 | *** Long time cohorts 5 | * Tips 6 | ** Don't define things in terms of undefined things 7 | *** someone else will just trip over later 8 | ** Test 9 | *** nil 10 | ** Encapsulate use of -methods in a single place 11 | ** Where's the global namespace? 12 | * Where are we at 13 | * Where are we going 14 | ** [[file:corelib.org][Core lib punchlist]] 15 | ** [[file:~/dev/clojurescript/todo.org][To do]] 16 | ** [[https://github.com/relevance/clojurescript/issues][Tickets]] 17 | * Release 1 18 | ** Make goog-compatible libs work 19 | ** Data structures 20 | *** work but are not optimal for large instances 21 | *** persistent guarantees 22 | ** seq library 23 | ** associative library 24 | ** indexed library 25 | ** atoms 26 | ** binding 27 | ** great tooling 28 | *** push button 29 | ** reader? 30 | *** print-read 31 | ** regex 32 | * Release 2 33 | ** DOM manipulation 34 | ** Can I use jQuery? 35 | ** bitops 36 | ** multimethods 37 | ** hierarchy 38 | ** reader + record support 39 | ** unchecked 40 | ** bitops 41 | ** print 42 | ** eventing value add 43 | ** DOM value add 44 | ** UI value add 45 | -------------------------------------------------------------------------------- /test/cljs/test_runner.cljs: -------------------------------------------------------------------------------- 1 | (ns test-runner 2 | (:require [cljs.core-test :as core-test] 3 | [cljs.reader-test :as reader-test] 4 | [cljs.binding-test :as binding-test] 5 | [cljs.ns-test :as ns-test] 6 | [clojure.string-test :as string-test] 7 | [clojure.data-test :as data-test] 8 | [cljs.macro-test :as macro-test] 9 | [cljs.letfn-test :as letfn-test] 10 | [foo.ns-shadow-test :as ns-shadow-test] 11 | [cljs.top-level :as top-level] 12 | [cljs.reducers-test :as reducers-test] 13 | [cljs.keyword-test :as keyword-test] 14 | [cljs.import-test :as import-test])) 15 | 16 | (set-print-fn! js/print) 17 | 18 | (core-test/test-stuff) 19 | (reader-test/test-reader) 20 | (string-test/test-string) 21 | (data-test/test-data) 22 | (binding-test/test-binding) 23 | (binding-test/test-with-redefs) 24 | (ns-test/test-ns) 25 | (macro-test/test-macros) 26 | (letfn-test/test-letfn) 27 | (ns-shadow-test/test-shadow) 28 | (top-level/test) 29 | (reducers-test/test-all) 30 | (keyword-test/test-keyword) 31 | (import-test/test-import) 32 | 33 | (println "Tests completed without exception") 34 | 35 | 36 | -------------------------------------------------------------------------------- /test/cljs/clojure/data_test.cljs: -------------------------------------------------------------------------------- 1 | (ns clojure.data-test 2 | (:require [clojure.data :refer [diff]])) 3 | 4 | (defn test-data [] 5 | (assert (= [nil nil nil] (diff nil nil))) 6 | (assert (= [1 2 nil] (diff 1 2))) 7 | (assert (= [nil nil [1 2 3]] (diff [1 2 3] '(1 2 3)))) 8 | (assert (= [1 [:a :b] nil] (diff 1 [:a :b]))) 9 | (assert (= [{:a 1} :b nil] (diff {:a 1} :b))) 10 | (assert (= [:team #{:p1 :p2} nil] (diff :team #{:p1 :p2}))) 11 | (assert (= [{0 :a} [:a] nil] (diff {0 :a} [:a]))) 12 | (assert (= [nil [nil 2] [1]] (diff [1] [1 2]))) 13 | (assert (= [nil nil [1 2]] (diff [1 2] (into-array [1 2])))) 14 | (assert (= [#{:a} #{:b} #{:c :d}] (diff #{:a :c :d} #{:b :c :d}))) 15 | (assert (= [nil nil {:a 1}] (diff {:a 1} {:a 1}))) 16 | (assert (= [{:a #{2}} {:a #{4}} {:a #{3}}] (diff {:a #{2 3}} {:a #{3 4}}))) 17 | (assert (= [nil nil [1 2]] (diff [1 2] (into-array [1 2])))) 18 | (assert (= [nil nil [1 2]] (diff (into-array [1 2]) [1 2]))) 19 | (assert (= [{:a {:c [1]}} {:a {:c [0]}} {:a {:c [nil 2] :b 1}}] 20 | (diff {:a {:b 1 :c [1 2]}} {:a {:b 1 :c [0 2]}}))) 21 | (assert (= [{:a nil} {:a false} {:b nil :c false}] 22 | (diff {:a nil :b nil :c false} {:a false :b nil :c false})))) 23 | -------------------------------------------------------------------------------- /test/cljscm/clojure/data_test.cljs: -------------------------------------------------------------------------------- 1 | (ns clojure.data-test 2 | (:require [clojure.data :refer [diff]])) 3 | 4 | (defn test-data [] 5 | (assert (= [nil nil nil] (diff nil nil))) 6 | (assert (= [1 2 nil] (diff 1 2))) 7 | (assert (= [nil nil [1 2 3]] (diff [1 2 3] '(1 2 3)))) 8 | (assert (= [1 [:a :b] nil] (diff 1 [:a :b]))) 9 | (assert (= [{:a 1} :b nil] (diff {:a 1} :b))) 10 | (assert (= [:team #{:p1 :p2} nil] (diff :team #{:p1 :p2}))) 11 | (assert (= [{0 :a} [:a] nil] (diff {0 :a} [:a]))) 12 | (assert (= [nil [nil 2] [1]] (diff [1] [1 2]))) 13 | (assert (= [nil nil [1 2]] (diff [1 2] (into-array [1 2])))) 14 | (assert (= [#{:a} #{:b} #{:c :d}] (diff #{:a :c :d} #{:b :c :d}))) 15 | (assert (= [nil nil {:a 1}] (diff {:a 1} {:a 1}))) 16 | (assert (= [{:a #{2}} {:a #{4}} {:a #{3}}] (diff {:a #{2 3}} {:a #{3 4}}))) 17 | (assert (= [nil nil [1 2]] (diff [1 2] (into-array [1 2])))) 18 | (assert (= [nil nil [1 2]] (diff (into-array [1 2]) [1 2]))) 19 | (assert (= [{:a {:c [1]}} {:a {:c [0]}} {:a {:c [nil 2] :b 1}}] 20 | (diff {:a {:b 1 :c [1 2]}} {:a {:b 1 :c [0 2]}}))) 21 | (assert (= [{:a nil} {:a false} {:b nil :c false}] 22 | (diff {:a nil :b nil :c false} {:a false :b nil :c false})))) 23 | -------------------------------------------------------------------------------- /samples/repl/src/build.clj: -------------------------------------------------------------------------------- 1 | (ns build 2 | (:require [cljscm.compiler :as comp] 3 | [clojure.java.io :as io] 4 | [clojure.string :as string])) 5 | 6 | (defn build-file [fln] 7 | (println "building " fln) 8 | (binding [comp/*emit-source-loc?* true] 9 | (comp/compile-file* (io/resource fln) 10 | (->> (string/replace fln #"\.clj.*" ".scm") 11 | (str "scm/") 12 | (io/file) 13 | (comp/mkdirs))))) 14 | 15 | (defn copy-file [fln] 16 | (println "copying " fln) 17 | (org.apache.commons.io.FileUtils/copyURLToFile 18 | (io/resource fln) 19 | (-> (str "scm/" fln) 20 | (io/file) 21 | (comp/mkdirs)))) 22 | 23 | (defn build-repl [] 24 | (build-file "cljscm/core.cljscm") 25 | (build-file "cljscm/core_macros.clj") 26 | (build-file "cljscm/reader.cljscm") 27 | (build-file "clojure/walk.cljscm") 28 | (build-file "clojure/string.cljscm") 29 | (build-file "cljscm/conditional.clj") 30 | (build-file "cljscm/analyzer.clj") 31 | (build-file "cljscm/compiler.clj") 32 | (copy-file "cljscm/polymorphic-apply.scm") 33 | (copy-file "cljscm/source-at.scm")) 34 | 35 | (defn -main [] (build-repl)) 36 | -------------------------------------------------------------------------------- /src/cljscm/cljscm/polymorphic-apply.scm: -------------------------------------------------------------------------------- 1 | (define (##apply-global-with-procedure-check-nary gv . args) 2 | (##declare (not interrupts-enabled)) 3 | (polymorphic-apply-with-procedure-check (##global-var-ref gv) args)) 4 | 5 | (define (##apply-with-procedure-check-nary oper . args) 6 | (##declare (not interrupts-enabled)) 7 | (polymorphic-apply-with-procedure-check oper args)) 8 | 9 | (define (##apply-with-procedure-check oper args) 10 | (##declare (not interrupts-enabled)) 11 | (if (##procedure? oper) 12 | (##apply oper args) 13 | (polymorphic-invoke oper args))) 14 | 15 | (define (polymorphic-apply-with-procedure-check oper args) 16 | (##declare (not interrupts-enabled)) 17 | (if (##procedure? oper) 18 | (##apply oper args) 19 | (polymorphic-invoke oper args))) 20 | 21 | (define (polymorphic-invoke oper args) 22 | (##declare (not interrupts-enabled)) 23 | (if (eqv? #!void oper) 24 | (raise "-invoke called on nil") 25 | (cljscm.core/-invoke oper args))) 26 | 27 | ;This seems to be necessary for interpreted code. Compiled code uses above procedures. 28 | (let ((old-handler (current-exception-handler))) 29 | (current-exception-handler 30 | (lambda (e) 31 | (if (nonprocedure-operator-exception? e) 32 | (let ((oper (nonprocedure-operator-exception-operator e)) 33 | (args (nonprocedure-operator-exception-arguments e))) 34 | (polymorphic-invoke oper args)) 35 | (old-handler e))))) 36 | -------------------------------------------------------------------------------- /src/cljscm/cljscm/source-at.scm: -------------------------------------------------------------------------------- 1 | (##define-syntax source-at 2 | (lambda (source-at-form) 3 | 4 | (define (unwrap x) 5 | (if (##source? x) (##source-code x) x)) 6 | 7 | (define (wrap path line col code) 8 | (##make-source 9 | code 10 | (##make-locat 11 | (##path->container path) 12 | (##make-filepos (- line 1) (- col 1) 0)))) 13 | 14 | (define (rewrap-list code) 15 | (cond ((null? code) 16 | code) 17 | ((pair? code) 18 | (cons (rewrap (car code)) 19 | (rewrap-list (cdr code)))) 20 | (else 21 | (rewrap code)))) 22 | 23 | (define (rewrap form) 24 | 25 | (define (return code) 26 | (if (##source? form) 27 | (##make-source code (##source-locat form)) 28 | code)) 29 | 30 | (let ((code (unwrap form))) 31 | (cond ((pair? code) 32 | (if (eq? (unwrap (car code)) 'source-at) 33 | 34 | (rewrap (apply (lambda (_ path line col subform) 35 | (wrap (unwrap path) 36 | (unwrap line) 37 | (unwrap col) 38 | (unwrap (rewrap subform)))) 39 | code)) 40 | 41 | (return (rewrap-list code)))) 42 | 43 | ((vector? code) 44 | (return (list->vector (map rewrap (vector->list code))))) 45 | 46 | (else 47 | form)))) 48 | 49 | (rewrap source-at-form))) 50 | -------------------------------------------------------------------------------- /script/compile: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | rm -f core.js 4 | 5 | java -server -Xmx2G -Xms2G -Xmn256m -cp 'lib/*:src/clj:src/cljs' clojure.main - < coresimple.js 25 | 26 | java -jar closure/compiler/compiler.jar \ 27 | --compilation_level=ADVANCED_OPTIMIZATIONS \ 28 | --warning_level=VERBOSE \ 29 | --formatting=PRETTY_PRINT \ 30 | --jscomp_off=missingProperties \ 31 | --js closure/library/closure/goog/base.js \ 32 | --js closure/library/closure/goog/string/string.js \ 33 | --js closure/library/closure/goog/useragent/jscript.js \ 34 | --js closure/library/closure/goog/string/stringbuffer.js \ 35 | --js closure/library/closure/goog/object/object.js \ 36 | --js closure/library/closure/goog/debug/error.js \ 37 | --js closure/library/closure/goog/asserts/asserts.js \ 38 | --js closure/library/closure/goog/array/array.js \ 39 | --js core.js \ 40 | > coreadvanced.js 41 | 42 | -------------------------------------------------------------------------------- /src/cljscm/clojure/reflect.cljscm: -------------------------------------------------------------------------------- 1 | (ns clojure.reflect 2 | (:refer-clojure :exclude [meta]) 3 | (:require [clojure.browser.net :as net] 4 | [clojure.browser.event :as event])) 5 | 6 | (defn- evaluate-javascript [block] 7 | (let [result (try (js* "eval(~{block})") 8 | (catch js/Error e 9 | (.log js/console e)))] 10 | result)) 11 | 12 | (defn- query-reflection 13 | "Issues a GET to /reflect with a single query-parameter string. 14 | Calls cb with the result." 15 | [query-param cb] 16 | (let [conn (net/xhr-connection) 17 | url (str "/reflect?" query-param)] 18 | (event/listen conn :success (fn [e] 19 | (let [resp (.getResponseText e/currentTarget ())] 20 | (cb resp)))) 21 | (event/listen conn :error #(println "Reflection query failed.")) 22 | (net/transmit conn url))) 23 | 24 | (defn meta 25 | "Queries the reflection api with a fully qualified symbol, then calls 26 | callback fn cb with the evaluated cljs map containing that symbol's 27 | meta information." 28 | [sym cb] 29 | (query-reflection (str "var=" (js/encodeURIComponent (str sym))) 30 | #(cb (evaluate-javascript %)))) 31 | 32 | (defn macroexpand 33 | "Queries the reflection api with a quoted macro form, then calls the 34 | callback function with the macroexpanded form, as a string." 35 | [form] 36 | (query-reflection (str "macroform=" (js/encodeURIComponent (str form))) println)) 37 | 38 | (defn print-doc [{:keys [name method-params doc]}] 39 | (when-not (empty? name) 40 | (println name) 41 | (println method-params) 42 | (println doc))) 43 | 44 | (defn doc 45 | "Queries the reflection api with a fully qualified symbol, then prints 46 | documentation information at the repl." 47 | [sym] 48 | (meta sym print-doc)) 49 | -------------------------------------------------------------------------------- /script/build: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | # This script must be run within the ClojureScript top-level project 4 | # directory. 5 | 6 | set -ex 7 | 8 | cd `dirname $0`/.. 9 | 10 | DATE=`date '+%Y%m%d%H%M%S'` 11 | WORKING="clojurescript_release_$DATE" 12 | mkdir "$WORKING" 13 | 14 | POM_TEMPLATE="pom.template.xml" 15 | 16 | # The command `git describe --match v0.0` will return a string like 17 | # 18 | # v0.0-856-g329708b 19 | # 20 | # where 856 is the number of commits since the v0.0 tag. It will always 21 | # find the v0.0 tag and will always return the total number of commits (even 22 | # if the tag is v0.0.1). 23 | REVISION=`git --no-replace-objects describe --match v0.0` 24 | 25 | # Extract the version number from the string. Do this in two steps so 26 | # it is a little easier to understand. 27 | REVISION=${REVISION:5} # drop the first 5 characters 28 | REVISION=${REVISION:0:${#REVISION}-9} # drop the last 9 characters 29 | 30 | TAG=r$REVISION 31 | 32 | POM_FILE="$WORKING/clojurescript-0.0-$REVISION.pom" 33 | JAR_FILE="$WORKING/clojurescript-0.0-$REVISION.jar" 34 | 35 | 36 | # `jar cf` errors on duplicate entries, 37 | # so we have to assemble the directory manually 38 | mkdir "$WORKING/jar_contents" 39 | 40 | cp -R epl-v10.html src/clj/cljs src/cljs/cljs src/cljs/clojure \ 41 | "$WORKING/jar_contents" 42 | 43 | jar cf "$JAR_FILE" -C "$WORKING/jar_contents" . 44 | 45 | sed -e s/CLOJURESCRIPT_VERSION/0.0-$REVISION/ < "$POM_TEMPLATE" > "$POM_FILE" 46 | 47 | mvn install:install-file -Dfile="$JAR_FILE" -DpomFile="$POM_FILE" 48 | 49 | # For Hudson server 50 | if [ "$HUDSON" = "true" ]; then 51 | echo "Creating tag $TAG" 52 | git tag -f "$TAG" 53 | git push origin "$TAG" 54 | 55 | mvn gpg:sign-and-deploy-file -Durl=https://oss.sonatype.org/service/local/staging/deploy/maven2/ -DrepositoryId=sonatype-nexus-staging -DpomFile="$POM_FILE" -Dfile="$JAR_FILE" 56 | mvn nexus:staging-close nexus:staging-release -DtargetRepositoryId=releases -Dnexus.promote.autoSelectOverride=true 57 | else 58 | echo "Skipping Maven deployment and Git push because we are not on Hudson." 59 | fi 60 | -------------------------------------------------------------------------------- /devnotes/README.org: -------------------------------------------------------------------------------- 1 | * ClojureScript 2 | - What: Clojure running on Javascript VMs 3 | - Why: Clojure rocks, Javascript reaches 4 | - When: Now! - a compiler exists, we need libraries and tool integration. Full day sessions 6/10 and 6/17 5 | - Where: In stealth mode 'here' at Clojure/core 6 | - How: ClojureScript -> ClojureScript-Compiler -> Javascript -> [Google-Closure-JS->JS-Compiler -> Optimized-Javascript] ->Browser/V8/Node/PhoneGap... 7 | - Who: You, if you're interested in: 8 | - How hand-written recursive descent compilers work (the ClojureScript compiler is about 1/6 the code of the CoffeeScript compiler) 9 | - Writing libraries using Clojure's latest type and polymorphism tools 10 | - How Clojure works - its data structures and abstractions 11 | - Extending the reach of Clojure 12 | - Google's industrial-strength JS tools 13 | - Investigating how powerful code-emitting tools can change the face 14 | of web and mobile development... 15 | * Getting Started 16 | - Clone the repo 17 | - cd clojurescript 18 | - run script/bootstrap 19 | - copy clojure.jar into /lib 20 | - script/repl will start a properly-classpathed repl 21 | * Starting the clojurescript repl 22 | - (require '[cljs.compiler :as comp]) 23 | - (def jse (comp/repl-env)) 24 | - (comp/repl jse) 25 | * Reading list 26 | - If you are interested in participating, please read: 27 | - [[http://www.amazon.com/Closure-Definitive-Guide-Michael-Bolin/dp/1449381871][Closure-Definitive-Guide-Michael-Bolin]] 28 | - and maybe: 29 | - [[http://www.amazon.com/JavaScript-Good-Parts-Douglas-Crockford/dp/0596517742][JavaScript-Good-Parts-Douglas-Crockford]] 30 | - [[http://www.amazon.com/Performance-JavaScript-Faster-Application-Interfaces/dp/059680279X][Performance-JavaScript-Faster-Application-Interfaces]] 31 | - [[http://www.amazon.com/JavaScript-Patterns-Stoyan-Stefanov/dp/0596806752][JavaScript-Patterns-Stoyan-Stefanov]] 32 | - Those looking to cram tonight can get the O'Reilly Closure book on kindle above or ebook directly: 33 | - [[http://oreilly.com/catalog/0636920001416/]] 34 | * More info 35 | [[https://github.com/relevance/clojurescript/wiki][Check the Wiki]] 36 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ## UNMAINTAINED ## 2 | 3 | This project is unmaintained and I won't likely investigate any issues. 4 | 5 | ## clojure-scheme ## 6 | 7 | Pervasive tail-call optimization anyone? 8 | 9 | A few cosmetic changes to the lovely ClojureScript compiler and we are producing output suitable for compilation to C via [Gambit Scheme](http://dynamo.iro.umontreal.ca/~gambit/wiki/index.php/Main_Page)! 10 | 11 | Clojure/West 2013 hosted a talk introducing clojure-scheme. The [slides are online](http://www.iro.umontreal.ca/~gambit/Sorenson-Clojure-to-Native-via-Scheme.pdf) and the corresponding video will be made available this August. 12 | 13 | ## Getting Started ## 14 | 15 | The fastest way to get started is to try the self-hosted clojure-scheme REPL: 16 | 17 | 1. Install Gambit Scheme [from source](https://github.com/feeley/gambit/blob/master/INSTALL.txt) or from an [OSX/Win32 installer](http://dynamo.iro.umontreal.ca/wiki/index.php/Main_Page). 18 | 2. Put `gsc` on your PATH (`make install` puts gsc in /usr/local/Gambit-C/bin by default). 19 | 3. Install [Leiningen](https://github.com/technomancy/leiningen). 20 | 4. `git clone https://github.com/takeoutweight/clojure-scheme.git` 21 | 5. In the root clojure-scheme directory, run `lein install` 22 | 6. In the samples/repl directory, run `lein run` to build the self-hosted REPL. (src/build.clj demonstrates how to compile .clj files to scheme code). 23 | 7. run `sh run-clojure-repl` to launch the REPL, and enter `(install-clojure-repl)` to switch from Scheme mode to Clojure mode. 24 | 25 | ## Performance ## 26 | 27 | Gambit seems to be a promising compile target for Clojure: 28 | 29 | (scm* [] (load "core")) 30 | (ns bench) 31 | (defn fib [n] 32 | (if (or (identical? n 0) (identical? n 1)) 33 | 1 34 | (+ (fib (dec n) ) (fib (- n 2))))) 35 | (prn "fib 36:" (fib 36)) 36 | 37 | ... in the Clojure REPL ... 38 | 39 | cljs.compiler> (time (fib 36)) 40 | "Elapsed time: 1138.814 msecs" 41 | 24157817 42 | cljs.compiler> (compile-file "bench.cljs") 43 | 44 | ... in the shell ... 45 | 46 | $ gsc -exe bench.scm 47 | $ time ./bench 48 | fib 36: 24157817 49 | real 0m0.775s 50 | user 0m0.737s 51 | sys 0m0.009s 52 | -------------------------------------------------------------------------------- /script/closure-library-release/make-closure-library-jars.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | set -e 4 | 5 | ## Set the version numbers to download and release: 6 | 7 | ZIP_VERSION="20120710-r2029" 8 | RELEASE_VERSION="0.0-2029" 9 | 10 | ## These only need to change if the URL or file names change: 11 | 12 | ZIP_BASE="closure-library-${ZIP_VERSION}" 13 | ZIP_FILE="${ZIP_BASE}.zip" 14 | ZIP_URL="http://closure-library.googlecode.com/files/${ZIP_FILE}" 15 | 16 | RELEASE_BASE="google-closure-library-${RELEASE_VERSION}" 17 | JAR_FILE="$RELEASE_BASE.jar" 18 | POM_FILE="$RELEASE_BASE.pom" 19 | 20 | THIRD_PARTY_RELEASE_BASE="google-closure-library-third-party-${RELEASE_VERSION}" 21 | THIRD_PARTY_JAR_FILE="$THIRD_PARTY_RELEASE_BASE.jar" 22 | THIRD_PARTY_POM_FILE="$THIRD_PARTY_RELEASE_BASE.pom" 23 | 24 | POM_TEMPLATE_FILE="google-closure-library.pom.template" 25 | THIRD_PARTY_POM_TEMPLATE_FILE="google-closure-library-third-party.pom.template" 26 | 27 | ## Main script begins: 28 | 29 | cd `dirname $0` 30 | 31 | DATE=`date "+%Y%m%d%H%M%S"` 32 | WORKING="closure-release-${DATE}" 33 | 34 | rm -rf "$WORKING" 35 | mkdir "$WORKING" 36 | 37 | if [ ! -e "$ZIP_FILE" ]; then 38 | curl "$ZIP_URL" -o "$ZIP_FILE" 39 | fi 40 | 41 | if [ ! -d "$WORKING/$ZIP_BASE" ]; then 42 | ( cd "$WORKING" && unzip "../$ZIP_FILE" ) 43 | fi 44 | 45 | cd "$WORKING" 46 | 47 | ## Modify deps.js for third-party JAR; see CLJS-276: 48 | 49 | perl -p -i -e 's/..\/..\/third_party\/closure\/goog\///go' \ 50 | closure/goog/deps.js 51 | 52 | rm -f ./third_party/closure/goog/base.js \ 53 | ./third_party/closure/goog/deps.js 54 | 55 | ## Build the JARs: 56 | 57 | jar cf "$JAR_FILE" \ 58 | AUTHORS \ 59 | LICENSE \ 60 | README \ 61 | -C closure goog \ 62 | -C closure css 63 | 64 | jar cf "$THIRD_PARTY_JAR_FILE" \ 65 | AUTHORS \ 66 | LICENSE \ 67 | README \ 68 | -C third_party/closure goog 69 | 70 | ## Generate the POM files: 71 | 72 | perl -p -e "s/RELEASE_VERSION/$RELEASE_VERSION/go" \ 73 | "../$POM_TEMPLATE_FILE" \ 74 | > "$POM_FILE" 75 | 76 | perl -p -e "s/RELEASE_VERSION/$RELEASE_VERSION/go" \ 77 | "../$THIRD_PARTY_POM_TEMPLATE_FILE" \ 78 | > "$THIRD_PARTY_POM_FILE" 79 | 80 | ## Uncomment these lines for an official release: 81 | 82 | # for FILE in "$JAR_FILE" "$THIRD_PARTY_JAR_FILE" "$POM_FILE" "$THIRD_PARTY_POM_FILE" 83 | # do 84 | # gpg --verbose --armor --detach-sign \ 85 | # --default-key "Clojure/core (build.clojure.org Release Key version 2) " \ 86 | # "$FILE" 87 | # done 88 | -------------------------------------------------------------------------------- /script/bootstrap: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | set -e 4 | 5 | mkdir -p lib 6 | 7 | echo "Fetching Clojure..." 8 | curl -O -s http://repo1.maven.org/maven2/org/clojure/clojure/1.4.0/clojure-1.4.0.zip 9 | unzip -qu clojure-1.4.0.zip 10 | echo "Copying clojure-1.4.0/clojure-1.4.0.jar to lib/clojure.jar..." 11 | cp clojure-1.4.0/clojure-1.4.0.jar lib/clojure.jar 12 | echo "Cleaning up Clojure directory..." 13 | rm -rf clojure-1.4.0/ 14 | echo "Cleaning up Clojure archive..." 15 | rm clojure-1.4.0.zip 16 | 17 | echo "Fetching Google Closure library..." 18 | mkdir -p closure/library 19 | cd closure/library 20 | if [ "$1" = "--closure-library-head" ] ; then 21 | echo "Building against HEAD of Google Closure library..." 22 | 23 | # Check if svn present 24 | type svn >/dev/null 2>&1 || { echo >&2 "Need svn command to checkout HEAD of Google Closure library. Aborting."; exit 1; } 25 | 26 | # Existing checkout? 27 | if svn info --non-interactive >/dev/null 2>&1; then 28 | echo "Updating Google Closure library from HEAD..." 29 | svn update -q --non-interactive 30 | else 31 | echo "Checking out HEAD of Google Closure library..." 32 | rm -rf * 33 | svn checkout -q --non-interactive http://closure-library.googlecode.com/svn/trunk/ ./ 34 | fi 35 | else 36 | echo "Fetching Google Closure library..." 37 | f=closure-library-20120710-r2029.zip 38 | curl -O -s "http://closure-library.googlecode.com/files/$f" 39 | unzip -qu "$f" 40 | echo "Cleaning up Google Closure library archive..." 41 | rm "$f" 42 | fi 43 | cd .. 44 | 45 | echo "Fetching Google Closure compiler..." 46 | mkdir -p compiler 47 | cd compiler 48 | curl -O -s http://closure-compiler.googlecode.com/files/compiler-latest.zip 49 | unzip -qu compiler-latest.zip 50 | echo "Cleaning up Google Closure compiler archive..." 51 | rm compiler-latest.zip 52 | cd ../.. 53 | echo "Building lib/goog.jar..." 54 | echo "jar cf ./lib/goog.jar -C closure/library/closure/ goog" 55 | jar cf ./lib/goog.jar -C closure/library/closure/ goog 56 | 57 | echo "Fetching Rhino..." 58 | curl -O -s http://ftp.mozilla.org/pub/mozilla.org/js/rhino1_7R3.zip 59 | unzip -qu rhino1_7R3.zip 60 | echo "Copying rhino1_7R3/js.jar to lib/js.jar..." 61 | cp rhino1_7R3/js.jar lib/js.jar 62 | echo "Cleaning up Rhino directory..." 63 | rm -rf rhino1_7R3/ 64 | echo "Cleaning up Rhino archive..." 65 | rm rhino1_7R3.zip 66 | 67 | echo "Copying closure/compiler/compiler.jar to lib/compiler.jar" 68 | cp closure/compiler/compiler.jar lib 69 | 70 | echo "[Bootstrap Completed]" 71 | -------------------------------------------------------------------------------- /script/closure-library-release/google-closure-library.pom.template: -------------------------------------------------------------------------------- 1 | 2 | 4.0.0 3 | org.clojure 4 | google-closure-library 5 | RELEASE_VERSION 6 | jar 7 | Google Closure Library 8 | 9 | http://code.google.com/p/closure-library/ 10 | 11 | 12 | The Google Closure Library is a collection of JavaScript code 13 | designed for use with the Google Closure JavaScript Compiler. 14 | 15 | This non-official distribution was prepared by the ClojureScript 16 | team at http://clojure.org/ 17 | 18 | 19 | 20 | 21 | The Apache Software License, Version 2.0 22 | http://www.apache.org/licenses/LICENSE-2.0.html 23 | repo 24 | 25 | 26 | 27 | 28 | Google 29 | http://www.google.com 30 | 31 | 32 | 33 | Google, Inc. 34 | Mohamed Mansourhello@mohamedmansour.com 35 | Bjorn Tiplingbjorn.tipling@gmail.com 36 | SameGoal LLChelp@samegoal.com 37 | Guido Tapiaguido.tapia@gmail.com 38 | Andrew Mattieamattie@gmail.com 39 | Ilia Mirkinibmirkin@gmail.com 40 | Ivan Kozikivan.kozik@gmail.com 41 | Rich Doughertyrich@rd.gen.nz 42 | 43 | 44 | 45 | scm:svn:http://closure-library.googlecode.com/svn/trunk 46 | scm:svn:http://closure-library.googlecode.com/svn/trunk 47 | http://code.google.com/p/closure-library/source/browse/#svn/trunk 48 | 49 | 50 | 51 | code.google.com 52 | http://code.google.com/p/closure-library/issues 53 | 54 | -------------------------------------------------------------------------------- /src/clj/cljscm/repl/reflect.clj: -------------------------------------------------------------------------------- 1 | (ns cljscm.repl.reflect 2 | (:refer-clojure :exclude [macroexpand]) 3 | (:require [cljscm.repl.server :as server] 4 | [cljscm.analyzer :as analyzer] 5 | [cljscm.compiler :as compiler] 6 | [clojure.string :as str] 7 | [clojure.pprint :as pprint])) 8 | 9 | (defn- dissoc-unless 10 | "Dissoc all keys from map that do not appear in key-set. 11 | 12 | (dissoc-unless {:foo 1 :bar 2} #{:foo}) 13 | => {:foo 1}" 14 | [m key-set] 15 | {:pre [(map? m) 16 | (set? key-set)]} 17 | (reduce (fn [coll key] 18 | (if (contains? key-set key) 19 | coll 20 | (dissoc coll key))) 21 | m (keys m))) 22 | 23 | (defn- get-meta [sym] 24 | (let [ns (symbol (namespace sym)) 25 | n (symbol (name sym))] 26 | (if-let [sym-meta (get (:defs (get @analyzer/namespaces ns)) n)] 27 | (-> (dissoc-unless sym-meta 28 | #{:name :method-params :doc :line :file}) 29 | (update-in [:name] str) 30 | (update-in [:method-params] #(str (vec %))))))) 31 | 32 | (defn macroexpand [form] 33 | "Fully expands a cljs macro form." 34 | (let [mform (analyzer/macroexpand-1 {} form)] 35 | (if (identical? form mform) 36 | mform 37 | (macroexpand mform)))) 38 | 39 | (defn- url-decode [encoded & [encoding]] 40 | (java.net.URLDecoder/decode encoded (or encoding "UTF-8"))) 41 | 42 | (def read-url-string (comp read-string url-decode)) 43 | 44 | (defn parse-param 45 | "Parses the query parameter of a path of the form \"/reflect?var=foo\" 46 | into the vector [\"var\" \"foo\"]." 47 | [path] 48 | (-> (str/split path #"\?") 49 | (last) 50 | (str/split #"="))) 51 | 52 | (defn- compile-and-return 53 | "Compiles a form to javascript and returns it on conn." 54 | [conn form] 55 | (let [ast (analyzer/analyze {:ns {:name 'cljscm.user}} form) 56 | js (try (compiler/emit-str ast) 57 | (catch Exception e (println e)))] 58 | (server/send-and-close conn 200 js "text/javascript"))) 59 | 60 | (defmulti handle-reflect-query (fn [[param _] & _] param)) 61 | 62 | (defmethod handle-reflect-query "var" 63 | [[_ sym] req conn opts] 64 | (let [sym (read-url-string sym)] 65 | (compile-and-return conn (get-meta sym)))) 66 | 67 | (defmethod handle-reflect-query "macroform" 68 | [[_ mform] req conn opts] 69 | (let [mform (-> mform read-url-string macroexpand)] 70 | (server/send-and-close conn 200 (with-out-str (pprint/pprint mform))))) 71 | 72 | (server/dispatch-on :get 73 | (fn [{:keys [path]} _ _] (.startsWith path "/reflect")) 74 | (fn [{:keys [path] :as req} conn opts] 75 | (handle-reflect-query (parse-param path) req conn opts))) 76 | -------------------------------------------------------------------------------- /script/closure-library-release/google-closure-library-third-party.pom.template: -------------------------------------------------------------------------------- 1 | 2 | 4.0.0 3 | org.clojure 4 | google-closure-library-third-party 5 | RELEASE_VERSION 6 | jar 7 | Google Closure Library Third-Party Extensions 8 | 9 | http://code.google.com/p/closure-library/ 10 | 11 | 12 | The Google Closure Library is a collection of JavaScript code 13 | designed for use with the Google Closure JavaScript Compiler. 14 | 15 | This non-official distribution was prepared by the ClojureScript 16 | team at http://clojure.org/ 17 | 18 | This package contains extensions to the Google Closure Library 19 | using third-party components, which may be distributed under 20 | licenses other than the Apache license. Licenses for individual 21 | library components may be found in source-code comments. 22 | 23 | 24 | 25 | 26 | The Apache Software License, Version 2.0 27 | http://www.apache.org/licenses/LICENSE-2.0.html 28 | repo 29 | 30 | 31 | 32 | 33 | Google 34 | http://www.google.com 35 | 36 | 37 | 38 | Google, Inc. 39 | Mohamed Mansourhello@mohamedmansour.com 40 | Bjorn Tiplingbjorn.tipling@gmail.com 41 | SameGoal LLChelp@samegoal.com 42 | Guido Tapiaguido.tapia@gmail.com 43 | Andrew Mattieamattie@gmail.com 44 | Ilia Mirkinibmirkin@gmail.com 45 | Ivan Kozikivan.kozik@gmail.com 46 | Rich Doughertyrich@rd.gen.nz 47 | 48 | 49 | 50 | scm:svn:http://closure-library.googlecode.com/svn/trunk 51 | scm:svn:http://closure-library.googlecode.com/svn/trunk 52 | http://code.google.com/p/closure-library/source/browse/#svn/trunk 53 | 54 | 55 | 56 | code.google.com 57 | http://code.google.com/p/closure-library/issues 58 | 59 | -------------------------------------------------------------------------------- /devnotes/todo.org: -------------------------------------------------------------------------------- 1 | #+TODO: TODO IN-PROGRESS REVIEW DONE 2 | * The near term tasks 3 | * Compiler 4 | ** IN-PROGRESS throw/try/catch/finally :@stuarthalloway: 5 | * Data structures 6 | ** IN-PROGRESS keyword :@levand: 7 | *** requires interning strategy 8 | **** possibly compiler support for same 9 | *** string starting with noncharacter code 10 | **** \uFFFE and \uFFFF are guaranteed noncharacters 11 | **** use as prefix for keywords and symbols 12 | **** must test in predicates string? symbol? keyword? 13 | ** IN-PROGRESS symbol :@levand: 14 | *** string starting with noncharacter code 15 | ** DONE cons cell/list 16 | ** DONE map 17 | *** first cut COW, string uniqueness required 18 | ** DONE vector 19 | *** first cut, COW, internal array 20 | ** TODO numbers 21 | *** js native number is our double 22 | *** goog.math.Long? 23 | **** building Long objects defeats fixnum support in JS VMs 24 | **** but they are 32-bit - some type bits 25 | * Abstractions 26 | ** TODO Clojure's interfaces 27 | *** we don't need all of them 28 | Associative 29 | Counted 30 | Fn 31 | IBlockingDeref 32 | IChunk 33 | IChunkedSeq 34 | IDeref 35 | IEditableCollection 36 | IFn 37 | IKeywordLookup 38 | ILookup 39 | ILookupSite 40 | ILookupThunk 41 | IMapEntry 42 | IMeta 43 | Indexed 44 | IndexedSeq 45 | IObj 46 | IPending 47 | IPersistentCollection 48 | IPersistentList 49 | IPersistentMap 50 | IPersistentSet 51 | IPersistentStack 52 | IPersistentVector 53 | IProxy 54 | IRecord 55 | IReduce 56 | IRef 57 | IReference 58 | ISeq 59 | ITransientAssociative 60 | ITransientCollection 61 | ITransientMap 62 | ITransientSet 63 | ITransientVector 64 | IType 65 | MapEquivalence 66 | Named 67 | Reversible 68 | Seqable 69 | Sequential 70 | Settable 71 | Sorted 72 | ** Naming convention for protocols? 73 | *** IBlah 74 | ** TODO equality and hashing 75 | *** investigate gclosure and GWT 76 | ** TODO seqable 77 | ** TODO collection 78 | ** TODO counted 79 | ** DONE seq 80 | ** TODO lookup 81 | ** TODO associative 82 | ** TODO indexed 83 | ** TODO map 84 | ** TODO set 85 | ** TODO vector 86 | ** TODO deref 87 | ** TODO metadata 88 | * Runtime Lib 89 | ** key missing macros 90 | *** binding 91 | **** single threaded 92 | **** save, set!, finally restore 93 | **** deps: try/finally primitives in compiler 94 | *** dotimes 95 | ** math ops 96 | *** intrinsify built-ins 97 | *** handle variadic 98 | ** core.cljs! 99 | *** crank through core.clj 100 | *** see [[file:docs/corelib.org][docs/corelib.org]] 101 | * Tools 102 | ** getting set up story 103 | *** gclosure library 104 | *** gclosure compiler 105 | *** V8 106 | **** optional for now? 107 | ** DONE REPL 108 | *** there's a ticket for this 109 | ** Integration of gclosure library 110 | *** how do we reference/load? 111 | **** REPL runtime behavior of provide/require 112 | *** versioning issues 113 | **** just SVN revs 114 | **** how to bind to version 115 | ** Testing 116 | *** anything good in gclosure? 117 | ** Build 118 | *** deps 119 | *** glcosure compiler 120 | **** invocation via API gives most control 121 | **** but deps a Python thingy 122 | -------------------------------------------------------------------------------- /src/cljscm/clojure/browser/event.cljscm: -------------------------------------------------------------------------------- 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 ^{:doc "This namespace contains functions to work with browser 10 | events. It is based on the Google Closure Library event system." 11 | :author "Bobby Calderwood"} 12 | clojure.browser.event 13 | (:require [goog.events :as events] 14 | [goog.events.EventTarget :as gevent-target] 15 | [goog.events.EventType :as gevent-type])) 16 | 17 | (defprotocol EventType 18 | (event-types [this])) 19 | 20 | (extend-protocol EventType 21 | 22 | goog.events.EventTarget 23 | (event-types 24 | [this] 25 | (into {} 26 | (map 27 | (fn [[k v]] 28 | [(keyword (. k (toLowerCase))) 29 | v]) 30 | (merge 31 | (js->clj goog.events.EventType))))) 32 | 33 | js/Element 34 | (event-types 35 | [this] 36 | (into {} 37 | (map 38 | (fn [[k v]] 39 | [(keyword (. k (toLowerCase))) 40 | v]) 41 | (merge 42 | (js->clj goog.events.EventType)))))) 43 | 44 | (defn listen 45 | ([src type fn] 46 | (listen src type fn false)) 47 | ([src type fn capture?] 48 | (goog.events/listen src 49 | (get (event-types src) type type) 50 | fn 51 | capture?))) 52 | 53 | (defn listen-once 54 | ([src type fn] 55 | (listen-once src type fn false)) 56 | ([src type fn capture?] 57 | (goog.events/listenOnce src 58 | (get (event-types src) type type) 59 | fn 60 | capture?))) 61 | 62 | (defn unlisten 63 | ([src type fn] 64 | (unlisten src type fn false)) 65 | ([src type fn capture?] 66 | (goog.events/unlisten src 67 | (get (event-types src) type type) 68 | fn 69 | capture?))) 70 | 71 | (defn unlisten-by-key 72 | [key] 73 | (goog.events/unlistenByKey key)) 74 | 75 | (defn dispatch-event 76 | [src event] 77 | (goog.events/dispatchEvent src event)) 78 | 79 | (defn expose [e] 80 | (goog.events/expose e)) 81 | 82 | (defn fire-listeners 83 | [obj type capture event]) 84 | 85 | (defn total-listener-count [] 86 | (goog.events/getTotalListenerCount)) 87 | 88 | ;; TODO 89 | (defn get-listener [src type listener opt_capt opt_handler]); ⇒ ?Listener 90 | (defn all-listeners [obj type capture]); ⇒ Array. 91 | 92 | (defn unique-event-id [event-type]); ⇒ string 93 | 94 | (defn has-listener [obj opt_type opt_capture]); ⇒ boolean 95 | ;; TODO? (defn listen-with-wrapper [src wrapper listener opt_capt opt_handler]) 96 | ;; TODO? (defn protect-browser-event-entry-point [errorHandler]) 97 | 98 | (defn remove-all [opt_obj opt_type opt_capt]); ⇒ number 99 | ;; TODO? (defn unlisten-with-wrapper [src wrapper listener opt_capt opt_handler]) 100 | 101 | -------------------------------------------------------------------------------- /src/cljscm/clojure/walk.cljscm: -------------------------------------------------------------------------------- 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 | ;;; walk.cljs - generic tree walker with replacement 10 | 11 | ;; by Stuart Sierra 12 | ;; Jul5 17, 2011 13 | 14 | ;; CHANGE LOG: 15 | ;; 16 | ;; * July 17, 2011: Port to ClojureScript 17 | ;; 18 | ;; * December 15, 2008: replaced 'walk' with 'prewalk' & 'postwalk' 19 | ;; 20 | ;; * December 9, 2008: first version 21 | 22 | 23 | (ns 24 | ^{:author "Stuart Sierra", 25 | :doc "This file defines a generic tree walker for Clojure data 26 | structures. It takes any data structure (list, vector, map, set, 27 | seq), calls a function on every element, and uses the return value 28 | of the function in place of the original. This makes it fairly 29 | easy to write recursive search-and-replace functions, as shown in 30 | the examples. 31 | 32 | Note: \"walk\" supports all Clojure data structures EXCEPT maps 33 | created with sorted-map-by. There is no (obvious) way to retrieve 34 | the sorting function."} 35 | clojure.walk) 36 | 37 | (defn walk 38 | "Traverses form, an arbitrary data structure. inner and outer are 39 | functions. Applies inner to each element of form, building up a 40 | data structure of the same type, then applies outer to the result. 41 | Recognizes all Clojure data structures. Consumes seqs as with doall." 42 | 43 | {:added "1.1"} 44 | [inner outer form] 45 | (cond 46 | (seq? form) (outer (doall (map inner form))) 47 | (coll? form) (outer (into (empty form) (map inner form))) 48 | :else (outer form))) 49 | 50 | (defn postwalk 51 | "Performs a depth-first, post-order traversal of form. Calls f on 52 | each sub-form, uses f's return value in place of the original. 53 | Recognizes all Clojure data structures. Consumes seqs as with doall." 54 | {:added "1.1"} 55 | [f form] 56 | (walk (partial postwalk f) f form)) 57 | 58 | (defn prewalk 59 | "Like postwalk, but does pre-order traversal." 60 | {:added "1.1"} 61 | [f form] 62 | (walk (partial prewalk f) identity (f form))) 63 | 64 | (defn keywordize-keys 65 | "Recursively transforms all map keys from strings to keywords." 66 | {:added "1.1"} 67 | [m] 68 | (let [f (fn [[k v]] (if (string? k) [(keyword k) v] [k v]))] 69 | ;; only apply to maps 70 | (postwalk (fn [x] (if (map? x) (into {} (map f x)) x)) m))) 71 | 72 | (defn stringify-keys 73 | "Recursively transforms all map keys from keywords to strings." 74 | {:added "1.1"} 75 | [m] 76 | (let [f (fn [[k v]] (if (keyword? k) [(name k) v] [k v]))] 77 | ;; only apply to maps 78 | (postwalk (fn [x] (if (map? x) (into {} (map f x)) x)) m))) 79 | 80 | (defn prewalk-replace 81 | "Recursively transforms form by replacing keys in smap with their 82 | values. Like clojure/replace but works on any data structure. Does 83 | replacement at the root of the tree first." 84 | {:added "1.1"} 85 | [smap form] 86 | (prewalk (fn [x] (if (contains? smap x) (smap x) x)) form)) 87 | 88 | (defn postwalk-replace 89 | "Recursively transforms form by replacing keys in smap with their 90 | values. Like clojure/replace but works on any data structure. Does 91 | replacement at the leaves of the tree first." 92 | {:added "1.1"} 93 | [smap form] 94 | (postwalk (fn [x] (if (contains? smap x) (smap x) x)) form)) 95 | -------------------------------------------------------------------------------- /devnotes/talk.org: -------------------------------------------------------------------------------- 1 | * Title 2 | ** Clojure 3 | *** Rocks 4 | ** Javascript 5 | *** Reaches 6 | ** Announcing Clojure on Javascript 7 | *** ClojureScript 8 | * Problem statement 9 | ** Javascript is the only programmable technology in key target environments 10 | *** i.e. the browser 11 | *** nothing will change that for years to come 12 | ** and has the greatest reach in other key environments 13 | *** i.e. mobile 14 | ** Javascript (the language) is not very robust 15 | *** Fewer good parts than bad parts 16 | *** Much convention and discipline required to avoid headaches 17 | *** Conventions differ between shops, libs 18 | ** Ever increasing pressure to create richer applications in these environments 19 | *** requiring more, and larger, libraries 20 | **** ordinary minification doesn't scale up 21 | *** increasing requirements complexity 22 | **** can't add language or environment complexity on top 23 | * Rationale 24 | ** Clojure is arguably simpler, more powerful and more robust than JS 25 | ** JS VMs getting faster and more sophisticated 26 | ** Putting Clojure on JS empowers developers 27 | * Strategy 28 | ** Compile (a substantial subset of) Clojure to Javascript source 29 | ** Leverage best-of-breed JS approaches 30 | ** Look beyond the browser 31 | ** Non-objectives 32 | *** Complete Clojure 33 | *** Portable large applications 34 | *** Browser REPL demos etc 35 | ** Target is production applications 36 | * Tactics 37 | ** Clojure[Script] in Clojure 38 | *** Written in Clojure and itself 39 | ** Clojure on Closure 40 | *** Google's JS toolkit 41 | ** Clojure[Script] in Clojure 42 | ** Google Closure 43 | ** some subset of my gclosure lightning talk 44 | * Where we are at 45 | ** What's there? 46 | *** Compiler 47 | *** REPL 48 | *** All the primitives (that make sense) 49 | *** Arity overloading 50 | *** Macros 51 | *** Seqs, maps, vectors, sets 52 | **** and supporting library 53 | **** callable maps, vectors, sets 54 | *** Symbols and keywords 55 | *** deftypes and protocols 56 | *** all the core abstractions as protocols 57 | *** destructuring 58 | *** 2500 lines of core libs! 59 | *** clojure.string and .set .walk .zip 60 | *** regex 61 | *** reader? 62 | *** Full participation with Google Closure library 63 | **** ns mechanism maps to provide/require 64 | *** compile-file and compile-project 65 | ** What's not (yet)? 66 | *** Full collection persistence 67 | *** defrecord 68 | *** Multimethods 69 | *** Hierarchy 70 | *** Rich numerics 71 | *** Testing framework 72 | *** Misc core lib 73 | ** What won't be? 74 | *** things related to threads 75 | *** eval and runtime compilation 76 | *** structs, proxy, Java type stuff 77 | *** Runtime reification of: 78 | **** Vars 79 | **** Namespaces 80 | **** Protocols 81 | **** etc 82 | ** TBD 83 | *** optimizations 84 | **** chunks, transients 85 | *** agents (on webworkers?) 86 | *** unchecked 87 | ** What's different 88 | *** no runtime Vars 89 | *** some in-function subsetting 90 | **** e.g. satisfies? is a macro, can't be mapped/applied 91 | ** It's alpha 92 | * Where we are going 93 | ** This is Clojure's client story 94 | ** This is Clojure's mobile story 95 | ** This is Clojure's CLI scripting story 96 | * The Team thus far - Clojure/core and friends 97 | ** Aaron Bedra 98 | ** Alan Dipert 99 | ** Alex Redington 100 | ** Bobby Calderwood 101 | ** Brenton Ashworth 102 | ** Chris Houser 103 | ** Devin Walters 104 | ** Eric Thorsen 105 | ** Frank Failla 106 | ** Michael Fogus 107 | ** Jonathan Clagett 108 | ** Jess Martin 109 | ** Luke VanderHart 110 | ** Chris Redinger 111 | ** Stuart Halloway 112 | ** Stuart Sierra 113 | ** Tom Hickey 114 | * Participating 115 | ** This is a Clojure dev project 116 | *** all with Clojure CAs welcome to participate 117 | ** The Friday invite 118 | ** The Conj 119 | * Demo 120 | ** REPL 121 | ** Compilation 122 | ** Web app 123 | ** CLI app? 124 | * Q & A 125 | 126 | 127 | -------------------------------------------------------------------------------- /pom.template.xml: -------------------------------------------------------------------------------- 1 | 2 | 4.0.0 3 | org.clojure 4 | clojurescript 5 | 6 | CLOJURESCRIPT_VERSION 7 | jar 8 | ClojureScript 9 | 10 | https://github.com/clojure/clojurescript 11 | 12 | 13 | ClojureScript compiler and core runtime library. 14 | 15 | 16 | 17 | 18 | Eclipse Public License 1.0 19 | http://opensource.org/licenses/eclipse-1.0.php 20 | repo 21 | 22 | 23 | 24 | 25 | 26 | com.google.javascript 27 | closure-compiler 28 | r2180 29 | 30 | 31 | org.clojure 32 | google-closure-library 33 | 0.0-2029 34 | 35 | 36 | org.mozilla 37 | rhino 38 | 1.7R4 39 | 40 | 41 | 42 | 43 | Aaron Bedra 44 | Alan Dipert 45 | Alan Malloy 46 | Alen Ribic 47 | Alex Redington 48 | Bobby Calderwood 49 | Brandon Bloom 50 | Brenton Ashworth 51 | Chris Houser 52 | Christopher Redinger 53 | Creighton Kirkendall 54 | David Nolen 55 | Devin Walters 56 | Eric Thorsen 57 | Frank Failla 58 | Hubert Iwaniuk 59 | Hugo Duncan 60 | Jess Martin 61 | John Li 62 | Jonas Enlund 63 | Juergen Hoetzel 64 | Kevin J. Lynagh 65 | Laszlo Toeroek 66 | Luke VanderHart 67 | Michael Fogus 68 | Michał Marczyk 69 | Moritz Ulrich 70 | Nicola Mometto 71 | Paul Michael Bauer 72 | Rich Hickey 73 | Roman Gonzalez 74 | Russ Olsen 75 | Stuart Halloway 76 | Stuart Sierra 77 | Takahiro Hozumi 78 | Thomas Scheiblauer 79 | Tom Hickey 80 | Wilkes Joiner 81 | 82 | 83 | 84 | scm:git:git://github.com/clojure/clojurescript.git 85 | scm:git:git@github.com:clojure/clojurescript.git 86 | https://github.com/clojure/clojurescript 87 | 88 | 89 | -------------------------------------------------------------------------------- /test/cljs/clojure/string_test.cljs: -------------------------------------------------------------------------------- 1 | (ns clojure.string-test 2 | (:require [clojure.string :as s])) 3 | 4 | (defn test-string 5 | [] 6 | ;; reverse 7 | (assert (= "" (s/reverse ""))) 8 | (assert (= "tab" (s/reverse "bat"))) 9 | ;; replace 10 | (assert (= "faabar" (s/replace "foobar" \o \a))) 11 | (assert (= "barbarbar" (s/replace "foobarfoo" "foo" "bar"))) 12 | (assert (= "FOObarFOO" (s/replace "foobarfoo" #"foo" s/upper-case))) 13 | (assert (= "barbar)foo" (s/replace "foo(bar)foo" "foo(" "bar"))) 14 | ;; join 15 | (assert (= "" (s/join nil))) 16 | (assert (= "" (s/join []))) 17 | (assert (= "1" (s/join [1]))) 18 | (assert (= "12" (s/join [1 2]))) 19 | (assert (= "1,2,3" (s/join \, [1 2 3]))) 20 | (assert (= "" (s/join \, []))) 21 | (assert (= "1 and-a 2 and-a 3" (s/join " and-a " [1 2 3]))) 22 | ;; capitalize 23 | (assert (= "FOOBAR" (s/upper-case "Foobar"))) 24 | (assert (= "foobar" (s/lower-case "FooBar"))) 25 | (assert (= "Foobar" (s/capitalize "foobar"))) 26 | (assert (= "Foobar" (s/capitalize "FOOBAR"))) 27 | ;; split 28 | (assert (= ["a" "b"] (s/split "a-b" #"-"))) 29 | (assert (= ["a" "b" "c"] (s/split "a-b-c" #"-" -1))) 30 | (assert (= ["a" "b" "c"] (s/split "a-b-c" #"-" 0))) 31 | (assert (= ["a-b-c"] (s/split "a-b-c" #"-" 1))) 32 | (assert (= ["a" "b-c"] (s/split "a-b-c" #"-" 2))) 33 | (assert (= ["a" "b" "c"] (s/split "a-b-c" #"-" 3))) 34 | (assert (= ["a" "b" "c"] (s/split "a-b-c" #"-" 4))) 35 | (assert (vector? (s/split "abc" #"-"))) 36 | (assert (= ["a-b-c"] (s/split "a-b-c" #"x" 2))) 37 | ;; split-lines 38 | (let [result (s/split-lines "one\ntwo\r\nthree")] 39 | (assert (= ["one" "two" "three"] result)) 40 | (assert (vector? result))) 41 | (assert (= (list "foo") (s/split-lines "foo"))) 42 | ;; blank 43 | (assert (s/blank? nil)) 44 | (assert (s/blank? "")) 45 | (assert (s/blank? " ")) 46 | (assert (s/blank? " \t \n \r ")) 47 | (assert (not (s/blank? " foo "))) 48 | ;; escape 49 | (assert (= "<foo&bar>" 50 | (s/escape "" {\& "&" \< "<" \> ">"}))) 51 | (assert (= " \\\"foo\\\" " 52 | (s/escape " \"foo\" " {\" "\\\""}))) 53 | (assert (= "faabor" 54 | (s/escape "foobar" {\a \o, \o \a}))) 55 | ;; replace-first 56 | (assert (= "barbarfoo" (s/replace-first "foobarfoo" "foo" "bar"))) 57 | (assert (= "barbarfoo" (s/replace-first "foobarfoo" #"foo" "bar"))) 58 | (assert (= "z.ology" (s/replace-first "zoology" \o \.))) 59 | (assert (= "FOObarfoo" (s/replace-first "foobarfoo" #"foo" s/upper-case))) 60 | ;; trim 61 | (assert (= "foo " (s/triml " foo "))) 62 | (assert (= "" (s/triml " "))) 63 | (assert (= " foo" (s/trimr " foo "))) 64 | (assert (= "" (s/trimr " "))) 65 | (assert (= "foo" (s/trim " foo \r\n"))) 66 | ;; trim-newline 67 | (assert (= "foo" (s/trim-newline "foo\n"))) 68 | (assert (= "foo" (s/trim-newline "foo\r\n"))) 69 | (assert (= "foo" (s/trim-newline "foo"))) 70 | (assert (= "foo\r " (s/trim-newline "foo\r "))) 71 | (assert (= "" (s/trim-newline ""))) 72 | :ok) 73 | 74 | (comment 75 | 76 | (deftest char-sequence-handling 77 | (are [result f args] (let [[^CharSequence s & more] args] 78 | (= result (apply f (StringBuffer. s) more))) 79 | "paz" s/reverse ["zap"] 80 | "foo:bar" s/replace ["foo-bar" \- \:] 81 | "ABC" s/replace ["abc" #"\w" s/upper-case] 82 | "faa" s/replace ["foo" #"o" (StringBuffer. "a")] 83 | "baz::quux" s/replace-first ["baz--quux" #"--" "::"] 84 | "baz::quux" s/replace-first ["baz--quux" (StringBuffer. "--") (StringBuffer. "::")] 85 | "zim-zam" s/replace-first ["zim zam" #" " (StringBuffer. "-")] 86 | "Pow" s/capitalize ["POW"] 87 | "BOOM" s/upper-case ["boom"] 88 | "whimper" s/lower-case ["whimPER"] 89 | ["foo" "bar"] s/split ["foo-bar" #"-"] 90 | "calvino" s/trim [" calvino "] 91 | "calvino " s/triml [" calvino "] 92 | " calvino" s/trimr [" calvino "] 93 | "the end" s/trim-newline ["the end\r\n\r\r\n"] 94 | true s/blank? [" "] 95 | ["a" "b"] s/split-lines ["a\nb"] 96 | "fa la la" s/escape ["fo lo lo" {\o \a}])) 97 | ) 98 | -------------------------------------------------------------------------------- /test/cljscm/clojure/string_test.cljs: -------------------------------------------------------------------------------- 1 | (ns clojure.string-test 2 | (:require [clojure.string :as s])) 3 | 4 | (defn test-string 5 | [] 6 | ;; reverse 7 | (assert (= "" (s/reverse ""))) 8 | (assert (= "tab" (s/reverse "bat"))) 9 | ;; replace 10 | (assert (= "faabar" (s/replace "foobar" \o \a))) 11 | (assert (= "barbarbar" (s/replace "foobarfoo" "foo" "bar"))) 12 | (assert (= "FOObarFOO" (s/replace "foobarfoo" #"foo" s/upper-case))) 13 | (assert (= "barbar)foo" (s/replace "foo(bar)foo" "foo(" "bar"))) 14 | ;; join 15 | (assert (= "" (s/join nil))) 16 | (assert (= "" (s/join []))) 17 | (assert (= "1" (s/join [1]))) 18 | (assert (= "12" (s/join [1 2]))) 19 | (assert (= "1,2,3" (s/join \, [1 2 3]))) 20 | (assert (= "" (s/join \, []))) 21 | (assert (= "1 and-a 2 and-a 3" (s/join " and-a " [1 2 3]))) 22 | ;; capitalize 23 | (assert (= "FOOBAR" (s/upper-case "Foobar"))) 24 | (assert (= "foobar" (s/lower-case "FooBar"))) 25 | (assert (= "Foobar" (s/capitalize "foobar"))) 26 | (assert (= "Foobar" (s/capitalize "FOOBAR"))) 27 | ;; split 28 | (assert (= ["a" "b"] (s/split "a-b" #"-"))) 29 | (assert (= ["a" "b" "c"] (s/split "a-b-c" #"-" -1))) 30 | (assert (= ["a" "b" "c"] (s/split "a-b-c" #"-" 0))) 31 | (assert (= ["a-b-c"] (s/split "a-b-c" #"-" 1))) 32 | (assert (= ["a" "b-c"] (s/split "a-b-c" #"-" 2))) 33 | (assert (= ["a" "b" "c"] (s/split "a-b-c" #"-" 3))) 34 | (assert (= ["a" "b" "c"] (s/split "a-b-c" #"-" 4))) 35 | (assert (vector? (s/split "abc" #"-"))) 36 | (assert (= ["a-b-c"] (s/split "a-b-c" #"x" 2))) 37 | ;; split-lines 38 | (let [result (s/split-lines "one\ntwo\r\nthree")] 39 | (assert (= ["one" "two" "three"] result)) 40 | (assert (vector? result))) 41 | (assert (= (list "foo") (s/split-lines "foo"))) 42 | ;; blank 43 | (assert (s/blank? nil)) 44 | (assert (s/blank? "")) 45 | (assert (s/blank? " ")) 46 | (assert (s/blank? " \t \n \r ")) 47 | (assert (not (s/blank? " foo "))) 48 | ;; escape 49 | (assert (= "<foo&bar>" 50 | (s/escape "" {\& "&" \< "<" \> ">"}))) 51 | (assert (= " \\\"foo\\\" " 52 | (s/escape " \"foo\" " {\" "\\\""}))) 53 | (assert (= "faabor" 54 | (s/escape "foobar" {\a \o, \o \a}))) 55 | ;; replace-first 56 | (assert (= "barbarfoo" (s/replace-first "foobarfoo" "foo" "bar"))) 57 | (assert (= "barbarfoo" (s/replace-first "foobarfoo" #"foo" "bar"))) 58 | (assert (= "z.ology" (s/replace-first "zoology" \o \.))) 59 | (assert (= "FOObarfoo" (s/replace-first "foobarfoo" #"foo" s/upper-case))) 60 | ;; trim 61 | (assert (= "foo " (s/triml " foo "))) 62 | (assert (= "" (s/triml " "))) 63 | (assert (= " foo" (s/trimr " foo "))) 64 | (assert (= "" (s/trimr " "))) 65 | (assert (= "foo" (s/trim " foo \r\n"))) 66 | ;; trim-newline 67 | (assert (= "foo" (s/trim-newline "foo\n"))) 68 | (assert (= "foo" (s/trim-newline "foo\r\n"))) 69 | (assert (= "foo" (s/trim-newline "foo"))) 70 | (assert (= "foo\r " (s/trim-newline "foo\r "))) 71 | (assert (= "" (s/trim-newline ""))) 72 | :ok) 73 | 74 | (comment 75 | 76 | (deftest char-sequence-handling 77 | (are [result f args] (let [[^CharSequence s & more] args] 78 | (= result (apply f (StringBuffer. s) more))) 79 | "paz" s/reverse ["zap"] 80 | "foo:bar" s/replace ["foo-bar" \- \:] 81 | "ABC" s/replace ["abc" #"\w" s/upper-case] 82 | "faa" s/replace ["foo" #"o" (StringBuffer. "a")] 83 | "baz::quux" s/replace-first ["baz--quux" #"--" "::"] 84 | "baz::quux" s/replace-first ["baz--quux" (StringBuffer. "--") (StringBuffer. "::")] 85 | "zim-zam" s/replace-first ["zim zam" #" " (StringBuffer. "-")] 86 | "Pow" s/capitalize ["POW"] 87 | "BOOM" s/upper-case ["boom"] 88 | "whimper" s/lower-case ["whimPER"] 89 | ["foo" "bar"] s/split ["foo-bar" #"-"] 90 | "calvino" s/trim [" calvino "] 91 | "calvino " s/triml [" calvino "] 92 | " calvino" s/trimr [" calvino "] 93 | "the end" s/trim-newline ["the end\r\n\r\r\n"] 94 | true s/blank? [" "] 95 | ["a" "b"] s/split-lines ["a\nb"] 96 | "fa la la" s/escape ["fo lo lo" {\o \a}])) 97 | ) 98 | -------------------------------------------------------------------------------- /src/cljscm/clojure/browser/repl.cljscm: -------------------------------------------------------------------------------- 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 ^{:doc "Receive - Eval - Print - Loop 10 | 11 | Receive a block of JS (presumably generated by a ClojureScript compiler) 12 | Evaluate it naively 13 | Print the result of evaluation to a string 14 | Send the resulting string back to the server Loop!" 15 | 16 | :author "Bobby Calderwood and Alex Redington"} 17 | clojure.browser.repl 18 | (:require [clojure.browser.net :as net] 19 | [clojure.browser.event :as event])) 20 | 21 | (def xpc-connection (atom nil)) 22 | 23 | (defn repl-print [data] 24 | (if-let [conn @xpc-connection] 25 | (net/transmit conn :print (pr-str data)))) 26 | 27 | (defn evaluate-javascript 28 | "Process a single block of JavaScript received from the server" 29 | [conn block] 30 | (let [result (try {:status :success :value (str (js* "eval(~{block})"))} 31 | (catch js/Error e 32 | {:status :exception :value (pr-str e) 33 | :stacktrace (if (.hasOwnProperty e "stack") 34 | (.-stack e) 35 | "No stacktrace available.")}))] 36 | (pr-str result))) 37 | 38 | (defn send-result [connection url data] 39 | (net/transmit connection url "POST" data nil 0)) 40 | 41 | (defn send-print 42 | "Send data to be printed in the REPL. If there is an error, try again 43 | up to 10 times." 44 | ([url data] 45 | (send-print url data 0)) 46 | ([url data n] 47 | (let [conn (net/xhr-connection)] 48 | (event/listen conn :error 49 | (fn [_] 50 | (if (< n 10) 51 | (send-print url data (inc n)) 52 | (.log js/console (str "Could not send " data " after " n " attempts."))))) 53 | (net/transmit conn url "POST" data nil 0)))) 54 | 55 | (def order (atom 0)) 56 | 57 | (defn wrap-message [t data] 58 | (pr-str {:type t :content data :order (swap! order inc)})) 59 | 60 | (defn start-evaluator 61 | "Start the REPL server connection." 62 | [url] 63 | (if-let [repl-connection (net/xpc-connection)] 64 | (let [connection (net/xhr-connection)] 65 | (event/listen connection 66 | :success 67 | (fn [e] 68 | (net/transmit 69 | repl-connection 70 | :evaluate-javascript 71 | (.getResponseText e/currentTarget 72 | ())))) 73 | 74 | (net/register-service repl-connection 75 | :send-result 76 | (fn [data] 77 | (send-result connection url (wrap-message :result data)))) 78 | 79 | (net/register-service repl-connection 80 | :print 81 | (fn [data] 82 | (send-print url (wrap-message :print data)))) 83 | 84 | (net/connect repl-connection 85 | (constantly nil)) 86 | 87 | (js/setTimeout #(send-result connection url (wrap-message :ready "ready")) 50)) 88 | (js/alert "No 'xpc' param provided to child iframe."))) 89 | 90 | (defn connect 91 | "Connects to a REPL server from an HTML document. After the 92 | connection is made, the REPL will evaluate forms in the context of 93 | the document that called this function." 94 | [repl-server-url] 95 | (let [repl-connection (net/xpc-connection 96 | {:peer_uri repl-server-url})] 97 | (swap! xpc-connection (constantly repl-connection)) 98 | (net/register-service repl-connection 99 | :evaluate-javascript 100 | (fn [js] 101 | (net/transmit 102 | repl-connection 103 | :send-result 104 | (evaluate-javascript repl-connection js)))) 105 | (net/connect repl-connection 106 | (constantly nil) 107 | (fn [iframe] 108 | (set! (.-display (.-style iframe)) 109 | "none"))))) 110 | -------------------------------------------------------------------------------- /src/cljscm/clojure/data.cljscm: -------------------------------------------------------------------------------- 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 10 | ^{:author "Stuart Halloway", 11 | :doc "Non-core data functions."} 12 | clojure.data 13 | (:require [clojure.set :as set])) 14 | 15 | (declare diff) 16 | 17 | (defn- atom-diff 18 | "Internal helper for diff." 19 | [a b] 20 | (if (= a b) [nil nil a] [a b nil])) 21 | 22 | ;; for big things a sparse vector class would be better 23 | (defn- vectorize 24 | "Convert an associative-by-numeric-index collection into 25 | an equivalent vector, with nil for any missing keys" 26 | [m] 27 | (when (seq m) 28 | (reduce 29 | (fn [result [k v]] (assoc result k v)) 30 | (vec (repeat (apply max (keys m)) nil)) 31 | m))) 32 | 33 | (defn- diff-associative-key 34 | "Diff associative things a and b, comparing only the key k." 35 | [a b k] 36 | (let [va (get a k) 37 | vb (get b k) 38 | [a* b* ab] (diff va vb) 39 | in-a (contains? a k) 40 | in-b (contains? b k) 41 | same (and in-a in-b 42 | (or (not (nil? ab)) 43 | (and (nil? va) (nil? vb))))] 44 | [(when (and in-a (or (not (nil? a*)) (not same))) {k a*}) 45 | (when (and in-b (or (not (nil? b*)) (not same))) {k b*}) 46 | (when same {k ab}) 47 | ])) 48 | 49 | (defn- diff-associative 50 | "Diff associative things a and b, comparing only keys in ks (if supplied)." 51 | ([a b] 52 | (diff-associative a b (set/union (keys a) (keys b)))) 53 | ([a b ks] 54 | (reduce 55 | (fn [diff1 diff2] 56 | (doall (map merge diff1 diff2))) 57 | [nil nil nil] 58 | (map 59 | (partial diff-associative-key a b) 60 | ks)))) 61 | 62 | (defn- diff-sequential 63 | [a b] 64 | (vec (map vectorize (diff-associative 65 | (if (vector? a) a (vec a)) 66 | (if (vector? b) b (vec b)) 67 | (range (max (count a) (count b))))))) 68 | 69 | (defn- diff-set 70 | [a b] 71 | [(not-empty (set/difference a b)) 72 | (not-empty (set/difference b a)) 73 | (not-empty (set/intersection a b))]) 74 | 75 | (defprotocol EqualityPartition 76 | "Implementation detail. Subject to change." 77 | (equality-partition [x] "Implementation detail. Subject to change.")) 78 | 79 | (defprotocol Diff 80 | "Implementation detail. Subject to change." 81 | (diff-similar [a b] "Implementation detail. Subject to change.")) 82 | 83 | (extend-protocol EqualityPartition 84 | nil 85 | (equality-partition [x] :atom) 86 | 87 | string 88 | (equality-partition [x] :atom) 89 | 90 | number 91 | (equality-partition [x] :atom) 92 | 93 | array 94 | (equality-partition [x] :sequential) 95 | 96 | function 97 | (equality-partition [x] :atom) 98 | 99 | boolean 100 | (equality-partition [x] :atom) 101 | 102 | default 103 | (equality-partition [x] 104 | (cond 105 | (satisfies? IMap x) :map 106 | (satisfies? ISet x) :set 107 | (satisfies? ISequential x) :sequential 108 | :default :atom))) 109 | 110 | (extend-protocol Diff 111 | nil 112 | (diff-similar [a b] 113 | (atom-diff a b)) 114 | 115 | string 116 | (diff-similar [a b] 117 | (atom-diff a b)) 118 | 119 | number 120 | (diff-similar [a b] 121 | (atom-diff a b)) 122 | 123 | array 124 | (diff-similar [a b] 125 | (diff-sequential a b)) 126 | 127 | function 128 | (diff-similar [a b] 129 | (atom-diff a b)) 130 | 131 | boolean 132 | (diff-similar [a b] 133 | (atom-diff a b)) 134 | 135 | default 136 | (diff-similar [a b] 137 | ((case (equality-partition a) 138 | :atom atom-diff 139 | :set diff-set 140 | :sequential diff-sequential 141 | :map diff-associative) 142 | a b))) 143 | 144 | (defn diff 145 | "Recursively compares a and b, returning a tuple of 146 | [things-only-in-a things-only-in-b things-in-both]. 147 | Comparison rules: 148 | 149 | * For equal a and b, return [nil nil a]. 150 | * Maps are subdiffed where keys match and values differ. 151 | * Sets are never subdiffed. 152 | * All sequential things are treated as associative collections 153 | by their indexes, with results returned as vectors. 154 | * Everything else (including strings!) is treated as 155 | an atom and compared for equality." 156 | [a b] 157 | (if (= a b) 158 | [nil nil a] 159 | (if (= (equality-partition a) (equality-partition b)) 160 | (diff-similar a b) 161 | (atom-diff a b)))) 162 | 163 | -------------------------------------------------------------------------------- /test/cljs/cljs/reader_test.cljs: -------------------------------------------------------------------------------- 1 | (ns cljs.reader-test 2 | (:require [cljs.reader :as reader] 3 | [goog.object :as o])) 4 | 5 | (deftype T [a b]) 6 | (defrecord R [a b]) 7 | 8 | (defn test-reader 9 | [] 10 | (assert (= 1 (reader/read-string "1"))) 11 | (assert (= 2 (reader/read-string "#_nope 2"))) 12 | (assert (= -1 (reader/read-string "-1"))) 13 | (assert (= -1.5 (reader/read-string "-1.5"))) 14 | (assert (= [3 4] (reader/read-string "[3 4]"))) 15 | (assert (= "foo" (reader/read-string "\"foo\""))) 16 | (assert (= :hello (reader/read-string ":hello"))) 17 | (assert (= 'goodbye (reader/read-string "goodbye"))) 18 | (assert (= #{1 2 3} (reader/read-string "#{1 2 3}"))) 19 | (assert (= '(7 8 9) (reader/read-string "(7 8 9)"))) 20 | (assert (= '(deref foo) (reader/read-string "@foo"))) 21 | (assert (= '(quote bar) (reader/read-string "'bar"))) 22 | (assert (= 'foo/bar (reader/read-string "foo/bar"))) 23 | (assert (= \a (reader/read-string "\\a"))) 24 | (assert (= {:tag 'String} (meta (reader/read-string "^String {:a 1}")))) 25 | (assert (= [:a 'b #{'c {:d [:e :f :g]}}] 26 | (reader/read-string "[:a b #{c {:d [:e :f :g]}}]"))) 27 | (assert (= :foo/bar (reader/read-string ":foo/bar"))) 28 | (assert (= nil (reader/read-string "nil"))) 29 | (assert (= true (reader/read-string "true"))) 30 | (assert (= false (reader/read-string "false"))) 31 | (assert (= "string" (reader/read-string "\"string\""))) 32 | (assert (= "escape chars \t \r \n \\ \" \b \f" (reader/read-string "\"escape chars \\t \\r \\n \\\\ \\\" \\b \\f\""))) 33 | 34 | ;; queue literals 35 | (assert (= cljs.core.PersistentQueue/EMPTY 36 | (reader/read-string "#queue []"))) 37 | 38 | (assert (= (-> cljs.core.PersistentQueue/EMPTY (conj 1)) 39 | (reader/read-string "#queue [1]"))) 40 | 41 | (assert (= (into cljs.core.PersistentQueue/EMPTY [1 2]) 42 | (reader/read-string "#queue [1 2]"))) 43 | 44 | ;; inst 45 | (let [est-inst (reader/read-string "#inst \"2010-11-12T13:14:15.666-05:00\"") 46 | utc-inst (reader/read-string "#inst \"2010-11-12T18:14:15.666-00:00\"")] 47 | 48 | (assert (= (.valueOf (js/Date. "2010-11-12T13:14:15.666-05:00")) 49 | (.valueOf est-inst))) 50 | 51 | (assert (= (.valueOf est-inst) 52 | (.valueOf (reader/read-string (pr-str est-inst))))) 53 | 54 | (assert (= (.valueOf est-inst) 55 | (.valueOf utc-inst))) 56 | 57 | (doseq [month (range 1 13) day (range 1 29) hour (range 1 23)] 58 | (let [s (str "#inst \"2010-" month "-" day "T" hour ":14:15.666-06:00\"")] 59 | (assert (= (-> s reader/read-string .valueOf) 60 | (-> s reader/read-string pr-str reader/read-string .valueOf)))))) 61 | 62 | ;; uuid literals 63 | (let [u (reader/read-string "#uuid \"550e8400-e29b-41d4-a716-446655440000\"")] 64 | (assert (= u (reader/read-string "#uuid \"550e8400-e29b-41d4-a716-446655440000\""))) 65 | 66 | (assert (not (identical? u (reader/read-string "#uuid \"550e8400-e29b-41d4-a716-446655440000\"")))) 67 | 68 | (assert (= u (-> u pr-str reader/read-string)))) 69 | 70 | ;; new tag parsers 71 | 72 | (reader/register-tag-parser! 'foo identity) 73 | 74 | (assert (= [1 2] (reader/read-string "#foo [1 2]"))) 75 | 76 | ;; tag elements with prefix component 77 | (reader/register-tag-parser! 'foo.bar/baz identity) 78 | (assert (= [1 2] (reader/read-string "#foo.bar/baz [1 2]"))) 79 | 80 | ;; default tag parser 81 | (reader/register-default-tag-parser! (fn [tag val] val)) 82 | (assert (= [1 2] (reader/read-string "#a.b/c [1 2]"))) 83 | 84 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 85 | ;; Unicode Tests 86 | 87 | ; sample unicode strings, symbols, keywords 88 | (doseq [unicode 89 | ["اختبار" ; arabic 90 | "ทดสอบ" ; thai 91 | "こんにちは" ; japanese hiragana 92 | "你好" ; chinese traditional 93 | "אַ גוט יאָר" ; yiddish 94 | "cześć" ; polish 95 | "привет" ; russian 96 | 97 | ;; RTL languages skipped below because tricky to insert 98 | ;; ' and : at the "start" 99 | 100 | 'ทดสอบ 101 | 'こんにちは 102 | '你好 103 | 'cześć 104 | 'привет 105 | 106 | :ทดสอบ 107 | :こんにちは 108 | :你好 109 | :cześć 110 | :привет 111 | 112 | ;compound data 113 | {:привет :ru "你好" :cn} 114 | ]] 115 | (let [input (pr-str unicode) 116 | read (reader/read-string input)] 117 | (assert (= unicode read) 118 | (str "Failed to read-string \"" unicode "\" from: " input)))) 119 | 120 | ; unicode error cases 121 | (doseq [unicode-error 122 | ["\"abc \\ua\"" ; truncated 123 | "\"abc \\x0z ...etc\"" ; incorrect code 124 | "\"abc \\u0g00 ..etc\"" ; incorrect code 125 | ]] 126 | (let [r (try 127 | (reader/read-string unicode-error) 128 | :failed-to-throw 129 | (catch js/Error e :ok))] 130 | (assert (= r :ok) (str "Failed to throw reader error for: " unicode-error)))) 131 | 132 | :ok) 133 | -------------------------------------------------------------------------------- /test/cljscm/cljscm/reader_test.cljscm: -------------------------------------------------------------------------------- 1 | (ns cljscm.reader-test 2 | (:require [cljscm.reader :as reader] 3 | [goog.object :as o])) 4 | 5 | (deftype T [a b]) 6 | (defrecord R [a b]) 7 | 8 | (defn test-reader 9 | [] 10 | (assert (= 1 (reader/read-string "1"))) 11 | (assert (= 2 (reader/read-string "#_nope 2"))) 12 | (assert (= -1 (reader/read-string "-1"))) 13 | (assert (= -1.5 (reader/read-string "-1.5"))) 14 | (assert (= [3 4] (reader/read-string "[3 4]"))) 15 | (assert (= "foo" (reader/read-string "\"foo\""))) 16 | (assert (= :hello (reader/read-string ":hello"))) 17 | (assert (= 'goodbye (reader/read-string "goodbye"))) 18 | (assert (= #{1 2 3} (reader/read-string "#{1 2 3}"))) 19 | (assert (= '(7 8 9) (reader/read-string "(7 8 9)"))) 20 | (assert (= '(deref foo) (reader/read-string "@foo"))) 21 | (assert (= '(quote bar) (reader/read-string "'bar"))) 22 | (assert (= 'foo/bar (reader/read-string "foo/bar"))) 23 | (assert (= \a (reader/read-string "\\a"))) 24 | (assert (= {:tag 'String} (meta (reader/read-string "^String {:a 1}")))) 25 | (assert (= [:a 'b #{'c {:d [:e :f :g]}}] 26 | (reader/read-string "[:a b #{c {:d [:e :f :g]}}]"))) 27 | (assert (= :foo/bar (reader/read-string ":foo/bar"))) 28 | (assert (= nil (reader/read-string "nil"))) 29 | (assert (= true (reader/read-string "true"))) 30 | (assert (= false (reader/read-string "false"))) 31 | (assert (= "string" (reader/read-string "\"string\""))) 32 | (assert (= "escape chars \t \r \n \\ \" \b \f" (reader/read-string "\"escape chars \\t \\r \\n \\\\ \\\" \\b \\f\""))) 33 | 34 | ;; queue literals 35 | (assert (= cljscm.core.PersistentQueue/EMPTY 36 | (reader/read-string "#queue []"))) 37 | 38 | (assert (= (-> cljscm.core.PersistentQueue/EMPTY (conj 1)) 39 | (reader/read-string "#queue [1]"))) 40 | 41 | (assert (= (into cljscm.core.PersistentQueue/EMPTY [1 2]) 42 | (reader/read-string "#queue [1 2]"))) 43 | 44 | ;; inst 45 | (let [est-inst (reader/read-string "#inst \"2010-11-12T13:14:15.666-05:00\"") 46 | utc-inst (reader/read-string "#inst \"2010-11-12T18:14:15.666-00:00\"")] 47 | 48 | (assert (= (.valueOf (js/Date. "2010-11-12T13:14:15.666-05:00")) 49 | (.valueOf est-inst))) 50 | 51 | (assert (= (.valueOf est-inst) 52 | (.valueOf (reader/read-string (pr-str est-inst))))) 53 | 54 | (assert (= (.valueOf est-inst) 55 | (.valueOf utc-inst))) 56 | 57 | (doseq [month (range 1 13) day (range 1 29) hour (range 1 23)] 58 | (let [s (str "#inst \"2010-" month "-" day "T" hour ":14:15.666-06:00\"")] 59 | (assert (= (-> s reader/read-string .valueOf) 60 | (-> s reader/read-string pr-str reader/read-string .valueOf)))))) 61 | 62 | ;; uuid literals 63 | (let [u (reader/read-string "#uuid \"550e8400-e29b-41d4-a716-446655440000\"")] 64 | (assert (= u (reader/read-string "#uuid \"550e8400-e29b-41d4-a716-446655440000\""))) 65 | 66 | (assert (not (identical? u (reader/read-string "#uuid \"550e8400-e29b-41d4-a716-446655440000\"")))) 67 | 68 | (assert (= u (-> u pr-str reader/read-string)))) 69 | 70 | ;; new tag parsers 71 | 72 | (reader/register-tag-parser! 'foo identity) 73 | 74 | (assert (= [1 2] (reader/read-string "#foo [1 2]"))) 75 | 76 | ;; tag elements with prefix component 77 | (reader/register-tag-parser! 'foo.bar/baz identity) 78 | (assert (= [1 2] (reader/read-string "#foo.bar/baz [1 2]"))) 79 | 80 | ;; default tag parser 81 | (reader/register-default-tag-parser! (fn [tag val] val)) 82 | (assert (= [1 2] (reader/read-string "#a.b/c [1 2]"))) 83 | 84 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 85 | ;; Unicode Tests 86 | 87 | ; sample unicode strings, symbols, keywords 88 | (doseq [unicode 89 | ["اختبار" ; arabic 90 | "ทดสอบ" ; thai 91 | "こんにちは" ; japanese hiragana 92 | "你好" ; chinese traditional 93 | "אַ גוט יאָר" ; yiddish 94 | "cześć" ; polish 95 | "привет" ; russian 96 | 97 | ;; RTL languages skipped below because tricky to insert 98 | ;; ' and : at the "start" 99 | 100 | 'ทดสอบ 101 | 'こんにちは 102 | '你好 103 | 'cześć 104 | 'привет 105 | 106 | :ทดสอบ 107 | :こんにちは 108 | :你好 109 | :cześć 110 | :привет 111 | 112 | ;compound data 113 | {:привет :ru "你好" :cn} 114 | ]] 115 | (let [input (pr-str unicode) 116 | read (reader/read-string input)] 117 | (assert (= unicode read) 118 | (str "Failed to read-string \"" unicode "\" from: " input)))) 119 | 120 | ; unicode error cases 121 | (doseq [unicode-error 122 | ["\"abc \\ua\"" ; truncated 123 | "\"abc \\x0z ...etc\"" ; incorrect code 124 | "\"abc \\u0g00 ..etc\"" ; incorrect code 125 | ]] 126 | (let [r (try 127 | (reader/read-string unicode-error) 128 | :failed-to-throw 129 | (catch js/Error e :ok))] 130 | (assert (= r :ok) (str "Failed to throw reader error for: " unicode-error)))) 131 | 132 | :ok) 133 | -------------------------------------------------------------------------------- /src/cljscm/clojure/string.cljscm: -------------------------------------------------------------------------------- 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 clojure.string 10 | (:refer-clojure :exclude [replace reverse])) 11 | 12 | (defn- seq-reverse 13 | [coll] 14 | (reduce conj () coll)) 15 | 16 | (defn reverse 17 | "Returns s with its characters reversed." 18 | [s] 19 | (scm* [s] (list->string (reverse (string->list s))))) 20 | 21 | #_(defn replace 22 | "Replaces all instance of match with replacement in s. 23 | match/replacement can be: 24 | 25 | string / string 26 | pattern / (string or function of match)." 27 | [s match replacement] 28 | (cond (string? match) 29 | (.replace s (js/RegExp. (gstring/regExpEscape match) "g") replacement) 30 | (.hasOwnProperty match "source") 31 | (.replace s (js/RegExp. (.-source match) "g") replacement) 32 | :else (throw (str "Invalid match arg: " match)))) 33 | 34 | #_(defn replace-first 35 | "Replaces the first instance of match with replacement in s. 36 | match/replacement can be: 37 | 38 | string / string 39 | pattern / (string or function of match)." 40 | [s match replacement] 41 | (.replace s match replacement)) 42 | 43 | (defn join 44 | "Returns a string of all elements in coll, as returned by (seq coll), 45 | separated by an optional separator." 46 | ([coll] 47 | (apply str coll)) 48 | ([separator coll] 49 | (apply str (interpose separator coll)))) 50 | 51 | (defn upper-case 52 | "Converts string to all upper-case." 53 | [s] 54 | (scm* [s] (list->string 55 | (map char-upcase 56 | (string->list s))))) 57 | 58 | (defn lower-case 59 | "Converts string to all lower-case." 60 | [s] 61 | (scm* [s] (list->string 62 | (map char-downcase 63 | (string->list s))))) 64 | 65 | (defn capitalize 66 | "Converts first character of the string to upper-case, all other 67 | characters to lower-case." 68 | [s] 69 | (if (< (count s) 2) 70 | (upper-case s) 71 | (str (upper-case (subs s 0 1)) 72 | (lower-case (subs s 1))))) 73 | 74 | ;; The JavaScript split function takes a limit argument but the return 75 | ;; value is not the same as the Java split function. 76 | ;; 77 | ;; Java: (.split "a-b-c" #"-" 2) => ["a" "b-c"] 78 | ;; JavaScript: (.split "a-b-c" #"-" 2) => ["a" "b"] 79 | ;; 80 | ;; For consistency, the three arg version has been implemented to 81 | ;; mimic Java's behavior. 82 | 83 | #_(defn split 84 | "Splits string on a regular expression. Optional argument limit is 85 | the maximum number of splits. Not lazy. Returns vector of the splits." 86 | ([s re] 87 | (vec (.split (str s) re))) 88 | ([s re limit] 89 | (if (< limit 1) 90 | (vec (.split (str s) re)) 91 | (loop [s s 92 | limit limit 93 | parts []] 94 | (if (= limit 1) 95 | (conj parts s) 96 | (if-let [m (re-find re s)] 97 | (let [index (.indexOf s m)] 98 | (recur (.substring s (+ index (count m))) 99 | (dec limit) 100 | (conj parts (.substring s 0 index)))) 101 | (conj parts s))))))) 102 | 103 | #_(defn split-lines 104 | "Splits s on \n or \r\n." 105 | [s] 106 | (split s #"\n|\r\n")) 107 | 108 | #_(defn trim 109 | "Removes whitespace from both ends of string." 110 | [s] 111 | (gstring/trim s)) 112 | 113 | #_(defn triml 114 | "Removes whitespace from the left side of string." 115 | [s] 116 | (gstring/trimLeft s)) 117 | 118 | #_(defn trimr 119 | "Removes whitespace from the right side of string." 120 | [s] 121 | (gstring/trimRight s)) 122 | 123 | #_(defn trim-newline 124 | "Removes all trailing newline \\n or return \\r characters from 125 | string. Similar to Perl's chomp." 126 | [s] 127 | (loop [index (.-length s)] 128 | (if (zero? index) 129 | "" 130 | (let [ch (get s (dec index))] 131 | (if (or (= ch \newline) (= ch \return)) 132 | (recur (dec index)) 133 | (.substring s 0 index)))))) 134 | 135 | #_(defn blank? 136 | "True is s is nil, empty, or contains only whitespace." 137 | [s] 138 | (gstring/isEmptySafe s)) 139 | 140 | #_(defn escape 141 | "Return a new string, using cmap to escape each character ch 142 | from s as follows: 143 | 144 | If (cmap ch) is nil, append ch to the new string. 145 | If (cmap ch) is non-nil, append (str (cmap ch)) instead." 146 | [s cmap] 147 | (let [buffer (gstring/StringBuffer.) 148 | length (.-length s)] 149 | (loop [index 0] 150 | (if (= length index) 151 | (. buffer (toString)) 152 | (let [ch (.charAt s index)] 153 | (if-let [replacement (get cmap ch)] 154 | (.append buffer (str replacement)) 155 | (.append buffer ch)) 156 | (recur (inc index))))))) 157 | -------------------------------------------------------------------------------- /src/cljscm/clojure/browser/dom.cljscm: -------------------------------------------------------------------------------- 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 clojure.browser.dom 10 | (:require [goog.dom :as gdom] 11 | [goog.object :as gobject])) 12 | 13 | (defn append [parent & children] 14 | (apply gdom/append parent children) 15 | parent) 16 | 17 | (defprotocol DOMBuilder 18 | (-element [this] [this attrs-or-children] [this attrs children])) 19 | 20 | (defn log [& args] 21 | (.log js/console (apply pr-str args))) 22 | 23 | (defn log-obj [obj] 24 | (.log js/console obj)) 25 | 26 | (extend-protocol DOMBuilder 27 | 28 | string 29 | (-element 30 | ([this] 31 | (log "string (-element " this ")") 32 | (cond (keyword? this) (gdom/createElement (name this)) 33 | :else (gdom/createTextNode (name this)))) 34 | 35 | ([this attrs-or-children] 36 | (log "string (-element " this " " attrs-or-children ")") 37 | (let [attrs (first attrs-or-children)] 38 | (if (map? attrs) 39 | (-element this attrs (rest attrs-or-children)) 40 | (-element this nil attrs-or-children)))) 41 | 42 | ([this attrs children] 43 | (log "string (-element " this " " attrs " " children ")") 44 | (let [str-attrs (if (and (map? attrs) (seq attrs)) 45 | (reduce (fn [o [k v]] 46 | (let [o (if (nil? o) (js-obj) o)] 47 | (log "o = " o) 48 | (log "k = " k) 49 | (log "v = " v) 50 | (when (or (keyword? k) 51 | (string? k)) 52 | (doto o (aset (name k) v))))) 53 | (js-obj) 54 | attrs) 55 | nil)] 56 | (log-obj str-attrs) 57 | (if (seq children) 58 | (apply gdom/createDom 59 | (name this) 60 | str-attrs 61 | (map -element children)) 62 | (gdom/createDom (name this) 63 | str-attrs))))) 64 | 65 | PersistentVector 66 | (-element 67 | [this] 68 | (log "PersistentVector (-element " this ")") 69 | (let [tag (first this) 70 | attrs (second this) 71 | children (drop 2 this)] 72 | (if (map? attrs) 73 | (-element tag attrs children) 74 | (-element tag nil (rest this))))) 75 | 76 | js/Element 77 | (-element [this] 78 | (log "js/Element (-element " this ")") 79 | this)) 80 | 81 | (defn element 82 | ([tag-or-text] 83 | (log "(element " tag-or-text ")") 84 | (-element tag-or-text)) 85 | ([tag & children] 86 | (log "(element " tag " " children ")") 87 | (let [attrs (first children)] 88 | (if (map? attrs) 89 | (-element tag attrs (rest children)) 90 | (-element tag nil children))))) 91 | 92 | (defn remove-children 93 | "Remove all children from the element with the passed id." 94 | [id] 95 | (let [parent (gdom/getElement (name id))] 96 | (do (gdom/removeChildren parent)))) 97 | 98 | (defn get-element [id] 99 | (gdom/getElement (name id))) 100 | 101 | (defn html->dom [s] 102 | (gdom/htmlToDocumentFragment s)) 103 | 104 | (defn insert-at [parent child index] 105 | (gdom/insertChildAt parent child index)) 106 | 107 | (defn ensure-element 108 | "Coerce the argument to a dom element if possible." 109 | [e] 110 | (cond (keyword? e) (get-element e) 111 | (string? e) (html->dom e) 112 | :else e)) 113 | 114 | (defn replace-node 115 | "Replace old-node with new-node. old-node can be an element or a 116 | keyword which is the id of the node to replace. new-node can be an 117 | element or an html string." 118 | [old-node new-node] 119 | (let [old-node (ensure-element old-node) 120 | new-node (ensure-element new-node)] 121 | (gdom/replaceNode new-node old-node) 122 | new-node)) 123 | 124 | (defn set-text 125 | "Set the text content for the passed element returning the 126 | element. If a keyword is passed in the place of e, the element with 127 | that id will be used and returned." 128 | [e s] 129 | (gdom/setTextContent (ensure-element e) s)) 130 | 131 | (defn get-value 132 | "Get the value of an element." 133 | [e] 134 | (.-value (ensure-element e))) 135 | 136 | (defn set-properties 137 | "Set properties on an element" 138 | [e m] 139 | (gdom/setProperties (ensure-element e) 140 | (apply gobject/create (interleave (keys m) (vals m))))) 141 | 142 | (defn set-value 143 | "Set the value property for an element." 144 | [e v] 145 | (set-properties e {"value" v})) 146 | 147 | (defn click-element 148 | [e] 149 | (.click (ensure-element e) ())) 150 | 151 | ;; TODO CSS class manipulation 152 | ;; TODO Query syntax 153 | -------------------------------------------------------------------------------- /src/cljscm/clojure/set.cljscm: -------------------------------------------------------------------------------- 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 ^{:doc "Set operations such as union/intersection." 10 | :author "Rich Hickey"} 11 | clojure.set) 12 | 13 | (defn- bubble-max-key [k coll] 14 | "Move a maximal element of coll according to fn k (which returns a number) 15 | to the front of coll." 16 | (let [max (apply max-key k coll)] 17 | (cons max (remove #(identical? max %) coll)))) 18 | 19 | (defn union 20 | "Return a set that is the union of the input sets" 21 | ([] #{}) 22 | ([s1] s1) 23 | ([s1 s2] 24 | (if (< (count s1) (count s2)) 25 | (reduce conj s2 s1) 26 | (reduce conj s1 s2))) 27 | ([s1 s2 & sets] 28 | (let [bubbled-sets (bubble-max-key count (conj sets s2 s1))] 29 | (reduce into (first bubbled-sets) (rest bubbled-sets))))) 30 | 31 | (defn intersection 32 | "Return a set that is the intersection of the input sets" 33 | ([s1] s1) 34 | ([s1 s2] 35 | (if (< (count s2) (count s1)) 36 | (recur s2 s1) 37 | (reduce (fn [result item] 38 | (if (contains? s2 item) 39 | result 40 | (disj result item))) 41 | s1 s1))) 42 | ([s1 s2 & sets] 43 | (let [bubbled-sets (bubble-max-key #(- (count %)) (conj sets s2 s1))] 44 | (reduce intersection (first bubbled-sets) (rest bubbled-sets))))) 45 | 46 | (defn difference 47 | "Return a set that is the first set without elements of the remaining sets" 48 | ([s1] s1) 49 | ([s1 s2] 50 | (if (< (count s1) (count s2)) 51 | (reduce (fn [result item] 52 | (if (contains? s2 item) 53 | (disj result item) 54 | result)) 55 | s1 s1) 56 | (reduce disj s1 s2))) 57 | ([s1 s2 & sets] 58 | (reduce difference s1 (conj sets s2)))) 59 | 60 | 61 | (defn select 62 | "Returns a set of the elements for which pred is true" 63 | [pred xset] 64 | (reduce (fn [s k] (if (pred k) s (disj s k))) 65 | xset xset)) 66 | 67 | (defn project 68 | "Returns a rel of the elements of xrel with only the keys in ks" 69 | [xrel ks] 70 | (set (map #(select-keys % ks) xrel))) 71 | 72 | (defn rename-keys 73 | "Returns the map with the keys in kmap renamed to the vals in kmap" 74 | [map kmap] 75 | (reduce 76 | (fn [m [old new]] 77 | (if (and (not= old new) 78 | (contains? m old)) 79 | (-> m (assoc new (get m old)) (dissoc old)) 80 | m)) 81 | map kmap)) 82 | 83 | (defn rename 84 | "Returns a rel of the maps in xrel with the keys in kmap renamed to the vals in kmap" 85 | [xrel kmap] 86 | (set (map #(rename-keys % kmap) xrel))) 87 | 88 | (defn index 89 | "Returns a map of the distinct values of ks in the xrel mapped to a 90 | set of the maps in xrel with the corresponding values of ks." 91 | [xrel ks] 92 | (reduce 93 | (fn [m x] 94 | (let [ik (select-keys x ks)] 95 | (assoc m ik (conj (get m ik #{}) x)))) 96 | {} xrel)) 97 | 98 | (defn map-invert 99 | "Returns the map with the vals mapped to the keys." 100 | [m] (reduce (fn [m [k v]] (assoc m v k)) {} m)) 101 | 102 | (defn join 103 | "When passed 2 rels, returns the rel corresponding to the natural 104 | join. When passed an additional keymap, joins on the corresponding 105 | keys." 106 | ([xrel yrel] ;natural join 107 | (if (and (seq xrel) (seq yrel)) 108 | (let [ks (intersection (set (keys (first xrel))) (set (keys (first yrel)))) 109 | [r s] (if (<= (count xrel) (count yrel)) 110 | [xrel yrel] 111 | [yrel xrel]) 112 | idx (index r ks)] 113 | (reduce (fn [ret x] 114 | (let [found (idx (select-keys x ks))] 115 | (if found 116 | (reduce #(conj %1 (merge %2 x)) ret found) 117 | ret))) 118 | #{} s)) 119 | #{})) 120 | ([xrel yrel km] ;arbitrary key mapping 121 | (let [[r s k] (if (<= (count xrel) (count yrel)) 122 | [xrel yrel (map-invert km)] 123 | [yrel xrel km]) 124 | idx (index r (vals k))] 125 | (reduce (fn [ret x] 126 | (let [found (idx (rename-keys (select-keys x (keys k)) k))] 127 | (if found 128 | (reduce #(conj %1 (merge %2 x)) ret found) 129 | ret))) 130 | #{} s)))) 131 | 132 | (defn subset? 133 | "Is set1 a subset of set2?" 134 | [set1 set2] 135 | (and (<= (count set1) (count set2)) 136 | (every? #(contains? set2 %) set1))) 137 | 138 | (defn superset? 139 | "Is set1 a superset of set2?" 140 | [set1 set2] 141 | (and (>= (count set1) (count set2)) 142 | (every? #(contains? set1 %) set2))) 143 | 144 | (comment 145 | (refer 'set) 146 | (def xs #{{:a 11 :b 1 :c 1 :d 4} 147 | {:a 2 :b 12 :c 2 :d 6} 148 | {:a 3 :b 3 :c 3 :d 8 :f 42}}) 149 | 150 | (def ys #{{:a 11 :b 11 :c 11 :e 5} 151 | {:a 12 :b 11 :c 12 :e 3} 152 | {:a 3 :b 3 :c 3 :e 7 }}) 153 | 154 | (join xs ys) 155 | (join xs (rename ys {:b :yb :c :yc}) {:a :a}) 156 | 157 | (union #{:a :b :c} #{:c :d :e }) 158 | (difference #{:a :b :c} #{:c :d :e}) 159 | (intersection #{:a :b :c} #{:c :d :e}) 160 | 161 | (index ys [:b])) 162 | 163 | -------------------------------------------------------------------------------- /src/cljscm/clojure/browser/net.cljscm: -------------------------------------------------------------------------------- 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 ^{:doc "Network communication library, wrapping goog.net. 10 | Includes a common API over XhrIo, CrossPageChannel, and Websockets." 11 | :author "Bobby Calderwood and Alex Redington"} 12 | clojure.browser.net 13 | (:require [clojure.browser.event :as event] 14 | [goog.net.XhrIo :as gxhrio] 15 | [goog.net.EventType :as gnet-event-type] 16 | [goog.net.xpc.CfgFields :as gxpc-config-fields] 17 | [goog.net.xpc.CrossPageChannel :as xpc] 18 | #_[goog.net.WebSocket :as gwebsocket] 19 | [goog.json :as gjson])) 20 | 21 | (def *timeout* 10000) 22 | 23 | (def event-types 24 | (into {} 25 | (map 26 | (fn [[k v]] 27 | [(keyword (. k (toLowerCase))) 28 | v]) 29 | (merge 30 | (js->clj goog.net.EventType))))) 31 | 32 | (defprotocol IConnection 33 | (connect 34 | [this] 35 | [this opt1] 36 | [this opt1 opt2] 37 | [this opt1 opt2 opt3]) 38 | (transmit 39 | [this opt] 40 | [this opt opt2] 41 | [this opt opt2 opt3] 42 | [this opt opt2 opt3 opt4] 43 | [this opt opt2 opt3 opt4 opt5]) 44 | (close [this])) 45 | 46 | (extend-type goog.net.XhrIo 47 | 48 | IConnection 49 | (transmit 50 | ([this uri] 51 | (transmit this uri "GET" nil nil *timeout*)) 52 | ([this uri method] 53 | (transmit this uri method nil nil *timeout*)) 54 | ([this uri method content] 55 | (transmit this uri method content nil *timeout*)) 56 | ([this uri method content headers] 57 | (transmit this uri method content headers *timeout*)) 58 | ([this uri method content headers timeout] 59 | (.setTimeoutInterval this timeout) 60 | (.send this uri method content headers))) 61 | 62 | 63 | event/EventType 64 | (event-types [this] 65 | (into {} 66 | (map 67 | (fn [[k v]] 68 | [(keyword (. k (toLowerCase))) 69 | v]) 70 | (merge 71 | (js->clj goog.net.EventType)))))) 72 | 73 | ;; TODO jQuery/sinatra/RestClient style API: (get [uri]), (post [uri payload]), (put [uri payload]), (delete [uri]) 74 | 75 | (def xpc-config-fields 76 | (into {} 77 | (map 78 | (fn [[k v]] 79 | [(keyword (. k (toLowerCase))) 80 | v]) 81 | (js->clj goog.net.xpc.CfgFields)))) 82 | 83 | (defn xhr-connection 84 | "Returns an XhrIo connection" 85 | [] 86 | (goog.net.XhrIo.)) 87 | 88 | (defprotocol ICrossPageChannel 89 | (register-service [this service-name fn] [this service-name fn encode-json?])) 90 | 91 | (extend-type goog.net.xpc.CrossPageChannel 92 | 93 | ICrossPageChannel 94 | (register-service 95 | ([this service-name fn] 96 | (register-service this service-name fn false)) 97 | ([this service-name fn encode-json?] 98 | (.registerService this (name service-name) fn encode-json?))) 99 | 100 | IConnection 101 | (connect 102 | ([this] 103 | (connect this nil)) 104 | ([this on-connect-fn] 105 | (.connect this on-connect-fn)) 106 | ([this on-connect-fn config-iframe-fn] 107 | (connect this on-connect-fn config-iframe-fn (.-body js/document))) 108 | ([this on-connect-fn config-iframe-fn iframe-parent] 109 | (.createPeerIframe this iframe-parent config-iframe-fn) 110 | (.connect this on-connect-fn))) 111 | 112 | (transmit [this service-name payload] 113 | (.send this (name service-name) payload)) 114 | 115 | (close [this] 116 | (.close this ()))) 117 | 118 | (defn xpc-connection 119 | "When passed with a config hash-map, returns a parent 120 | CrossPageChannel object. Keys in the config hash map are downcased 121 | versions of the goog.net.xpc.CfgFields enum keys, 122 | e.g. goog.net.xpc.CfgFields.PEER_URI becomes :peer_uri in the config 123 | hash. 124 | 125 | When passed with no args, creates a child CrossPageChannel object, 126 | and the config is automatically taken from the URL param 'xpc', as 127 | per the CrossPageChannel API." 128 | ([] 129 | (when-let [config (.getParameterValue 130 | (goog.Uri. (.-href (.-location js/window))) 131 | "xpc")] 132 | (goog.net.xpc.CrossPageChannel. (gjson/parse config)))) 133 | ([config] 134 | (goog.net.xpc.CrossPageChannel. 135 | (reduce (fn [sum [k v]] 136 | (if-let [field (get xpc-config-fields k)] 137 | (doto sum (aset field v)) 138 | sum)) 139 | (js-obj) 140 | config)))) 141 | 142 | ;; WebSocket is not supported in the 3/23/11 release of Google 143 | ;; Closure, but will be included in the next release. 144 | 145 | #_(defprotocol IWebSocket 146 | (open? [this])) 147 | 148 | #_(extend-type goog.net.WebSocket 149 | 150 | IWebSocket 151 | (open? [this] 152 | (.isOpen this ())) 153 | 154 | IConnection 155 | (connect 156 | ([this url] 157 | (connect this url nil)) 158 | ([this url protocol] 159 | (.open this url protocol))) 160 | 161 | (transmit [this message] 162 | (.send this message)) 163 | 164 | (close [this] 165 | (.close this ())) 166 | 167 | event/EventType 168 | (event-types [this] 169 | (into {} 170 | (map 171 | (fn [[k v]] 172 | [(keyword (. k (toLowerCase))) 173 | v]) 174 | (merge 175 | (js->clj goog.net.WebSocket/EventType)))))) 176 | 177 | #_(defn websocket-connection 178 | ([] 179 | (websocket-connection nil nil)) 180 | ([auto-reconnect?] 181 | (websocket-connection auto-reconnect? nil)) 182 | ([auto-reconnect? next-reconnect-fn] 183 | (goog.net.WebSocket. auto-reconnect? next-reconnect-fn))) -------------------------------------------------------------------------------- /benchmark/cljs/benchmark_runner.cljs: -------------------------------------------------------------------------------- 1 | (ns cljs.benchmark-runner 2 | (:refer-clojure :exclude [println]) 3 | (:require [cljs.reader :as reader])) 4 | 5 | (def println print) 6 | 7 | (set! *print-fn* js/print) 8 | 9 | (simple-benchmark [x 1] (identity x) 1000000) 10 | 11 | (println ";; array-reduce & ci-reduce") 12 | (def arr (let [arr (array)] 13 | (dotimes [i 1000000] 14 | (.push arr i)) 15 | arr)) 16 | (defn sum [a b] (+ a b)) 17 | (simple-benchmark [coll (seq arr)] (ci-reduce coll + 0) 1) 18 | (simple-benchmark [coll (seq arr)] (ci-reduce coll sum 0) 1) 19 | (simple-benchmark [coll arr] (array-reduce coll + 0) 1) 20 | (simple-benchmark [coll arr] (array-reduce coll sum 0) 1) 21 | 22 | (println ";;; instance?") 23 | ;; WARNING: will get compiled away under advanced 24 | (simple-benchmark [coll []] (instance? PersistentVector coll) 1000000) 25 | (println ";;; satisfies?") 26 | (simple-benchmark [coll (list 1 2 3)] (satisfies? ISeq coll) 1000000) 27 | (simple-benchmark [coll [1 2 3]] (satisfies? ISeq coll) 1000000) 28 | (println) 29 | 30 | (println ";;; list ops") 31 | (simple-benchmark [coll (list 1 2 3)] (first coll) 1000000) 32 | (simple-benchmark [coll (list 1 2 3)] (-first coll) 1000000) 33 | (simple-benchmark [coll (list 1 2 3)] (rest coll) 1000000) 34 | (simple-benchmark [coll (list 1 2 3)] (-rest coll) 1000000) 35 | (simple-benchmark [] (list) 1000000) 36 | (simple-benchmark [] (list 1 2 3) 1000000) 37 | (println) 38 | 39 | (println ";;; vector ops") 40 | (simple-benchmark [] [] 1000000) 41 | (simple-benchmark [] [1 2 3] 1000000) 42 | (simple-benchmark [coll [1 2 3]] (transient coll) 100000) 43 | (simple-benchmark [coll [1 2 3]] (nth coll 0) 1000000) 44 | (simple-benchmark [coll [1 2 3]] (-nth coll 0) 1000000) 45 | (simple-benchmark [coll [1 2 3]] (conj coll 4) 1000000) 46 | (simple-benchmark [coll [1 2 3]] (-conj coll 4) 1000000) 47 | (simple-benchmark [coll [1 2 3]] (seq coll) 1000000) 48 | (simple-benchmark [coll (seq [1 2 3])] (first coll) 1000000) 49 | (simple-benchmark [coll (seq [1 2 3])] (-first coll) 1000000) 50 | (simple-benchmark [coll (seq [1 2 3])] (rest coll) 1000000) 51 | (simple-benchmark [coll (seq [1 2 3])] (-rest coll) 1000000) 52 | (simple-benchmark [coll (seq [1 2 3])] (next coll) 1000000) 53 | (println) 54 | 55 | (println ";;; large vector ops") 56 | (simple-benchmark [] (reduce conj [] (range 40000)) 10) 57 | (simple-benchmark [coll (reduce conj [] (range (+ 32768 32)))] (conj coll :foo) 100000) 58 | (simple-benchmark [coll (reduce conj [] (range 40000))] (assoc coll 123 :foo) 100000) 59 | (simple-benchmark [coll (reduce conj [] (range (+ 32768 33)))] (pop coll) 100000) 60 | (println) 61 | 62 | (println ";;; transients") 63 | (print "transient vector, conj! 1000000 items") 64 | (time 65 | (let [v (transient [])] 66 | (loop [i 0 v v] 67 | (if (> i 1000000) 68 | (persistent! v) 69 | (recur (inc i) (conj! v i)))))) 70 | 71 | (println ";;; reduce lazy-seqs, vectors, ranges") 72 | (simple-benchmark [coll (take 100000 (iterate inc 0))] (reduce + 0 coll) 1) 73 | (simple-benchmark [coll (range 1000000)] (reduce + 0 coll) 1) 74 | (simple-benchmark [coll (into [] (range 1000000))] (reduce + 0 coll) 1) 75 | (println) 76 | 77 | (println ";; apply") 78 | (simple-benchmark [coll (into [] (range 1000000))] (apply + coll) 1) 79 | (println) 80 | 81 | (println ";;; map / record ops") 82 | (simple-benchmark [coll {:foo 1 :bar 2}] (get coll :foo) 1000000) 83 | (simple-benchmark [coll {:foo 1 :bar 2}] (-lookup coll :foo nil) 1000000) 84 | (simple-benchmark [coll {:foo 1 :bar 2}] (:foo coll) 1000000) 85 | (defrecord Foo [bar baz]) 86 | (simple-benchmark [coll (Foo. 1 2)] (:bar coll) 1000000) 87 | (simple-benchmark [coll {:foo 1 :bar 2}] (assoc coll :baz 3) 100000) 88 | (simple-benchmark [coll {:foo 1 :bar 2}] (assoc coll :foo 2) 100000) 89 | (simple-benchmark [coll {:foo 1 :bar 2}] 90 | (loop [i 0 m coll] 91 | (if (< i 100000) 92 | (recur (inc i) (assoc m :foo 2)) 93 | m)) 94 | 1) 95 | (println ";;; persistent hash maps") 96 | (def pmap (into cljs.core.PersistentHashMap/EMPTY 97 | [[:a 0] [:b 1] [:c 2] [:d 3] [:e 4] [:f 5] [:g 6] [:h 7] 98 | [:i 8] [:j 9] [:k 10] [:l 11] [:m 12] [:n 13] [:o 14] [:p 15] 99 | [:q 16] [:r 17] [:s 18] [:t 19] [:u 20] [:v 21] [:w 22] [:x 23] 100 | [:y 24] [:z 25] [:a0 26] [:b0 27] [:c0 28] [:d0 29] [:e0 30] [:f0 31]])) 101 | (simple-benchmark [key :f0] (hash key) 1000000) 102 | (simple-benchmark [key :unsynchronized-mutable] (hash key false) 1000000) 103 | (simple-benchmark [key :unsynchronized-mutable] (hash key) 1000000) 104 | (def hash-coll-test 105 | (loop [i 0 r []] 106 | (if (< i 1000) 107 | (recur (inc i) (conj r (str "foo" i))) 108 | r))) 109 | (simple-benchmark [coll hash-coll-test] (hash-coll coll) 100) 110 | (simple-benchmark [coll pmap] (:f0 coll) 1000000) 111 | (simple-benchmark [coll pmap] (get coll :f0) 1000000) 112 | (simple-benchmark [coll pmap] (-lookup coll :f0 nil) 1000000) 113 | (simple-benchmark [coll pmap] (assoc coll :g0 32) 1000000) 114 | (simple-benchmark [coll pmap] 115 | (loop [i 0 m coll] 116 | (if (< i 1000000) 117 | (recur (inc i) (assoc m :a 1)) 118 | m)) 119 | 1) 120 | (simple-benchmark [coll cljs.core.PersistentHashMap/EMPTY] (assoc coll :f0 1) 1000000) 121 | (println) 122 | 123 | (println ";;; set ops") 124 | (simple-benchmark [] #{} 100000) 125 | (simple-benchmark [] #{1 2 3} 100000) 126 | (simple-benchmark [coll #{1 2 3}] (conj coll 4) 100000) 127 | (println) 128 | 129 | (println ";;; seq ops") 130 | (simple-benchmark [coll (range 500000)] (reduce + coll) 1) 131 | (println) 132 | 133 | (println ";;; reader") 134 | (simple-benchmark [s "{:foo [1 2 3]}"] (reader/read-string s) 1000) 135 | (println) 136 | 137 | (println ";;; range") 138 | (simple-benchmark [r (range 1000000)] (last r) 1) 139 | (println) 140 | 141 | (defn ints-seq 142 | ([n] (ints-seq 0 n)) 143 | ([i n] 144 | (when (< i n) 145 | (lazy-seq 146 | (cons i (ints-seq (inc i) n)))))) 147 | (def r (ints-seq 1000000)) 148 | (println ";;; lazy-seq") 149 | (println ";;; first run") 150 | (simple-benchmark [r r] (last r) 1) 151 | (println ";;; second run") 152 | (simple-benchmark [r r] (last r) 1) 153 | (println) 154 | 155 | (println "\n") 156 | -------------------------------------------------------------------------------- /src/clj/cljscm/repl/server.clj: -------------------------------------------------------------------------------- 1 | (ns cljscm.repl.server 2 | (:refer-clojure :exclude [loaded-libs]) 3 | (:require [clojure.string :as str] 4 | [clojure.java.io :as io] 5 | [cljscm.compiler :as comp] 6 | [cljscm.closure :as cljsc] 7 | [cljscm.repl :as repl]) 8 | (:import java.io.BufferedReader 9 | java.io.BufferedWriter 10 | java.io.InputStreamReader 11 | java.io.OutputStreamWriter 12 | java.net.Socket 13 | java.net.ServerSocket 14 | cljscm.repl.IJavaScriptEnv)) 15 | 16 | (defonce state (atom {:socket nil 17 | :connection nil 18 | :promised-conn nil})) 19 | 20 | (defn connection 21 | "Promise to return a connection when one is available. If a 22 | connection is not available, store the promise in server/state." 23 | [] 24 | (let [p (promise) 25 | conn (:connection @state)] 26 | (if (and conn (not (.isClosed conn))) 27 | (do (deliver p conn) 28 | p) 29 | (do (swap! state (fn [old] (assoc old :promised-conn p))) 30 | p)))) 31 | 32 | (defn set-connection 33 | "Given a new available connection, either use it to deliver the 34 | connection which was promised or store the connection for later 35 | use." 36 | [conn] 37 | (if-let [promised-conn (:promised-conn @state)] 38 | (do (swap! state (fn [old] (-> old 39 | (assoc :connection nil) 40 | (assoc :promised-conn nil)))) 41 | (deliver promised-conn conn)) 42 | (swap! state (fn [old] (assoc old :connection conn))))) 43 | 44 | (defonce handlers (atom {})) 45 | 46 | (defn dispatch-on 47 | "Registers a handler to be dispatched based on a request method and a 48 | predicate. 49 | 50 | pred should be a function that accepts an options map, a connection, 51 | and a request map and returns a boolean value based on whether or not 52 | that request should be dispatched to the related handler." 53 | ([method pred handler] 54 | (dispatch-on method {:pred pred :handler handler})) 55 | ([method {:as m}] 56 | (swap! handlers (fn [old] 57 | (update-in old [method] #(conj (vec %) m)))))) 58 | 59 | ;;; assumes first line already consumed 60 | (defn parse-headers 61 | "Parse the headers of an HTTP POST request." 62 | [header-lines] 63 | (apply hash-map 64 | (mapcat 65 | (fn [line] 66 | (let [[k v] (str/split line #":" 2)] 67 | [(keyword (str/lower-case k)) (str/triml v)])) 68 | header-lines))) 69 | 70 | (defn read-headers [rdr] 71 | (loop [next-line (.readLine rdr) 72 | header-lines []] 73 | (if (= "" next-line) 74 | header-lines ;we're done reading headers 75 | (recur (.readLine rdr) (conj header-lines next-line))))) 76 | 77 | (defn read-post [line rdr] 78 | (let [[_ path _] (str/split line #" ") 79 | headers (parse-headers (read-headers rdr)) 80 | content-length (Integer/parseInt (:content-length headers)) 81 | content (char-array content-length)] 82 | (io! (.read rdr content 0 content-length) 83 | {:method :post 84 | :path path 85 | :headers headers 86 | :content (String. content)}))) 87 | 88 | (defn read-get [line rdr] 89 | (let [[_ path _] (str/split line #" ") 90 | headers (parse-headers (read-headers rdr))] 91 | {:method :get 92 | :path path 93 | :headers headers})) 94 | 95 | (defn read-request [rdr] 96 | (let [line (.readLine rdr)] 97 | (cond (.startsWith line "POST") (read-post line rdr) 98 | (.startsWith line "GET") (read-get line rdr) 99 | :else {:method :unknown :content line}))) 100 | 101 | (defn- status-line [status] 102 | (case status 103 | 200 "HTTP/1.1 200 OK" 104 | 404 "HTTP/1.1 404 Not Found" 105 | "HTTP/1.1 500 Error")) 106 | 107 | (defn send-and-close 108 | "Use the passed connection to send a form to the browser. Send a 109 | proper HTTP response." 110 | ([conn status form] 111 | (send-and-close conn status form "text/html")) 112 | ([conn status form content-type] 113 | (let [utf-8-form (.getBytes form "UTF-8") 114 | content-length (count utf-8-form) 115 | headers (map #(.getBytes (str % "\r\n")) 116 | [(status-line status) 117 | "Server: ClojureScript REPL" 118 | (str "Content-Type: " 119 | content-type 120 | "; charset=utf-8") 121 | (str "Content-Length: " content-length) 122 | ""])] 123 | (with-open [os (.getOutputStream conn)] 124 | (do (doseq [header headers] 125 | (.write os header 0 (count header))) 126 | (.write os utf-8-form 0 content-length) 127 | (.flush os) 128 | (.close conn)))))) 129 | 130 | (defn send-404 [conn path] 131 | (send-and-close conn 404 132 | (str "" 133 | "

Page not found

" 134 | "No page " path " found on this server." 135 | "") 136 | "text/html")) 137 | 138 | (defn- dispatch-request [request conn opts] 139 | (if-let [handlers ((:method request) @handlers)] 140 | (if-let [handler (some (fn [{:keys [pred handler]}] 141 | (when (pred request conn opts) 142 | handler)) 143 | handlers)] 144 | (if (= :post (:method request)) 145 | (handler (read-string (:content request)) conn opts ) 146 | (handler request conn opts)) 147 | (send-404 conn (:path request))) 148 | (.close conn))) 149 | 150 | (defn- handle-connection 151 | [opts conn] 152 | (let [rdr (BufferedReader. (InputStreamReader. (.getInputStream conn)))] 153 | (if-let [request (read-request rdr)] 154 | (dispatch-request request conn opts) 155 | (.close conn)))) 156 | 157 | (defn- server-loop 158 | [opts server-socket] 159 | (let [conn (.accept server-socket)] 160 | (do (.setKeepAlive conn true) 161 | (future (handle-connection opts conn)) 162 | (recur opts server-socket)))) 163 | 164 | (defn start 165 | "Start the server on the specified port." 166 | [opts] 167 | (let [ss (ServerSocket. (:port opts))] 168 | (future (server-loop opts ss)) 169 | (swap! state (fn [old] (assoc old :socket ss :port (:port opts)))))) 170 | 171 | (defn stop 172 | [] 173 | (.close (:socket @state))) 174 | -------------------------------------------------------------------------------- /src/clj/cljscm/repl/rhino.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Rich Hickey. All rights reserved. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ;; which can be found in the file epl-v10.html at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns cljscm.repl.rhino 10 | (:require [clojure.string :as string] 11 | [clojure.java.io :as io] 12 | [cljscm.compiler :as comp] 13 | [cljscm.analyzer :as ana] 14 | [cljscm.repl :as repl]) 15 | (:import cljscm.repl.IJavaScriptEnv 16 | [org.mozilla.javascript Context ScriptableObject])) 17 | 18 | (def current-repl-env (atom nil)) 19 | 20 | ;;todo - move to core.cljs, using js 21 | (def ^String bootjs (str "goog.require = function(rule){" 22 | "Packages.clojure.lang.RT[\"var\"](\"cljscm.repl.rhino\",\"goog-require\")" 23 | ".invoke(___repl_env, rule);}")) 24 | 25 | (defprotocol IEval 26 | (-eval [this env filename line])) 27 | 28 | (extend-protocol IEval 29 | 30 | java.lang.String 31 | (-eval [this {:keys [cx scope]} filename line] 32 | (.evaluateString cx scope this filename line nil)) 33 | 34 | java.io.Reader 35 | (-eval [this {:keys [cx scope]} filename line] 36 | (.evaluateReader cx scope this filename line nil)) 37 | ) 38 | 39 | (defmulti stacktrace class) 40 | 41 | (defmethod stacktrace :default [e] 42 | (apply str (interpose "\n" (map #(str " " (.toString %)) (.getStackTrace e))))) 43 | 44 | (defmethod stacktrace org.mozilla.javascript.RhinoException [e] 45 | (.getScriptStackTrace e)) 46 | 47 | (defmulti eval-result class) 48 | 49 | (defmethod eval-result :default [r] 50 | (.toString r)) 51 | 52 | (defmethod eval-result nil [_] "") 53 | 54 | (defmethod eval-result org.mozilla.javascript.Undefined [_] "") 55 | 56 | (defn rhino-eval 57 | [repl-env filename line js] 58 | (try 59 | (let [linenum (or line Integer/MIN_VALUE)] 60 | {:status :success 61 | :value (eval-result (-eval js repl-env filename linenum))}) 62 | (catch Throwable ex 63 | {:status :exception 64 | :value (.toString ex) 65 | :stacktrace (stacktrace ex)}))) 66 | 67 | (defn goog-require [repl-env rule] 68 | (when-not (contains? @(:loaded-libs repl-env) rule) 69 | (let [repl-env @current-repl-env 70 | path (string/replace (comp/munge rule) \. java.io.File/separatorChar) 71 | cljs-path (str path ".cljs") 72 | js-path (str "goog/" 73 | (-eval (str "goog.dependencies_.nameToPath['" rule "']") 74 | repl-env 75 | "" 76 | 1))] 77 | (if-let [res (io/resource cljs-path)] 78 | (binding [ana/*cljs-ns* 'cljscm.user] 79 | (repl/load-stream repl-env res)) 80 | (if-let [res (io/resource js-path)] 81 | (-eval (io/reader res) repl-env js-path 1) 82 | (throw (Exception. (str "Cannot find " cljs-path " or " js-path " in classpath"))))) 83 | (swap! (:loaded-libs repl-env) conj rule)))) 84 | 85 | (defn load-javascript [repl-env ns url] 86 | (let [missing (remove #(contains? @(:loaded-libs repl-env) %) ns)] 87 | (when (seq missing) 88 | (do (try 89 | (-eval (io/reader url) repl-env (.toString url) 1) 90 | ;; TODO: don't show errors for goog/base.js line number 105 91 | (catch Throwable ex (println (.getMessage ex)))) 92 | (swap! (:loaded-libs repl-env) (partial apply conj) missing))))) 93 | 94 | (defn rhino-setup [repl-env] 95 | (let [env (ana/empty-env) 96 | scope (:scope repl-env)] 97 | (repl/load-file repl-env "cljs/core.cljs") 98 | (swap! (:loaded-libs repl-env) conj "cljscm.core") 99 | (repl/evaluate-form repl-env 100 | env 101 | "" 102 | '(ns cljscm.user)) 103 | (ScriptableObject/putProperty scope 104 | "out" 105 | (Context/javaToJS System/out scope)) 106 | (repl/evaluate-form repl-env 107 | env 108 | "" 109 | '(set! *print-fn* (fn [x] (.print js/out x)))))) 110 | 111 | (defrecord RhinoEnv [loaded-libs] 112 | repl/IJavaScriptEnv 113 | (-setup [this] 114 | (rhino-setup this)) 115 | (-evaluate [this filename line js] 116 | (rhino-eval this filename line js)) 117 | (-load [this ns url] 118 | (load-javascript this ns url)) 119 | (-tear-down [_] (Context/exit))) 120 | 121 | (defn repl-env 122 | "Returns a fresh JS environment, suitable for passing to repl. 123 | Hang on to return for use across repl calls." 124 | [] 125 | (let [cx (Context/enter) 126 | scope (.initStandardObjects cx) 127 | base (io/resource "goog/base.js") 128 | deps (io/resource "goog/deps.js") 129 | new-repl-env (merge (RhinoEnv. (atom #{})) {:cx cx :scope scope})] 130 | (assert base "Can't find goog/base.js in classpath") 131 | (assert deps "Can't find goog/deps.js in classpath") 132 | (swap! current-repl-env (fn [old] new-repl-env)) 133 | (ScriptableObject/putProperty scope 134 | "___repl_env" 135 | (Context/javaToJS new-repl-env scope)) 136 | (with-open [r (io/reader base)] 137 | (-eval r new-repl-env "goog/base.js" 1)) 138 | (-eval bootjs new-repl-env "bootjs" 1) 139 | ;; Load deps.js line-by-line to avoid 64K method limit 140 | (doseq [^String line (line-seq (io/reader deps))] 141 | (-eval line new-repl-env "goog/deps.js" 1)) 142 | new-repl-env)) 143 | 144 | (comment 145 | 146 | (require '[cljscm.repl :as repl]) 147 | (require '[cljscm.repl.rhino :as rhino]) 148 | (def env (rhino/repl-env)) 149 | (repl/repl env) 150 | (+ 1 1) 151 | "hello" 152 | {:a "hello"} 153 | (:a {:a "hello"}) 154 | (:a {:a :b}) 155 | (reduce + [1 2 3 4 5]) 156 | (time (reduce + [1 2 3 4 5])) 157 | (even? :a) 158 | (throw (js/Error. "There was an error")) 159 | (load-file "clojure/string.cljs") 160 | (clojure.string/triml " hello") 161 | (clojure.string/reverse " hello") 162 | 163 | (load-namespace 'clojure.set) 164 | 165 | (ns test.crypt 166 | (:require [goog.crypt :as c])) 167 | (c/stringToByteArray "Hello") 168 | 169 | (load-namespace 'goog.date.Date) 170 | (goog.date.Date.) 171 | 172 | ) 173 | -------------------------------------------------------------------------------- /src/clj/cljscm/repl.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Rich Hickey. All rights reserved. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ;; which can be found in the file epl-v10.html at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns cljscm.repl 10 | (:refer-clojure :exclude [load-file]) 11 | (:import java.io.File) 12 | (:require [clojure.string :as string] 13 | [clojure.java.io :as io] 14 | [cljscm.compiler :as comp] 15 | [cljscm.analyzer :as ana] 16 | [cljscm.tagged-literals :as tags] 17 | [cljscm.closure :as cljsc])) 18 | 19 | (def ^:dynamic *cljs-verbose* false) 20 | 21 | (defprotocol IJavaScriptEnv 22 | (-setup [this] "initialize the environment") 23 | (-evaluate [this filename line js] "evaluate a javascript string") 24 | (-load [this ns url] "load code at url into the environment") 25 | (-tear-down [this] "dispose of the environment")) 26 | 27 | (defn load-namespace 28 | "Load a namespace and all of its dependencies into the evaluation environment. 29 | The environment is responsible for ensuring that each namespace is loaded once and 30 | only once." 31 | [repl-env sym] 32 | (let [sym (if (and (seq? sym) 33 | (= (first sym) 'quote)) 34 | (second sym) 35 | sym) 36 | opts {:output-dir (get repl-env :working-dir ".repl")} 37 | deps (->> (cljsc/add-dependencies opts {:requires [(name sym)] :type :seed}) 38 | (remove (comp #{["goog"]} :provides)) 39 | (remove (comp #{:seed} :type)) 40 | (map #(select-keys % [:provides :url])))] 41 | (doseq [{:keys [url provides]} deps] 42 | (-load repl-env provides url)))) 43 | 44 | (defn- load-dependencies 45 | [repl-env requires] 46 | (doseq [ns requires] 47 | (load-namespace repl-env ns))) 48 | 49 | (defn- display-error 50 | ([ret form] 51 | (display-error ret form (constantly nil))) 52 | ([ret form f] 53 | (when-not (and (seq? form) (= 'ns (first form))) 54 | (f) 55 | (println (:value ret)) 56 | (when-let [st (:stacktrace ret)] 57 | (println st))))) 58 | 59 | (defn evaluate-form 60 | "Evaluate a ClojureScript form in the JavaScript environment. Returns a 61 | string which is the ClojureScript return value. This string may or may 62 | not be readable by the Clojure reader." 63 | ([repl-env env filename form] 64 | (evaluate-form repl-env env filename form identity)) 65 | ([repl-env env filename form wrap] 66 | (try 67 | (let [ast (ana/analyze env form) 68 | js (comp/emit-str ast) 69 | wrap-js (comp/emit-str (binding [ana/*cljs-warn-on-undeclared* false 70 | ana/*cljs-warn-on-redef* false 71 | ana/*cljs-warn-on-dynamic* false 72 | ana/*cljs-warn-on-fn-var* false 73 | ana/*cljs-warn-fn-arity* false] 74 | (ana/analyze env (wrap form))))] 75 | (when (= (:op ast) :ns) 76 | (load-dependencies repl-env (into (vals (:requires ast)) 77 | (distinct (vals (:uses ast)))))) 78 | (when *cljs-verbose* 79 | (print js)) 80 | (let [ret (-evaluate repl-env filename (:line (meta form)) wrap-js)] 81 | (case (:status ret) 82 | ;;we eat ns errors because we know goog.provide() will throw when reloaded 83 | ;;TODO - file bug with google, this is bs error 84 | ;;this is what you get when you try to 'teach new developers' 85 | ;;via errors (goog/base.js 104) 86 | :error (display-error ret form) 87 | :exception (display-error ret form 88 | #(prn "Error evaluating:" form :as js)) 89 | :success (:value ret)))) 90 | (catch Throwable ex 91 | (.printStackTrace ex) 92 | (println (str ex)))))) 93 | 94 | (defn load-stream [repl-env filename stream] 95 | (with-open [r (io/reader stream)] 96 | (let [env (ana/empty-env) 97 | pbr (clojure.lang.LineNumberingPushbackReader. r) 98 | eof (Object.)] 99 | (loop [r (read pbr false eof false)] 100 | (let [env (assoc env :ns (ana/get-namespace ana/*cljs-ns*))] 101 | (when-not (identical? eof r) 102 | (evaluate-form repl-env env filename r) 103 | (recur (read pbr false eof false)))))))) 104 | 105 | (defn load-file 106 | [repl-env f] 107 | (binding [ana/*cljs-ns* 'cljscm.user] 108 | (let [res (if (= \/ (first f)) f (io/resource f))] 109 | (assert res (str "Can't find " f " in classpath")) 110 | (load-stream repl-env f res)))) 111 | 112 | (defn- wrap-fn [form] 113 | (cond (and (seq? form) (= 'ns (first form))) identity 114 | ('#{*1 *2 *3} form) (fn [x] `(cljscm.core.pr-str ~x)) 115 | :else (fn [x] `(cljscm.core.pr-str 116 | (let [ret# ~x] 117 | (do (set! *3 *2) 118 | (set! *2 *1) 119 | (set! *1 ret#) 120 | ret#)))))) 121 | 122 | (defn- eval-and-print [repl-env env form] 123 | (let [ret (evaluate-form repl-env 124 | (assoc env :ns (ana/get-namespace ana/*cljs-ns*)) 125 | "" 126 | form 127 | (wrap-fn form))] 128 | (try (prn (read-string ret)) 129 | (catch Exception e 130 | (if (string? ret) 131 | (println ret) 132 | (prn nil)))))) 133 | 134 | (defn- read-next-form [] 135 | (try {:status :success :form (binding [*ns* (create-ns ana/*cljs-ns*) 136 | *data-readers* tags/*cljs-data-readers*] 137 | (read))} 138 | (catch Exception e 139 | (println (.getMessage e)) 140 | {:status :error}))) 141 | 142 | (def default-special-fns 143 | (let [load-file-fn (fn [repl-env file] (load-file repl-env file))] 144 | {'in-ns (fn [_ quoted-ns] 145 | (let [ns-name (second quoted-ns)] 146 | (when-not (ana/get-namespace ns-name) 147 | (ana/set-namespace ns-name {:name ns-name})) 148 | (set! ana/*cljs-ns* ns-name))) 149 | 'load-file load-file-fn 150 | 'clojure.core/load-file load-file-fn 151 | 'load-namespace (fn [repl-env ns] (load-namespace repl-env ns))})) 152 | 153 | (defn analyze-source 154 | "Given a source directory, analyzes all .cljs files. Used to populate 155 | cljscm.analyzer/namespaces so as to support code reflection." 156 | [src-dir] 157 | (if-let [src-dir (and (not (empty? src-dir)) 158 | (File. src-dir))] 159 | (doseq [file (comp/cljs-files-in src-dir)] 160 | (ana/analyze-file (str "file://" (.getAbsolutePath file)))))) 161 | 162 | (defn repl 163 | "Note - repl will reload core.cljs every time, even if supplied old repl-env" 164 | [repl-env & {:keys [analyze-path verbose warn-on-undeclared special-fns]}] 165 | (prn "Type: " :cljs/quit " to quit") 166 | (binding [ana/*cljs-ns* 'cljscm.user 167 | *cljs-verbose* verbose 168 | ana/*cljs-warn-on-undeclared* warn-on-undeclared] 169 | (when analyze-path 170 | (analyze-source analyze-path)) 171 | (let [env {:context :expr :locals {}} 172 | special-fns (merge default-special-fns special-fns) 173 | is-special-fn? (set (keys special-fns))] 174 | (-setup repl-env) 175 | (loop [] 176 | (print (str "ClojureScript:" ana/*cljs-ns* "> ")) 177 | (flush) 178 | (let [{:keys [status form]} (read-next-form)] 179 | (cond 180 | (= form :cljs/quit) :quit 181 | 182 | (= status :error) (recur) 183 | 184 | (and (seq? form) (is-special-fn? (first form))) 185 | (do (apply (get special-fns (first form)) repl-env (rest form)) (newline) (recur)) 186 | 187 | :else 188 | (do (eval-and-print repl-env env form) (recur))))) 189 | (-tear-down repl-env)))) 190 | -------------------------------------------------------------------------------- /devnotes/day1.org: -------------------------------------------------------------------------------- 1 | * ClojureScript Day #1 2 | * Important things to note 3 | ** This should be a dialog, not a lecture 4 | *** stop me, ask questions, understand deeply 5 | ** There are still many things I don't know or haven't decided 6 | *** some tasks will be research 7 | *** some pushback welcome 8 | **** I reserve BDFL rights :) 9 | ** This is an opportunity to get involved early 10 | *** stay flexible to avoid pain 11 | ** Welcome Chouser! 12 | *** One of my first and best users and contributors 13 | *** Someone whose opinions I value, and a Clojure expert 14 | *** Author of a Clojure book not (yet) working at Relevance! 15 | *** The first to walk down the ClojureScript road 16 | ** This is a key Clojure/core (with help) deliverable 17 | *** We do more than maintain, we lead 18 | **** community should be stunned (shhh!) 19 | *** I'm very excited about this aspect 20 | **** let's knock this out of the park! 21 | * Intro and rationale 22 | ** Problem statement 23 | *** Javascript is the only programmable technology in key target environments 24 | **** i.e. the browser 25 | **** nothing will change that for years to come 26 | *** Javascript has the greatest reach in other key environments 27 | **** i.e. mobile 28 | *** Javascript (the language) is not very robust 29 | **** Fewer good parts than bad parts 30 | **** Much convention and discipline required to avoid headaches 31 | **** Conventions differ between shops, libs 32 | *** Ever increasing pressure to create richer applications in these environments 33 | **** requiring more and larger libraries 34 | ***** ordinary minification doesn't scale up 35 | **** increasing requirements complexity 36 | ***** can't add language or environment complexity on top 37 | ** Rationale 38 | *** solving this problem will give developers important leverage 39 | *** empower them to tackle more difficult problems 40 | **** with greater confidence in the robustness of their solutions 41 | *** inspire next-generation approaches to web and mobile development 42 | * Strategy 43 | ** Compile (a subset of) Clojure to Javascript 44 | *** reach everywhere JS does 45 | ** Clojure is simpler, more robust, more concise, more powerful overall than JS 46 | *** yet maps well to JS as implementation artifact 47 | ** Leverage best-of-breed JS appraoches 48 | *** Currently, IMO that is Google's, with Closure compiler and libraries 49 | **** called gclosure hereafter 50 | *** Fortunately both open sourced 51 | *** Gclosure's strategy is whole-program optimization 52 | **** resulting application includes only code actually used 53 | **** this is essential to writing large (and small) applications against large and manifold libraries 54 | ***** while allowing those libs to be written in a straightforward, non-clever manner 55 | ** This is not just about the browser 56 | *** Node.js, plugins anywhere JS is accepted, any future JS-based environments 57 | ** Non-objectives 58 | *** complete Closure 59 | **** subset, but try to make identical features identical 60 | **** document differences 61 | *** porting large applications in their entirety 62 | **** portability layers unifying JS and Java 63 | **** cross platform reach is about moving core competencies and libraries, not everything 64 | ** Profit! 65 | *** ClojureScript becomes the most powerful language for generating the smallest and fastest JS applications 66 | **** ClojureScript runs everywhere JS runs 67 | *** This is Clojure's client story 68 | *** This is Clojure's mobile story 69 | *** A powerful tool for anyone willing to learn Clojure 70 | * Tactics 71 | ** Don't change Clojure itself 72 | *** even though it might make things easier 73 | **** track those things we'd like to be different, and work into Clojure dev schedule 74 | ** The ClojureScript compiler is written in Clojure 75 | *** The reader is Clojure's 76 | *** Macros are written in Clojure 77 | *** therefor, no compiler at runtime, *no eval* 78 | **** browser-hosted REPL a non-target! 79 | *** also, some things that are runtime-reified in Clojure (namespaces, Vars) may not be in ClojureScript 80 | ** GClosure's strategy requires JS to be written in a particular idiom 81 | *** especially for the most advanced optimization 82 | *** ClojureScript will always generate code compliant with advanced optimizations 83 | *** ClojureScript will use the same packaging and dependency strategy as gclosure 84 | ** The gclosure library is an accepted dependency 85 | *** but *nothing else* (other than base JS) 86 | **** ok, and maybe some stealing from GWT output, if we're desperate 87 | ***** but that's really it 88 | *** in particular, use gclosure for all environmental conditionality 89 | **** we make no per-browser decisions ourselves 90 | ** The gclosure compiler is optional, but recommended for final delivery 91 | *** but don't be too stupid without it 92 | ** The compiler has an enriched primitive set (vs Clojure's) 93 | *** deftype 94 | *** defprotocol 95 | *** extend-type 96 | *** need no runtime lib 97 | **** allows bootstrap abstraction and data structures to be written in terms of these 98 | ** The runtime library is completely written in ClojureScript 99 | *** No Javascript! 100 | *** js* primitive escape hatch to reach gnarly stuff that ClojureScript won't expose 101 | ** Presumptions 102 | *** JS is single-threaded, forever 103 | **** nevertheless, we will use Clojure reference primitives (at least atom) 104 | * Roadmap 105 | ** Compiler 106 | *** It's alive! 107 | *** a few more primitives to go 108 | *** output needs to be sussed out 109 | **** esp tested with gclosure compiler 110 | *** some niceties missing (load-file etc) 111 | ** Libraries 112 | *** Many core macros imported and work 113 | **** testing required 114 | **** some missing, like binding, dotimes 115 | *** This space intentionally left blank (core.cljs) 116 | **** that's why you're here! 117 | **** Much work, but following trodden ground 118 | ***** Move the core abstractions to protocols 119 | ***** Implement the core data structures with deftype 120 | ***** copy fn impls, tweaking as needed 121 | ** Tooling 122 | *** ClojureScript written to the spec of gclosure 123 | *** Actual integration with tool chain TODO 124 | **** Deps builder 125 | **** Compilation with gclosure compiler 126 | ***** drive through API for greatest control vs CLI 127 | **** finding/loading gclosure lib 128 | **** testing 129 | **** delivery 130 | *** REPL and other expected dev conveniences 131 | **** load (file), load-js 132 | * Inside the compiler 133 | ** I will not be the only one who knows this! 134 | *** only 500 lines 135 | ** [[http://en.wikipedia.org/wiki/Recursive_descent_parser][Recursive descent parser]] 136 | ** 2 phases 137 | *** analyze 138 | **** code data in -> AST data out 139 | ***** all ordinary Clojure data 140 | **** each expr recursively analyzes nested exprs 141 | **** checks for correct structure 142 | *** emit 143 | **** AST data in -> print JS (via side effect to *out*) 144 | ***** this allows with-out-str, or direct to file 145 | ***** alternative - thread output stream, meh 146 | **** each expr recursively emits nested exprs 147 | ** Both analyze and emit are polymorphic 148 | *** using multimethods 149 | *** other than a little hand-routing at top of analyze, no global switch statement 150 | **** extend the compiler by defining parse and emit methods 151 | **** add special ops to specials set 152 | ** The threaded environment (env) 153 | *** most important, :context and :locals 154 | *** all name-introducing exprs (e.g. fn, let) augment the environment before passing to children 155 | ** Tricky bit - :context 156 | *** In ClojureScript everything is an expression 157 | **** but not in JS 158 | **** optimal output requires knowledge of the context 159 | ***** :statement, :return, :expr 160 | **** non-exprs in expr contexts require transformation (usually a function wrapper) 161 | ** Primitives walkthrough 162 | *** if 163 | *** def 164 | *** fn* 165 | *** do 166 | *** let* 167 | *** loop* 168 | *** recur 169 | *** new 170 | *** set! 171 | *** ns 172 | *** deftype* 173 | *** . 174 | *** js* 175 | ** Macros walkthrough 176 | *** macroexpansion 177 | *** defprototype 178 | *** extend-type 179 | *** import-macros 180 | *** the core/core trick 181 | ** Evaluation model 182 | *** top down, form at a time 183 | **** just like Clojure 184 | **** just like JS 185 | ** What's missing? 186 | *** validation that compilation ns resolved names exist in ns 187 | *** more correctness checking 188 | *** better error messages 189 | **** ... 190 | *** strategy for apply 191 | * What's where 192 | ** src/clj/cljs/compiler.clj 193 | *** the compiler 194 | ** src/clj/cljs/core.clj 195 | *** core macros 196 | ** src/cljs/core.cljs 197 | *** core library 198 | * Todo 199 | ** separate org file 200 | * Breakout and tackle tasks 201 | ** we'll substantially be in the same file 202 | *** ideas for making that work? 203 | * Regroup and feedback 204 | -------------------------------------------------------------------------------- /src/cljscm/clojure/core/reducers.cljscm: -------------------------------------------------------------------------------- 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 ^{:doc 10 | "A library for reduction and parallel folding. Alpha and subject 11 | to change. Note that fold and its derivatives require 12 | jsr166y.jar for fork/join support. See Clojure's pom.xml for the 13 | dependency info." 14 | :author "Rich Hickey"} 15 | clojure.core.reducers 16 | (:refer-clojure :exclude [reduce map mapcat filter remove take take-while drop flatten]) 17 | (:require [clojure.walk :as walk] 18 | [cljscm.core :as core])) 19 | 20 | (defn reduce 21 | "Like core/reduce except: 22 | When init is not provided, (f) is used. 23 | Maps are reduced with reduce-kv" 24 | ([f coll] (reduce f (f) coll)) 25 | ([f init coll] 26 | (if (map? coll) 27 | (-kv-reduce coll f init) 28 | (-reduce coll f init)))) 29 | 30 | #_ 31 | (defprotocol CollFold 32 | (coll-fold [coll n combinef reducef])) 33 | 34 | ;;; TODO: update docstring for CLJS 35 | #_ 36 | (defn fold 37 | "Reduces a collection using a (potentially parallel) reduce-combine 38 | strategy. The collection is partitioned into groups of approximately 39 | n (default 512), each of which is reduced with reducef (with a seed 40 | value obtained by calling (combinef) with no arguments). The results 41 | of these reductions are then reduced with combinef (default 42 | reducef). combinef must be associative, and, when called with no 43 | arguments, (combinef) must produce its identity element. These 44 | operations may be performed in parallel, but the results will 45 | preserve order." 46 | ([reducef coll] (fold reducef reducef coll)) 47 | ([combinef reducef coll] (fold 512 combinef reducef coll)) 48 | ([n combinef reducef coll] 49 | (coll-fold coll n combinef reducef))) 50 | 51 | (def fold reduce) 52 | 53 | (defn reducer 54 | "Given a reducible collection, and a transformation function xf, 55 | returns a reducible collection, where any supplied reducing 56 | fn will be transformed by xf. xf is a function of reducing fn to 57 | reducing fn." 58 | ([coll xf] 59 | (reify 60 | cljscm.core/IReduce 61 | (-reduce [this f1] 62 | (-reduce this f1 (f1))) 63 | (-reduce [_ f1 init] 64 | (-reduce coll (xf f1) init))))) 65 | 66 | (defn folder 67 | "Given a foldable collection, and a transformation function xf, 68 | returns a foldable collection, where any supplied reducing 69 | fn will be transformed by xf. xf is a function of reducing fn to 70 | reducing fn." 71 | ([coll xf] 72 | (reify 73 | cljscm.core/IReduce 74 | (-reduce [_ f1] 75 | (-reduce coll (xf f1) (f1))) 76 | (-reduce [_ f1 init] 77 | (-reduce coll (xf f1) init)) 78 | 79 | #_ 80 | CollFold 81 | #_ 82 | (coll-fold [_ n combinef reducef] 83 | (coll-fold coll n combinef (xf reducef)))))) 84 | 85 | (defcurried map 86 | "Applies f to every value in the reduction of coll. Foldable." 87 | {} 88 | [f coll] 89 | (folder coll 90 | (fn [f1] 91 | (rfn [f1 k] 92 | ([ret k v] 93 | (f1 ret (f k v))))))) 94 | 95 | (defcurried mapcat 96 | "Applies f to every value in the reduction of coll, concatenating the result 97 | colls of (f val). Foldable." 98 | {} 99 | [f coll] 100 | (folder coll 101 | (fn [f1] 102 | (rfn [f1 k] 103 | ([ret k v] 104 | (reduce f1 ret (f k v))))))) 105 | 106 | (defcurried filter 107 | "Retains values in the reduction of coll for which (pred val) 108 | returns logical true. Foldable." 109 | {} 110 | [pred coll] 111 | (folder coll 112 | (fn [f1] 113 | (rfn [f1 k] 114 | ([ret k v] 115 | (if (pred k v) 116 | (f1 ret k v) 117 | ret)))))) 118 | 119 | (defcurried flatten 120 | "Takes any nested combination of sequential things (lists, vectors, 121 | etc.) and returns their contents as a single, flat foldable 122 | collection." 123 | {} 124 | [coll] 125 | (folder coll 126 | (fn [f1] 127 | (fn 128 | ([] (f1)) 129 | ([ret v] 130 | (if (sequential? v) 131 | (-reduce (flatten v) f1 ret) 132 | (f1 ret v))))))) 133 | 134 | (defcurried remove 135 | "Removes values in the reduction of coll for which (pred val) 136 | returns logical true. Foldable." 137 | {} 138 | [pred coll] 139 | (filter (complement pred) coll)) 140 | 141 | (defcurried take-while 142 | "Ends the reduction of coll when (pred val) returns logical false." 143 | {} 144 | [pred coll] 145 | (reducer coll 146 | (fn [f1] 147 | (rfn [f1 k] 148 | ([ret k v] 149 | (if (pred k v) 150 | (f1 ret k v) 151 | (reduced ret))))))) 152 | 153 | (defcurried take 154 | "Ends the reduction of coll after consuming n values." 155 | {} 156 | [n coll] 157 | (reducer coll 158 | (fn [f1] 159 | (let [cnt (atom n)] 160 | (rfn [f1 k] 161 | ([ret k v] 162 | (swap! cnt dec) 163 | (if (neg? @cnt) 164 | (reduced ret) 165 | (f1 ret k v)))))))) 166 | 167 | (defcurried drop 168 | "Elides the first n values from the reduction of coll." 169 | {} 170 | [n coll] 171 | (reducer coll 172 | (fn [f1] 173 | (let [cnt (atom n)] 174 | (rfn [f1 k] 175 | ([ret k v] 176 | (swap! cnt dec) 177 | (if (neg? @cnt) 178 | (f1 ret k v) 179 | ret))))))) 180 | 181 | ;;do not construct this directly, use cat 182 | (deftype Cat [cnt left right] 183 | cljscm.core/ICounted 184 | (-count [_] cnt) 185 | 186 | cljscm.core/ISeqable 187 | (-seq [_] (concat (seq left) (seq right))) 188 | 189 | cljscm.core/IReduce 190 | (-reduce [this f1] (-reduce this f1 (f1))) 191 | (-reduce 192 | [_ f1 init] 193 | (-reduce 194 | right f1 195 | (-reduce left f1 init))) 196 | 197 | #_ 198 | CollFold 199 | #_ 200 | (coll-fold 201 | [this n combinef reducef] 202 | (-reduce this reducef))) 203 | 204 | (defn cat 205 | "A high-performance combining fn that yields the catenation of the 206 | reduced values. The result is reducible, foldable, seqable and 207 | counted, providing the identity collections are reducible, seqable 208 | and counted. The single argument version will build a combining fn 209 | with the supplied identity constructor. Tests for identity 210 | with (zero? (count x)). See also foldcat." 211 | ([] (array)) 212 | ([ctor] 213 | (fn 214 | ([] (ctor)) 215 | ([left right] (cat left right)))) 216 | ([left right] 217 | (cond 218 | (zero? (count left)) right 219 | (zero? (count right)) left 220 | :else 221 | (Cat. (+ (count left) (count right)) left right)))) 222 | 223 | (defn append! 224 | ".adds x to acc and returns acc" 225 | [acc x] 226 | (doto acc (.add x))) 227 | 228 | (defn foldcat 229 | "Equivalent to (fold cat append! coll)" 230 | [coll] 231 | (fold cat append! coll)) 232 | 233 | (defn monoid 234 | "Builds a combining fn out of the supplied operator and identity 235 | constructor. op must be associative and ctor called with no args 236 | must return an identity value for it." 237 | [op ctor] 238 | (fn m 239 | ([] (ctor)) 240 | ([a b] (op a b)))) 241 | 242 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 243 | (comment 244 | (require '[clojure.core.reduce :as r]) 245 | (def v (take 1000000 (range))) 246 | (reduce + 0 (r/map inc [1 2 3 4])) 247 | (into [] (r/take 12 (range 100))) 248 | (into [] (r/drop 12 (range 100))) 249 | (reduce + 0 (r/filter even? [1 2 3 4])) 250 | (into [] (r/filter even? [1 2 3 4])) 251 | (reduce + (filter even? [1 2 3 4])) 252 | (dotimes [_ 10] (time (reduce + 0 (r/map inc v)))) 253 | (dotimes [_ 10] (time (reduce + 0 (map inc v)))) 254 | (dotimes [_ 100] (time (reduce + 0 v))) 255 | (dotimes [_ 100] (time (reduce + 0 v))) 256 | (dotimes [_ 20] (time (reduce + 0 (r/map inc (r/filter even? v))))) 257 | (dotimes [_ 20] (time (reduce + 0 (map inc (filter even? v))))) 258 | (reduce + 0 (r/take-while even? [2 4 3])) 259 | (into [] (r/filter even? (r/flatten (r/remove #{4} [[1 2 3] 4 [5 [6 7 8]] [9] 10])))) 260 | (into [] (r/flatten nil)) 261 | ) 262 | 263 | (comment 264 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; fold impls ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 265 | (defn- foldvec 266 | [v n combinef reducef] 267 | (cond 268 | (empty? v) (combinef) 269 | (<= (count v) n) (reduce reducef (combinef) v) 270 | :else 271 | (let [split (quot (count v) 2) 272 | v1 (subvec v 0 split) 273 | v2 (subvec v split (count v)) 274 | fc (fn [child] #(foldvec child n combinef reducef))] 275 | (fjinvoke 276 | #(let [f1 (fc v1) 277 | t2 (fjtask (fc v2))] 278 | (fjfork t2) 279 | (combinef (f1) (fjjoin t2))))))) 280 | 281 | (extend-protocol CollFold 282 | Object 283 | (coll-fold 284 | [coll n combinef reducef] 285 | ;;can't fold, single reduce 286 | (reduce reducef (combinef) coll)) 287 | 288 | clojure.lang.IPersistentVector 289 | (coll-fold 290 | [v n combinef reducef] 291 | (foldvec v n combinef reducef)) 292 | 293 | clojure.lang.PersistentHashMap 294 | (coll-fold 295 | [m n combinef reducef] 296 | (.fold m n combinef reducef fjinvoke fjtask fjfork fjjoin))) 297 | 298 | ) -------------------------------------------------------------------------------- /src/cljscm/clojure/zip.cljscm: -------------------------------------------------------------------------------- 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 | ;functional hierarchical zipper, with navigation, editing and enumeration 10 | ;see Huet 11 | 12 | (ns ^{:doc "Functional hierarchical zipper, with navigation, editing, 13 | and enumeration. See Huet" 14 | :author "Rich Hickey"} 15 | clojure.zip 16 | (:refer-clojure :exclude (replace remove next))) 17 | 18 | (defn zipper 19 | "Creates a new zipper structure. 20 | 21 | branch? is a fn that, given a node, returns true if can have 22 | children, even if it currently doesn't. 23 | 24 | children is a fn that, given a branch node, returns a seq of its 25 | children. 26 | 27 | make-node is a fn that, given an existing node and a seq of 28 | children, returns a new branch node with the supplied children. 29 | root is the root node." 30 | [branch? children make-node root] 31 | ^{:zip/branch? branch? :zip/children children :zip/make-node make-node} 32 | [root nil]) 33 | 34 | (defn seq-zip 35 | "Returns a zipper for nested sequences, given a root sequence" 36 | [root] 37 | (zipper seq? 38 | identity 39 | (fn [node children] (with-meta children (meta node))) 40 | root)) 41 | 42 | (defn vector-zip 43 | "Returns a zipper for nested vectors, given a root vector" 44 | [root] 45 | (zipper vector? 46 | seq 47 | (fn [node children] (with-meta (vec children) (meta node))) 48 | root)) 49 | 50 | (defn xml-zip 51 | "Returns a zipper for xml elements (as from xml/parse), 52 | given a root element" 53 | [root] 54 | (zipper (complement string?) 55 | (comp seq :content) 56 | (fn [node children] 57 | (assoc node :content (and children (apply vector children)))) 58 | root)) 59 | 60 | (defn node 61 | "Returns the node at loc" 62 | [loc] (loc 0)) 63 | 64 | (defn branch? 65 | "Returns true if the node at loc is a branch" 66 | [loc] 67 | ((:zip/branch? (meta loc)) (node loc))) 68 | 69 | (defn children 70 | "Returns a seq of the children of node at loc, which must be a branch" 71 | [loc] 72 | (if (branch? loc) 73 | ((:zip/children (meta loc)) (node loc)) 74 | (throw "called children on a leaf node"))) 75 | 76 | (defn make-node 77 | "Returns a new branch node, given an existing node and new 78 | children. The loc is only used to supply the constructor." 79 | [loc node children] 80 | ((:zip/make-node (meta loc)) node children)) 81 | 82 | (defn path 83 | "Returns a seq of nodes leading to this loc" 84 | [loc] 85 | (:pnodes (loc 1))) 86 | 87 | (defn lefts 88 | "Returns a seq of the left siblings of this loc" 89 | [loc] 90 | (seq (:l (loc 1)))) 91 | 92 | (defn rights 93 | "Returns a seq of the right siblings of this loc" 94 | [loc] 95 | (:r (loc 1))) 96 | 97 | 98 | (defn down 99 | "Returns the loc of the leftmost child of the node at this loc, or 100 | nil if no children" 101 | [loc] 102 | (when (branch? loc) 103 | (let [[node path] loc 104 | [c & cnext :as cs] (children loc)] 105 | (when cs 106 | (with-meta [c {:l [] 107 | :pnodes (if path (conj (:pnodes path) node) [node]) 108 | :ppath path 109 | :r cnext}] (meta loc)))))) 110 | 111 | (defn up 112 | "Returns the loc of the parent of the node at this loc, or nil if at 113 | the top" 114 | [loc] 115 | (let [[node {l :l, ppath :ppath, pnodes :pnodes r :r, changed? :changed?, :as path}] loc] 116 | (when pnodes 117 | (let [pnode (peek pnodes)] 118 | (with-meta (if changed? 119 | [(make-node loc pnode (concat l (cons node r))) 120 | (and ppath (assoc ppath :changed? true))] 121 | [pnode ppath]) 122 | (meta loc)))))) 123 | 124 | (defn root 125 | "zips all the way up and returns the root node, reflecting any 126 | changes." 127 | [loc] 128 | (if (= :end (loc 1)) 129 | (node loc) 130 | (let [p (up loc)] 131 | (if p 132 | (recur p) 133 | (node loc))))) 134 | 135 | (defn right 136 | "Returns the loc of the right sibling of the node at this loc, or nil" 137 | [loc] 138 | (let [[node {l :l [r & rnext :as rs] :r :as path}] loc] 139 | (when (and path rs) 140 | (with-meta [r (assoc path :l (conj l node) :r rnext)] (meta loc))))) 141 | 142 | (defn rightmost 143 | "Returns the loc of the rightmost sibling of the node at this loc, or self" 144 | [loc] 145 | (let [[node {l :l r :r :as path}] loc] 146 | (if (and path r) 147 | (with-meta [(last r) (assoc path :l (apply conj l node (butlast r)) :r nil)] (meta loc)) 148 | loc))) 149 | 150 | (defn left 151 | "Returns the loc of the left sibling of the node at this loc, or nil" 152 | [loc] 153 | (let [[node {l :l r :r :as path}] loc] 154 | (when (and path (seq l)) 155 | (with-meta [(peek l) (assoc path :l (pop l) :r (cons node r))] (meta loc))))) 156 | 157 | (defn leftmost 158 | "Returns the loc of the leftmost sibling of the node at this loc, or self" 159 | [loc] 160 | (let [[node {l :l r :r :as path}] loc] 161 | (if (and path (seq l)) 162 | (with-meta [(first l) (assoc path :l [] :r (concat (rest l) [node] r))] (meta loc)) 163 | loc))) 164 | 165 | (defn insert-left 166 | "Inserts the item as the left sibling of the node at this loc, 167 | without moving" 168 | [loc item] 169 | (let [[node {l :l :as path}] loc] 170 | (if (nil? path) 171 | (throw "Insert at top") 172 | (with-meta [node (assoc path :l (conj l item) :changed? true)] (meta loc))))) 173 | 174 | (defn insert-right 175 | "Inserts the item as the right sibling of the node at this loc, 176 | without moving" 177 | [loc item] 178 | (let [[node {r :r :as path}] loc] 179 | (if (nil? path) 180 | (throw "Insert at top") 181 | (with-meta [node (assoc path :r (cons item r) :changed? true)] (meta loc))))) 182 | 183 | (defn replace 184 | "Replaces the node at this loc, without moving" 185 | [loc node] 186 | (let [[_ path] loc] 187 | (with-meta [node (assoc path :changed? true)] (meta loc)))) 188 | 189 | (defn edit 190 | "Replaces the node at this loc with the value of (f node args)" 191 | [loc f & args] 192 | (replace loc (apply f (node loc) args))) 193 | 194 | (defn insert-child 195 | "Inserts the item as the leftmost child of the node at this loc, 196 | without moving" 197 | [loc item] 198 | (replace loc (make-node loc (node loc) (cons item (children loc))))) 199 | 200 | (defn append-child 201 | "Inserts the item as the rightmost child of the node at this loc, 202 | without moving" 203 | [loc item] 204 | (replace loc (make-node loc (node loc) (concat (children loc) [item])))) 205 | 206 | (defn next 207 | "Moves to the next loc in the hierarchy, depth-first. When reaching 208 | the end, returns a distinguished loc detectable via end?. If already 209 | at the end, stays there." 210 | [loc] 211 | (if (= :end (loc 1)) 212 | loc 213 | (or 214 | (and (branch? loc) (down loc)) 215 | (right loc) 216 | (loop [p loc] 217 | (if (up p) 218 | (or (right (up p)) (recur (up p))) 219 | [(node p) :end]))))) 220 | 221 | (defn prev 222 | "Moves to the previous loc in the hierarchy, depth-first. If already 223 | at the root, returns nil." 224 | [loc] 225 | (if-let [lloc (left loc)] 226 | (loop [loc lloc] 227 | (if-let [child (and (branch? loc) (down loc))] 228 | (recur (rightmost child)) 229 | loc)) 230 | (up loc))) 231 | 232 | (defn end? 233 | "Returns true if loc represents the end of a depth-first walk" 234 | [loc] 235 | (= :end (loc 1))) 236 | 237 | (defn remove 238 | "Removes the node at loc, returning the loc that would have preceded 239 | it in a depth-first walk." 240 | [loc] 241 | (let [[node {l :l, ppath :ppath, pnodes :pnodes, rs :r, :as path}] loc] 242 | (if (nil? path) 243 | (throw "Remove at top") 244 | (if (pos? (count l)) 245 | (loop [loc (with-meta [(peek l) (assoc path :l (pop l) :changed? true)] (meta loc))] 246 | (if-let [child (and (branch? loc) (down loc))] 247 | (recur (rightmost child)) 248 | loc)) 249 | (with-meta [(make-node loc (peek pnodes) rs) 250 | (and ppath (assoc ppath :changed? true))] 251 | (meta loc)))))) 252 | 253 | (comment 254 | 255 | (load-file "/Users/rich/dev/clojure/src/zip.clj") 256 | (refer 'zip) 257 | (def data '[[a * b] + [c * d]]) 258 | (def dz (vector-zip data)) 259 | 260 | (right (down dz)) 261 | (right (down (right (right (down dz))))) 262 | (lefts (right (down (right (right (down dz)))))) 263 | (rights (right (down (right (right (down dz)))))) 264 | (up (up (right (down (right (right (down dz))))))) 265 | (path (right (down (right (right (down dz)))))) 266 | 267 | (-> dz down right right down right) 268 | (-> dz down right right down right (replace '/) root) 269 | (-> dz next next (edit str) next next next (replace '/) root) 270 | (-> dz next next next next next next next next next remove root) 271 | (-> dz next next next next next next next next next remove (insert-right 'e) root) 272 | (-> dz next next next next next next next next next remove up (append-child 'e) root) 273 | 274 | (end? (-> dz next next next next next next next next next remove next)) 275 | 276 | (-> dz next remove next remove root) 277 | 278 | (loop [loc dz] 279 | (if (end? loc) 280 | (root loc) 281 | (recur (next (if (= '* (node loc)) 282 | (replace loc '/) 283 | loc))))) 284 | 285 | (loop [loc dz] 286 | (if (end? loc) 287 | (root loc) 288 | (recur (next (if (= '* (node loc)) 289 | (remove loc) 290 | loc))))) 291 | ) 292 | -------------------------------------------------------------------------------- /samples/repl/src/clojure-repl.scm: -------------------------------------------------------------------------------- 1 | (##include "~~lib/gambit#.scm") 2 | (##include "~~lib/_gambit#.scm") 3 | (include "../scm/cljscm/source-at.scm") 4 | (load "scm/cljscm/core.scm") 5 | (cljscm.core/require '(cljscm.analyzer as: ana)) 6 | (load "scm/cljscm/core_macros.scm") 7 | (cljscm.core/require '(cljscm.reader)) 8 | (cljscm.core/require '(clojure.walk)) 9 | (cljscm.core/require '(cljscm.compiler as: sc)) 10 | 11 | (define (wrap-code path line col code) 12 | (##make-source 13 | code 14 | (##make-locat 15 | (##path->container path) 16 | (##make-filepos (- line 1) (- col 1) 0)))) 17 | 18 | (define (interp-procedure-locals cte) ;see ##display-rte 19 | (define locals (list)) 20 | (let loop1 ((c cte)) 21 | (cond ((##cte-top? c)) 22 | ((##cte-frame? c) 23 | (let loop2 ((vars (##cte-frame-vars c))) 24 | (if (##pair? vars) 25 | (let ((var (##car vars))) 26 | (if (##not (##hidden-local-var? var)) 27 | (set! locals (cons var locals))) 28 | (loop2 (##cdr vars))) 29 | (loop1 (##cte-parent-cte c))))) 30 | (else 31 | (loop1 (##cte-parent-cte c))))) 32 | locals) 33 | 34 | ;##continuation-locals is used per-continuation, and only for non-interp procs. 35 | (define (continuation-locals cont) 36 | (define locals (list)) 37 | (let loop ((cont (##continuation-first-frame cont #t))) 38 | (and cont 39 | (if (##interp-continuation? cont) 40 | (set! locals (append (interp-procedure-locals (macro-code-cte (##interp-continuation-code cont))) locals)) 41 | (let ((loc-pairs (##continuation-locals cont))) 42 | (and loc-pairs (set! locals (append (map car loc-pairs) locals))))) 43 | ;(loop (##continuation-next-frame cont #t)) ;FIXME This doubles locals. We don't need to walk them? 44 | )) 45 | locals) 46 | 47 | (define-type-of-repl-channel-ports clojure-repl-channel-ports 48 | pushback-reader) 49 | 50 | (define (clojure-repl-write-results channel results) 51 | (let ((output-port (macro-repl-channel-output-port channel))) 52 | (##for-each 53 | (lambda (obj) 54 | (cljscm.core/prn obj)) 55 | results))) 56 | 57 | ;a Clojure macro. 58 | (define (cljscm.core/repl-command &form &env sym) 59 | (list 'scm* (vector) (list 'unquote sym))) 60 | (cljscm.core/swap! (cljscm.core/get-namespaces) cljscm.core/assoc-in (cljscm.core/PersistentVector-fromArray (vector (quote cljscm.core) defs: (quote repl-command) macro:) #t) #t) 61 | 62 | (define (clojure-repl-context-prompt repl-context) 63 | 64 | (define (read-command) 65 | (let* ((channel (##thread-repl-channel-get! (macro-current-thread))) (src 66 | ((macro-repl-channel-read-command channel) 67 | channel 68 | repl-context))) ;can't go through ##repl-channel-read-command as we've changed arity 69 | (cond ((##eof-object? src) 70 | src) 71 | (else 72 | (let ((code (##source-code src))) 73 | (if (and (##pair? code) 74 | (##eq? (##source-code (##car code)) 'six.prefix)) 75 | (let ((rest (##cdr code))) 76 | (if (and (##pair? rest) 77 | (##null? (##cdr rest))) 78 | (##car rest) 79 | src)) 80 | src)))))) 81 | 82 | (##step-off) ;; turn off single-stepping 83 | 84 | (##repl-context-command repl-context (read-command))) 85 | 86 | (define (make-clojure-repl-channel old-channel) 87 | (make-clojure-repl-channel-ports 88 | 89 | (##make-mutex 'channel-arbiter) 90 | (macro-current-thread) 91 | (macro-repl-channel-input-port old-channel) 92 | (macro-repl-channel-output-port old-channel) 93 | (##make-empty-repl-result-history) 94 | 95 | (lambda (channel repl-context) ;repl-channel-read-command (whole context instead of just level & depth) 96 | 97 | (define prompt "> ") 98 | 99 | (let ((level (macro-repl-context-level repl-context)) 100 | (depth (macro-repl-context-depth repl-context)) 101 | (output-port (macro-repl-channel-output-port channel))) 102 | (if (##fixnum.< 0 level) 103 | (##write level output-port)) 104 | (if (##fixnum.< 0 depth) 105 | (begin 106 | (##write-string "\\" output-port) 107 | (##write depth output-port))) 108 | (##write-string prompt output-port) 109 | (##force-output output-port)) 110 | ((macro-repl-channel-ports-read-expr channel) channel repl-context)) 111 | clojure-repl-write-results 112 | ##repl-channel-ports-display-monoline-message 113 | ##repl-channel-ports-display-multiline-message 114 | ##repl-channel-ports-display-continuation 115 | ##repl-channel-ports-pinpoint-continuation 116 | ##repl-channel-ports-really-exit? 117 | ##repl-channel-ports-newline 118 | 119 | (let ((installed-handler #f) 120 | (old-read-expr (macro-repl-channel-ports-read-expr old-channel))) 121 | (lambda (channel repl-context) ;read-expr 122 | (let ((cur-handler (current-exception-handler))) 123 | (if (not (eq? cur-handler installed-handler)) 124 | (begin 125 | ;(display "installing new handler\n") 126 | (current-exception-handler 127 | (lambda (e) 128 | (if (nonprocedure-operator-exception? e) 129 | (let ((oper (nonprocedure-operator-exception-operator e)) 130 | (args (nonprocedure-operator-exception-arguments e))) 131 | (polymorphic-invoke oper args)) 132 | (cur-handler e)))) 133 | (set! installed-handler (current-exception-handler))))) 134 | (parameterize 135 | ((cljscm.compiler/*emit-source-loc?* #t)) 136 | (let* ((reader (clojure-repl-channel-ports-pushback-reader channel)) 137 | (port (cljscm.reader/PortPushbackReader-port reader)) 138 | (first-char (let loop ((pk-char (peek-char port))) 139 | (if (equal? #\newline pk-char) 140 | (begin (read-char port) 141 | (loop (peek-char port))) 142 | pk-char)))) 143 | (if (equal? #\, first-char) 144 | (old-read-expr channel) 145 | (let* ((cont (macro-repl-context-cont repl-context)) 146 | (locals (continuation-locals cont)) 147 | (result (cljscm.compiler/emit 148 | (cljscm.analyzer/analyze 149 | (apply cljscm.analyzer/empty-env locals) 150 | (cljscm.reader/read reader #t #!void #f)))) 151 | (sanitized (cljscm.core/scm-form-sanitize result #t)) 152 | (output-port (macro-repl-channel-output-port channel))) 153 | (##output-port-column-set! output-port 1) 154 | (let ((ret (if (or (list? sanitized) (vector? sanitized)) 155 | (##sourcify-deep sanitized (wrap-code "(repl)" 1 1 sanitized)) 156 | (wrap-code "(repl)" 1 1 sanitized)))) 157 | ;(display ret) 158 | ;(display "\n") 159 | ret))))))) 160 | 161 | (cljscm.reader/port-push-back-reader (macro-repl-channel-input-port old-channel)))) 162 | 163 | (define (clone-repl-channel channel) 164 | (make-clojure-repl-channel-ports 165 | 166 | (##make-mutex 'channel-arbiter) 167 | (macro-current-thread) 168 | (macro-repl-channel-input-port channel) 169 | (macro-repl-channel-output-port channel) 170 | (##make-empty-repl-result-history) 171 | 172 | ##repl-channel-ports-read-command 173 | ##repl-channel-ports-write-results 174 | ##repl-channel-ports-display-monoline-message 175 | ##repl-channel-ports-display-multiline-message 176 | ##repl-channel-ports-display-continuation 177 | ##repl-channel-ports-pinpoint-continuation 178 | ##repl-channel-ports-really-exit? 179 | ##repl-channel-ports-newline 180 | 181 | (macro-repl-channel-ports-read-expr channel) 182 | 183 | (cljscm.reader/port-push-back-reader (macro-repl-channel-input-port channel)))) 184 | 185 | (define (clone2-repl-channel channel) 186 | (make-clojure-repl-channel-ports 187 | 188 | (##make-mutex 'channel-arbiter) 189 | (macro-current-thread) 190 | (macro-repl-channel-input-port channel) 191 | (macro-repl-channel-output-port channel) 192 | (##make-empty-repl-result-history) 193 | 194 | ##repl-channel-ports-read-command 195 | ##repl-channel-ports-write-results 196 | ##repl-channel-ports-display-monoline-message 197 | ##repl-channel-ports-display-multiline-message 198 | ##repl-channel-ports-display-continuation 199 | ##repl-channel-ports-pinpoint-continuation 200 | ##repl-channel-ports-really-exit? 201 | ##repl-channel-ports-newline 202 | 203 | (let ((oldfn (macro-repl-channel-ports-read-expr channel))) 204 | (lambda (channel) 205 | (let ((result 206 | (let ((input-port (macro-repl-channel-input-port channel))) 207 | (##read-expr-from-port input-port)))) 208 | (let ((output-port (macro-repl-channel-output-port channel))) 209 | (##output-port-column-set! output-port 1)) 210 | ;(display result) 211 | (write (current-exception-handler)) 212 | (display "\n") 213 | result))) 214 | 215 | (cljscm.reader/port-push-back-reader (macro-repl-channel-input-port channel)))) 216 | 217 | ;(set! ##thread-make-repl-channel (lambda (thread) (make-clojure-repl-channel ##stdin-port ##stdout-port))) 218 | (define (install-clojure-repl) 219 | (let* ((old-channel (macro-thread-repl-channel (macro-current-thread))) 220 | (input (macro-repl-channel-input-port old-channel)) 221 | (output (macro-repl-channel-output-port old-channel))) 222 | (macro-thread-repl-channel-set! 223 | (macro-current-thread) 224 | (make-clojure-repl-channel old-channel)) 225 | (set! ##repl-context-prompt clojure-repl-context-prompt))) 226 | 227 | '(define rc (let* ((old-channel (macro-thread-repl-channel (macro-current-thread))) 228 | (input (macro-repl-channel-input-port old-channel)) 229 | (output (macro-repl-channel-output-port old-channel))) 230 | (make-clojure-repl-channel input output))) 231 | 232 | 233 | (define (install-clone2-repl) 234 | (let* ((old-channel (macro-thread-repl-channel (macro-current-thread)))) 235 | (macro-thread-repl-channel-set! 236 | (macro-current-thread) 237 | (clone2-repl-channel old-channel)))) 238 | 239 | (display "\n") 240 | (display "enter (install-clojure-repl) to switch to Clojure\n") 241 | (display "enter ,? for more options\n") 242 | -------------------------------------------------------------------------------- /src/clj/cljscm/repl/browser.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Rich Hickey. All rights reserved. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ;; which can be found in the file epl-v10.html at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | (ns cljscm.repl.browser 10 | (:refer-clojure :exclude [loaded-libs]) 11 | (:require [clojure.java.io :as io] 12 | [cljscm.compiler :as comp] 13 | [cljscm.closure :as cljsc] 14 | [cljscm.repl :as repl] 15 | [cljscm.repl.server :as server]) 16 | (:import cljscm.repl.IJavaScriptEnv)) 17 | 18 | (defonce browser-state (atom {:return-value-fn nil 19 | :client-js nil})) 20 | 21 | (def loaded-libs (atom #{})) 22 | (def preloaded-libs (atom #{})) 23 | 24 | (defn- set-return-value-fn 25 | "Save the return value function which will be called when the next 26 | return value is received." 27 | [f] 28 | (swap! browser-state (fn [old] (assoc old :return-value-fn f)))) 29 | 30 | (defn send-for-eval 31 | "Given a form and a return value function, send the form to the 32 | browser for evaluation. The return value function will be called 33 | when the return value is received." 34 | ([form return-value-fn] 35 | (send-for-eval @(server/connection) form return-value-fn)) 36 | ([conn form return-value-fn] 37 | (do (set-return-value-fn return-value-fn) 38 | (server/send-and-close conn 200 form "text/javascript")))) 39 | 40 | (defn- return-value 41 | "Called by the server when a return value is received." 42 | [val] 43 | (when-let [f (:return-value-fn @browser-state)] 44 | (f val))) 45 | 46 | (defn repl-client-js [] 47 | (slurp @(:client-js @browser-state))) 48 | 49 | (defn send-repl-client-page 50 | [request conn opts] 51 | (server/send-and-close conn 200 52 | (str " 53 | " 56 | "" 59 | "") 60 | "text/html")) 61 | 62 | (defn send-static [{path :path :as request} conn opts] 63 | (if (and (:static-dir opts) 64 | (not= "/favicon.ico" path)) 65 | (let [path (if (= "/" path) "/index.html" path) 66 | st-dir (:static-dir opts)] 67 | (if-let [local-path (seq (for [x (if (string? st-dir) [st-dir] st-dir) 68 | :when (.exists (io/file (str x path)))] 69 | (str x path)))] 70 | (server/send-and-close conn 200 (slurp (first local-path)) 71 | (condp #(.endsWith %2 %1) path 72 | ".html" "text/html" 73 | ".css" "text/css" 74 | ".html" "text/html" 75 | ".jpg" "image/jpeg" 76 | ".js" "text/javascript" 77 | ".png" "image/png" 78 | "text/plain")) 79 | (server/send-404 conn path))) 80 | (server/send-404 conn path))) 81 | 82 | (server/dispatch-on :get 83 | (fn [{:keys [path]} _ _] (.startsWith path "/repl")) 84 | send-repl-client-page) 85 | 86 | (server/dispatch-on :get 87 | (fn [{:keys [path]} _ _] (or (= path "/") 88 | (.endsWith path ".js") 89 | (.endsWith path ".html"))) 90 | send-static) 91 | 92 | (defmulti handle-post (fn [m _ _ ] (:type m))) 93 | 94 | (server/dispatch-on :post (constantly true) handle-post) 95 | 96 | (def ordering (agent {:expecting nil :fns {}})) 97 | 98 | (defmethod handle-post :ready [_ conn _] 99 | (do (reset! loaded-libs @preloaded-libs) 100 | (send ordering (fn [_] {:expecting nil :fns {}})) 101 | (send-for-eval conn 102 | (cljsc/-compile 103 | '[(ns cljscm.user) 104 | (set! *print-fn* clojure.browser.repl/repl-print)] {}) 105 | identity))) 106 | 107 | (defn add-in-order [{:keys [expecting fns]} order f] 108 | {:expecting (or expecting order) :fns (assoc fns order f)}) 109 | 110 | (defn run-in-order [{:keys [expecting fns]}] 111 | (loop [order expecting 112 | fns fns] 113 | (if-let [f (get fns order)] 114 | (do (f) 115 | (recur (inc order) (dissoc fns order))) 116 | {:expecting order :fns fns}))) 117 | 118 | (defn constrain-order 119 | "Elements to be printed in the REPL will arrive out of order. Ensure 120 | that they are printed in the correct order." 121 | [order f] 122 | (send-off ordering add-in-order order f) 123 | (send-off ordering run-in-order)) 124 | 125 | (defmethod handle-post :print [{:keys [content order]} conn _ ] 126 | (do (constrain-order order (fn [] (do (print (read-string content)) 127 | (.flush *out*)))) 128 | (server/send-and-close conn 200 "ignore__"))) 129 | 130 | (defmethod handle-post :result [{:keys [content order]} conn _ ] 131 | (constrain-order order (fn [] (do (return-value content) 132 | (server/set-connection conn))))) 133 | 134 | (defn browser-eval 135 | "Given a string of JavaScript, evaluate it in the browser and return a map representing the 136 | result of the evaluation. The map will contain the keys :type and :value. :type can be 137 | :success, :exception, or :error. :success means that the JavaScript was evaluated without 138 | exception and :value will contain the return value of the evaluation. :exception means that 139 | there was an exception in the browser while evaluating the JavaScript and :value will 140 | contain the error message. :error means that some other error has occured." 141 | [form] 142 | (let [return-value (promise)] 143 | (send-for-eval form 144 | (fn [val] (deliver return-value val))) 145 | (let [ret @return-value] 146 | (try (read-string ret) 147 | (catch Exception e 148 | {:status :error 149 | :value (str "Could not read return value: " ret)}))))) 150 | 151 | (defn load-javascript 152 | "Accepts a REPL environment, a list of namespaces, and a URL for a 153 | JavaScript file which contains the implementation for the list of 154 | namespaces. Will load the JavaScript file into the REPL environment 155 | if any of the namespaces have not already been loaded from the 156 | ClojureScript REPL." 157 | [repl-env ns-list url] 158 | (let [missing (remove #(contains? @loaded-libs %) ns-list)] 159 | (when (seq missing) 160 | (browser-eval (slurp url)) 161 | (swap! loaded-libs (partial apply conj) missing)))) 162 | 163 | (defrecord BrowserEnv [] 164 | repl/IJavaScriptEnv 165 | (-setup [this] 166 | (do (require 'cljscm.repl.reflect) 167 | (repl/analyze-source (:src this)) 168 | (comp/with-core-cljs (server/start this)))) 169 | (-evaluate [_ _ _ js] (browser-eval js)) 170 | (-load [this ns url] (load-javascript this ns url)) 171 | (-tear-down [_] 172 | (do (server/stop) 173 | (reset! server/state {}) 174 | (reset! browser-state {})))) 175 | 176 | (defn compile-client-js [opts] 177 | (cljsc/build '[(ns clojure.browser.repl.client 178 | (:require [goog.events :as event] 179 | [clojure.browser.repl :as repl])) 180 | (defn start [url] 181 | (event/listen js/window 182 | "load" 183 | (fn [] 184 | (repl/start-evaluator url))))] 185 | {:optimizations (:optimizations opts) 186 | :output-dir (:working-dir opts)})) 187 | 188 | (defn create-client-js-file [opts file-path] 189 | (let [file (io/file file-path)] 190 | (when (not (.exists file)) 191 | (spit file (compile-client-js opts))) 192 | file)) 193 | 194 | (defn- provides-and-requires 195 | "Return a flat list of all provided and required namespaces from a 196 | sequence of IJavaScripts." 197 | [deps] 198 | (flatten (mapcat (juxt :provides :requires) deps))) 199 | 200 | (defn- always-preload 201 | "Return a list of all namespaces which are always loaded into the browser 202 | when using a browser-connected REPL." 203 | [] 204 | (let [cljs (provides-and-requires (cljsc/cljs-dependencies {} ["clojure.browser.repl"])) 205 | goog (provides-and-requires (cljsc/js-dependencies {} cljs))] 206 | (disj (set (concat cljs goog)) nil))) 207 | 208 | (defn repl-env 209 | "Create a browser-connected REPL environment. 210 | 211 | Options: 212 | 213 | port: The port on which the REPL server will run. Defaults to 9000. 214 | working-dir: The directory where the compiled REPL client JavaScript will 215 | be stored. Defaults to \".repl\". 216 | serve-static: Should the REPL server attempt to serve static content? 217 | Defaults to true. 218 | static-dir: List of directories to search for static content. Defaults to 219 | [\".\" \"out/\"]. 220 | preloaded-libs: List of namespaces that should not be sent from the REPL server 221 | to the browser. This may be required if the browser is already 222 | loading code and reloading it would cause a problem. 223 | optimizations: The level of optimization to use when compiling the client 224 | end of the REPL. Defaults to :simple. 225 | src: The source directory containing user-defined cljs files. Used to 226 | support reflection. Defaults to \"src/\". 227 | " 228 | [& {:as opts}] 229 | (let [opts (merge (BrowserEnv.) 230 | {:port 9000 231 | :optimizations :simple 232 | :working-dir ".repl" 233 | :serve-static true 234 | :static-dir ["." "out/"] 235 | :preloaded-libs [] 236 | :src "src/"} 237 | opts)] 238 | (do (reset! preloaded-libs (set (concat (always-preload) (map str (:preloaded-libs opts))))) 239 | (reset! loaded-libs @preloaded-libs) 240 | (swap! browser-state 241 | (fn [old] (assoc old :client-js 242 | (future (create-client-js-file 243 | opts 244 | (io/file (:working-dir opts) "client.js")))))) 245 | opts))) 246 | 247 | (comment 248 | 249 | (require '[cljscm.repl :as repl]) 250 | (require '[cljscm.repl.browser :as browser]) 251 | (def env (browser/repl-env)) 252 | (repl/repl env) 253 | ;; simulate the browser with curl 254 | ;; curl -v -d "ready" http://127.0.0.1:9000 255 | ClojureScript:> (+ 1 1) 256 | ;; curl -v -d "2" http://127.0.0.1:9000 257 | 258 | ) 259 | -------------------------------------------------------------------------------- /devnotes/corelib.org: -------------------------------------------------------------------------------- 1 | * DONE * 2 | * *' 3 | * DONE *1 4 | * DONE *2 5 | * DONE *3 6 | * *agent* 7 | * *allow-unresolved-vars* 8 | * *assert* 9 | * *clojure-version* 10 | * *command-line-args* 11 | * *compile-files* 12 | * *compile-path* 13 | * TODO *e 14 | * *err* 15 | * *file* 16 | * *flush-on-newline* 17 | * *fn-loader* 18 | * *in* 19 | * *math-context* 20 | * *ns* 21 | * *out* 22 | * *print-dup* 23 | * *print-length* 24 | * *print-level* 25 | * *print-meta* 26 | * *print-readably* 27 | * *read-eval* 28 | * *source-path* 29 | * TODO *unchecked-math* 30 | does what? 31 | * *use-context-classloader* 32 | * *verbose-defrecords* 33 | * *warn-on-reflection* 34 | * DONE + 35 | * +' 36 | * DONE - 37 | * -' 38 | * DONE -> 39 | * DONE ->> 40 | * ->ArrayChunk 41 | * ->Vec 42 | * ->VecNode 43 | * ->VecSeq 44 | * -cache-protocol-fn 45 | * -reset-methods 46 | * DONE .. 47 | * DONE / 48 | * DONE < 49 | * DONE <= 50 | * DONE = 51 | * DONE == 52 | * DONE > 53 | * DONE >= 54 | * EMPTY-NODE 55 | * accessor 56 | * DONE aclone 57 | * add-classpath 58 | * add-watch 59 | * agent 60 | * agent-error 61 | * agent-errors 62 | * DONE aget 63 | * DONE alength 64 | * TODO alias 65 | * all-ns 66 | * alter 67 | * DONE alter-meta! 68 | * alter-var-root 69 | * DONE amap 70 | * DONE ancestors 71 | * DONE and 72 | * DONE apply 73 | * DONE areduce 74 | * DONE array-map 75 | * DONE aset 76 | * aset-boolean 77 | * aset-byte 78 | * aset-char 79 | * aset-double 80 | * aset-float 81 | * aset-int 82 | * aset-long 83 | * aset-short 84 | * DONE assert 85 | * DONE assoc 86 | * DONE assoc! 87 | * DONE assoc-in 88 | * DONE associative? 89 | * DONE atom 90 | * await 91 | * await-for 92 | * await1 93 | * bases 94 | * bean 95 | * bigdec 96 | * TODO bigint 97 | * biginteger 98 | * DONE binding 99 | * DONE bit-and 100 | * DONE bit-and-not 101 | * DONE bit-clear 102 | * DONE bit-flip 103 | * DONE bit-not 104 | * DONE bit-or 105 | * DONE bit-set 106 | * DONE bit-shift-left 107 | * DONE bit-shift-right 108 | * DONE bit-test 109 | * DONE bit-xor 110 | * DONE boolean 111 | * boolean-array 112 | * booleans 113 | * bound-fn 114 | * bound-fn* 115 | * bound? 116 | * DONE butlast 117 | * TODO byte 118 | * byte-array 119 | * bytes 120 | * DONE case 121 | * cast 122 | * char 123 | * char-array 124 | * char-escape-string 125 | * char-name-string 126 | * char? 127 | * chars 128 | * chunk 129 | * chunk-append 130 | * chunk-buffer 131 | * chunk-cons 132 | * chunk-first 133 | * chunk-next 134 | * chunk-rest 135 | * chunked-seq? 136 | * class 137 | * class? 138 | * clear-agent-errors 139 | * clojure-version 140 | * DONE coll? 141 | * DONE comment 142 | * commute 143 | * DONE comp 144 | * TODO comparator 145 | * DONE compare 146 | * DONE compare-and-set! 147 | * compile 148 | * DONE complement 149 | * DONE concat 150 | * DONE cond 151 | * DONE condp 152 | * DONE conj 153 | * DONE conj! 154 | * DONE cons 155 | * DONE constantly 156 | * construct-proxy 157 | * DONE contains? 158 | * DONE count 159 | * DONE counted? 160 | * create-ns 161 | * create-struct 162 | * DONE cycle 163 | * DONE dec 164 | * dec' 165 | * decimal? 166 | * DONE declare 167 | * definline 168 | * definterface 169 | * DONE defmacro 170 | * DONE defmethod 171 | * DONE defmulti 172 | * DONE defn 173 | * DONE defn- 174 | * defonce 175 | * DONE defprotocol 176 | * DONE defrecord 177 | * defstruct 178 | * DONE deftype 179 | * DONE delay 180 | * DONE delay? 181 | * deliver 182 | * TODO denominator 183 | * DONE deref 184 | * DONE derive 185 | * DONE descendants 186 | * DONE destructure 187 | For macros only, uses clojure.core version 188 | * DONE disj 189 | * DONE disj! 190 | * DONE dissoc 191 | * DONE dissoc! 192 | * DONE distinct 193 | * DONE distinct? 194 | * DONE doall 195 | * DONE dorun 196 | * DONE doseq 197 | * dosync 198 | * DONE dotimes 199 | * DONE doto 200 | * TODO double 201 | * DONE double-array 202 | * TODO doubles 203 | * DONE drop 204 | * DONE drop-last 205 | * DONE drop-while 206 | * DONE empty 207 | * DONE empty? 208 | * ensure 209 | * enumeration-seq 210 | * error-handler 211 | * error-mode 212 | * eval 213 | * DONE even? 214 | * DONE every-pred 215 | * DONE every? 216 | * TODO extend 217 | maybe not? 218 | * DONE extend-protocol 219 | macro currently expands into extend call 220 | * DONE extend-type 221 | * extenders 222 | * extends? 223 | * DONE false? 224 | * DONE ffirst 225 | * file-seq 226 | * DONE filter 227 | * DONE find 228 | * TODO find-keyword 229 | * find-ns 230 | * find-protocol-impl 231 | * find-protocol-method 232 | * find-var 233 | * DONE first 234 | * DONE flatten 235 | * float 236 | * float-array 237 | * float? 238 | * floats 239 | * flush 240 | * DONE fn 241 | * DONE fn? 242 | * DONE fnext 243 | * DONE fnil 244 | * DONE for 245 | * DONE force 246 | * format 247 | * DONE frequencies 248 | * future 249 | * future-call 250 | * future-cancel 251 | * future-cancelled? 252 | * future-done? 253 | * future? 254 | * gen-class 255 | * gen-interface 256 | * DONE gensym 257 | * DONE get 258 | * DONE get-in 259 | * DONE get-method 260 | * get-proxy-class 261 | * get-thread-bindings 262 | * DONE get-validator 263 | * DONE group-by 264 | * DONE hash 265 | * DONE hash-combine 266 | * DONE hash-map 267 | * TODO hash-set 268 | * DONE identical? 269 | * DONE identity 270 | * DONE if-let 271 | * DONE if-not 272 | * DONE ifn? 273 | * import 274 | * DONE in-ns 275 | * DONE inc 276 | * inc' 277 | * init-proxy 278 | * DONE instance? 279 | does what? 280 | * DONE int 281 | * int-array 282 | * DONE integer? 283 | * DONE interleave 284 | * intern 285 | * DONE interpose 286 | * DONE into 287 | * DONE into-array 288 | * ints 289 | * io! 290 | * DONE isa? 291 | does what? 292 | * DONE iterate 293 | * iterator-seq 294 | * DONE juxt 295 | * DONE keep 296 | * DONE keep-indexed 297 | * DONE key 298 | * DONE keys 299 | * DONE keyword 300 | * DONE keyword? 301 | * DONE last 302 | * TODO lazy-cat 303 | * DONE lazy-seq 304 | * DONE let 305 | * DONE letfn 306 | ** TODO needs compiler letfn* 307 | * line-seq 308 | * DONE list 309 | * DONE list* 310 | * DONE list? 311 | * load 312 | * DONE load-file 313 | * load-reader 314 | * load-string 315 | * loaded-libs 316 | * locking 317 | * DONE long 318 | * DONE long-array 319 | * TODO longs 320 | * DONE loop 321 | * macroexpand 322 | * macroexpand-1 323 | * DONE make-array 324 | * DONE make-hierarchy 325 | * DONE map 326 | * DONE map-indexed 327 | * DONE map? 328 | * DONE mapcat 329 | * DONE max 330 | * DONE max-key 331 | * memfn 332 | * DONE memoize 333 | * DONE merge 334 | * DONE merge-with 335 | * DONE meta 336 | * method-sig 337 | * DONE methods 338 | * DONE min 339 | * DONE min-key 340 | * DONE mod 341 | * munge 342 | * DONE name 343 | * DONE namespace 344 | * namespace-munge 345 | * DONE neg? 346 | * newline 347 | * DONE next 348 | * DONE nfirst 349 | * DONE nil? 350 | * DONE nnext 351 | * DONE not 352 | * DONE not-any? 353 | * DONE not-empty 354 | * DONE not-every? 355 | * DONE not= 356 | * DONE ns 357 | * ns-aliases 358 | * ns-imports 359 | * ns-interns 360 | * ns-map 361 | * ns-name 362 | * ns-publics 363 | * ns-refers 364 | * ns-resolve 365 | * ns-unalias 366 | * ns-unmap 367 | * DONE nth 368 | * DONE nthnext 369 | * TODO num 370 | * DONE number? 371 | * TODO numerator 372 | * DONE object-array 373 | * DONE odd? 374 | * DONE or 375 | * DONE parents 376 | * DONE partial 377 | * DONE partition 378 | * DONE partition-all 379 | * DONE partition-by 380 | * pcalls 381 | * DONE peek 382 | * DONE persistent! 383 | * pmap 384 | * DONE pop 385 | * DONE pop! 386 | * pop-thread-bindings 387 | * DONE pos? 388 | * DONE pr 389 | dunno about printing 390 | * DONE pr-str 391 | * DONE prefer-method 392 | * DONE prefers 393 | * primitives-classnames 394 | * DONE print 395 | * print-ctor 396 | * TODO print-dup 397 | * TODO print-method 398 | * TODO print-simple 399 | * DONE print-str 400 | * printf 401 | * DONE println 402 | * DONE println-str 403 | * DONE prn 404 | * DONE prn-str 405 | * promise 406 | * proxy 407 | * proxy-call-with-super 408 | * proxy-mappings 409 | * proxy-name 410 | * proxy-super 411 | * push-thread-bindings 412 | * pvalues 413 | * DONE quot 414 | * DONE rand 415 | * DONE rand-int 416 | * DONE rand-nth 417 | * DONE range 418 | * TODO ratio? 419 | * TODO rational? 420 | * TODO rationalize 421 | * DONE re-find 422 | dunno about regex 423 | * re-groups 424 | * re-matcher 425 | * DONE re-matches 426 | * DONE re-pattern 427 | * DONE re-seq 428 | * read 429 | * read-line 430 | * read-string 431 | * DONE realized? 432 | * DONE reduce 433 | * DONE reductions 434 | * ref 435 | * ref-history-count 436 | * ref-max-history 437 | * ref-min-history 438 | * ref-set 439 | * refer 440 | * refer-clojure 441 | * DONE reify 442 | * TODO specify - make a particular object extend a protocol 443 | * release-pending-sends 444 | * DONE rem 445 | * DONE remove 446 | * DONE remove-all-methods 447 | * DONE remove-method 448 | * remove-ns 449 | * remove-watch 450 | * DONE repeat 451 | * DONE repeatedly 452 | * DONE replace 453 | * DONE replicate 454 | * TODO require 455 | ticket #8 456 | * DONE reset! 457 | * reset-meta! 458 | * resolve 459 | * DONE rest 460 | * restart-agent 461 | * resultset-seq 462 | * DONE reverse 463 | * DONE reversible? 464 | * DONE rseq 465 | * DONE rsubseq 466 | * DONE satisfies? 467 | as macro 468 | * DONE second 469 | * DONE select-keys 470 | * send 471 | * send-off 472 | * DONE seq 473 | * DONE seq? 474 | * seque 475 | * TODO sequence 476 | * DONE sequential? 477 | * DONE set 478 | * set-error-handler! 479 | * set-error-mode! 480 | * set-validator! 481 | * DONE set? 482 | * short 483 | * short-array 484 | * shorts 485 | * TODO shuffle 486 | * shutdown-agents 487 | * slurp 488 | * DONE some 489 | * DONE some-fn 490 | * DONE sort 491 | * DONE sort-by 492 | * TODO sorted-map 493 | * TODO sorted-map-by 494 | * TODO sorted-set 495 | * TODO sorted-set-by 496 | * TODO sorted? 497 | * TODO special-symbol? 498 | * spit 499 | * DONE split-at 500 | * DONE split-with 501 | * DONE str 502 | * DONE string? 503 | * struct 504 | * struct-map 505 | * DONE subs 506 | * TODO subseq 507 | * DONE subvec 508 | * TODO supers 509 | * DONE swap! 510 | * DONE symbol 511 | * DONE symbol? 512 | * sync 513 | * DONE take 514 | * DONE take-last 515 | * DONE take-nth 516 | * DONE take-while 517 | * test 518 | * the-ns 519 | * thread-bound? 520 | * DONE time 521 | * DONE to-array 522 | * DONE to-array-2d 523 | * DONE trampoline 524 | * DONE transient 525 | * DONE tree-seq 526 | * DONE true? 527 | * DONE type - returns JS constructor 528 | * TODO unchecked-add 529 | * TODO unchecked-add-int 530 | * TODO unchecked-byte 531 | * TODO unchecked-char 532 | * TODO unchecked-dec 533 | * TODO unchecked-dec-int 534 | * TODO unchecked-divide-int 535 | * TODO unchecked-double 536 | * TODO unchecked-float 537 | * TODO unchecked-inc 538 | * TODO unchecked-inc-int 539 | * TODO unchecked-int 540 | * TODO unchecked-long 541 | * TODO unchecked-multiply 542 | * TODO unchecked-multiply-int 543 | * TODO unchecked-negate 544 | * TODO unchecked-negate-int 545 | * TODO unchecked-remainder-int 546 | * TODO unchecked-short 547 | * TODO unchecked-subtract 548 | * TODO unchecked-subtract-int 549 | * DONE underive 550 | * unquote 551 | * unquote-splicing 552 | * DONE update-in 553 | * update-proxy 554 | * use 555 | * DONE val 556 | * DONE vals 557 | * var-get 558 | * var-set 559 | * var? 560 | * DONE vary-meta 561 | * DONE vec 562 | * DONE vector 563 | * vector-of 564 | * DONE vector? 565 | * DONE when 566 | * DONE when-first 567 | * DONE when-let 568 | * DONE when-not 569 | * DONE while 570 | * with-bindings 571 | * with-bindings* 572 | * with-in-str 573 | * with-loading-context 574 | * TODO with-local-vars 575 | * DONE with-meta 576 | * with-open 577 | * with-out-str 578 | * with-precision 579 | * with-redefs 580 | * with-redefs-fn 581 | * TODO xml-seq 582 | * DONE zero? 583 | * DONE zipmap 584 | --------------------------------------------------------------------------------