internals: add _defaultctor function for defining ctors

src/ast.c

@@ -1369,6 +1369,34 @@ 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);
 }
 
+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)
+{
+    JL_TIMING(LOWERING, LOWERING);
+    jl_timing_show_location(file, line, inmodule, JL_TIMING_DEFAULT_BLOCK);
+    jl_expr_t *expr = jl_exprn(jl_empty_sym, 3);
+    JL_GC_PUSH1(&expr);
+    jl_exprargset(expr, 0, thistype);
+    jl_exprargset(expr, 1, jl_box_long(nfields));
+    jl_exprargset(expr, 2, jl_box_long(nsparams));
+    jl_code_info_t *ci = (jl_code_info_t*)jl_call_scm_on_ast_and_loc("jl-default-outer-ctor-body", (jl_value_t*)expr, inmodule, file, line);
+    JL_GC_POP();
+    assert(jl_is_code_info(ci));
+    return ci;
+}
+
+jl_code_info_t *jl_inner_ctor_body(jl_array_t *fieldkinds, jl_module_t *inmodule, const char *file, int line)
+{
+    JL_TIMING(LOWERING, LOWERING);
+    jl_timing_show_location(file, line, inmodule, JL_TIMING_DEFAULT_BLOCK);
+    jl_expr_t *expr = jl_exprn(jl_empty_sym, 0);
+    JL_GC_PUSH1(&expr);
+    expr->args = fieldkinds;
+    jl_code_info_t *ci = (jl_code_info_t*)jl_call_scm_on_ast_and_loc("jl-default-inner-ctor-body", (jl_value_t*)expr, inmodule, file, line);
+    JL_GC_POP();
+    assert(jl_is_code_info(ci));
+    return ci;
+}
+
 
 //------------------------------------------------------------------------------
 // Parsing API and utils for calling parser from runtime

src/builtin_proto.h

@@ -80,6 +80,7 @@ JL_CALLABLE(jl_f__structtype);
 JL_CALLABLE(jl_f__abstracttype);
 JL_CALLABLE(jl_f__primitivetype);
 JL_CALLABLE(jl_f__setsuper);
+JL_CALLABLE(jl_f__defaultctors);
 JL_CALLABLE(jl_f__equiv_typedef);
 JL_CALLABLE(jl_f_get_binding_type);
 JL_CALLABLE(jl_f__compute_sparams);

src/builtins.c

@@ -2345,6 +2345,13 @@ JL_CALLABLE(jl_f__equiv_typedef)
     return equiv_type(args[0], args[1]) ? jl_true : jl_false;
 }
 
+JL_CALLABLE(jl_f__defaultctors)
+{
+    JL_NARGS(_defaultctors, 2, 2);
+    jl_ctor_def(args[0], args[1]);
+    return jl_nothing;
+}
+
 // IntrinsicFunctions ---------------------------------------------------------
 
 static void (*runtime_fp[num_intrinsics])(void);
@@ -2541,6 +2548,7 @@ void jl_init_primitives(void) JL_GC_DISABLED
     add_builtin_func("_abstracttype", jl_f__abstracttype);
     add_builtin_func("_primitivetype", jl_f__primitivetype);
     add_builtin_func("_setsuper!", jl_f__setsuper);
+    add_builtin_func("_defaultctors", jl_f__defaultctors);
     jl_builtin__typebody = add_builtin_func("_typebody!", jl_f__typebody);
     add_builtin_func("_equiv_typedef", jl_f__equiv_typedef);
     jl_builtin_donotdelete = add_builtin_func("donotdelete", jl_f_donotdelete);

src/jlfrontend.scm

@@ -198,6 +198,12 @@
   (error-wrap (lambda ()
                 (julia-expand-macroscope expr))))
 
+(define (jl-default-inner-ctor-body field-kinds file line)
+  (expand-to-thunk- (default-inner-ctor-body (cdr field-kinds) file line) file line))
+
+(define (jl-default-outer-ctor-body args file line)
+  (expand-to-thunk- (default-outer-ctor-body (cadr args) (caddr args) (cadddr args) file line) file line))
+
 ; run whole frontend on a string. useful for testing.
 (define (fe str)
   (expand-toplevel-expr (julia-parse str) 'none 0))

src/jltypes.c

@@ -3876,7 +3876,10 @@ void jl_init_types(void) JL_GC_DISABLED
     jl_string_type->ismutationfree = jl_string_type->isidentityfree = 1;
     jl_symbol_type->ismutationfree = jl_symbol_type->isidentityfree = 1;
     jl_simplevector_type->ismutationfree = jl_simplevector_type->isidentityfree = 1;
+    jl_typename_type->ismutationfree = 1;
     jl_datatype_type->ismutationfree = 1;
+    jl_uniontype_type->ismutationfree = 1;
+    jl_unionall_type->ismutationfree = 1;
     assert(((jl_datatype_t*)jl_array_any_type)->ismutationfree == 0);
     assert(((jl_datatype_t*)jl_array_uint8_type)->ismutationfree == 0);
 

src/julia-syntax.scm

@@ -183,6 +183,7 @@
                        (meta ret-type ,R)
                        ,@(list-tail body (+ 1 (length meta))))))))))
 
+
 ;; convert x<:T<:y etc. exprs into (name lower-bound upper-bound)
 ;; a bound is #f if not specified
 (define (analyze-typevar e)
@@ -753,64 +754,34 @@
    (params bounds) (sparam-name-bounds params)
    (struct-def-expr- name params bounds super (flatten-blocks fields) mut)))
 
-;; replace field names with gensyms if they conflict with field-types
-(define (safe-field-names field-names field-types)
-  (if (any (lambda (v) (contains (lambda (e) (eq? e v)) field-types))
-           field-names)
-      (map (lambda (x) (gensy)) field-names)
-      ;; use a different name for a field called `_`
-      (map (lambda (x) (if (eq? x '_) (gensy) x)) field-names)))
-
-(define (with-wheres call wheres)
-  (if (pair? wheres)
-      `(where ,call ,@wheres)
-      call))
-
-(define (default-inner-ctors name field-names field-types params bounds locs)
-  (let* ((field-names (safe-field-names field-names field-types))
-         (all-ctor (if (null? params)
-          ;; definition with exact types for all arguments
-          `(function (call ,name
-                          ,@(map make-decl field-names field-types))
-                    (block
-                     ,@locs
-                     (new (globalref (thismodule) ,name) ,@field-names)))
-          #f))
-         (any-ctor (if (or (not all-ctor) (any (lambda (t) (not (equal? t '(core Any))))
-                                 field-types))
-          ;; definition with Any for all arguments
-          ;; only if any field type is not Any, checked at runtime
-          `(function (call (|::| |#ctor-self#|
-                            ,(with-wheres
-                              `(curly (core Type) ,(if (pair? params)
-                                                       `(curly ,name ,@params)
-                                                       name))
-                              (map (lambda (b) (cons 'var-bounds b)) bounds)))
-                           ,@field-names)
-                     (block
-                      ,@locs
-                      (call new ,@field-names))) ; this will add convert calls later
-          #f)))
-    (if all-ctor
-        (if any-ctor
-            (list all-ctor
-                  `(if ,(foldl (lambda (t u)
-                           `(&& ,u (call (core ===) (core Any) ,t)))
-                         `(call (core ===) (core Any) ,(car field-types))
-                         (cdr field-types))
-                       '(block)
-                       ,any-ctor))
-            (list all-ctor))
-        (list any-ctor))))
-
-(define (default-outer-ctor name field-names field-types params bounds locs)
-  (let ((field-names (safe-field-names field-names field-types)))
-    `(function ,(with-wheres
-                 `(call ,name ,@(map make-decl field-names field-types))
-                 (map (lambda (b) (cons 'var-bounds b)) bounds))
-               (block
-                ,@locs
-                (new (curly ,name ,@params) ,@field-names)))))
+;; definition with Any for all arguments (except type, which is exact)
+;; field-kinds:
+;;   -1 no convert (e.g. because it is Any)
+;;    0 normal convert to fieldtype
+;;   1+ static_parameter N
+(define (default-inner-ctor-body field-kinds file line)
+  (let* ((name '|#ctor-self#|)
+         (field-names (map (lambda (idx) (symbol (string "_" (+ idx 1)))) (iota (length field-kinds))))
+         (field-convert (lambda (fld fty val)
+              (cond ((eq? fty -1) val)
+                    ((> fty 0) (convert-for-type-decl val `(static_parameter ,fty) #f #f))
+                    (else (convert-for-type-decl val `(call (core fieldtype) ,name ,(+ fld 1)) #f #f)))))
+         (field-vals (map field-convert (iota (length field-names)) field-kinds field-names))
+         (body `(block
+                 (line ,line ,file)
+                 (return (new ,name ,@field-vals)))))
+    `(lambda ,(cons name field-names) () (scope-block ,body))))
+
+;; definition with exact types for all arguments (except type, which is not parameterized)
+(define (default-outer-ctor-body thistype field-count sparam-count file line)
+  (let* ((name '|#ctor-self#|)
+         (field-names (map (lambda (idx) (symbol (string "_" (+ idx 1)))) (iota field-count)))
+         (sparams (map (lambda (idx) `(static_parameter ,(+ idx 1))) (iota sparam-count)))
+         (type (if (null? sparams) name `(curly ,thistype ,@sparams)))
+         (body `(block
+                 (line ,line ,file)
+                 (return (new ,type ,@field-names)))))
+    `(lambda ,(cons name field-names) () (scope-block ,body))))
 
 (define (num-non-varargs args)
   (count (lambda (a) (not (vararg? a))) args))
@@ -993,14 +964,11 @@
                          fields)))
           (attrs (reverse attrs))
           (defs        (filter (lambda (x) (not (or (effect-free? x) (eq? (car x) 'string)))) defs))
-          (locs        (if (and (pair? fields0) (linenum? (car fields0)))
-                           (list (car fields0))
-                           '()))
+          (loc         (if (and (pair? fields0) (linenum? (car fields0)))
+                           (car fields0)
+                           '(line 0 ||)))
           (field-names (map decl-var fields))
           (field-types (map decl-type fields))
-          (defs2 (if (null? defs)
-                     (default-inner-ctors name field-names field-types params bounds locs)
-                     defs))
           (min-initialized (min (ctors-min-initialized defs) (length fields)))
           (hasprev (make-ssavalue))
           (prev (make-ssavalue))
@@ -1042,34 +1010,21 @@
          (const (globalref (thismodule) ,name) ,newdef)
          (latestworld)
          (null)))
-       ;; "inner" constructors
-       (scope-block
-        (block
-         (hardscope)
-         (global ,name)
-         ,@(map (lambda (c)
-                  (rewrite-ctor c name params field-names field-types))
-                defs2)))
-       ;; "outer" constructors
-       ,@(if (and (null? defs)
-                  (not (null? params))
-                  ;; To generate an outer constructor, each parameter must occur in a field
-                  ;; type, or in the bounds of a subsequent parameter.
-                  ;; Otherwise the constructor would not work, since the parameter values
-                  ;; would never be specified.
-                  (let loop ((root-types field-types)
-                             (sp         (reverse bounds)))
-                    (or (null? sp)
-                        (let ((p (car sp)))
-                          (and (expr-contains-eq (car p) (cons 'list root-types))
-                               (loop (append (cdr p) root-types)
-                                     (cdr sp)))))))
-             `((scope-block
-                (block
-                 (global ,name)
-                 ,(default-outer-ctor name field-names field-types
-                    params bounds locs))))
-             '())
+       ;; Always define ctors even if we didn't change the definition.
+       ;; If newdef===prev, then this is a bit suspect, since we don't know what might be
+       ;; changing about the old ctor definitions (we don't even track whether we're
+       ;; replacing defaultctors with identical ones). But it seems better to have the ctors
+       ;; added alongside (replacing) the old ones, than to not have them and need them.
+       ;; Commonly Revise.jl should be used to figure out actually which methods should
+       ;; actually be deleted or added anew.
+       ,(if (null? defs)
+          `(call (core _defaultctors) ,newdef (inert ,loc))
+          `(scope-block
+            (block
+             (hardscope)
+             (global ,name)
+             ,@(map (lambda (c) (rewrite-ctor c name params field-names field-types)) defs))))
+       (latestworld)
        (null)))))
 
 (define (abstract-type-def-expr name params super)
@@ -4646,7 +4601,7 @@ f(x) = yt(x)
     ;; from the current function.
     (define (compile e break-labels value tail)
       (if (or (not (pair? e)) (memq (car e) '(null true false ssavalue quote inert top core copyast the_exception $
-                                                   globalref thismodule cdecl stdcall fastcall thiscall llvmcall)))
+                                                   globalref thismodule cdecl stdcall fastcall thiscall llvmcall static_parameter)))
           (let ((e1 (if (and arg-map (symbol? e))
                         (get arg-map e e)
                         e)))
@@ -4657,7 +4612,7 @@ f(x) = yt(x)
             (cond (tail  (emit-return tail e1))
                   (value e1)
                   ((symbol? e1) (emit e1) #f)  ;; keep symbols for undefined-var checking
-                  ((and (pair? e1) (eq? (car e1) 'globalref)) (emit e1) #f) ;; keep globals for undefined-var checking
+                  ((and (pair? e1) (memq (car e1) '(globalref static_parameter))) (emit e1) #f) ;; keep for undefined-var checking
                   (else #f)))
           (case (car e)
             ((call new splatnew foreigncall cfunction new_opaque_closure)

src/julia.h

@@ -1612,6 +1612,7 @@ static inline int jl_field_isconst(jl_datatype_t *st, int i) JL_NOTSAFEPOINT
 #define jl_is_quotenode(v)   jl_typetagis(v,jl_quotenode_type)
 #define jl_is_newvarnode(v)  jl_typetagis(v,jl_newvarnode_type)
 #define jl_is_linenode(v)    jl_typetagis(v,jl_linenumbernode_type)
+#define jl_is_linenumbernode(v) jl_typetagis(v,jl_linenumbernode_type)
 #define jl_is_method_instance(v) jl_typetagis(v,jl_method_instance_type)
 #define jl_is_code_instance(v) jl_typetagis(v,jl_code_instance_type)
 #define jl_is_code_info(v)   jl_typetagis(v,jl_code_info_type)

src/julia_internal.h

@@ -1214,6 +1214,9 @@ JL_DLLEXPORT int jl_has_meta(jl_array_t *body, jl_sym_t *sym) JL_NOTSAFEPOINT;
 
 JL_DLLEXPORT jl_value_t *jl_parse(const char *text, size_t text_len, jl_value_t *filename,
                                   size_t lineno, size_t offset, jl_value_t *options);
+jl_code_info_t *jl_inner_ctor_body(jl_array_t *fieldkinds, jl_module_t *inmodule, const char *file, int line);
+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);
+void jl_ctor_def(jl_value_t *ty, jl_value_t *functionloc);
 
 //--------------------------------------------------
 // Backtraces