Skip to content

lower new() to reference the called object instead of re-creating it with apply_type #44664

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Apr 26, 2022
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
90 changes: 54 additions & 36 deletions src/julia-syntax.scm
Original file line number Diff line number Diff line change
Expand Up @@ -752,12 +752,13 @@
(let* ((field-names (safe-field-names field-names field-types))
(any-ctor
;; definition with Any for all arguments
`(function ,(with-wheres
`(call ,(if (pair? params)
`(curly ,name ,@params)
name)
,@field-names)
(map (lambda (b) (cons 'var-bounds b)) bounds))
`(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)))))
Expand Down Expand Up @@ -791,7 +792,9 @@
(define (num-non-varargs args)
(count (lambda (a) (not (vararg? a))) args))

(define (new-call Tname type-params sparams params args field-names field-types)
;; selftype?: tells us whether the called object is the type being constructed,
;; i.e. `new()` and not `new{...}()`.
(define (new-call Tname type-params sparams params args field-names field-types selftype?)
(if (any kwarg? args)
(error "\"new\" does not accept keyword arguments"))
(let ((nnv (num-non-varargs type-params)))
Expand All @@ -801,14 +804,16 @@
(error "too many type parameters specified in \"new{...}\"")))
(let* ((Texpr (if (null? type-params)
`(outerref ,Tname)
`(curly (outerref ,Tname)
,@type-params)))
(tn (make-ssavalue))
(if selftype?
'|#ctor-self#|
`(curly (outerref ,Tname)
,@type-params))))
(tn (if (symbol? Texpr) Texpr (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))
,(if (and (not selftype?) (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)))
Expand All @@ -823,7 +828,7 @@
(let ((argt (make-ssavalue))
(nf (make-ssavalue)))
`(block
(= ,tn ,Texpr)
,@(if (symbol? tn) '() `((= ,tn ,Texpr)))
(= ,argt (call (core tuple) ,@args))
(= ,nf (call (core nfields) ,argt))
(if (call (top ult_int) ,nf ,(length field-names))
Expand All @@ -835,9 +840,9 @@
(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
`(block
(= ,tn ,Texpr)
(new ,tn ,@(map field-convert (iota (length args)) (list-head field-types (length args)) args)))))))
`(block
,@(if (symbol? tn) '() `((= ,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)
Expand All @@ -850,56 +855,69 @@
((length= lno 3) (string " around " (caddr lno) ":" (cadr lno)))
(else "")))

;; convert constructor signature from X(...) to (|#ctor-self#|::Type{X})(...),
;; or return #f if we can't
(define (ctor-sig sig)
(cond ((or (eq? (car sig) '|::|) (eq? (car sig) 'where))
(let ((s2 (ctor-sig (cadr sig))))
(and s2 `(,(car sig) ,s2 ,@(cddr sig)))))
((eq? (car sig) 'call)
(let ((head (cadr sig)))
(if (decl? head)
(if (eq? (cadr head) '|#ctor-self#|)
sig ;; already in the required form
#f)
`(call (|::| |#ctor-self#| (curly (core Type) ,head)) ,@(cddr sig)))))
(else #f)))

(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))
(sparams (map car (map analyze-typevar wheres))))
(cond ((not (eq? name Tname))
`(function ,(with-wheres `(call ,(if curly?
`(curly ,name ,@curlyargs)
name)
,@sig)
wheres)
`(function ,sig
;; pass '() in order to require user-specified parameters with
;; new{...} inside a non-ctor inner definition.
,(ctor-body body '() sparams)))
,(ctor-body body '() sparams #f)))
(else
`(function ,(with-wheres `(call ,(if curly?
`(curly ,name ,@curlyargs)
name)
,@sig)
wheres)
,(ctor-body body curlyargs sparams))))))
(let ((newsig (ctor-sig sig)))
`(function ,(or newsig sig)
,(ctor-body body curlyargs sparams (not (not newsig)))))))))

;; rewrite calls to `new( ... )` to `new` expressions on the appropriate
;; type, determined by the containing constructor definition.
(define (rewrite-ctor ctor Tname params field-names field-types)
(define (ctor-body body type-params sparams)
(define (ctor-body body type-params sparams selftype?)
(pattern-replace (pattern-set
(pattern-lambda
(call (-/ new) . args)
(new-call Tname type-params sparams params
(map (lambda (a) (ctor-body a type-params sparams)) args)
field-names field-types))
(map (lambda (a) (ctor-body a type-params sparams selftype?)) args)
field-names field-types selftype?))
(pattern-lambda
(call (curly (-/ new) . p) . args)
(new-call Tname p sparams params
(map (lambda (a) (ctor-body a type-params sparams)) args)
field-names field-types)))
(map (lambda (a) (ctor-body a type-params sparams selftype?)) args)
field-names field-types #f)))
body))
(pattern-replace
(pattern-set
;; recognize `(t::(Type{X{T}} where T))(...)` as an inner-style constructor for X
(pattern-lambda (function (-$ (call (|::| self (where (curly (core (-/ Type)) name) . wheres)) . sig)
(|::| (call (|::| self (where (curly (core (-/ Type)) name) . wheres)) . sig) _t))
body)
(ctor-def name Tname ctor-body (cadr __) body wheres))
;; definitions without `where`
(pattern-lambda (function (-$ (call name . sig) (|::| (call name . sig) _t)) body)
(ctor-def name Tname ctor-body sig body #f))
(ctor-def name Tname ctor-body (cadr __) body #f))
(pattern-lambda (= (-$ (call name . sig) (|::| (call name . sig) _t)) body)
(ctor-def name Tname ctor-body sig body #f))
(ctor-def name Tname ctor-body (cadr __) body #f))
;; definitions with `where`
(pattern-lambda (function (where (-$ (call name . sig) (|::| (call name . sig) _t)) . wheres) body)
(ctor-def name Tname ctor-body sig body wheres))
(ctor-def name Tname ctor-body (cadr __) body wheres))
(pattern-lambda (= (where (-$ (call name . sig) (|::| (call name . sig) _t)) . wheres) body)
(ctor-def name Tname ctor-body sig body wheres)))
(ctor-def name Tname ctor-body (cadr __) body wheres)))

;; flatten `where`s first
(pattern-replace
Expand Down
8 changes: 8 additions & 0 deletions test/syntax.jl
Original file line number Diff line number Diff line change
Expand Up @@ -3357,3 +3357,11 @@ demo44723()::Any = Base.Experimental.@opaque () -> true ? 1 : 2
@test y == Core.svec(2, 3)
@test z == 4
end

# rewriting inner constructors with return type decls
struct InnerCtorRT{T}
InnerCtorRT()::Int = new{Int}()
InnerCtorRT{T}() where {T} = ()->new()
end
@test_throws MethodError InnerCtorRT()
@test InnerCtorRT{Int}()() isa InnerCtorRT{Int}