canonicalize names of nested functions and nested lambdas

Author: d-netto

src/ast.c

@@ -208,11 +208,54 @@ static value_t fl_nothrow_julia_global(fl_context_t *fl_ctx, value_t *args, uint
     return b != NULL && jl_atomic_load_relaxed(&b->value) != NULL ? fl_ctx->T : fl_ctx->F;
 }
 
+arraylist_t parsed_method_stack; // for keeping track of which methods are being parsed
+uv_mutex_t counter_table_lock;
+htable_t counter_table; // map from module_name -> inner htable; inner htable maps from char * -> uint32_t
+
 static value_t fl_current_module_counter(fl_context_t *fl_ctx, value_t *args, uint32_t nargs) JL_NOTSAFEPOINT
 {
     jl_ast_context_t *ctx = jl_ast_ctx(fl_ctx);
     assert(ctx->module);
-    return fixnum(jl_module_next_counter(ctx->module));
+    // Create a string of the form <$outermost_func_name>$counter
+    // where counter is the next counter for the module obtained by calling `jl_module_next_counter`
+    // Get the module name
+    char *modname = jl_symbol_name(ctx->module->name);
+    // Get the outermost function name from the `parsed_method_stack` top
+    char *funcname = NULL;
+    value_t funcname_v = parsed_method_stack.len > 0 ? (value_t)parsed_method_stack.items[0] : fl_ctx->NIL;
+    if (funcname_v != fl_ctx->NIL) {
+        funcname = symbol_name(fl_ctx, funcname_v);
+    }
+    // Create the string
+    char buf[(funcname != NULL ? strlen(funcname) : 0) + 20];
+    if (funcname != NULL && funcname[0] != '#') {
+        uint32_t nxt;
+        uv_mutex_lock(&counter_table_lock);
+        // try to find the module name in the counter table, if it's not create a symbol table for it
+        if (ptrhash_get(&counter_table, modname) == HT_NOTFOUND) {
+            // if not found, add it to the counter table
+            htable_t *new_table = (htable_t*)malloc_s(sizeof(htable_t));
+            htable_new(new_table, 0);
+            ptrhash_put(&counter_table, modname, new_table);
+        }
+        htable_t *mod_table = (htable_t*)ptrhash_get(&counter_table, modname);
+        // try to find the function name in the module's counter table, if it's not found, add it
+        if (ptrhash_get(mod_table, funcname) == HT_NOTFOUND) {
+            // Don't forget to shift the counter by 2 and or it with 3
+            // to avoid the counter being 0 or 1, which are reserved
+            ptrhash_put(mod_table, funcname, (void*)(uintptr_t)3);
+        }
+        nxt = ((uint32_t)(uintptr_t)ptrhash_get(mod_table, funcname) >> 2);
+        // Increment the counter and don't forget to shift it by 2 and or it with 3
+        // to avoid the counter being 0 or 1, which are reserved
+        ptrhash_put(mod_table, funcname, (void*)(uintptr_t)((nxt + 1) << 2 | 3));
+        uv_mutex_unlock(&counter_table_lock);
+        snprintf(buf, sizeof(buf), "%s%d", funcname, nxt);
+    }
+    else {
+        snprintf(buf, sizeof(buf), "%d", jl_module_next_counter(ctx->module));
+    }
+    return symbol(fl_ctx, buf);
 }
 
 static int jl_is_number(jl_value_t *v)
@@ -240,13 +283,51 @@ static value_t fl_julia_scalar(fl_context_t *fl_ctx, value_t *args, uint32_t nar
     return fl_ctx->F;
 }
 
+static value_t fl_julia_push_closure_expr(fl_context_t *fl_ctx, value_t *args, uint32_t nargs)
+{
+    argcount(fl_ctx, "julia-push-closure-expr", nargs, 1);
+    // Check if the head of the symbol at `args[0]` is (method <name>) or (method (outerref <name>))
+    // and if so, push the name onto the `parsed_method_stack`
+    value_t arg = args[0];
+    if (iscons(arg)) {
+        value_t head = car_(arg);
+        if (head == symbol(fl_ctx, "method")) {
+            value_t name = car_(cdr_(arg));
+            if (issymbol(name)) {
+                arraylist_push(&parsed_method_stack, (void*)name);
+                return fl_ctx->T;
+            }
+            if (iscons(name)) {
+                value_t head = car_(name);
+                if (head == symbol(fl_ctx, "outerref")) {
+                    value_t name_inner = car_(cdr_(name));
+                    assert(issymbol(name_inner));
+                    arraylist_push(&parsed_method_stack, (void*)name_inner);
+                    return fl_ctx->T;
+                }
+            }
+        }
+    }
+    return fl_ctx->F;
+}
+
+static value_t fl_julia_pop_closure_expr(fl_context_t *fl_ctx, value_t *args, uint32_t nargs)
+{
+    argcount(fl_ctx, "julia-pop-closure-expr", nargs, 0);
+    // Pop the top of the `parsed_method_stack`
+    arraylist_pop(&parsed_method_stack);
+    return fl_ctx->NIL;
+}
+
 static jl_value_t *scm_to_julia_(fl_context_t *fl_ctx, value_t e, jl_module_t *mod);
 
 static const builtinspec_t julia_flisp_ast_ext[] = {
     { "defined-julia-global", fl_defined_julia_global }, // TODO: can we kill this safepoint
     { "nothrow-julia-global", fl_nothrow_julia_global },
     { "current-julia-module-counter", fl_current_module_counter },
     { "julia-scalar?", fl_julia_scalar },
+    { "julia-push-closure-expr", fl_julia_push_closure_expr },
+    { "julia-pop-closure-expr", fl_julia_pop_closure_expr },
     { NULL, NULL }
 };
 

src/datatype.c

@@ -36,7 +36,7 @@ static jl_sym_t *jl_demangle_typename(jl_sym_t *s) JL_NOTSAFEPOINT
         len = strlen(n) - 1;
     else
         len = (end-n) - 1;  // extract `f` from `#f#...`
-    if (is10digit(n[1]))
+    if (is10digit(n[1]) || is_anonfn_typename(n))
         return _jl_symbol(n, len+1);
     return _jl_symbol(&n[1], len);
 }

src/flisp/flisp.h

@@ -158,7 +158,7 @@ value_t fl_cons(fl_context_t *fl_ctx, value_t a, value_t b) JL_NOTSAFEPOINT;
 value_t fl_list2(fl_context_t *fl_ctx, value_t a, value_t b) JL_NOTSAFEPOINT;
 value_t fl_listn(fl_context_t *fl_ctx, size_t n, ...) JL_NOTSAFEPOINT;
 value_t symbol(fl_context_t *fl_ctx, const char *str) JL_NOTSAFEPOINT;
-char *symbol_name(fl_context_t *fl_ctx, value_t v);
+char *symbol_name(fl_context_t *fl_ctx, value_t v) JL_NOTSAFEPOINT;
 int fl_is_keyword_name(const char *str, size_t len);
 value_t alloc_vector(fl_context_t *fl_ctx, size_t n, int init);
 size_t llength(value_t v);

src/init.c

@@ -742,6 +742,10 @@ static void init_global_mutexes(void) {
     JL_MUTEX_INIT(&profile_show_peek_cond_lock, "profile_show_peek_cond_lock");
 }
 
+extern arraylist_t parsed_method_stack;
+extern uv_mutex_t counter_table_lock;
+extern htable_t counter_table;
+
 JL_DLLEXPORT void julia_init(JL_IMAGE_SEARCH rel)
 {
     // initialize many things, in no particular order
@@ -824,6 +828,9 @@ JL_DLLEXPORT void julia_init(JL_IMAGE_SEARCH rel)
 
     jl_gc_init();
 
+    uv_mutex_init(&counter_table_lock);
+    htable_new(&counter_table, 0);
+    arraylist_new(&parsed_method_stack, 0);
     arraylist_new(&jl_linkage_blobs, 0);
     arraylist_new(&jl_image_relocs, 0);
     arraylist_new(&eytzinger_image_tree, 0);

src/julia-syntax.scm

@@ -2370,7 +2370,7 @@
                 (= ,lhs ,(car rr))))
       `(= ,lhs ,rhs)))
 
-(define (expand-forms e)
+(define (expand-forms- e)
   (if (or (atom? e) (memq (car e) '(quote inert top core globalref outerref module toplevel ssavalue null true false meta using import export public thismodule toplevel-only)))
       e
       (let ((ex (get expand-table (car e) #f)))
@@ -2379,6 +2379,14 @@
             (cons (car e)
                   (map expand-forms (cdr e)))))))
 
+;; wrapper for `cl-convert-`
+(define (expand-forms e)
+  (let ((pushed (julia-push-closure-expr e)))
+    (let ((res (expand-forms- e)))
+      (if pushed
+          (julia-pop-closure-expr))
+      res)))
+
 ;; table mapping expression head to a function expanding that form
 (define expand-table
   (table
@@ -3888,7 +3896,7 @@ f(x) = yt(x)
             (list-tail (car (lam:vinfo lam)) (length (lam:args lam))))
   (lambda-optimize-vars! lam))
 
-(define (cl-convert e fname lam namemap defined toplevel interp opaq (globals (table)) (locals (table)))
+(define (cl-convert- e fname lam namemap defined toplevel interp opaq (globals (table)) (locals (table)))
   (if (and (not lam)
            (not (and (pair? e) (memq (car e) '(lambda method macro opaque_closure)))))
       (if (atom? e) e
@@ -4243,6 +4251,14 @@ f(x) = yt(x)
            (cons (car e)
                  (map-cl-convert (cdr e) fname lam namemap defined toplevel interp opaq globals locals))))))))
 
+;; wrapper for `cl-convert-`
+(define (cl-convert e fname lam namemap defined toplevel interp opaq (globals (table)) (locals (table)))
+  (let ((pushed (julia-push-closure-expr e)))
+    (let ((res (cl-convert- e fname lam namemap defined toplevel interp opaq globals locals)))
+      (if pushed
+          (julia-pop-closure-expr))
+      res)))
+
 (define (closure-convert e) (cl-convert e #f #f (table) (table) #f #f #f))
 
 ;; pass 5: convert to linear IR

src/julia_internal.h

@@ -13,6 +13,7 @@
 #include "support/strtod.h"
 #include "gc-alloc-profiler.h"
 #include "support/rle.h"
+#include <ctype.h>
 #include <stdint.h>
 #include <uv.h>
 #include <llvm-c/Types.h>
@@ -842,12 +843,13 @@ 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 is_anonfn_typename(char *name)
+STATIC_INLINE int is_anonfn_typename(char *name) JL_NOTSAFEPOINT
 {
     if (name[0] != '#' || name[1] == '#')
         return 0;
     char *other = strrchr(name, '#');
-    return other > &name[1] && other[1] > '0' && other[1] <= '9';
+    // Check if the last character is a digit
+    return other > &name[1] && isdigit(name[strlen(name) - 1]);
 }
 
 // Each tuple can exist in one of 4 Vararg states: