Permalink
Browse files

CLJS-441: Replace "blocks" with implict do nodes

  • Loading branch information...
1 parent 26b2541 commit 764565e9e7696379ada5ac8168b20ee5f9cde6a2 @brandonbloom brandonbloom committed with David Nolen Dec 12, 2012
Showing with 45 additions and 79 deletions.
  1. +24 −40 src/clj/cljs/analyzer.clj
  2. +21 −39 src/clj/cljs/compiler.clj
View
@@ -230,16 +230,6 @@
(keyword (-> env :ns :name name) (name sym))
sym)})
-(defn analyze-block
- "returns {:statements .. :ret ..}"
- [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}))
-
(defmulti parse (fn [op & rest] op))
(defmethod parse 'if
@@ -260,9 +250,6 @@
:throw throw-expr
:children [throw-expr]}))
-(defn- block-children [{:keys [statements ret] :as block}]
- (when block (conj (vec statements) ret)))
-
(defmethod parse 'try*
[op env [_ & body :as form] name]
(let [body (vec body)
@@ -271,9 +258,7 @@
fblock (when (and (seq? tail) (= 'finally (first tail)))
(rest tail))
finally (when fblock
- (analyze-block
- (assoc env :context :statement)
- fblock))
+ (analyze (assoc env :context :statement) `(do ~@fblock)))
body (if finally (pop body) body)
tail (peek body)
cblock (when (and (seq? tail)
@@ -285,18 +270,16 @@
(assoc locals name {:name name})
locals)
catch (when cblock
- (analyze-block (assoc catchenv :locals locals) (rest cblock)))
+ (analyze (assoc catchenv :locals locals) `(do ~@(rest cblock))))
body (if name (pop body) body)
- try (when body
- (analyze-block (if (or name finally) catchenv env) body))]
+ try (analyze (if (or name finally) catchenv env) `(do ~@body))]
(when name (assert (not (namespace name)) "Can't qualify symbol in catch"))
{:env env :op :try* :form form
:try try
:finally finally
:name name
:catch catch
- :children (vec (mapcat block-children
- [try catch finally]))}))
+ :children [try catch finally]}))
(defmethod parse 'def
[op env form name]
@@ -380,11 +363,10 @@
[locals []] param-names)
fixed-arity (count (if variadic (butlast params) params))
recur-frame {:params 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 params :max-fixed-arity fixed-arity
- :type type :form form :recurs @(:flag recur-frame)}
- block)))
+ expr (binding [*recur-frames* (cons recur-frame *recur-frames*)]
+ (analyze (assoc env :context :return :locals locals) `(do ~@body)))]
+ {:env env :variadic variadic :params params :max-fixed-arity fixed-arity
+ :type type :form form :recurs @(:flag recur-frame) :expr expr}))
(defmethod parse 'fn*
[op env [_ & args :as form] name]
@@ -434,8 +416,7 @@
:max-fixed-arity max-fixed-arity
:protocol-impl protocol-impl
:protocol-inline protocol-inline
- :children (vec (mapcat block-children
- methods))}))
+ :children (mapv :expr methods)}))
(defmethod parse 'letfn*
[op env [_ bindings & exprs :as form] name]
@@ -457,16 +438,20 @@
(let [env (assoc-in meth-env [:locals name] shadow)]
(assoc be :init (analyze env (n->fexpr name)))))
bes))
- {:keys [statements ret]}
- (analyze-block (assoc meth-env :context (if (= :expr context) :return context)) exprs)]
- {:env env :op :letfn :bindings bes :statements statements :ret ret :form form
- :children (into (vec (map :init bes))
- (conj (vec statements) ret))}))
+ expr (analyze (assoc meth-env :context (if (= :expr context) :return context)) `(do ~@exprs))]
+ {:env env :op :letfn :bindings bes :expr expr :form form
+ :children (conj (vec (map :init bes)) expr)}))
(defmethod parse 'do
[op env [_ & exprs :as form] _]
- (let [block (analyze-block env exprs)]
- (merge {:env env :op :do :form form :children (block-children block)} block)))
+ (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)))]
+ {:env env :op :do :form form
+ :statements statements :ret ret
+ :children (conj (vec statements) ret)}))
(defn analyze-let
[encl-env [_ bindings & exprs :as form] is-loop]
@@ -501,16 +486,15 @@
(next bindings))))
[bes env])))
recur-frame (when is-loop {:params bes :flag (atom nil)})
- {:keys [statements ret]}
+ expr
(binding [*recur-frames* (if recur-frame (cons recur-frame *recur-frames*) *recur-frames*)
*loop-lets* (cond
is-loop (or *loop-lets* ())
*loop-lets* (cons {:params bes} *loop-lets*))]
- (analyze-block (assoc env :context (if (= :expr context) :return context)) exprs))]
+ (analyze (assoc env :context (if (= :expr context) :return context)) `(do ~@exprs)))]
{:env encl-env :op (if is-loop :loop :let)
- :bindings bes :statements statements :ret ret :form form
- :children (into (vec (map :init bes))
- (conj (vec statements) ret))}))
+ :bindings bes :expr expr :form form
+ :children (conj (vec (map :init bes)) expr)}))
(defmethod parse 'let*
[op encl-env form _]
View
@@ -206,12 +206,6 @@
(comma-sep (map #(fn [] (emit-constant %)) x))
["])"])))
-(defn emit-block
- [context statements ret]
- (when statements
- (emits statements))
- (emit ret))
-
(defmacro emit-wrap [env & body]
`(let [env# ~env]
(when (= :return (:context env#)) (emits "return "))
@@ -389,20 +383,20 @@
(emits "})")))
(defn emit-fn-method
- [{:keys [type name variadic params statements ret env recurs max-fixed-arity]}]
+ [{:keys [type name variadic params expr env recurs max-fixed-arity]}]
(emit-wrap env
(emitln "(function " (munge name) "(" (comma-sep (map munge params)) "){")
(when type
(emitln "var self__ = this;"))
(when recurs (emitln "while(true){"))
- (emit-block :return statements ret)
+ (emits expr)
(when recurs
(emitln "break;")
(emitln "}"))
(emits "})")))
(defn emit-variadic-fn-method
- [{:keys [type name variadic params statements ret env recurs max-fixed-arity] :as f}]
+ [{:keys [type name variadic params expr env recurs max-fixed-arity] :as f}]
(emit-wrap env
(let [name (or name (gensym))
mname (munge name)
@@ -411,7 +405,7 @@
(emitln "(function() { ")
(emitln "var " delegate-name " = function (" (comma-sep params) "){")
(when recurs (emitln "while(true){"))
- (emit-block :return statements ret)
+ (emits expr)
(when recurs
(emitln "break;")
(emitln "}"))
@@ -515,42 +509,30 @@
[{:keys [statements ret env]}]
(let [context (:context env)]
(when (and statements (= :expr context)) (emits "(function (){"))
- ;(when statements (emitln "{"))
- (emit-block context statements ret)
- ;(when statements (emits "}"))
+ (when statements
+ (emits statements))
+ (emit ret)
(when (and statements (= :expr context)) (emits "})()"))))
(defmethod emit :try*
[{:keys [env try catch name finally]}]
- (let [context (:context env)
- subcontext (if (= :expr context) :return context)]
+ (let [context (:context env)]
(if (or name finally)
(do
- (when (= :expr context) (emits "(function (){"))
- (emits "try{")
- (let [{:keys [statements ret]} try]
- (emit-block subcontext statements ret))
- (emits "}")
+ (when (= :expr context)
+ (emits "(function (){"))
+ (emits "try{" try "}")
(when name
- (emits "catch (" (munge name) "){")
- (when catch
- (let [{:keys [statements ret]} catch]
- (emit-block subcontext statements ret)))
- (emits "}"))
+ (emits "catch (" (munge name) "){" catch "}"))
(when finally
- (let [{:keys [statements ret]} finally]
- (assert (not= :constant (:op ret)) "finally block cannot contain constant")
- (emits "finally {")
- (emit-block subcontext statements ret)
- (emits "}")))
- (when (= :expr context) (emits "})()")))
- (let [{:keys [statements ret]} try]
- (when (and statements (= :expr context)) (emits "(function (){"))
- (emit-block subcontext statements ret)
- (when (and statements (= :expr context)) (emits "})()"))))))
+ (assert (not= :constant (:op finally)) "finally block cannot contain constant")
+ (emits "finally {" finally "}"))
+ (when (= :expr context)
+ (emits "})()")))
+ (emits try))))
(defn emit-let
- [{:keys [bindings statements ret env]} is-loop]
+ [{:keys [bindings expr env]} is-loop]
(let [context (:context env)]
(when (= :expr context) (emits "(function (){"))
(binding [*lexical-renames* (into *lexical-renames*
@@ -561,7 +543,7 @@
(doseq [{:keys [init] :as binding} bindings]
(emitln "var " (munge binding) " = " init ";"))
(when is-loop (emitln "while(true){"))
- (emit-block (if (= :expr context) :return context) statements ret)
+ (emits expr)
(when is-loop
(emitln "break;")
(emitln "}")))
@@ -586,12 +568,12 @@
(emitln "}")))
(defmethod emit :letfn
- [{:keys [bindings statements ret env]}]
+ [{:keys [bindings expr env]}]
(let [context (:context env)]
(when (= :expr context) (emits "(function (){"))
(doseq [{:keys [init] :as binding} bindings]
(emitln "var " (munge binding) " = " init ";"))
- (emit-block (if (= :expr context) :return context) statements ret)
+ (emits expr)
(when (= :expr context) (emits "})()"))))
(defn protocol-prefix [psym]

0 comments on commit 764565e

Please sign in to comment.