Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Showing with 833 additions and 0 deletions.
  1. +422 −0 cljs.org
  2. +411 −0 src/clj/clojure/cljs.clj
422 cljs.org
@@ -0,0 +1,422 @@
+* ClojureScript
+* Rationale
+** What
+*** Compiler that compiles (a subset of?) Clojure to Javascript
+** Why?
+*** Because js is the only universally available client target
+**** and can't be supplanted due to its browser integration and installed base
+**** yet isn't very good, expressive, concise, or robust
+**** but JS engines continue to get lots of optimization love, and are now quite capable perf-wise
+*** Use same skillset and libs for client and server
+**** only other similar options are:
+***** JS native client, JS (e.g. node) server
+****** node still much less powerful than JVM, and might be a mere fad
+***** Java (GWT) client, Java native server
+****** GWT has lots of baggage due to semantic mismatches etc
+****** but familiar tooling if already a Java dev
+***** esoteric, open question as to skills and libs:
+****** [[http://clamato.net/][Clamato Smalltalk]]
+****** [[http://www.wescheme.org/][Moby Scheme]]
+*** Clojure semantics can fit well on JS
+**** i.e. defn/type/protocol won't fight with js core model
+*** ClojureJS arguably becomes most powerful lang on client
+**** Robust, simple Clojure model
+**** Macros etc
+*** Might be best way to run Clojure on mobile
+*** js a possible path to delivering Clojure libs to C-linkage clients
+**** via embedded Google V8 js engine
+**** somewhat speculative, but considering for M
+**** V8 wrappers exist for Python, Ruby, PHP etc
+** How?
+*** Compiler written in Clojure, generates (readable?) JS
+*** Optionally run that JS through Google Closure js->js compiler
+**** for minification, dead code elimination etc
+*** Use Google Closure js library where needed for implementation support
+**** e.g. goog.math has Long arithmetic
+**** module system
+**** use gclosure annotations for stronger type checking or better code gen?
+**** dependency system
+*** Macros written in Clojure proper, run by the compiler
+**** stick to subset in macros if eval supported
+*** Any runtime support written completely in itself
+**** make deftype and protocols work early
+** Non-objectives
+*** complete Clojure
+**** feel free to subset, especially at first
+**** but try to make anything present in both work identically
+*** compiling e.g. core.clj as-is
+**** don't want to touch Clojure itself for this
+**** bootstrap will differ anyway
+** Ancillary benefits
+*** Analysis component of compiler might serve Clojure-in-Clojure, or other tooling
+**** maybe - we'll need far less analysis support in js than we do in Java
+*** Boost for Clojure adoption due to increased reach
+*** Power tool for exploring next-gen client approach
+* Implementation
+** Primitives
+*** DONE def
+*** fn
+**** DONE basics
+**** DONE recur
+**** TODO variable arity
+**** TODO arity overloading
+**** closures shouldn't map directly to js closures? - no, they should
+***** they capture entire surrounding environment
+****** hearsay, V8 already better
+***** premature optimization to avoid that? - yes
+***** shouldn't js engines do that for us? - yes
+***** try goog.partial? - not for this
+**** variable arity how?
+***** switch on arguments.length
+*** DONE if
+**** need to match Clojure semantics (nil/false)
+***** must deal with undefined (group with nil/false?)
+*** DONE let
+**** must fix local scoping problem
+***** nested fns or renaming?
+**** let* semantics
+*** DONE do
+**** as with Java, not an expression
+**** doFn(...) -> returns last arg
+***** must alloc array for arguments?
+*** DONE loop
+*** DONE recur
+**** to loop
+**** to fn head
+***** can't do in single pass
+*** DONE invoke
+*** TODO macros
+*** TODO ns
+**** (ns my.ns (:require your.ns ...) (:macros a-clojure-ns ...))
+***** aliases?
+**** =>
+***** make a clojure ns? cljs.my.ns?
+***** goog.provide('my.ns'); goog.require('your.ns');
+***** (
+*** TODO deftype
+**** not primitive in Clojure proper
+**** maps to prototype/contructor combo
+*** TODO defprotocol
+**** not primitive in Clojure proper
+**** when given ctor, modifies prototype with slot
+***** slot is ns-qualified
+***** what about core prototypes - Object, Array et al (String, Number, Boolean, Function)?
+****** poor citizenship to modify these
+**** protocol fns just turn (my.ns/foo x a b c) into x["my.ns/foo"](a, b ,c)
+***** better - x.my$ns$foo(a, b ,c)
+****** can be minified
+*** defrecord?
+**** any way to get (:foo x) => x.foo?
+***** beware GClojure renaming
+*** DONE new
+**** what to do? ordinary invoke works fine
+***** new could be aliased, not special form then
+***** not ordinary - first arg not evaluated
+****** but should be in JS since new is an operator on a function, not a name
+**** new itself shouldn't be evaluated, won't pass fnOf
+**** (my.ns.Blah. x y z) - just macroexpander stuff
+**** (Blah. x y z) - requires import and registry
+***** class aliases a bigger issue, will there be more conflicts?
+***** any interpretation will fit only one ns strategy (e.g. gclosure's, and thus ClojureScript's)
+***** start without this
+*** DONE dot
+**** field/zero-arg-method distinguished how?
+***** not, just support scoped var and be done
+*** DONE set! (assign)
+**** same binding rules?
+***** no
+**** or just allow assign to scoped 'vars'?
+*** TODO name munging
+**** special chars
+**** js reserved words
+*** TODO (js code-string)
+**** with name escaping
+*** TODO exceptions
+**** throw
+**** try
+**** catch
+***** won't have exception type
+**** finally
+*** quote?
+*** vars?
+*** TODO reify?
+**** yes, for one-off protocol impls
+**** no ctor created, just put impls on object
+***** can share code with putting impls on prototype?
+*** case?
+*** callable non-function types?
+**** seems not possible portably
+**** could do with __proto__ (non-standard, all but IE support, even IE9 doesn't)
+**** how would Clojure feel without callable collections and keywords?
+**** could do with conditional every invocation:
+***** (f instanceof Function?f:f.cljs_lang_invoke)(args)
+***** but where to put f (in expr context)?
+****** needs helper fn
+****** fnOf(f)(args)
+******* function fnOf(x){return (f instanceof Function?f:f.cljs_lang_invoke);}
+****** i.e. every call is 2 calls
+******* tracing jit will inline?
+** Translation
+| Op | JS | Notes | Questions |
+|--------------------------+------------------------------------+-------------------------------------------+------------------------------------------------------|
+| (def x 42) | cljs.my.ns['x'] = 42 | Following gclosure module system | No vars? Compilation-time representation of ns? |
+| | cljs.my.ns.x = 42 | only this one will get minified | but this precludes special chars in names |
+| | | | def returns var in Clojure, no var here |
+|--------------------------+------------------------------------+-------------------------------------------+------------------------------------------------------|
+| (fn [x y] ...) | (function (x, y) {...}) | never do named function, use anon + def | Use for closures too? |
+| (fn [x y] ... (recur...) | | rewrite as fn + nested loop | require analysis to transmit recur fact up |
+| | | | rewrite when? |
+| | | block always in return context | access to this for methods? |
+|--------------------------+------------------------------------+-------------------------------------------+------------------------------------------------------|
+| (if test then else) | (test ? then : else) | | |
+|--------------------------+------------------------------------+-------------------------------------------+------------------------------------------------------|
+| (do e1 e2 e3) | cljs.dofn(e1,e2,e3) | dofn returns last arg, allocs array? | requires js bootstrap file? |
+| | | no, forces all to be exprs | no fn needed when not expr context |
+| | (function () {e1;e2;return e3;})() | | |
+| | | expr context becomes return except when | |
+| | | single expr | |
+|--------------------------+------------------------------------+-------------------------------------------+------------------------------------------------------|
+| (let [x 1 y 2] ...) | (function [x,y] {...})(1, 2) | need to create nested functions for let* | how to detect ref to earlier? |
+| | var x__42 = 1;var y__43 = 2; ... | var numbering | statement/expr dichotomy if inline? |
+| | (function [] | could wrap in no-arg function always | needed for expr anyhow |
+| | {var x = 1; var y = 2; ...})() | if always wrapped, don't need numbers? | can we do var x = 42; var x = 43? |
+| | | might still when nested | yes, but not var x = 42 ...nesting... var x = x |
+| | | | |
+| | | expr always becomes return context | |
+|--------------------------+------------------------------------+-------------------------------------------+------------------------------------------------------|
+| (. x y) | x.y or x.y()? | no type info to distinguish | bigger problem, both calling and retrieving |
+| | | | fn in slot are viable, Clojure says method wins |
+| (. x y ...) | x.y(...) | | |
+| | | | |
+| (: x y) ? | x.y | | make all calls, add special field accessor |
+| x.y | x.y | . not used for classes in JS | so not global, but scoped? |
+| | | can't test from Clojure | but would want resolution of first segment to locals |
+| | | | what do macros use? |
+| | | | |
+| (. x y _) | ick | | no arg == field, penalize no-arg methods? |
+| ((. x y)) | | | |
+| (-> (. x y) ()) | doesn't currently work, could | | |
+|--------------------------+------------------------------------+-------------------------------------------+------------------------------------------------------|
+| (set! (. x y) 42) | x.y = 42 | | whither vars and binding?? |
+| (set! some.global.x 42) | some.global.x = 42 | | |
+|--------------------------+------------------------------------+-------------------------------------------+------------------------------------------------------|
+| (loop [bindings] | while(true){ | | wrap in function? depends on context |
+| ... (recur)) | ... rebind-continue | | |
+| | ret=xxx;break;} | | |
+|--------------------------+------------------------------------+-------------------------------------------+------------------------------------------------------|
+| (deftype Foo [a b c]) | my.ns.Foo = function(a,b,c) | turn inline defs into explicit extends | |
+| | {this.a = a;...this.c=c;} | can't access this and fields then | |
+| | | in locals map, bind a to this.a etc | |
+|--------------------------+------------------------------------+-------------------------------------------+------------------------------------------------------|
+| (new Foo 1 2 3) | (new Foo(1,2,3)) | | |
+|--------------------------+------------------------------------+-------------------------------------------+------------------------------------------------------|
+| (defprotocol P | my.ns.foo = function(obj args) | | How to extend built-ins, default, nil, undefined |
+| (foo [args])) | {obj['my.ns.foo'](obj, args);} | can't minify | |
+| | | | |
+| | obj.my$ns$foo(obj, args) | | |
+| | P.ns = 'my.ns' | this only compile-time need, but compiler | |
+| | | not in js world, can't see it | |
+| | | Require fully qualified protocol names? | |
+|--------------------------+------------------------------------+-------------------------------------------+------------------------------------------------------|
+| (extend Foo my.ns.P | for each fn in map: | if no reified protocols, extend can't be | or use Object.defineProperty to add method to |
+| {:foo (fn [foo]...)} | Foo.prototype['my.ns.foo'] = fn | a function, unless protocol quoted | prototype? can then set enumerable to false |
+| | Foo.prototype.my$ns$foo = fn | or string | |
+|--------------------------+------------------------------------+-------------------------------------------+------------------------------------------------------|
+| constants | | | |
+| nil | null | | |
+| "foo", true, false, 42.0 | same | | |
+| 42 | goog.Long? | | |
+| 'foo | symbol ctor | | |
+| :foo | ? | | how to do keyword interning? |
+| | | | don't want intern every reference |
+|--------------------------+------------------------------------+-------------------------------------------+------------------------------------------------------|
+** Library
+*** persistent data structures?
+**** make base literals create JS base literals? (array, object-as-map)
+***** seems a big waste not to leverage js optimization of dynamic properties
+****** or, that's what deftype is about, maps have always added overhead
+***** we care more about accessors than assignment/modification
+****** i.e. we will superimpose copy-on-write
+***** string/keyword problem
+****** can make {:a 1 :b 2 :c 3} => {a: 1, b: 2, c: 3}
+****** but (keys that) => ["a" "b" "c"]
+****** could use internal array of keys trick
+******* keys used as strings in property map
+******* kept intact in internal arrays, which is what is returned by keys fn
+******* means keys must be string distinct - ick
+**** promote only on conj?
+***** or on size as well?
+** Questions
+*** equality and hashing
+*** undefined
+**** turn into nil?
+**** can't catch everywhere
+*** vars
+**** def should create slots in global ns objects?
+**** what var semantics matter?
+*** keywords and symbols
+**** make separate object types?
+***** not many symbols make it into runtime use, but keywords do
+**** need to make sure {:key val} and (:key obj) are fast
+**** native maps can have only string keys
+*** metadata
+**** just claim a slot?
+*** namespaces
+**** tie into gclosure module system?
+**** compile-time enumerability?
+*** eval
+**** runtime compiler?
+**** would let you develop in the browser, repl etc
+**** means compiler must self-host
+***** and needs runtime reader
+***** and syntax-quote
+**** no macros?
+***** can't do without, as so many basic things are macros
+**** won't have google closure compiler there
+***** ok, shouldn't rely on that
+*** laziness
+**** not a great fit
+**** GC probably not as good
+**** unlikely to be working with bigger-than-memory
+**** non-lazy mapping/filtering or mapv, filterv
+***** can make it back into Clojure
+*** Immutability
+**** enforced?
+***** or just use safe lib fns to avoid
+****** lets you use base types
+****** no final on which to base it anyway
+****** would need fancy encapsulation techniques
+******* how fancy?
+***** correct (non-assigning) code does the same thing, but incorrect not caught
+****** fair compromise?
+**** gclosure compiler can do some enforcement
+***** given some const hints in comment-based annotations
+*** Interactive development
+**** REPL
+***** easiest:
+***** Clojure read -> cljs analyze -> cljs emits -> embedded Rhino eval+print
+**** Incompatible constructs
+***** for host interop
+****** preclude development in Clojure
+**** Missing JS things
+***** e.g. DOM etc
+***** headless JS environment with DOM mocks?
+* Namespaces and macros
+** Want some equivalent of refer clojure.core
+*** else practically everything will be qualified
+**** e.g. core/defn - ick
+*** but fewer things brought in by default?
+**** requires selectivity control, or just a smaller core.cljs?
+*** this is equivalent to a 'use', which we otherwise aren't supporting
+**** unfair or don't care?
+** Any 'use' equivalent (e.g. refer core) means compile-time disambiguation of unqualified references
+*** if names a referred thing, that thing, else current.ns.name
+**** like current namespaces
+**** but if refers are limited to (entirety of) core, just look there first
+**** so double lookup instead of copying core vars into name table
+** Some core things defined in js
+*** where we don't want to otherwise expose things needed for their impl
+**** e.g. ==, ===, math ops, instanceOf typeof etc
+*** how to reserve names?
+**** declare in core.cljs?
+*** if in actual .js file, separate ns for deps purposes?
+**** i.e. it will be a different file than that produced by compiling core.cljs
+**** or just a wad of js injected into core.cljs?
+***** include a (js code-string) primitive for this purpose?
+****** yes, much better than js files
+****** accept only at top level? - no
+****** using in local scope means knowing how locals are represented
+****** some sort of escaping construct for getting (local and other) names resolved
+******* ~{identifier}
+** Are we doing forward reference detection here?
+*** requires listing of contents of current ns
+**** like namespaces
+** Are we doing extern-ns name validation?
+*** could do for cljs names, but not others
+**** e.g. goog.whatever not enumerable in cljs
+**** can we discern this situation?
+***** probably not, when compiling from files
+****** since 'require' doesn't load code at compile time
+**** another reason we can't support 'use'
+***** we do want to be able to (:require goog.foo)
+****** but not a compile-time enumerable ns
+***** or especially: (:require [goog.foo :as gfoo])
+***** means alias map, like namespaces
+** Macros written in separate Clojure files
+*** Clojure code, in regular namespaces
+*** Means core split into core.cljs, and core-macros.clj
+**** both need to be auto-referred
+*** if no use/only for macro ns, then can only get as succinct as (alias/macro ...)
+**** could allow explicit aliasing of vars instead of use
+**** extend alias for this?
+***** not really extending, alias will do this due to how nses are just vars
+***** but need not be used in that pat of resolution
+** goog.provide throws called-twice exception
+*** intended to prevent providing the same ns in more than one file
+*** actually prevents reloading same file? - aargh
+*** can't wrap, since deps checkers look for it at top level
+**** will we need to track at compilation-time?
+**** will we still need *compile-file* notion?
+** Compilation needs
+*** current ns
+**** *cljs-ns* ?
+**** is this a Clojure ns?
+***** not a fit
+****** map is sym->Var or Class
+****** aliases are sym->Namespace
+*** ns has:
+**** *cljs-namespaces* - {name->ns}
+**** {:name "my.ns" :defs {sym qualified.sym} :deps {alias Namepsace-or-qualified.sym}}
+**** defs
+***** just set of names? no map
+***** or map to fully qualified self?
+**** deps
+***** aliases
+****** sym->fully-qualified-sym
+****** is this a separate mapping vs macros and requires?
+******* if not, fn alias can mask out ns alias
+******* that can't happen in Clojure
+***** macro nses
+****** map of sym->Namespaces?
+******* require an alias?
+******* (:macros {mm my.macros, ym your.macros})
+****** aliases for these same as others?
+***** required libs must have aliases too?
+****** (:require [goog.math.Long :as gml])
+****** or new (:require {gml goog.math.Long})
+*** lookup 'foo - no ns, no dots
+**** if special - done
+**** if local - done
+**** if found in cljs.macros Namespace, the macro cljs.macros/foo
+**** if found in cljs.core ns, cljs.core.foo
+**** whatever 'foo maps to in (:ns env) defs
+**** no use of deps
+*** lookup 'foo.bar.baz - no ns, dot(s)
+**** if foo is a local, foo_nnnn.bar.baz
+**** if foo has a mapping in (:ns env) - that.mapping.bar.baz - no
+***** really? covered by alias/whatever
+****** more idiomatic for goog.stuff than goog.stuff/foo
+****** but no :as there
+***** leave out for now
+**** else foo.bar.baz
+*** lookup 'foo/bar - ns with no dots
+**** get what 'foo maps to in (:ns env) deps
+***** if nothing - error "no alias foo"
+**** if maps to Namespace, the macro 'bar in that ns
+**** else a symbol, e.g. 'fred.ethel => fred.ethel.bar
+*** lookup fully.qualified/foo - ns with dots
+**** would only use this if local shadowed (and no alias)?
+**** what doesn't have alias?
+***** cljs.core, cljs.macros
+***** could use cljs.core.foo for former
+***** always interpret as macro ns?
+****** or check deps vals for Namespace, else not
+***** if Namespace, the macro foo in Namespace
+***** fully.quallified.foo
+**** everything might have alias, but macros/syntax-quote need to emit full expansions
+*** how to refer to true globals?
+**** e.g. Object, String, goog
+**** [[https://developer.mozilla.org/en/JavaScript/Reference/Global_Objects][JS Globals]]
+**** (global Name) primitive?
+**** means (extend (global Object) ...) needs to work
+***** ok if extend evaluates first arg
411 src/clj/clojure/cljs.clj
@@ -0,0 +1,411 @@
+; Copyright (c) Rich Hickey. All rights reserved.
+; The use and distribution terms for this software are covered by the
+; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+; which can be found in the file epl-v10.html at the root of this distribution.
+; By using this software in any fashion, you are agreeing to be bound by
+; the terms of this license.
+; You must not remove this notice, or any other, from this software.
+
+(ns clojure.cljs
+ )
+
+(defonce namespaces (atom {}))
+
+(def bootjs "
+cljs = {}
+cljs.user = {}
+cljs.lang.truth = function(x){return x != null && x !== false;}
+cljs.lang.fnOf = function(f){return (f instanceof Function?f:f.cljs$lang$Fn$invoke);}")
+
+(defn- resolve-var [env sym]
+ (let [s (str sym)
+ lb (-> env :locals sym)
+ nm
+ (cond
+ lb (:name lb)
+
+ ;;todo - resolve ns aliases when we have them
+ (namespace sym)
+ (symbol (str (namespace sym) "." (name sym)))
+
+ (.contains s ".")
+ (let [idx (.indexOf s ".")
+ prefix (symbol (subs s 0 idx))
+ suffix (subs s idx)
+ lb (-> env :locals prefix)]
+ (if lb
+ (symbol (str (:name lb) suffix))
+ sym))
+
+ :else
+ (symbol (str (:ns env) "." (name sym))))]
+ {:name nm}))
+
+(defmulti emit-constant class)
+(defmethod emit-constant nil [x] (print "null"))
+(defmethod emit-constant Long [x] (print x))
+(defmethod emit-constant Double [x] (print x))
+(defmethod emit-constant String [x] (pr x))
+(defmethod emit-constant Boolean [x] (print (if x "true" "false")))
+
+(defmulti emit :op)
+
+(defn emits [expr]
+ (with-out-str (emit expr)))
+
+(defn emit-block
+ [context statements ret]
+ (if statements
+ (let [body (str "\t" (apply str (interpose "\t" (map emits statements)))
+ "\t" (emits ret))]
+ (print body))
+ (emit ret)))
+
+(defmacro emit-wrap [env & body]
+ `(let [env# ~env]
+ (when (= :return (:context env#)) (print "return "))
+ ~@body
+ (when-not (= :expr (:context env#)) (print ";\n"))))
+
+(defmethod emit :var
+ [{:keys [info env] :as arg}]
+ (emit-wrap env (print (:name info))))
+
+(defmethod emit :constant
+ [{:keys [form env]}]
+ (emit-wrap env (emit-constant form)))
+
+(defmethod emit :if
+ [{:keys [test then else env]}]
+ (let [context (:context env)]
+ (if (= :expr context)
+ (print (str "(cljs.lang.truth(" (emits test) ")?" (emits then) ":" (emits else) ")"))
+ (print (str "if(cljs.lang.truth(" (emits test) "))\n\t" (emits then) " else\n\t" (emits else) "\n")))))
+
+(defmethod emit :def
+ [{:keys [name init env]}]
+ (when init
+ (print name)
+ (print (str " = " (emits init)))
+ (when-not (= :expr (:context env)) (print ";\n"))))
+
+(defmethod emit :fn
+ [{:keys [name params statements ret env recurs]}]
+ ;;fn statements get erased, serve no purpose and can pollute scope if named
+ (when-not (= :statement (:context env))
+ (emit-wrap env
+ (print (str "(function " name "(" (apply str (interpose "," params)) "){\n"))
+ (when recurs (print "while(true){\n"))
+ (emit-block :return statements ret)
+ (when recurs (print "break;\n}\n"))
+ (print "})"))))
+
+(defmethod emit :do
+ [{:keys [statements ret env]}]
+ (let [context (:context env)]
+ (when (and statements (= :expr context)) (print "(function ()"))
+ (when statements (print "{\n"))
+ (emit-block context statements ret)
+ (when statements (print "}"))
+ (when (and statements (= :expr context)) (print ")()"))))
+
+(defmethod emit :let
+ [{:keys [bindings statements ret env loop]}]
+ (let [context (:context env)
+ bs (map (fn [{:keys [name init]}]
+ (str "var " name " = " (emits init) ";\n"))
+ bindings)]
+ (when (= :expr context) (print "(function ()"))
+ (print (str "{\n" (apply str bs) "\n"))
+ (when loop (print "while(true){\n"))
+ (emit-block (if (= :expr context) :return context) statements ret)
+ (when loop (print "break;\n}\n"))
+ (print "}")
+ (when (= :expr context) (print ")()"))))
+
+(defmethod emit :recur
+ [{:keys [frame exprs env]}]
+ (let [temps (vec (take (count exprs) (repeatedly gensym)))
+ names (:names frame)]
+ (print "{\n")
+ (dotimes [i (count exprs)]
+ (print (str "var " (temps i) " = " (emits (exprs i)) ";\n")))
+ (dotimes [i (count exprs)]
+ (print (str (names i) " = " (temps i) ";\n")))
+ (print "continue;\n")
+ (print "}\n")))
+
+(defmethod emit :invoke
+ [{:keys [f args env]}]
+ (emit-wrap env
+ (print (str "cljs.lang.fnOf(" (emits f) ")("
+ (apply str (interpose "," (map emits args)))
+ ")"))))
+
+(defmethod emit :new
+ [{:keys [ctor args env]}]
+ (emit-wrap env
+ (print (str "new " (emits ctor) "("
+ (apply str (interpose "," (map emits args)))
+ ")"))))
+
+(defmethod emit :set!
+ [{:keys [target val env]}]
+ (emit-wrap env (print (str (emits target) " = "(emits val)))))
+
+(defmethod emit :ns
+ [{:keys [name requires macros env]}]
+ (println (str "//goog.provide('" name "');"))
+ (doseq [lib (vals requires)]
+ (println (str "//goog.require('" lib "');"))))
+
+(declare analyze analyze-symbol)
+
+(def specials '#{if def fn* do let* loop recur new set! ns})
+
+(def ^:dynamic *recur-frame* nil)
+
+(defmacro disallowing-recur [& body]
+ `(binding [*recur-frame* nil] ~@body))
+
+(defn analyze-block
+ "returns {:statements .. :ret .. :children ..}"
+ [env exprs]
+ (let [statements (disallowing-recur
+ (seq (map #(analyze (assoc env :context :statement) %) (butlast exprs))))
+ ret (if (<= (count exprs) 1)
+ (analyze env (first exprs))
+ (analyze (assoc env :context (if (= :statement (:context env)) :statement :return)) (last exprs)))]
+ {:statements statements :ret ret :children (vec (cons ret statements))}))
+
+(defmulti parse (fn [op & rest] op))
+
+(defmethod parse 'if
+ [op env [_ test then else :as form] name]
+ (let [test-expr (disallowing-recur (analyze (assoc env :context :expr) test))
+ then-expr (analyze env then)
+ else-expr (analyze env else)]
+ {:env env :op :if :form form
+ :test test-expr :then then-expr :else else-expr
+ :children [test-expr then-expr else-expr]}))
+
+(defmethod parse 'def
+ [op env form name]
+ (let [pfn (fn ([_ sym] {:sym sym})
+ ([_ sym init] {:sym sym :init init})
+ ([_ sym doc init] {:sym sym :doc doc :init init}))
+ args (apply pfn form)
+ sym (:sym args)]
+ (assert (not (namespace sym)) "Can't def ns-qualified name")
+ (let [name (:name (resolve-var (dissoc env :locals) sym))
+ init-expr (when (contains? args :init) (disallowing-recur
+ (analyze (assoc env :context :expr) (:init args) sym)))]
+ (merge {:env env :op :def :form form
+ :name name :doc (:doc args) :init init-expr}
+ (when init-expr {:children [init-expr]})))))
+
+(defmethod parse 'fn*
+ [op env [_ & args] name]
+ (let [name (if (symbol? (first args))
+ (first args)
+ name)
+ meths (if (symbol? (first args))
+ (next args)
+ args)
+ ;;turn (fn [] ...) into (fn ([]...))
+ meths (if (vector? (first meths)) (list meths) meths)
+ ;;todo, merge meths, switch on arguments.length
+ meth (first meths)
+ params (first meth)
+ ;;todo, variadics
+ params (remove '#{&} params)
+ body (next meth)
+ locals (reduce (fn [m name] (assoc m name {:name name})) (:locals env) params)
+ recur-frame {:names (vec params) :flag (atom nil)}
+ block (binding [*recur-frame* recur-frame]
+ (analyze-block (assoc env :context :return :locals locals) body))]
+ (assert (= 1 (count meths)) "Arity overloading not yet supported")
+ (merge {:env env :op :fn :name name :meths meths :params params :recurs @(:flag recur-frame)} block)))
+
+(defmethod parse 'do
+ [op env [_ & exprs] _]
+ (merge {:env env :op :do} (analyze-block env exprs)))
+
+(defn analyze-let
+ [encl-env [_ bindings & exprs :as form] is-loop]
+ (assert (and (vector? bindings) (even? (count bindings))) "bindings must be vector of even number of elements")
+ (let [context (:context encl-env)
+ [bes env]
+ (disallowing-recur
+ (loop [bes []
+ env (assoc encl-env :context :expr)
+ bindings (seq (partition 2 bindings))]
+ (if-let [[name init] (first bindings)]
+ (do
+ (assert (not (or (namespace name) (.contains (str name) "."))) (str "Invalid local name: " name))
+ (let [init-expr (analyze env init)
+ be {:name (gensym (str name "__")) :init init-expr}]
+ (recur (conj bes be)
+ (assoc-in env [:locals name] be)
+ (next bindings))))
+ [bes env])))
+ recur-frame (when is-loop {:names (vec (map :name bes)) :flag (atom nil)})
+ {:keys [statements ret children]}
+ (binding [*recur-frame* (or recur-frame *recur-frame*)]
+ (analyze-block (assoc env :context (if (= :expr context) :return context)) exprs))]
+ {:env encl-env :op :let :loop is-loop
+ :bindings bes :statements statements :ret ret :form form :children (into [children] (map :init bes))}))
+
+(defmethod parse 'let*
+ [op encl-env form _]
+ (analyze-let encl-env form false))
+
+(defmethod parse 'loop
+ [op encl-env form _]
+ (analyze-let encl-env form true))
+
+(defmethod parse 'recur
+ [op env [_ & exprs] _]
+ (let [context (:context env)]
+ (assert *recur-frame* "Can't recur here")
+ (assert (= (count exprs) (count (:names *recur-frame*))) "recur argument count mismatch")
+ (reset! (:flag *recur-frame*) true)
+ (assoc {:env env :op :recur}
+ :frame *recur-frame*
+ :exprs (disallowing-recur (vec (map #(analyze (assoc env :context :expr) %) exprs))))))
+
+(defmethod parse 'new
+ [_ env [_ ctor & args] _]
+ (disallowing-recur
+ (let [enve (assoc env :context :expr)
+ ctorexpr (analyze enve ctor)
+ argexprs (vec (map #(analyze enve %) args))]
+ {:env env :op :new :ctor ctorexpr :args argexprs :children (conj argexprs ctorexpr)})))
+
+(defmethod parse 'set!
+ [_ env [_ target val] _]
+ (assert (symbol? target) "set! target must be a symbol naming var")
+ (assert (nil? (-> env :locals target)) "Can't set! local var")
+ (disallowing-recur
+ (let [enve (assoc env :context :expr)
+ targetexpr (analyze-symbol enve target)
+ valexpr (analyze enve val)]
+ {:env env :op :set! :target targetexpr :val valexpr :children [targetexpr valexpr]})))
+
+(defmethod parse 'ns
+ [_ env [_ name & {:keys [requires macros] :as params}] _]
+ (doseq [nsym (vals macros)]
+ (require nsym))
+ (let [deps (into requires (map (fn [[alias nsym]]
+ [alias (find-ns nsym)])
+ macros))]
+ (swap! namespaces #(-> % (assoc-in [name :name] name)
+ (assoc-in [name :deps] deps))))
+ (merge {:env env :op :ns :name name} params))
+
+(defn parse-invoke
+ [env [f & args]]
+ (disallowing-recur
+ (let [enve (assoc env :context :expr)
+ fexpr (analyze enve f)
+ argexprs (vec (map #(analyze enve %) args))]
+ {:env env :op :invoke :f fexpr :args argexprs :children (conj argexprs fexpr)})))
+
+(defn analyze-symbol
+ "Finds the var associated with sym"
+ [env sym]
+ (let [ret {:env env :form sym}
+ lb (-> env :locals sym)]
+ (if lb
+ (assoc ret :op :var :info lb)
+ (assoc ret :op :var :info (resolve-var env sym)))))
+
+(defn get-expander [sym env]
+ (when-not (-> env :locals sym)
+ ))
+
+(defn analyze-seq
+ [env form name]
+ (let [op (first form)]
+ (assert (not (nil? op)) "Can't call nil")
+ (if (specials op)
+ (parse op env form name)
+ (if-let [mac (and (symbol? op) (get-expander op env))]
+ (analyze (apply mac (rest form)))
+ (parse-invoke env form)))))
+
+(defn analyze
+ "Given an environment, a map containing {:locals (mapping of names to bindings), :context
+ (one of :statement, :expr, :return), :ns (a symbol naming the
+ compilation ns)}, and form, returns an expression object (a map
+ containing at least :form, :op and :env keys). If expr has any (immediately)
+ nested exprs, must have :children [exprs...] entry. This will
+ facilitate code walking without knowing the details of the op set."
+ ([env form] (analyze env form nil))
+ ([env form name]
+ (let [form (if (instance? clojure.lang.LazySeq form)
+ (or (seq form) ())
+ form)]
+ (cond
+ (symbol? form) (analyze-symbol env form)
+ (and (seq? form) (seq form)) (analyze-seq env form name)
+ :else {:op :constant :env env :form form}))))
+
+(comment
+(in-ns 'clojure.cljs)
+(import '[javax.script ScriptEngineManager])
+(def jse (-> (ScriptEngineManager.) (.getEngineByName "JavaScript")))
+(.eval jse bootjs)
+(def envx {:ns 'test.ns :context :return :locals '{ethel {:name ethel__123 :init nil}}})
+(analyze envx nil)
+(analyze envx 42)
+(analyze envx "foo")
+(analyze envx 'fred)
+(analyze envx 'fred.x)
+(analyze envx 'ethel)
+(analyze envx 'ethel.x)
+(analyze envx 'my.ns/fred)
+(analyze envx 'your.ns.fred)
+(analyze envx '(if test then else))
+(analyze envx '(if test then))
+(analyze (assoc envx :context :statement) '(def test "fortytwo" 42))
+(analyze (assoc envx :context :expr) '(fn* [x y] x y x))
+(analyze (assoc envx :context :statement) '(let* [a 1 b 2] a))
+
+(analyze envx '(ns fred :requires {yn your.ns} :macros {core clojure.core}))
+(defmacro js [form]
+ `(emit (analyze {:ns (symbol "test.ns") :context :expr :locals {}} '~form)))
+
+(defn jseval [form]
+ (let [js (emits (analyze {:ns 'cljs.user :context :expr :locals {}}
+ form))]
+ (.eval jse (str "print(" js ")"))))
+
+(js (def foo (fn* [x y] (if true 46 (recur 1 x)))))
+(jseval '(ns fred :requires {yn your.ns} :macros {core clojure.core}))
+(js (def x 42))
+(jseval '(def x 42))
+(jseval 'x)
+(jseval '(if 42 1 2))
+(jseval '(fn* [x y] (if true 46 (recur 1 x))))
+(.eval jse "print(test.)")
+(.eval jse "undefined !== false")
+(js (def fred 42))
+
+(js (new foo.Bar 65))
+
+(doseq [e '[nil true false 42 "fred" fred ethel my.ns/fred your.ns.fred
+ (if test then "fooelse")
+ (def x 45)
+ (do x y y)
+ (fn* [x y] x y x)
+ (fn* [x y] (if true 46 (recur 1 x)))
+ (let* [a 1 b 2 a a] a b)
+ (do "do1")
+ (loop [x 1 y 2] (if true 42 (do (recur 43 44))))
+ (my.foo 1 2 3)
+ (let* [a 1 b 2 c 3] (set! y.s.d b) (new fred.Ethel a b c))
+ ]]
+ (->> e (analyze envx) emit)
+ (newline))
+)
Please sign in to comment.
Something went wrong with that request. Please try again.