Skip to content

Commit

Permalink
Merge branch 'master' into persistent-queue
Browse files Browse the repository at this point in the history
  • Loading branch information
@fogus
fogus committed Jan 14, 2012
2 parents 4ee24f7 + 63b6fb5 commit 72ad53f
Show file tree
Hide file tree
Showing 14 changed files with 254 additions and 120 deletions.
113 changes: 93 additions & 20 deletions src/clj/cljs/compiler.clj
View file
Expand Up @@ -37,6 +37,10 @@
(def ^:dynamic *cljs-file* nil)
(def ^:dynamic *cljs-warn-on-undeclared* false)

(defmacro ^:private debug-prn
[& args]
`(.println System/err (str ~@args)))

(defn munge [s]
(let [ss (str s)
ms (if (.contains ss "]")
Expand Down Expand Up @@ -119,10 +123,10 @@
{:name (js-var sym)}
(let [s (str sym)
lb (-> env :locals sym)
nm
nm
(cond
lb (:name lb)

(namespace sym)
(let [ns (namespace sym)
ns (if (= "clojure.core" ns) "cljs.core" ns)]
Expand Down Expand Up @@ -460,7 +464,7 @@
(print (str "catch (" name "){"))
(when catch
(let [{:keys [statements ret]} catch]
(emit-block subcontext statements ret)))
(emit-block subcontext statements ret)))
(print "}"))
(when finally
(let [{:keys [statements ret]} finally]
Expand Down Expand Up @@ -600,7 +604,7 @@

(defmethod parse 'if
[op env [_ test then else :as form] name]
(let [test-expr (disallowing-recur (analyze (assoc env :context :expr) test))
(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
Expand Down Expand Up @@ -689,7 +693,7 @@
recur-frame {:names (vec (map munge params)) :flag (atom nil)}
block (binding [*recur-frames* (cons recur-frame *recur-frames*)]
(analyze-block (assoc env :context :return :locals locals) body))]

(merge {:env env :variadic variadic :params (map munge params) :max-fixed-arity fixed-arity :gthis gthis :recurs @(:flag recur-frame)} block)))

(defmethod parse 'fn*
Expand Down Expand Up @@ -859,20 +863,88 @@
m))))
{:env env :op :defrecord* :t t :fields fields}))

;; dot accessor code

(def ^:private property-symbol? #(boolean (and (symbol? %) (re-matches #"^-.*" (name %)))))

(defn- clean-symbol
[sym]
(symbol
(if (property-symbol? sym)
(-> sym name (.substring 1) munge)
(-> sym name munge))))

(defn- classify-dot-form
[[target member args]]
[(cond (nil? target) ::error
:default ::expr)
(cond (property-symbol? member) ::property
(symbol? member) ::symbol
(seq? member) ::list
:default ::error)
(cond (nil? args) ()
:default ::expr)])

(defmulti build-dot-form #(classify-dot-form %))

;; (. o -p)
;; (. (...) -p)
(defmethod build-dot-form [::expr ::property ()]
[[target prop _]]
{:dot-action ::access :target target :field (clean-symbol prop)})

;; (. o -p <args>)
(defmethod build-dot-form [::expr ::property ::list]
[[target prop args]]
(throw (Error. (str "Cannot provide arguments " args " on property access " prop))))

(defn- build-method-call
"Builds the intermediate method call map used to reason about the parsed form during
compilation."
[target meth args]
(if (symbol? meth)
{:dot-action ::call :target target :method (munge meth) :args args}
{:dot-action ::call :target target :method (munge (first meth)) :args args}))

;; (. o m 1 2)
(defmethod build-dot-form [::expr ::symbol ::expr]
[[target meth args]]
(build-method-call target meth args))

;; (. o m)
(defmethod build-dot-form [::expr ::symbol ()]
[[target meth args]]
(debug-prn "WARNING: The form " (list '. target meth)
" is no longer a property access. Maybe you meant "
(list '. target (symbol (str '- meth))) " instead?")
(build-method-call target meth args))

;; (. o (m))
;; (. o (m 1 2))
(defmethod build-dot-form [::expr ::list ()]
[[target meth-expr _]]
(build-method-call target (first meth-expr) (rest meth-expr)))

(defmethod build-dot-form :default
[dot-form]
(throw (Error. (str "Unknown dot form of " (list* '. dot-form) " with classification " (classify-dot-form dot-form)))))

(defmethod parse '.
[_ env [_ target & member+] _]
[_ env [_ target & [field & member+]] _]
(disallowing-recur
(let [enve (assoc env :context :expr)
targetexpr (analyze enve target)
children [enve]]
(if (and (symbol? (first member+)) (nil? (next member+))) ;;(. target field)
{:env env :op :dot :target targetexpr :field (munge (first member+)) :children children}
(let [[method args]
(if (symbol? (first member+))
[(first member+) (next member+)]
[(ffirst member+) (nfirst member+)])
argexprs (map #(analyze enve %) args)]
{:env env :op :dot :target targetexpr :method (munge method) :args argexprs :children (into children argexprs)})))))
(let [{:keys [dot-action target method field args]} (build-dot-form [target field member+])
enve (assoc env :context :expr)
targetexpr (analyze enve target)
children [enve]]
(case dot-action
::access {:env env :op :dot :children children
:target targetexpr
:field field}
::call (let [argexprs (map #(analyze enve %) args)]
{:env env :op :dot :children (into children argexprs)
:target targetexpr
:method method
:args argexprs})))))

(defmethod parse 'js*
[op env [_ form & args] _]
Expand Down Expand Up @@ -916,7 +988,8 @@

(defn get-expander [sym env]
(let [mvar
(when-not (-> env :locals sym) ;locals hide macros
(when-not (or (-> env :locals sym) ;locals hide macros
(-> env :ns :excludes sym))
(if-let [nstr (namespace sym)]
(when-let [ns (cond
(= "clojure.core" nstr) (find-ns 'cljs.core)
Expand Down Expand Up @@ -1098,7 +1171,7 @@
Returns a map containing {:ns .. :provides .. :requires .. :file ..}.
If the file was not compiled returns only {:file ...}"
([src]
(let [dest (rename-to-js src)]
(let [dest (rename-to-js src)]
(compile-file src dest)))
([src dest]
(let [src-file (io/file src)
Expand Down Expand Up @@ -1224,7 +1297,7 @@
(deftype Foo [a] IMeta (-meta [_] (fn [] a)))
((-meta (Foo. 42)))

;;OLD way, don't you want to use the REPL?
;;OLD way, don't you want to use the REPL?
(in-ns 'cljs.compiler)
(import '[javax.script ScriptEngineManager])
(def jse (-> (ScriptEngineManager.) (.getEngineByName "JavaScript")))
Expand Down
25 changes: 16 additions & 9 deletions src/clj/cljs/core.clj
View file
Expand Up @@ -180,9 +180,14 @@
locals (keys (:locals &env))]
`(do
(when (undefined? ~t)
(deftype ~t [~@locals]
(deftype ~t [~@locals ~'__meta]
cljs.core.IWithMeta
(~'-with-meta [~'_ ~'__meta]
(new ~t ~@locals ~'__meta))
cljs.core.IMeta
(~'-meta [~'_] ~'__meta)
~@impls))
(new ~t ~@locals))))
(new ~t ~@locals nil))))

(defmacro this-as
"Defines a scope where JavaScript's implicit \"this\" is bound to the name provided."
Expand Down Expand Up @@ -282,8 +287,8 @@
`(~'-hash [this#] (hash-coll this#))
'IEquiv
`(~'-equiv [this# other#]
(and (identical? (.constructor this#) ;; TODO: change for prop lookup
(.constructor other#))
(and (identical? (.-constructor this#)
(.-constructor other#))
(equiv-map this# other#)))
'IMeta
`(~'-meta [this#] ~'__meta)
Expand Down Expand Up @@ -364,7 +369,7 @@
methods (if (string? (first doc+methods)) (next doc+methods) doc+methods)
expand-sig (fn [fname slot sig]
`(~sig
(if (and ~(first sig) (. ~(first sig) ~slot))
(if (and ~(first sig) (. ~(first sig) ~(symbol (str "-" slot)))) ;; Property access needed here.
(. ~(first sig) ~slot ~@sig)
((or
(aget ~(fqn fname) (goog.typeOf ~(first sig)))
Expand All @@ -386,9 +391,11 @@
(let [p (:name (cljs.compiler/resolve-var (dissoc &env :locals) psym))
prefix (protocol-prefix p)]
`(let [x# ~x]
(if (and x# (. x# ~(symbol prefix)) (not (cljs.core/is_proto_ x#)))
true
(cljs.core/type_satisfies_ ~psym x#)))))
(if (and x#
(. x# ~(symbol (str "-" prefix))) ;; Need prop lookup here
(not (. x# (~'hasOwnProperty ~prefix))))
true
(cljs.core/type_satisfies_ ~psym x#)))))

(defmacro lazy-seq [& body]
`(new cljs.core.LazySeq nil false (fn [] ~@body)))
Expand All @@ -404,7 +411,7 @@
[bindings & body]
(let [names (take-nth 2 bindings)
vals (take-nth 2 (drop 1 bindings))
tempnames (map gensym names)
tempnames (map (comp gensym name) names)
binds (map vector names vals)
resets (reverse (map vector names tempnames))]
`(let [~@(interleave tempnames names)]
Expand Down

0 comments on commit 72ad53f

Please sign in to comment.