Some changes I did for my ClojureC REPL project

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);

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);
 

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
@@ -585,17 +588,22 @@
         (emitln "*/")))))
 
 (defmethod emit :def
-  [{:keys [name init env]}]
+  [{: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 init "" "extern ") "value_t *VAR_NAME (" name ");"))
-  (when init
-    (let [init-name (emit init)]
-      (emitln "VAR_NAME (" name ") = " init-name ";")
-      init-name)))
+   (emitln (if extern "extern " "") "value_t *VAR_NAME (" 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)
@@ -1158,14 +1166,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,15 +1191,17 @@
                             :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
               :name name :doc doc :init init-expr}
              (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]]
@@ -1420,7 +1432,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
@@ -1518,13 +1530,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}))

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*

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@%p:%p>\", ((closure_t*)~{})->fn, ((closure_t*)~{})->env])" c c)
+      (c* "make_string_copy_free (g_strdup_printf (\"#<closure@%p:%p>\", ((closure_t*)~{})->fn, ((closure_t*)~{})->env))" c c)))))
 
 (extend-type RawPointer
   IPrintable
@@ -1762,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@%p:%p>\", ((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 ;;;