From 46e5ce2ae2416033ac178f5bce9c9b47c41ad79c Mon Sep 17 00:00:00 2001 From: Bert Frees Date: Sun, 12 Jan 2014 16:59:07 +0100 Subject: [PATCH 1/5] read-string must be the responsibility of read-exports-fn This way an alternative version of read-exports-fn could keep the exports data in memory instead of reading it from file. --- src/clj/cljc/compiler.clj | 2 +- src/clj/cljc/driver.clj | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/clj/cljc/compiler.clj b/src/clj/cljc/compiler.clj index 57b598c..7b5e2d0 100644 --- a/src/clj/cljc/compiler.clj +++ b/src/clj/cljc/compiler.clj @@ -1420,7 +1420,7 @@ (defn analyze-deps [deps] (doseq [dep deps] - (doseq [[kind info entry] (read-string ((var-get #'*read-exports-fn*) dep))] + (doseq [[kind info entry] ((var-get #'*read-exports-fn*) dep)] (case kind :defined-fields (emit-declaration diff --git a/src/clj/cljc/driver.clj b/src/clj/cljc/driver.clj index 7493eac..abc5ac9 100644 --- a/src/clj/cljc/driver.clj +++ b/src/clj/cljc/driver.clj @@ -117,7 +117,7 @@ (defn read-exports-fn-for-dir [dir] (fn [ns] (let [file (io/file dir (str (cljc/munge ns) "-exports.clj"))] - (slurp file)))) + (read-string (slurp file))))) (defn compile-expr [ns-name with-core expr] (binding [*build-options* (assoc *build-options* From 76bc50f4dc39ef8997199642ff1722e76287161a Mon Sep 17 00:00:00 2001 From: Bert Frees Date: Sun, 12 Jan 2014 17:28:43 +0100 Subject: [PATCH 2/5] Remember which vars are already defined and declare them as `extern` This change is needed for the REPL* (which compiles each form into a separate shared library) in order to be able to re-define a 'closed-over' variable and having the closure behave as expected. Example: (def x 1) (defn get-x [] x) (assert (= (get-x) 1)) (def x 2) (assert (= (get-x) 2)) (*) http://github.com/bertfrees/cljc.repl --- src/clj/cljc/compiler.clj | 34 +++++++++++++++++++++------------- 1 file changed, 21 insertions(+), 13 deletions(-) diff --git a/src/clj/cljc/compiler.clj b/src/clj/cljc/compiler.clj index 7b5e2d0..1b4c6e9 100644 --- a/src/clj/cljc/compiler.clj +++ b/src/clj/cljc/compiler.clj @@ -585,13 +585,13 @@ (emitln "*/"))))) (defmethod emit :def - [{:keys [name init env]}] + [{:keys [name init env extern]}] (emit-declaration ;; FIXME: This should really init to VALUE_NONE, but we have ;; defining inits in preamble.c for apply and print, which would ;; conflict with core.cljc. It's probably better to make them ;; non-defining. - (emitln (if init "" "extern ") "value_t *VAR_NAME (" name ");")) + (emitln (if extern "extern " "") "value_t *VAR_NAME (" name ");")) (when init (let [init-name (emit init)] (emitln "VAR_NAME (" name ") = " init-name ";") @@ -1158,14 +1158,16 @@ fn-var? (and init-expr (= (:op init-expr) :fn)) export-as (when-let [export-val (-> sym meta :export)] (if (= true export-val) name export-val)) - doc (or (:doc args) (-> sym meta :doc))] - (when-let [v (get-in @namespaces [ns-name :defs sym])] - (when (and *cljs-warn-on-fn-var* - (not (-> sym meta :declared)) - (and (:fn-var v) (not fn-var?))) - (warning env - (str "WARNING: " (symbol (str ns-name) (str sym)) - " no longer fn, references are stale")))) + doc (or (:doc args) (-> sym meta :doc)) + extern (when-let [v (get-in @namespaces [ns-name :defs sym])] + (when (and *cljs-warn-on-fn-var* + (not (-> sym meta :declared)) + (and (:fn-var v) (not fn-var?))) + (warning env + (str "WARNING: " (symbol (str ns-name) (str sym)) + " no longer fn, references are stale"))) + (or (:extern v) + (not (contains? v :defrecord))))] (let [entry (merge {:name name} (when tag {:tag tag}) (when dynamic {:dynamic true}) @@ -1181,7 +1183,8 @@ :max-fixed-arity (:max-fixed-arity init-expr) :method-params (map (fn [m] (:params m)) - (:methods init-expr))}))] + (:methods init-expr))}) + (when extern {:extern true}))] (swap! namespaces update-in [ns-name :defs sym] merge entry) (swap! exports conj [:namespaces [ns-name :defs sym] entry])) (merge {:env env :op :def :form form @@ -1189,7 +1192,8 @@ (when tag {:tag tag}) (when dynamic {:dynamic true}) (when export-as {:export export-as}) - (when init-expr {:children [init-expr]}))))) + (when init-expr {:children [init-expr]}) + (when extern {:extern true}))))) (defn- analyze-fn-method [env locals meth] (letfn [(uniqify [[p & r]] @@ -1518,13 +1522,17 @@ [_ env [_ tsym fields pmasks :as form] _] (let [t (munge (:name (resolve-var (dissoc env :locals) tsym))) ns-name (-> env :ns :name) + extern (when-let [v (get-in @namespaces [ns-name :defs tsym])] + (or (:extern v) + (not (contains? v :defrecord)))) entry (merge {:name t :defrecord (:defrecord (meta tsym)) :fields fields :num-fields (count fields)} (if-let [line (:line env)] {:file *cljs-file* :line line} - {}))] + {}) + (if extern {:extern true}))] (swap! namespaces update-in [ns-name :defs tsym] merge entry) (swap! exports conj [:namespaces [ns-name :defs tsym] entry]) {:env env :op :deftype* :as form :t t :fields fields :pmasks pmasks})) From 27127c2f4f7eba4e358ecc164efbdad4013b7c8c Mon Sep 17 00:00:00 2001 From: Bert Frees Date: Thu, 16 Jan 2014 18:53:42 +0100 Subject: [PATCH 3/5] Make Closure printable --- src/cljc/cljc/core.cljc | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/src/cljc/cljc/core.cljc b/src/cljc/cljc/core.cljc index 2add31d..5474c36 100644 --- a/src/cljc/cljc/core.cljc +++ b/src/cljc/cljc/core.cljc @@ -392,7 +392,14 @@ (extend-type Closure IHash (-hash [o] - (c* "make_integer ((long)~{})" o))) + (c* "make_integer ((long)~{})" o)) + + IPrintable + (-pr-seq [c opts] + (list + (if-objc + (c* "make_objc_object ([NSString stringWithFormat: @\"#\", ((closure_t*)~{})->fn, ((closure_t*)~{})->env])" c c) + (c* "make_string_copy_free (g_strdup_printf (\"#\", ((closure_t*)~{})->fn, ((closure_t*)~{})->env))" c c))))) (extend-type RawPointer IPrintable From 90870d744c60b591ecaff1281452ea553756dc0e Mon Sep 17 00:00:00 2001 From: Bert Frees Date: Thu, 16 Jan 2014 22:52:07 +0100 Subject: [PATCH 4/5] New type: cljc.core.Var so that vars can be passed around (and e.g. printed in the REPL) --- src/c/cljc.h | 12 +++++++++++- src/c/runtime.c | 39 +++++++++++++++++++++++++++++++++++++++ src/clj/cljc/compiler.clj | 15 ++++++++++----- src/cljc/cljc/core.cljc | 8 ++++++++ 4 files changed, 68 insertions(+), 6 deletions(-) diff --git a/src/c/cljc.h b/src/c/cljc.h index 57b0a8a..e3ea5c7 100644 --- a/src/c/cljc.h +++ b/src/c/cljc.h @@ -90,6 +90,12 @@ typedef struct { const char *utf8; } symbol_t; +typedef struct { + value_t val; + symbol_t *name; + value_t *binding; +} var_t; + typedef struct { value_t val; const char *utf8; @@ -151,6 +157,7 @@ struct ptable { #ifndef HAVE_OBJC #define TYPE_String 8 #endif +#define TYPE_Var 15 #define TYPE_Symbol 9 #define TYPE_Keyword 10 #define TYPE_RawPointer 11 @@ -159,7 +166,7 @@ struct ptable { #define TYPE_ObjCObject 13 #define TYPE_ObjCSelector 14 #endif -#define FIRST_TYPE 15 +#define FIRST_TYPE 16 #define FIRST_FIELD 1 @@ -210,6 +217,7 @@ extern value_t* VAR_NAME (cljc_DOT_core_SLASH_Character); #ifndef HAVE_OBJC extern value_t* VAR_NAME (cljc_DOT_core_SLASH_String); #endif +extern value_t* VAR_NAME (cljc_DOT_core_SLASH_Var); extern value_t* VAR_NAME (cljc_DOT_core_SLASH_Symbol); extern value_t* VAR_NAME (cljc_DOT_core_SLASH_Keyword); extern value_t* VAR_NAME (cljc_DOT_core_SLASH_RawPointer); @@ -225,6 +233,7 @@ extern ptable_t* PTABLE_NAME (cljc_DOT_core_SLASH_Character); #ifndef HAVE_OBJC extern ptable_t* PTABLE_NAME (cljc_DOT_core_SLASH_String); #endif +extern ptable_t* PTABLE_NAME (cljc_DOT_core_SLASH_Var); extern ptable_t* PTABLE_NAME (cljc_DOT_core_SLASH_Symbol); extern ptable_t* PTABLE_NAME (cljc_DOT_core_SLASH_Keyword); extern ptable_t* PTABLE_NAME (cljc_DOT_core_SLASH_RawPointer); @@ -285,6 +294,7 @@ extern value_t* make_string_from_unichar (cljc_unichar_t c); extern value_t* make_string_from_buf (const char *start, const char *end); extern const char* string_get_utf8 (value_t *v); extern uint32_t string_hash_code (const char *utf8); +extern value_t* intern (const symbol_t* name, const value_t *value); extern value_t* intern_symbol (const char *utf8, bool copy); extern const char* symbol_get_utf8 (value_t *v); extern value_t* symbol_get_name (value_t *v); diff --git a/src/c/runtime.c b/src/c/runtime.c index fd59cec..06a6e69 100644 --- a/src/c/runtime.c +++ b/src/c/runtime.c @@ -317,6 +317,7 @@ ptable_t* PTABLE_NAME (cljc_DOT_core_SLASH_Character) = NULL; #ifndef HAVE_OBJC ptable_t* PTABLE_NAME (cljc_DOT_core_SLASH_String) = NULL; #endif +ptable_t* PTABLE_NAME (cljc_DOT_core_SLASH_Var) = NULL; ptable_t* PTABLE_NAME (cljc_DOT_core_SLASH_Symbol) = NULL; ptable_t* PTABLE_NAME (cljc_DOT_core_SLASH_Keyword) = NULL; ptable_t* PTABLE_NAME (cljc_DOT_core_SLASH_RawPointer) = NULL; @@ -580,6 +581,40 @@ string_hash_code (const char *utf8) return hashmurmur3_32(utf8, len); } +static var_t* +make_var (const symbol_t *name, const value_t *binding) +{ + var_t *var = (var_t*)alloc_value_retired (PTABLE_NAME (cljc_DOT_core_SLASH_Var), sizeof (var_t)); + var->name = name; + var->binding = binding; + return var; +} + +KHASH_MAP_INIT_STR (VARS, var_t*); +static khash_t(VARS) *var_hash = NULL; + +value_t* +intern (const symbol_t* name, const value_t *value) +{ + khiter_t iter; + int ret; + if (var_hash == NULL) { + var_hash = kh_init (VARS); + assert (var_hash != NULL); + } + iter = kh_put (VARS, var_hash, name->utf8, &ret); + if (ret != 0) { + var_t *var = make_var (name, value); + kh_value (var_hash, iter) = var; + } else { + var_t* var = kh_value (var_hash, iter); + if (value != NULL) + var->binding = value; + assert (strcmp (var->name->utf8, name->utf8) == 0); + } + return &kh_value (var_hash, iter)->val; +} + static symbol_t* make_symbol (const char *utf8) { @@ -1059,6 +1094,7 @@ value_t* VAR_NAME (cljc_DOT_core_SLASH_Character) = VALUE_NONE; #ifndef HAVE_OBJC value_t* VAR_NAME (cljc_DOT_core_SLASH_String) = VALUE_NONE; #endif +value_t* VAR_NAME (cljc_DOT_core_SLASH_Var) = VALUE_NONE; value_t* VAR_NAME (cljc_DOT_core_SLASH_Symbol) = VALUE_NONE; value_t* VAR_NAME (cljc_DOT_core_SLASH_Keyword) = VALUE_NONE; value_t* VAR_NAME (cljc_DOT_core_SLASH_RawPointer) = VALUE_NONE; @@ -1101,6 +1137,9 @@ cljc_init (void) PTABLE_NAME (cljc_DOT_core_SLASH_String) = alloc_ptable (TYPE_String, VAR_NAME (cljc_DOT_core_SLASH_String), NULL); #endif + VAR_NAME (cljc_DOT_core_SLASH_Var) = make_closure (NULL, NULL); + PTABLE_NAME (cljc_DOT_core_SLASH_Var) = alloc_ptable (TYPE_Var, VAR_NAME (cljc_DOT_core_SLASH_Var), NULL); + VAR_NAME (cljc_DOT_core_SLASH_Symbol) = make_closure (NULL, NULL); PTABLE_NAME (cljc_DOT_core_SLASH_Symbol) = alloc_ptable (TYPE_Symbol, VAR_NAME (cljc_DOT_core_SLASH_Symbol), NULL); diff --git a/src/clj/cljc/compiler.clj b/src/clj/cljc/compiler.clj index 1b4c6e9..e7c0420 100644 --- a/src/clj/cljc/compiler.clj +++ b/src/clj/cljc/compiler.clj @@ -585,17 +585,22 @@ (emitln "*/"))))) (defmethod emit :def - [{:keys [name init env extern]}] + [{:keys [name init env extern form]}] (emit-declaration ;; FIXME: This should really init to VALUE_NONE, but we have ;; defining inits in preamble.c for apply and print, which would ;; conflict with core.cljc. It's probably better to make them ;; non-defining. (emitln (if extern "extern " "") "value_t *VAR_NAME (" name ");")) - (when init - (let [init-name (emit init)] - (emitln "VAR_NAME (" name ") = " init-name ";") - init-name))) + (let [sym (emit {:op :constant + :env (assoc env :context :expr) + :form (symbol (clojure.core/name (-> env :ns :name)) + (clojure.core/name (second form)))})] + (if init + (let [init-name (emit init)] + (emitln "VAR_NAME (" name ") = " init-name ";") + (emit-value-wrap :var nil (emits "intern ((symbol_t*)" sym ", " init-name ")"))) + (emit-value-wrap :var nil (emits "intern ((symbol_t*)" sym ", NULL)"))))) (defn- emit-val-init [vi] (if (string? vi) diff --git a/src/cljc/cljc/core.cljc b/src/cljc/cljc/core.cljc index 5474c36..eb21320 100644 --- a/src/cljc/cljc/core.cljc +++ b/src/cljc/cljc/core.cljc @@ -1769,6 +1769,14 @@ reduces them without incurring seq initialization" (-pr-seq [s opts] (list (str s)))) +(extend-type Var + IPrintable + (-pr-seq [v opts] + (list + (if-objc + (c* "make_objc_object ([NSString stringWithFormat: @\"#\", ((closure_t*)~{})->fn, ((closure_t*)~{})->env])" c c) + (c* "make_string_copy_free (g_strdup_printf (\"#'%s\", symbol_get_utf8 (((var_t*)~{})->name)))" v))))) + ; could use reify ;;; LazySeq ;;; From c5cca68193a03bcb4f16ebac6bb8c754b9f26038 Mon Sep 17 00:00:00 2001 From: Bert Frees Date: Sat, 18 Jan 2014 19:46:13 +0100 Subject: [PATCH 5/5] Support regular expression literals taken from schani/clojurec@12c10eff57 --- src/clj/cljc/compiler.clj | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/clj/cljc/compiler.clj b/src/clj/cljc/compiler.clj index e7c0420..45a4671 100644 --- a/src/clj/cljc/compiler.clj +++ b/src/clj/cljc/compiler.clj @@ -333,7 +333,10 @@ (defmethod emit-constant Boolean [x] (if x "value_true" "value_false")) (defmethod emit-constant java.util.regex.Pattern [x] - (FIXME-IMPLEMENT)) + (emit-value-wrap :pattern-const + nil + (emits "FUNCALL1 ((closure_t*)VAR_NAME (cljc_DOT_core_SLASH_re_pattern), make_string (" + (wrap-in-double-quotes (escape-string (str x))) "))"))) (defmethod emit-constant clojure.lang.Keyword [x] (emit-value-wrap :keyword nil