Lower const x = ... to new builtin Core.setconst!

Adds a new builtin, Core.setconst!, with the following signature:

    setconst!(module::Module, name::Symbol, [x])

The lowered Expr(:const, :name, value) form has been removed, saving some
duplicated effort in the interpreter and code generation.  Expr(:const, ...) is
now always lowered to the builtin.

The single-argument form of const, having no surface syntax, was previously only
available through eval(Expr(:const, :foo)).  It can now also be used by omitting
the value argument to setconst!.

Author: xal-0

Compiler/src/ssair/ir.jl

@@ -581,7 +581,7 @@ function is_relevant_expr(e::Expr)
                       :foreigncall, :isdefined, :copyast,
                       :throw_undef_if_not,
                       :cfunction, :method, :pop_exception,
-                      :leave, :const, :globaldecl,
+                      :leave, :globaldecl,
                       :new_opaque_closure)
 end
 

Compiler/src/validation.jl

@@ -9,7 +9,6 @@ const VALID_EXPR_HEADS = IdDict{Symbol,UnitRange{Int}}(
     :(&) => 1:1,
     :(=) => 2:2,
     :method => 1:4,
-    :const => 1:2,
     :new => 1:typemax(Int),
     :splatnew => 2:2,
     :the_exception => 0:0,
@@ -149,7 +148,7 @@ function validate_code!(errors::Vector{InvalidCodeError}, c::CodeInfo, is_top_le
             elseif head === :call || head === :invoke || x.head === :invoke_modify ||
                 head === :gc_preserve_end || head === :meta ||
                 head === :inbounds || head === :foreigncall || head === :cfunction ||
-                head === :const || head === :leave || head === :pop_exception ||
+                head === :leave || head === :pop_exception ||
                 head === :method || head === :global || head === :static_parameter ||
                 head === :new || head === :splatnew || head === :thunk || head === :loopinfo ||
                 head === :throw_undef_if_not || head === :code_coverage_effect || head === :inline || head === :noinline

base/docs/basedocs.jl

@@ -2753,6 +2753,38 @@ See also [`setpropertyonce!`](@ref Base.setpropertyonce!) and [`setglobal!`](@re
 """
 setglobalonce!
 
+"""
+    setconst!(module::Module, name::Symbol, [x])
+
+Create or replace the constant `name` in `module` with the new value `x`.  When
+replacing, `x` does not need to have the same type as the original constant.
+
+When `x` is not given, `name` becomes an undefined constant; it cannot be read
+or written to, but can be redefined.
+
+Note that this function does not update the world age of the current task:
+```
+julia> begin
+           const x = 1
+           println(x)
+           const x = 2
+           println(x)
+           Core.setconst!(Main, :x, 3)
+           println(x)
+       end
+1
+2
+2
+```
+
+!!! compat "Julia 1.12"
+    This function requires Julia 1.12 or later.  Redefining constants on earlier
+    versions of Julia is unpredictable.
+
+See also [`const`](@ref).
+"""
+Core.setconst!
+
 """
     typeof(x)
 

doc/src/base/base.md

@@ -492,6 +492,7 @@ Core.modifyglobal!
 Core.swapglobal!
 Core.setglobalonce!
 Core.replaceglobal!
+Core.setconst!
 ```
 
 ## Documentation

src/builtin_proto.h

@@ -61,6 +61,7 @@ DECLARE_BUILTIN(modifyglobal);
 DECLARE_BUILTIN(nfields);
 DECLARE_BUILTIN(replacefield);
 DECLARE_BUILTIN(replaceglobal);
+DECLARE_BUILTIN(setconst);
 DECLARE_BUILTIN(setfield);
 DECLARE_BUILTIN(setfieldonce);
 DECLARE_BUILTIN(setglobal);

src/builtins.c

@@ -1483,7 +1483,17 @@ JL_CALLABLE(jl_f_setglobalonce)
     return old == NULL ? jl_true : jl_false;
 }
 
-
+JL_CALLABLE(jl_f_setconst)
+{
+    JL_NARGS(setconst!, 2, 3);
+    JL_TYPECHK(setconst!, module, args[0]);
+    if (nargs == 3)
+        JL_TYPECHK(setconst!, symbol, args[1]);
+    jl_binding_t *b = jl_get_module_binding((jl_module_t *)args[0], (jl_sym_t *)args[1], 1);
+    jl_value_t *val = nargs == 3 ? args[2] : NULL;
+    jl_declare_constant_val(b, (jl_module_t *)args[0], (jl_sym_t *)args[1], val);
+    return args[2];
+}
 
 // apply_type -----------------------------------------------------------------
 
@@ -2486,6 +2496,7 @@ void jl_init_primitives(void) JL_GC_DISABLED
     jl_builtin_replaceglobal = add_builtin_func("replaceglobal!", jl_f_replaceglobal);
     jl_builtin_modifyglobal = add_builtin_func("modifyglobal!", jl_f_modifyglobal);
     jl_builtin_setglobalonce = add_builtin_func("setglobalonce!", jl_f_setglobalonce);
+    add_builtin_func("setconst!", jl_f_setconst);
 
     // memory primitives
     jl_builtin_memorynew = add_builtin_func("memorynew", jl_f_memorynew);

src/codegen.cpp

@@ -890,15 +890,6 @@ static const auto jlcheckassignonce_func = new JuliaFunction<>{
             {T_pjlvalue, T_pjlvalue, T_pjlvalue, PointerType::get(JuliaType::get_jlvalue_ty(C), AddressSpace::CalleeRooted)}, false); },
     nullptr,
 };
-static const auto jldeclareconstval_func = new JuliaFunction<>{
-    XSTR(jl_declare_constant_val),
-    [](LLVMContext &C) {
-        auto T_pjlvalue = JuliaType::get_pjlvalue_ty(C);
-        auto T_prjlvalue = JuliaType::get_prjlvalue_ty(C);
-        return FunctionType::get(getVoidTy(C),
-            {T_pjlvalue, T_pjlvalue, T_pjlvalue, T_prjlvalue}, false); },
-    nullptr,
-};
 static const auto jldeclareglobal_func = new JuliaFunction<>{
     XSTR(jl_declare_global),
     [](LLVMContext &C) {
@@ -6450,26 +6441,6 @@ static jl_cgval_t emit_expr(jl_codectx_t &ctx, jl_value_t *expr, ssize_t ssaidx_
             jl_method_type);
         return meth;
     }
-    else if (head == jl_const_sym) {
-        assert(nargs <= 2);
-        jl_sym_t *sym = (jl_sym_t*)args[0];
-        jl_module_t *mod = ctx.module;
-        if (jl_is_globalref(sym)) {
-            mod = jl_globalref_mod(sym);
-            sym = jl_globalref_name(sym);
-        }
-        if (jl_is_symbol(sym)) {
-            jl_binding_t *bnd = jl_get_module_binding(mod, sym, 1);
-            if (nargs == 2) {
-                jl_cgval_t rhs = emit_expr(ctx, args[1]);
-                ctx.builder.CreateCall(prepare_call(jldeclareconstval_func),
-                        { julia_binding_gv(ctx, bnd), literal_pointer_val(ctx, (jl_value_t*)mod), literal_pointer_val(ctx, (jl_value_t*)sym), boxed(ctx, rhs) });
-            } else {
-                ctx.builder.CreateCall(prepare_call(jldeclareconstval_func),
-                        { julia_binding_gv(ctx, bnd), literal_pointer_val(ctx, (jl_value_t*)mod), literal_pointer_val(ctx, (jl_value_t*)sym), ConstantPointerNull::get(cast<PointerType>(ctx.types().T_prjlvalue)) });
-            }
-        }
-    }
     else if (head == jl_globaldecl_sym) {
         assert(nargs <= 2 && nargs >= 1);
         jl_sym_t *sym = (jl_sym_t*)args[0];

src/interpreter.c

@@ -642,12 +642,6 @@ static jl_value_t *eval_body(jl_array_t *stmts, interpreter_state *s, size_t ip,
                     jl_declare_global(s->module, jl_exprarg(stmt, 0), val, 1);
                     s->locals[jl_source_nslots(s->src) + s->ip] = jl_nothing;
                 }
-                else if (head == jl_const_sym) {
-                    jl_value_t *val = jl_expr_nargs(stmt) == 1 ? NULL : eval_value(jl_exprarg(stmt, 1), s);
-                    s->locals[jl_source_nslots(s->src) + s->ip] = val; // temporarily root
-                    jl_eval_const_decl(s->module, jl_exprarg(stmt, 0), val);
-                    s->locals[jl_source_nslots(s->src) + s->ip] = jl_nothing;
-                }
                 else if (head == jl_latestworld_sym) {
                     ct->world_age = jl_atomic_load_acquire(&jl_world_counter);
                 }

src/jlfrontend.scm

@@ -140,7 +140,7 @@
   (and (pair? e)
        (or (memq (car e) '(toplevel line module export public
                                     error incomplete))
-           (and (memq (car e) '(global const)) (every symbol? (cdr e))))))
+           (and (memq (car e) '(global)) (every symbol? (cdr e))))))
 
 (define *in-expand* #f)
 

src/julia-syntax.scm

@@ -1460,16 +1460,22 @@
   (if (length= e 3)
       `(const ,(cadr e) ,(expand-forms (caddr e)))
       (let ((arg (cadr e)))
-        (case (car arg)
-          ((global) (let ((asgn (cadr arg)))
-                      (check-assignment asgn)
-                      `(block
-                        ,.(map (lambda (v) `(global ,v))
-                               (lhs-bound-names (cadr asgn)))
-                        ,(expand-assignment asgn #t))))
-          ((=)      (check-assignment arg)
-                    (expand-assignment arg #t))
-          (else     (error "expected assignment after \"const\""))))))
+        (cond
+         ((symbol? arg)
+          ;; Undefined constant: Expr(:const, :a) (not available in surface syntax)
+          `(block ,e (latestworld)))
+         ((eq? (car arg) 'global)
+          (let ((asgn (cadr arg)))
+            (check-assignment asgn)
+            `(block
+              ,.(map (lambda (v) `(global ,v))
+                     (lhs-bound-names (cadr asgn)))
+              ,(expand-assignment asgn #t))))
+         ((eq? (car arg) '=)
+          (check-assignment arg)
+          (expand-assignment arg #t))
+         (else
+          (error "expected assignment after \"const\""))))))
 
 (define (expand-atomic-decl e)
   (error "unimplemented or unsupported atomic declaration"))
@@ -3043,7 +3049,8 @@
             (set! vars (cons (cadr e) vars)))
           ((= const)
            (let ((v (decl-var (cadr e))))
-             (find-assigned-vars- (caddr e))
+             (unless (and (eq? (car e) 'const) (null? (cddr e)))
+               (find-assigned-vars- (caddr e)))
              (if (or (ssavalue? v) (globalref? v) (underscore-symbol? v))
                  '()
                  (set! vars (cons v vars)))))
@@ -3460,7 +3467,8 @@
                           (vinfo:set-sa! vi #f)
                           (vinfo:set-sa! vi #t))
                       (vinfo:set-asgn! vi #t))))
-         (analyze-vars (caddr e) env captvars sp tab))
+         (unless (null? (cddr e))
+           (analyze-vars (caddr e) env captvars sp tab)))
         ((call)
          (let ((vi (get tab (cadr e) #f)))
            (if vi
@@ -4070,8 +4078,6 @@ f(x) = yt(x)
                      '(null)
                      `(newvar ,(cadr e))))))
           ((const)
-           ;; Check we've expanded surface `const` (1 argument form)
-           (assert (and (length= e 3)))
            (when (globalref? (cadr e))
              (put! globals (cadr e) #f))
            e)
@@ -4642,10 +4648,15 @@ f(x) = yt(x)
                                  (list cnd))))))
           tests))
     (define (emit-assignment-or-setglobal lhs rhs (op '=))
-      ;; (const (globalref _ _) _) does not use setglobal!
-      (if (and (globalref? lhs) (eq? op '=))
-        (emit `(call (top setglobal!) ,(cadr lhs) (inert ,(caddr lhs)) ,rhs))
-        (emit `(,op ,lhs ,rhs))))
+      ;; (= (globalref _ _) _)     => setglobal!
+      ;; (const (globalref _ _) _) => setconst!
+      (cond ((and (globalref? lhs) (eq? op '=))
+             (emit `(call (top setglobal!) ,(cadr lhs) (inert ,(caddr lhs)) ,rhs)))
+            ((and (globalref? lhs) (eq? op 'const))
+             (emit `(call (core setconst!) ,(cadr lhs) (inert ,(caddr lhs)) ,rhs)))
+            (else
+             (assert (eq? op '=))
+             (emit `(= ,lhs ,rhs)))))
     (define (emit-assignment lhs rhs (op '=))
       (if rhs
           (if (valid-ir-rvalue? lhs rhs)
@@ -4726,21 +4737,26 @@ f(x) = yt(x)
                (when (pair? (cadr lam))
                  (error (string "`global const` declaration not allowed inside function" (format-loc current-loc)))))
              (let ((lhs (cadr e)))
-               (if (and (symbol? lhs) (underscore-symbol? lhs))
-                   (compile (caddr e) break-labels value tail)
-                   (let* ((rhs (compile (caddr e) break-labels #t #f))
-                          (lhs (if (and arg-map (symbol? lhs))
-                                   (get arg-map lhs lhs)
-                                   lhs)))
-                     (if (and value rhs)
-                         (let ((rr (if (or (atom? rhs) (ssavalue? rhs) (eq? (car rhs) 'null))
-                                       rhs (make-ssavalue))))
-                           (if (not (eq? rr rhs))
-                               (emit `(= ,rr ,rhs)))
-                           (emit-assignment-or-setglobal lhs rr (car e))
-                           (if tail (emit-return tail rr))
-                           rr)
-                         (emit-assignment lhs rhs (car e)))))))
+               (cond ((and (symbol? lhs) (underscore-symbol? lhs))
+                      (compile (caddr e) break-labels value tail))
+                     ((and (eq? (car e) 'const) (null? (cddr e)) (globalref? (cadr e)))
+                      ;; No RHS - make undefined constant
+                      (let ((lhs (cadr e)))
+                        (emit `(call (core setconst!) ,(cadr lhs) (inert ,(caddr lhs))))))
+                     (else
+                      (let* ((rhs (compile (caddr e) break-labels #t #f))
+                             (lhs (if (and arg-map (symbol? lhs))
+                                      (get arg-map lhs lhs)
+                                      lhs)))
+                        (if (and value rhs)
+                            (let ((rr (if (or (atom? rhs) (ssavalue? rhs) (eq? (car rhs) 'null))
+                                          rhs (make-ssavalue))))
+                              (if (not (eq? rr rhs))
+                                  (emit `(= ,rr ,rhs)))
+                              (emit-assignment-or-setglobal lhs rr (car e))
+                              (if tail (emit-return tail rr))
+                              rr)
+                            (emit-assignment lhs rhs (car e))))))))
             ((block)
              (let* ((last-fname filename)
                     (fnm        (first-non-meta e))