diff --git a/base/essentials.jl b/base/essentials.jl index 37c4361a47403..b028a07b64e2e 100644 --- a/base/essentials.jl +++ b/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? diff --git a/src/julia-syntax.scm b/src/julia-syntax.scm index c7270734123be..cd993e6b723e7 100644 --- a/src/julia-syntax.scm +++ b/src/julia-syntax.scm @@ -693,15 +693,27 @@ ,@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) ")")))) @@ -709,30 +721,24 @@ (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,14 +764,14 @@ 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))) @@ -772,32 +779,32 @@ ;; 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) diff --git a/test/core.jl b/test/core.jl index 14375439ebfee..e0890827cf168 100644 --- a/test/core.jl +++ b/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 diff --git a/test/syntax.jl b/test/syntax.jl index 4e751a5a66eff..3b9f516157bdd 100644 --- a/test/syntax.jl +++ b/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{...}\"")