From 7192979794ad10ffc3daee37ca4440123c954817 Mon Sep 17 00:00:00 2001 From: Brandon Bloom Date: Fri, 27 Apr 2012 20:32:59 -0700 Subject: [PATCH] Implement basics of Var form --- devnotes/corelib.org | 4 +- src/clj/cljs/compiler.clj | 26 ++++++++++++++++----- src/cljs/cljs/core.cljs | 50 +++++++++++++++++++++++++++++++++++++++++ test/cljs/cljs/core_test.cljs | 13 ++++++++++ 4 files changed, 85 insertions(+), 8 deletions(-) diff --git a/devnotes/corelib.org b/devnotes/corelib.org index 96dd420..0716e93 100644 --- a/devnotes/corelib.org +++ b/devnotes/corelib.org @@ -554,9 +554,9 @@ as macro * use * DONE val * DONE vals -* var-get +* DONE var-get * var-set -* var? +* DONE var? * DONE vary-meta * DONE vec * DONE vector diff --git a/src/clj/cljs/compiler.clj b/src/clj/cljs/compiler.clj index c3ea1e4..e3029d9 100644 --- a/src/clj/cljs/compiler.clj +++ b/src/clj/cljs/compiler.clj @@ -339,7 +339,15 @@ (defmethod emit :var [{:keys [info env] :as arg}] - (emit-wrap env (emits (munge (:name info))))) + (let [deref (get arg :deref true) + {:keys [name name-sym]} info] + (emit-wrap env + (if deref + (emits (munge name)) + (do + (emits "new cljs.core.Var(") + (emit-constant name-sym) + (emits ",function(){return " (munge name) ";})")))))) (defmethod emit :meta [{:keys [expr meta env]}] @@ -746,7 +754,7 @@ (declare analyze analyze-symbol analyze-seq) -(def specials '#{if def fn* do let* loop* throw try* recur new set! ns deftype* defrecord* . js* & quote}) +(def specials '#{if def fn* do let* loop* throw try* recur new set! ns deftype* defrecord* . js* & quote var}) (def ^:dynamic *recur-frames* nil) (def ^:dynamic *loop-lets* nil) @@ -1205,6 +1213,13 @@ {:env env :op :js :code (apply str (interp jsform)) :tag (-> form meta :tag)}))) +(defmethod parse 'var + [op env [_ sym] name] + (let [s (analyze-symbol env sym)] + (when-not (:info s) + (throw (Error. (str "Unable to resolve var: " sym " in this context")))) + (assoc s :deref false))) + (defn parse-invoke [env [f & args]] (disallowing-recur @@ -1226,10 +1241,9 @@ "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-existing-var env sym))))) + lb (-> env :locals sym) + info (if lb lb (resolve-existing-var env sym))] + (assoc ret :op :var :info info))) (defn get-expander [sym env] (let [mvar diff --git a/src/cljs/cljs/core.cljs b/src/cljs/cljs/core.cljs index 4821720..70c670c 100644 --- a/src/cljs/cljs/core.cljs +++ b/src/cljs/cljs/core.cljs @@ -253,6 +253,9 @@ (defprotocol ITransientSet (-disjoin! [tcoll v])) +(defprotocol IVar + (-bind-root [v root])) + ;;;;;;;;;;;;;;;;;;; fundamentals ;;;;;;;;;;;;;;; (defn ^boolean identical? "Tests if 2 arguments are the same object" @@ -5440,6 +5443,53 @@ reduces them without incurring seq initialization" (do (reset! a newval) true) false)) +;; Vars + +(deftype Var [sym getter] + IEquiv + (-equiv [_ other] (and other (= sym (.-sym other)))) + + IDeref + (-deref [_] (getter)) + + IPrintable + (-pr-seq [_ opts] + (concat ["#'"] (-pr-seq sym opts))) + + IHash + (-hash [_] (-hash sym)) + + IFn + (-invoke [this] ((getter))) + (-invoke [this a] ((getter) a)) + (-invoke [this a b] ((getter) a b)) + (-invoke [this a b c] ((getter) a b c)) + (-invoke [this a b c d] ((getter) a b c d)) + (-invoke [this a b c d e] ((getter) a b c d e)) + (-invoke [this a b c d e f] ((getter) a b c d e f)) + (-invoke [this a b c d e f g] ((getter) a b c d e f g)) + (-invoke [this a b c d e f g h] ((getter) a b c d e f g h)) + (-invoke [this a b c d e f g h i] ((getter) a b c d e f g h i)) + (-invoke [this a b c d e f g h i j] ((getter) a b c d e f g h i j)) + (-invoke [this a b c d e f g h i j k] ((getter) a b c d e f g h i j k)) + (-invoke [this a b c d e f g h i j k l] ((getter) a b c d e f g h i j k l)) + (-invoke [this a b c d e f g h i j k l m] ((getter) a b c d e f g h i j k l m)) + (-invoke [this a b c d e f g h i j k l m n] ((getter) a b c d e f g h i j k l m n)) + (-invoke [this a b c d e f g h i j k l m n o] ((getter) a b c d e f g h i j k l m n o)) + (-invoke [this a b c d e f g h i j k l m n o p] ((getter) a b c d e f g h i j k l m n o p)) + (-invoke [this a b c d e f g h i j k l m n o p q] ((getter) a b c d e f g h i j k l m n o p q)) + (-invoke [this a b c d e f g h i j k l m n o p q s] ((getter) a b c d e f g h i j k l m n o p q s)) + (-invoke [this a b c d e f g h i j k l m n o p q s t] ((getter) a b c d e f g h i j k l m n o p q s t)) + (-invoke [this a b c d e f g h i j k l m n o p q s t rest] ((getter) a b c d e f g h i j k l m n o p q s t rest))) + +(defn var-get + "Gets the value in the var object" + [x] (.getter x)) + +(defn ^boolean var? + "returns true if v is of type cljs.core.Var" + [v] (instance? cljs.core.Var v)) + ;; generic to all refs ;; (but currently hard-coded to atom!) diff --git a/test/cljs/cljs/core_test.cljs b/test/cljs/cljs/core_test.cljs index 5539463..e14afce 100644 --- a/test/cljs/cljs/core_test.cljs +++ b/test/cljs/cljs/core_test.cljs @@ -1305,5 +1305,18 @@ :fail)) :fail))) + (assert (= '(var f) '#'f)) + (defn f [x] (inc x)) + (def f' f) + (def f* #'f) + (assert (not (var? f'))) + (assert (var? f*)) + (defn f [x] (dec x)) + (assert (= (f' 5) 6)) + (assert (= (f* 5) 4)) + (assert (= #'f #'f)) + (assert (= (var-get #'f) @#'f f)) + (assert (= (pr-str #'f) "#'cljs.core-test/f")) + :ok ) -- 1.7.9.1