Create single entry point for lowering jl_lower

and redirect all calls to lowering through it.  `jl_fl_lower` is essentially a
     renamed `jl_expand_with_loc_warn`, but change the structure of the return
     value of its callee `jl-expand-to-thunk-warn` so we can ignore the warnings
     if they aren't relevant.

Author: mlechu

src/ast.c

@@ -1278,95 +1278,88 @@ JL_DLLEXPORT jl_value_t *jl_macroexpand1(jl_value_t *expr, jl_module_t *inmodule
 // Lower an expression tree into Julia's intermediate-representation.
 JL_DLLEXPORT jl_value_t *jl_expand(jl_value_t *expr, jl_module_t *inmodule)
 {
-    return jl_expand_with_loc(expr, inmodule, "none", 0);
+    return jl_lower(expr, inmodule, "none", 0, ~(size_t)0, 0, 0);
 }
 
 // Lowering, with starting program location specified
 JL_DLLEXPORT jl_value_t *jl_expand_with_loc(jl_value_t *expr, jl_module_t *inmodule,
                                             const char *file, int line)
 {
-    return jl_expand_in_world(expr, inmodule, file, line, ~(size_t)0);
+    return jl_lower(expr, inmodule, file, line, ~(size_t)0, 0, 0);
 }
 
 // Lowering, with starting program location and worldage specified
 JL_DLLEXPORT jl_value_t *jl_expand_in_world(jl_value_t *expr, jl_module_t *inmodule,
                                             const char *file, int line, size_t world)
 {
-    JL_TIMING(LOWERING, LOWERING);
-    jl_timing_show_location(file, line, inmodule, JL_TIMING_DEFAULT_BLOCK);
-    JL_GC_PUSH1(&expr);
-    expr = jl_copy_ast(expr);
-    expr = jl_expand_macros(expr, inmodule, NULL, 0, world, 1);
-    expr = jl_call_scm_on_ast_and_loc("jl-expand-to-thunk", expr, inmodule, file, line);
-    JL_GC_POP();
-    return expr;
+    return jl_lower(expr, inmodule, file, line, world, 0, 0);
 }
 
-// Same as the above, but printing warnings when applicable
-JL_DLLEXPORT jl_value_t *jl_expand_with_loc_warn(jl_value_t *expr, jl_module_t *inmodule,
-                                                 const char *file, int line)
+// Main entry point to flisp lowering
+// warn: Print any lowering warnings returned; otherwise ignore
+// stmt: Lower knowing that the value of expr is unused
+JL_DLLEXPORT jl_value_t *jl_fl_lower(jl_value_t *expr, jl_module_t *inmodule,
+                                     const char *file, int line, size_t world, bool_t warn, bool_t stmt)
 {
     JL_TIMING(LOWERING, LOWERING);
     jl_timing_show_location(file, line, inmodule, JL_TIMING_DEFAULT_BLOCK);
     jl_array_t *kwargs = NULL;
-    JL_GC_PUSH2(&expr, &kwargs);
+    JL_GC_PUSH3(&expr, &kwargs, &inmodule);
     expr = jl_copy_ast(expr);
-    expr = jl_expand_macros(expr, inmodule, NULL, 0, ~(size_t)0, 1);
+    expr = jl_expand_macros(expr, inmodule, NULL, 0, world, 1);
     jl_ast_context_t *ctx = jl_ast_ctx_enter(inmodule);
     fl_context_t *fl_ctx = &ctx->fl;
     value_t arg = julia_to_scm(fl_ctx, expr);
-    value_t e = fl_applyn(fl_ctx, 4, symbol_value(symbol(fl_ctx, "jl-expand-to-thunk-warn")), arg,
-                          symbol(fl_ctx, file), fixnum(line), fl_ctx->F);
-    expr = scm_to_julia(fl_ctx, e, inmodule);
+    value_t e = fl_applyn(fl_ctx, 4, symbol_value(symbol(fl_ctx, "jl-lower-to-thunk")), arg,
+                          symbol(fl_ctx, file), fixnum(line), stmt ? fl_ctx->T : fl_ctx->F);
+    value_t lwr = car_(e);
+    value_t warnings = car_(cdr_(e));
+    expr = scm_to_julia(fl_ctx, lwr, inmodule);
     jl_ast_ctx_leave(ctx);
     jl_sym_t *warn_sym = jl_symbol("warn");
-    if (jl_is_expr(expr) && ((jl_expr_t*)expr)->head == warn_sym) {
-        size_t nargs = jl_expr_nargs(expr);
-        for (int i = 0; i < nargs - 1; i++) {
-            jl_value_t *warning = jl_exprarg(expr, i);
-            size_t nargs = 0;
-            if (jl_is_expr(warning) && ((jl_expr_t*)warning)->head == warn_sym)
-                 nargs = jl_expr_nargs(warning);
-            int kwargs_len = (int)nargs - 6;
-            if (nargs < 6 || kwargs_len % 2 != 0) {
-                jl_error("julia-logmsg: bad argument list - expected "
-                         ":warn level (symbol) group (symbol) id file line msg . kwargs");
-            }
-            jl_value_t *level = jl_exprarg(warning, 0);
-            jl_value_t *group = jl_exprarg(warning, 1);
-            jl_value_t *id = jl_exprarg(warning, 2);
-            jl_value_t *file = jl_exprarg(warning, 3);
-            jl_value_t *line = jl_exprarg(warning, 4);
-            jl_value_t *msg = jl_exprarg(warning, 5);
-            kwargs = jl_alloc_vec_any(kwargs_len);
-            for (int i = 0; i < kwargs_len; ++i) {
-                jl_array_ptr_set(kwargs, i, jl_exprarg(warning, i + 6));
-            }
-            JL_TYPECHK(logmsg, long, level);
-            jl_log(jl_unbox_long(level), NULL, group, id, file, line, (jl_value_t*)kwargs, msg);
+    for (; warn && iscons(warnings); warnings = cdr_(warnings)) {
+        jl_value_t *warning = scm_to_julia(fl_ctx, car_(warnings), inmodule);
+        size_t nargs = 0;
+        if (jl_is_expr(warning) && ((jl_expr_t*)warning)->head == warn_sym)
+            nargs = jl_expr_nargs(warning);
+        int kwargs_len = (int)nargs - 6;
+        if (nargs < 6 || kwargs_len % 2 != 0) {
+            jl_error("julia-logmsg: bad argument list - expected "
+                     ":warn level (symbol) group (symbol) id file line msg . kwargs");
+        }
+        jl_value_t *level = jl_exprarg(warning, 0);
+        jl_value_t *group = jl_exprarg(warning, 1);
+        jl_value_t *id = jl_exprarg(warning, 2);
+        jl_value_t *file = jl_exprarg(warning, 3);
+        jl_value_t *line = jl_exprarg(warning, 4);
+        jl_value_t *msg = jl_exprarg(warning, 5);
+        kwargs = jl_alloc_vec_any(kwargs_len);
+        for (int i = 0; i < kwargs_len; ++i) {
+            jl_array_ptr_set(kwargs, i, jl_exprarg(warning, i + 6));
         }
-        expr = jl_exprarg(expr, nargs - 1);
+        JL_TYPECHK(logmsg, long, level);
+        jl_log(jl_unbox_long(level), NULL, group, id, file, line, (jl_value_t*)kwargs, msg);
     }
     JL_GC_POP();
     return expr;
 }
 
-// expand in a context where the expression value is unused
+JL_DLLEXPORT jl_value_t *jl_lower(jl_value_t *expr, jl_module_t *inmodule,
+                                  const char *file, int line, size_t world, bool_t warn, bool_t stmt)
+{
+    // TODO: Allow change of lowerer
+    return jl_fl_lower(expr, inmodule, file, line, world, warn, stmt);
+}
+
 JL_DLLEXPORT jl_value_t *jl_expand_stmt_with_loc(jl_value_t *expr, jl_module_t *inmodule,
                                                  const char *file, int line)
 {
-    JL_TIMING(LOWERING, LOWERING);
-    JL_GC_PUSH1(&expr);
-    expr = jl_copy_ast(expr);
-    expr = jl_expand_macros(expr, inmodule, NULL, 0, ~(size_t)0, 1);
-    expr = jl_call_scm_on_ast_and_loc("jl-expand-to-thunk-stmt", expr, inmodule, file, line);
-    JL_GC_POP();
-    return expr;
+    return jl_lower(expr, inmodule, file, line, ~(size_t)0, 0, 1);
 }
 
 JL_DLLEXPORT jl_value_t *jl_expand_stmt(jl_value_t *expr, jl_module_t *inmodule)
 {
-    return jl_expand_stmt_with_loc(expr, inmodule, "none", 0);
+    return jl_lower(expr, inmodule, "none", 0, ~(size_t)0, 0, 1);
 }
 
 jl_code_info_t *jl_outer_ctor_body(jl_value_t *thistype, size_t nfields, size_t nsparams, jl_module_t *inmodule, const char *file, int line)

src/jl_exported_funcs.inc

@@ -129,7 +129,6 @@
     XX(jl_expand_stmt) \
     XX(jl_expand_stmt_with_loc) \
     XX(jl_expand_with_loc) \
-    XX(jl_expand_with_loc_warn) \
     XX(jl_field_index) \
     XX(jl_field_isdefined) \
     XX(jl_gc_add_finalizer) \
@@ -289,6 +288,7 @@
     XX(jl_load_dynamic_library) \
     XX(jl_load_file_string) \
     XX(jl_lookup_code_address) \
+    XX(jl_lower) \
     XX(jl_lseek) \
     XX(jl_lstat) \
     XX(jl_macroexpand) \

src/jlfrontend.scm

@@ -173,7 +173,11 @@
                         `(block ,expr (null)))
                     file line))
 
-(define (jl-expand-to-thunk-warn expr file line stmt)
+;; Returns a list `(,lowered-code ,warnings) where
+;; - warnings (currently only ambiguous soft scope assignments) may be ignored,
+;;   e.g. when running interactively
+;; - more items may be added to the list later
+(define (jl-lower-to-thunk expr file line stmt)
   (let ((warnings '()))
     (with-bindings
      ;; Abuse scm_to_julia here to convert arguments to warn. This is meant for
@@ -186,13 +190,7 @@
      (let ((thunk (if stmt
                       (expand-to-thunk-stmt- expr file line)
                       (expand-to-thunk- expr file line))))
-       (if (pair? warnings) `(warn ,@(reverse warnings) ,thunk) thunk)))))
-
-(define (jl-expand-to-thunk expr file line)
-  (expand-to-thunk- expr file line))
-
-(define (jl-expand-to-thunk-stmt expr file line)
-  (expand-to-thunk-stmt- expr file line))
+       `(,thunk ,(reverse warnings))))))
 
 (define (jl-expand-macroscope expr)
   (error-wrap (lambda ()

src/julia.h

@@ -2260,8 +2260,9 @@ JL_DLLEXPORT jl_value_t *jl_parse_string(const char *text, size_t text_len,
 JL_DLLEXPORT jl_value_t *jl_expand(jl_value_t *expr, jl_module_t *inmodule);
 JL_DLLEXPORT jl_value_t *jl_expand_with_loc(jl_value_t *expr, jl_module_t *inmodule,
                                             const char *file, int line);
-JL_DLLEXPORT jl_value_t *jl_expand_with_loc_warn(jl_value_t *expr, jl_module_t *inmodule,
-                                                 const char *file, int line);
+JL_DLLEXPORT jl_value_t *jl_lower(jl_value_t *expr, jl_module_t *inmodule,
+                                  const char *file, int line, size_t world,
+                                  bool_t warn, bool_t stmt);
 JL_DLLEXPORT jl_value_t *jl_expand_in_world(jl_value_t *expr, jl_module_t *inmodule,
                                             const char *file, int line, size_t world);
 JL_DLLEXPORT jl_value_t *jl_expand_stmt(jl_value_t *expr, jl_module_t *inmodule);

src/toplevel.c

@@ -808,7 +808,7 @@ JL_DLLEXPORT jl_value_t *jl_toplevel_eval_flex(jl_module_t *JL_NONNULL m, jl_val
     size_t last_age = ct->world_age;
     if (!expanded && jl_needs_lowering(e)) {
         ct->world_age = jl_atomic_load_acquire(&jl_world_counter);
-        ex = (jl_expr_t*)jl_expand_with_loc_warn(e, m, *toplevel_filename, *toplevel_lineno);
+        ex = (jl_expr_t*)jl_lower(e, m, *toplevel_filename, *toplevel_lineno, ~(size_t)0, 1, 0);
         ct->world_age = last_age;
     }
     jl_sym_t *head = jl_is_expr(ex) ? ex->head : NULL;
@@ -972,7 +972,7 @@ JL_DLLEXPORT jl_value_t *jl_toplevel_eval_flex(jl_module_t *JL_NONNULL m, jl_val
             root = jl_array_ptr_ref(ex->args, i);
             if (jl_needs_lowering(root)) {
                 ct->world_age = jl_atomic_load_acquire(&jl_world_counter);
-                root = jl_expand_with_loc_warn(root, m, *toplevel_filename, *toplevel_lineno);
+                root = jl_lower(root, m, *toplevel_filename, *toplevel_lineno, ~(size_t)0, 1, 0);
             }
             ct->world_age = jl_atomic_load_acquire(&jl_world_counter);
             res = jl_toplevel_eval_flex(m, root, fast, 1, toplevel_filename, toplevel_lineno);
@@ -1151,8 +1151,8 @@ static jl_value_t *jl_parse_eval_all(jl_module_t *module, jl_value_t *text,
                 continue;
             }
             ct->world_age = jl_atomic_load_relaxed(&jl_world_counter);
-            expression = jl_expand_with_loc_warn(expression, module,
-                                                 jl_string_data(filename), lineno);
+            expression = jl_lower(expression, module,
+                                                 jl_string_data(filename), lineno, ~(size_t)0, 1, 0);
             ct->world_age = jl_atomic_load_relaxed(&jl_world_counter);
             result = jl_toplevel_eval_flex(module, expression, 1, 1, &filename_str, &lineno);
         }