lowering,new: improve implementation robustness (#32404)

- move implementation of splatnew into lowering instead of dispatch (given the current definition of splatnew)
- use field indexes with fieldtype instead of names
- use fieldtype in most cases, instead of copying expression tree
- explicit syntax error for too many type parameters on new (instead of deferring to the runtime apply_type error)

Author: vtjnash

base/essentials.jl

@@ -311,13 +311,6 @@ convert(::Type{Tuple{Vararg{V}}}, x::Tuple{Vararg{V}}) where {V} = x
 convert(T::Type{Tuple{Vararg{V}}}, x::Tuple) where {V} =
     (convert(tuple_type_head(T), x[1]), convert(T, tail(x))...)
 
-# used for splatting in `new`
-convert_prefix(::Type{Tuple{}}, x::Tuple) = x
-convert_prefix(::Type{<:AtLeast1}, x::Tuple{}) = x
-convert_prefix(::Type{T}, x::T) where {T<:AtLeast1} = x
-convert_prefix(::Type{T}, x::AtLeast1) where {T<:AtLeast1} =
-    (convert(tuple_type_head(T), x[1]), convert_prefix(tuple_type_tail(T), tail(x))...)
-
 # TODO: the following definitions are equivalent (behaviorally) to the above method
 # I think they may be faster / more efficient for inference,
 # if we could enable them, but are they?

src/julia-syntax.scm

@@ -693,46 +693,52 @@
                 ,@locs
                 (call (curly ,name ,@params) ,@field-names)))))
 
-(define (new-call Tname type-params params args field-names field-types)
+(define (new-call Tname type-params sparams params args field-names field-types)
   (if (any kwarg? args)
       (error "\"new\" does not accept keyword arguments"))
   (if (length> params (length type-params))
       (error "too few type parameters specified in \"new{...}\""))
-  (let ((Texpr (if (null? type-params)
-                   `(outerref ,Tname)
-                   `(curly (outerref ,Tname)
-                           ,@type-params))))
+  (if (length> type-params (length params))
+      (error "too many type parameters specified in \"new{...}\""))
+  (let* ((Texpr (if (null? type-params)
+                    `(outerref ,Tname)
+                    `(curly (outerref ,Tname)
+                            ,@type-params)))
+         (tn (make-ssavalue))
+         (field-convert (lambda (fld fty val)
+                          (if (equal? fty '(core Any))
+                              val
+                              `(call (top convert)
+                                     ,(if (and (equal? type-params params) (memq fty params) (memq fty sparams))
+                                          fty ; the field type is a simple parameter, the usage here is of a
+                                              ; local variable (currently just handles sparam) for the bijection of params to type-params
+                                          `(call (core fieldtype) ,tn ,(+ fld 1)))
+                                     ,val)))))
     (cond ((length> (filter (lambda (a) (not (vararg? a))) args) (length field-names))
            `(call (core throw) (call (top ArgumentError)
                                      ,(string "new: too many arguments (expected " (length field-names) ")"))))
           ((any vararg? args)
            (if (every (lambda (ty) (equal? ty '(core Any)))
                       field-types)
                `(splatnew ,Texpr (call (core tuple) ,@args))
-               (let ((tn (make-ssavalue)))
+               (let ((argt (make-ssavalue))
+                     (nf (make-ssavalue)))
                  `(block
                    (= ,tn ,Texpr)
-                   (splatnew ,tn (call (top convert_prefix)
-                                       (curly (core Tuple)
-                                              ,@(map (lambda (fld)
-                                                       `(call (core fieldtype) ,tn (quote ,fld)))
-                                                     field-names))
-                                       (call (core tuple) ,@args)))))))
+                   (= ,argt (call (core tuple) ,@args))
+                   (= ,nf (call (core nfields) ,argt))
+                   (if (call (top ult_int) ,nf ,(length field-names))
+                       (call (core throw) (call (top ArgumentError)
+                                                ,(string "new: too few arguments (expected " (length field-names) ")"))))
+                   (if (call (top ult_int) ,(length field-names) ,nf)
+                       (call (core throw) (call (top ArgumentError)
+                                                ,(string "new: too many arguments (expected " (length field-names) ")"))))
+                   (new ,tn ,@(map (lambda (fld fty) (field-convert fld fty `(call (core getfield) ,argt ,(+ fld 1) false)))
+                                   (iota (length field-names)) (list-head field-types (length field-names))))))))
           (else
-           (if (equal? type-params params)
-               `(new ,Texpr ,@(map (lambda (fty val)
-                                     (if (equal? fty '(core Any))
-                                         val
-                                         `(call (top convert) ,fty ,val)))
-                                   (list-head field-types (length args)) args))
-               (let ((tn (make-ssavalue)))
-                 `(block
-                   (= ,tn ,Texpr)
-                   (new ,tn ,@(map (lambda (fld val)
-                                     `(call (top convert)
-                                            (call (core fieldtype) ,tn (quote ,fld))
-                                            ,val))
-                                   (list-head field-names (length args)) args)))))))))
+            `(block
+              (= ,tn ,Texpr)
+              (new ,tn ,@(map field-convert (iota (length args)) (list-head field-types (length args)) args)))))))
 
 ;; insert item at start of arglist
 (define (arglist-unshift sig item)
@@ -745,10 +751,11 @@
         ((length= lno 3) (string " around " (caddr lno) ":" (cadr lno)))
         (else "")))
 
-(define (ctor-def name Tname params bounds sig ctor-body body wheres)
+(define (ctor-def name Tname ctor-body sig body wheres)
   (let* ((curly?     (and (pair? name) (eq? (car name) 'curly)))
          (curlyargs  (if curly? (cddr name) '()))
-         (name       (if curly? (cadr name) name)))
+         (name       (if curly? (cadr name) name))
+         (sparams (map car (map analyze-typevar wheres))))
     (cond ((not (eq? name Tname))
            `(function ,(with-wheres `(call ,(if curly?
                                                 `(curly ,name ,@curlyargs)
@@ -757,47 +764,47 @@
                                     wheres)
                       ;; pass '() in order to require user-specified parameters with
                       ;; new{...} inside a non-ctor inner definition.
-                      ,(ctor-body body '())))
+                      ,(ctor-body body '() sparams)))
           (else
            `(function ,(with-wheres `(call ,(if curly?
                                                 `(curly ,name ,@curlyargs)
                                                 name)
                                            ,@sig)
                                     wheres)
-                      ,(ctor-body body curlyargs))))))
+                      ,(ctor-body body curlyargs sparams))))))
 
 (define (function-body-lineno body)
   (let ((lnos (filter linenum? body)))
     (if (null? lnos) '() (car lnos))))
 
 ;; rewrite calls to `new( ... )` to `new` expressions on the appropriate
 ;; type, determined by the containing constructor definition.
-(define (rewrite-ctor ctor Tname params bounds field-names field-types)
-  (define (ctor-body body type-params)
+(define (rewrite-ctor ctor Tname params field-names field-types)
+  (define (ctor-body body type-params sparams)
     (pattern-replace (pattern-set
                       (pattern-lambda
                        (call (-/ new) . args)
-                       (new-call Tname type-params params
-                                 (map (lambda (a) (ctor-body a type-params)) args)
+                       (new-call Tname type-params sparams params
+                                 (map (lambda (a) (ctor-body a type-params sparams)) args)
                                  field-names field-types))
                       (pattern-lambda
                        (call (curly (-/ new) . p) . args)
-                       (new-call Tname p params
-                                 (map (lambda (a) (ctor-body a type-params)) args)
+                       (new-call Tname p sparams params
+                                 (map (lambda (a) (ctor-body a type-params sparams)) args)
                                  field-names field-types)))
                      body))
   (pattern-replace
    (pattern-set
     ;; definitions without `where`
     (pattern-lambda (function       (-$ (call name . sig) (|::| (call name . sig) _t)) body)
-                    (ctor-def name Tname params bounds sig ctor-body body #f))
+                    (ctor-def name Tname ctor-body sig body #f))
     (pattern-lambda (= (-$ (call name . sig) (|::| (call name . sig) _t)) body)
-                    (ctor-def name Tname params bounds sig ctor-body body #f))
+                    (ctor-def name Tname ctor-body sig body #f))
     ;; definitions with `where`
     (pattern-lambda (function       (where (-$ (call name . sig) (|::| (call name . sig) _t)) . wheres) body)
-                    (ctor-def name Tname params bounds sig ctor-body body wheres))
+                    (ctor-def name Tname ctor-body sig body wheres))
     (pattern-lambda (= (where (-$ (call name . sig) (|::| (call name . sig) _t)) . wheres) body)
-                    (ctor-def name Tname params bounds sig ctor-body body wheres)))
+                    (ctor-def name Tname ctor-body sig body wheres)))
 
    ;; flatten `where`s first
    (pattern-replace
@@ -853,7 +860,7 @@
         (block
          (global ,name)
          ,@(map (lambda (c)
-                  (rewrite-ctor c name params bounds field-names field-types))
+                  (rewrite-ctor c name params field-names field-types))
                 defs2)))
        ;; "outer" constructors
        ,@(if (and (null? defs)

test/core.jl

@@ -6988,3 +6988,39 @@ end
 # just constant folded by (future) over-eager compiler optimizations
 @test isa(Core.eval(@__MODULE__, :(Bar31062(()))), Bar31062)
 @test precompile(identity, (Foo31062,))
+
+ftype_eval = Ref(0)
+FieldTypeA = String
+FieldTypeE = UInt32
+struct FieldConvert{FieldTypeA, S}
+    a::FieldTypeA
+    b::(ftype_eval[] += 1; Vector{FieldTypeA})
+    c
+    d::Any
+    e::FieldTypeE
+    FieldConvert(a::S, b, c, d, e) where {S} = new{FieldTypeA, S}(a, b, c, d, e)
+end
+@test ftype_eval[] == 1
+FieldTypeA = UInt64
+FieldTypeE = String
+let fc = FieldConvert(1.0, [2.0], 0x3, 0x4, 0x5)
+    @test fc.a === UInt64(1)
+    @test fc.b isa Vector{UInt64}
+    @test fc.c === 0x3
+    @test fc.d === 0x4
+    @test fc.e === UInt32(0x5)
+end
+@test ftype_eval[] == 1
+let code = code_lowered(FieldConvert)[1].code
+    @test code[1] == Expr(:call, GlobalRef(Core, :apply_type), GlobalRef(@__MODULE__, :FieldConvert), GlobalRef(@__MODULE__, :FieldTypeA), Expr(:static_parameter, 1))
+    @test code[2] == Expr(:call, GlobalRef(Core, :fieldtype), Core.SSAValue(1), 1)
+    @test code[3] == Expr(:call, GlobalRef(Base, :convert), Core.SSAValue(2), Core.SlotNumber(2))
+    @test code[4] == Expr(:call, GlobalRef(Core, :fieldtype), Core.SSAValue(1), 2)
+    @test code[5] == Expr(:call, GlobalRef(Base, :convert), Core.SSAValue(4), Core.SlotNumber(3))
+    @test code[6] == Expr(:call, GlobalRef(Core, :fieldtype), Core.SSAValue(1), 4)
+    @test code[7] == Expr(:call, GlobalRef(Base, :convert), Core.SSAValue(6), Core.SlotNumber(5))
+    @test code[8] == Expr(:call, GlobalRef(Core, :fieldtype), Core.SSAValue(1), 5)
+    @test code[9] == Expr(:call, GlobalRef(Base, :convert), Core.SSAValue(8), Core.SlotNumber(6))
+    @test code[10] == Expr(:new, Core.SSAValue(1), Core.SSAValue(3), Core.SSAValue(5), Core.SlotNumber(4), Core.SSAValue(7), Core.SSAValue(9))
+    @test code[11] == Expr(:return, Core.SSAValue(10))
+ end

test/syntax.jl

@@ -1861,3 +1861,6 @@ let
     a32325(x) = a32325()
 end
 @test a32325(0) === a32325()
+
+@test Meta.lower(Main, :(struct A; A() = new{Int}(); end)) == Expr(:error, "too many type parameters specified in \"new{...}\"")
+@test Meta.lower(Main, :(struct A{T, S}; A() = new{Int}(); end)) == Expr(:error, "too few type parameters specified in \"new{...}\"")