WIP: canonicalize callable names through a per-module counter

src/ast.c

@@ -149,21 +149,83 @@ struct macroctx_stack {
     struct macroctx_stack *parent;
 };
 
+// Map of scheme symbols to forwarded julia symbols
+htable_t scm_to_jl_sym_map;
+
 static jl_value_t *scm_to_julia(fl_context_t *fl_ctx, value_t e, jl_module_t *mod);
 static value_t julia_to_scm(fl_context_t *fl_ctx, jl_value_t *v);
 static jl_value_t *jl_expand_macros(jl_value_t *expr, jl_module_t *inmodule, struct macroctx_stack *macroctx, int onelevel, size_t world, int throw_load_error);
 
 static jl_sym_t *scmsym_to_julia(fl_context_t *fl_ctx, value_t s)
 {
     assert(issymbol(s));
+    jl_sym_t *sym = ptrhash_get(&scm_to_jl_sym_map, (void*)s);
+    // Symbol has already been forwarded
+    if (sym != HT_NOTFOUND) {
+        return sym;
+    }
+    char *n = NULL;
     if (fl_isgensym(fl_ctx, s)) {
         char gsname[16];
-        char *n = uint2str(&gsname[1], sizeof(gsname)-1,
+        n = uint2str(&gsname[1], sizeof(gsname)-1,
                            ((gensym_t*)ptr(s))->id, 10);
         *(--n) = '#';
-        return jl_symbol(n);
     }
-    return jl_symbol(symbol_name(fl_ctx, s));
+    else {
+        n = symbol_name(fl_ctx, s);
+    }
+    if (has_gensym_suffix(n)) {
+        // Transform a symbol such as `#foo#42` into `#foo#{module}<{counter}>`
+        jl_module_t *m = jl_ast_ctx(fl_ctx)->module;
+        assert(m != NULL);
+        // Get the module name
+        const char *mname = jl_symbol_name(m->name);
+        size_t l = strlen(n) + 1 + strlen(mname) + 1;
+        char *nn = (char*)calloc_s(l);
+        // Get the last `#` in the symbol
+        char *p = strrchr(n, '#');
+        assert(p != NULL);
+        size_t pl;
+        // Now we check if the prefix itself is gensym'ed, i.e. #some_number
+        if (n[0] == '#' && '0' < n[1] && n[1] <= '9') {
+            // It is, so we forward the prefix as well
+            uint32_t nxt = ++m->sym_counter;
+            // Now convert it to module_name<counter>
+            char str[strlen(mname) + 16];
+            snprintf(str, sizeof(str), "#%s<%d>", mname, nxt);
+            // Copy the prefix
+            memcpy(nn, str, strlen(str) + 1);
+            pl = strlen(str);
+            // First get the flisp symbol corresponding to the prefix
+            char pp[strlen(n) + 1];
+            memcpy(pp, n, p - n);
+            pp[p - n] = '\0';
+            value_t ps = symbol(fl_ctx, pp);
+            // Then forward it
+            ptrhash_put(&scm_to_jl_sym_map, (void*)ps, (void*)jl_symbol(nn));
+            // If there is exactly one occurrence of `#` (instead of something like `#foo#42`), we are done
+            if (p == n) {
+                n = nn;
+                goto done;
+            }
+        }
+        else {
+            pl = p - n;
+            // Copy the prefix
+            memcpy(nn, n, pl);
+        }
+        nn[pl] = '#';
+        // Append the module_name<counter>
+        uint32_t nxt = ++m->sym_counter;
+        char str[strlen(mname) + 16];
+        snprintf(str, sizeof(str), "%s<%d>", mname, nxt);
+        memcpy(nn + pl + 1, str, strlen(str) + 1);
+        // Add it to the hash table of forwarded symbols
+        n = nn;
+        ptrhash_put(&scm_to_jl_sym_map, (void*)s, (void*)jl_symbol(n));
+    }
+done:
+    return jl_symbol(n);
 }
 
 static value_t fl_defined_julia_global(fl_context_t *fl_ctx, value_t *args, uint32_t nargs)

src/init.c

@@ -742,6 +742,8 @@ static void init_global_mutexes(void) {
     JL_MUTEX_INIT(&profile_show_peek_cond_lock, "profile_show_peek_cond_lock");
 }
 
+extern htable_t scm_to_jl_sym_map;
+
 JL_DLLEXPORT void julia_init(JL_IMAGE_SEARCH rel)
 {
     // initialize many things, in no particular order
@@ -824,6 +826,7 @@ JL_DLLEXPORT void julia_init(JL_IMAGE_SEARCH rel)
 
     jl_gc_init();
 
+    htable_new(&scm_to_jl_sym_map, 0);
     arraylist_new(&jl_linkage_blobs, 0);
     arraylist_new(&jl_image_relocs, 0);
     arraylist_new(&eytzinger_image_tree, 0);

src/julia.h

@@ -661,6 +661,7 @@ typedef struct _jl_module_t {
     int8_t max_methods;
     jl_mutex_t lock;
     intptr_t hash;
+    uint32_t sym_counter;
 } jl_module_t;
 
 struct _jl_globalref_t {

src/julia_internal.h

@@ -842,6 +842,12 @@ jl_method_t *jl_make_opaque_closure_method(jl_module_t *module, jl_value_t *name
     int nargs, jl_value_t *functionloc, jl_code_info_t *ci, int isva, int isinferred);
 JL_DLLEXPORT int jl_is_valid_oc_argtype(jl_tupletype_t *argt, jl_method_t *source);
 
+STATIC_INLINE int has_gensym_suffix(char *name) JL_NOTSAFEPOINT
+{
+    char *other = strrchr(name, '#');
+    return other != NULL && '0' < other[1] && other[1] <= '9';
+}
+
 // Each tuple can exist in one of 4 Vararg states:
 //   NONE: no vararg                            Tuple{Int,Float32}
 //   INT: vararg with integer length            Tuple{Int,Vararg{Float32,2}}

src/module.c

@@ -49,6 +49,7 @@ JL_DLLEXPORT jl_module_t *jl_new_module_(jl_sym_t *name, jl_module_t *parent, ui
         jl_module_public(m, name, 1);
         JL_GC_POP();
     }
+    m->sym_counter = 0;
     return m;
 }