Skip to content
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

fix some macro expander issues with new 0.6 syntax #22166

Merged
merged 1 commit into from
Jun 1, 2017
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
10 changes: 9 additions & 1 deletion base/essentials.jl
Original file line number Diff line number Diff line change
Expand Up @@ -34,9 +34,17 @@ convert(::Type{Tuple{Vararg{T}}}, x::Tuple) where {T} = cnvt_all(T, x...)
cnvt_all(T) = ()
cnvt_all(T, x, rest...) = tuple(convert(T,x), cnvt_all(T, rest...)...)

# test whether an assignment LHS is a function definition
function eventually_call(ex)
isa(ex, Expr) && (ex.head === :call ||
((ex.head === :where || ex.head === :(::)) &&
eventually_call(ex.args[1])))
end

macro generated(f)
isa(f, Expr) || error("invalid syntax; @generated must be used with a function definition")
if f.head === :function || (isdefined(:length) && f.head === :(=) && length(f.args) == 2 && f.args[1].head == :call)
if f.head === :function || (isdefined(:length) && f.head === :(=) && length(f.args) == 2 &&
eventually_call(f.args[1]))
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

use existing is_short_function_def instead

f.head = :stagedfunction
return Expr(:escape, f)
else
Expand Down
2 changes: 1 addition & 1 deletion src/julia-parser.scm
Original file line number Diff line number Diff line change
Expand Up @@ -613,7 +613,7 @@
(define (eventually-call ex)
(and (pair? ex)
(or (eq? (car ex) 'call)
(and (eq? (car ex) 'where)
(and (or (eq? (car ex) 'where) (eq? (car ex) '|::|))
(eventually-call (cadr ex))))))

;; insert line/file for short-form function defs, otherwise leave alone
Expand Down
24 changes: 14 additions & 10 deletions src/julia-syntax.scm
Original file line number Diff line number Diff line change
Expand Up @@ -828,18 +828,18 @@
(pattern-replace
(pattern-set
;; definitions without `where`
(pattern-lambda (function (call name . sig) body)
(pattern-lambda (function (-$ (call name . sig) (|::| (call name . sig) _t)) body)
(ctor-def (car __) name Tname params bounds sig ctor-body body #f))
(pattern-lambda (stagedfunction (call name . sig) body)
(pattern-lambda (stagedfunction (-$ (call name . sig) (|::| (call name . sig) _t)) body)
(ctor-def (car __) name Tname params bounds sig ctor-body body #f))
(pattern-lambda (= (call name . sig) body)
(pattern-lambda (= (-$ (call name . sig) (|::| (call name . sig) _t)) body)
(ctor-def 'function name Tname params bounds sig ctor-body body #f))
;; definitions with `where`
(pattern-lambda (function (where (call name . sig) . wheres) body)
(pattern-lambda (function (where (-$ (call name . sig) (|::| (call name . sig) _t)) . wheres) body)
(ctor-def (car __) name Tname params bounds sig ctor-body body wheres))
(pattern-lambda (stagedfunction (where (call name . sig) . wheres) body)
(pattern-lambda (stagedfunction (where (-$ (call name . sig) (|::| (call name . sig) _t)) . wheres) body)
(ctor-def (car __) name Tname params bounds sig ctor-body body wheres))
(pattern-lambda (= (where (call name . sig) . wheres) body)
(pattern-lambda (= (where (-$ (call name . sig) (|::| (call name . sig) _t)) . wheres) body)
(ctor-def 'function name Tname params bounds sig ctor-body body wheres)))

;; flatten `where`s first
Expand Down Expand Up @@ -1329,10 +1329,13 @@
e
(expand-forms (expand-decls (car e) (cdr e) #f))))

;; given a complex assignment LHS, return the symbol that will ultimately be assigned to
(define (assigned-name e)
(if (and (pair? e) (memq (car e) '(call curly)))
(assigned-name (cadr e))
e))
(cond ((atom? e) e)
((or (memq (car e) '(call curly where))
(and (eq? (car e) '|::|) (eventually-call e)))
(assigned-name (cadr e)))
(else e)))

;; local x, y=2, z => local x;local y;local z;y = 2
(define (expand-decls what binds const?)
Expand Down Expand Up @@ -2428,7 +2431,8 @@
(else '())))

(define (all-decl-vars e) ;; map decl-var over every level of an assignment LHS
(cond ((decl? e) (decl-var e))
(cond ((eventually-call e) e)
((decl? e) (decl-var e))
((and (pair? e) (eq? (car e) 'tuple))
(cons 'tuple (map all-decl-vars (cdr e))))
(else e)))
Expand Down
120 changes: 96 additions & 24 deletions src/macroexpand.scm
Original file line number Diff line number Diff line change
Expand Up @@ -54,33 +54,38 @@
;; function with static parameters
(pattern-lambda
(function (call (curly name . sparams) . argl) body)
(cons 'varlist (append (llist-vars (fix-arglist argl))
(apply nconc
(map (lambda (v) (trycatch
(list (typevar-expr-name v))
(lambda (e) '())))
sparams)))))
(cons 'varlist (append (safe-llist-positional-args (fix-arglist argl))
(typevar-names sparams))))

;; function definition
(pattern-lambda (function (call name . argl) body)
(cons 'varlist (llist-vars (fix-arglist argl))))
(pattern-lambda (function (-$ (call name . argl) (|::| (call name . argl) _t)) body)
(cons 'varlist (safe-llist-positional-args (fix-arglist argl))))
(pattern-lambda (function (where (-$ (call name . argl) (|::| (call name . argl) _t)) . wheres) body)
(cons 'varlist (append (safe-llist-positional-args (fix-arglist argl))
(typevar-names wheres))))

(pattern-lambda (function (tuple . args) body)
`(-> (tuple ,@args) ,body))

;; expression form function definition
(pattern-lambda (= (call (curly name . sparams) . argl) body)
`(function (call (curly ,name . ,sparams) . ,argl) ,body))
(pattern-lambda (= (call name . argl) body)
(pattern-lambda (= (-$ (call name . argl) (|::| (call name . argl) _t)) body)
`(function (call ,name ,@argl) ,body))
(pattern-lambda (= (where (-$ (call name . argl) (|::| (call name . argl) _t)) . wheres) body)
(cons 'function (cdr __)))

;; anonymous function
(pattern-lambda (-> a b)
(let ((a (if (and (pair? a)
(eq? (car a) 'tuple))
(cdr a)
(list a))))
(cons 'varlist (llist-vars (fix-arglist a)))))
(cons 'varlist (safe-llist-positional-args (fix-arglist a)))))

;; where
(pattern-lambda (where ex . vars)
(cons 'varlist (typevar-names vars)))

;; let
(pattern-lambda (let ex . binds)
Expand Down Expand Up @@ -127,10 +132,10 @@
;; type definition
(pattern-lambda (type mut (<: (curly tn . tvars) super) body)
(list* 'varlist (cons (unescape tn) (unescape tn)) '(new . new)
(map typevar-expr-name tvars)))
(typevar-names tvars)))
(pattern-lambda (type mut (curly tn . tvars) body)
(list* 'varlist (cons (unescape tn) (unescape tn)) '(new . new)
(map typevar-expr-name tvars)))
(typevar-names tvars)))
(pattern-lambda (type mut (<: tn super) body)
(list 'varlist (cons (unescape tn) (unescape tn)) '(new . new)))
(pattern-lambda (type mut tn body)
Expand All @@ -141,15 +146,19 @@
(define keywords-introduced-by-patterns
(pattern-set
(pattern-lambda (function (call (curly name . sparams) . argl) body)
(cons 'varlist (llist-keywords (fix-arglist argl))))
(cons 'varlist (safe-llist-keyword-args (fix-arglist argl))))

(pattern-lambda (function (call name . argl) body)
(cons 'varlist (llist-keywords (fix-arglist argl))))
(pattern-lambda (function (-$ (call name . argl) (|::| (call name . argl) _t)) body)
(cons 'varlist (safe-llist-keyword-args (fix-arglist argl))))
(pattern-lambda (function (where (-$ (call name . argl) (|::| (call name . argl) _t)) . wheres) body)
(cons 'varlist (safe-llist-keyword-args (fix-arglist argl))))

(pattern-lambda (= (call (curly name . sparams) . argl) body)
`(function (call (curly ,name . ,sparams) . ,argl) ,body))
(pattern-lambda (= (call name . argl) body)
(pattern-lambda (= (-$ (call name . argl) (|::| (call name . argl) _t)) body)
`(function (call ,name ,@argl) ,body))
(pattern-lambda (= (where (-$ (call name . argl) (|::| (call name . argl) _t)) . wheres) body)
(cons 'function (cdr __)))
))

(define (pair-with-gensyms v)
Expand All @@ -166,6 +175,70 @@

(define (typevar-expr-name e) (car (analyze-typevar e)))

;; get the list of names from a list of `where` variable expressions
(define (typevar-names lst)
(apply nconc
(map (lambda (v) (trycatch
(list (typevar-expr-name v))
(lambda (e) '())))
lst)))

;; get the name from a function formal argument expression, allowing `(escape x)`
(define (try-arg-name v)
(cond ((and (symbol? v) (not (eq? v 'true)) (not (eq? v 'false)))
(list v))
((atom? v) '())
(else
(case (car v)
((... kw |::|) (try-arg-name (cadr v)))
((escape) (list v))
(else '())))))

;; get names from a formal argument list, specifying whether to include escaped ones
(define (safe-arg-names lst (escaped #f))
(apply nconc
(map (lambda (v)
(let ((vv (try-arg-name v)))
(if (eq? escaped (and (pair? vv) (pair? (car vv)) (eq? (caar vv) 'escape)))
(if escaped (list (cadar vv)) vv)
'())))
lst)))

;; arg names, looking only at positional args
(define (safe-llist-positional-args lst (escaped #f))
(safe-arg-names
(filter (lambda (a) (not (and (pair? a)
(eq? (car a) 'parameters))))
lst)
escaped))

;; arg names from keyword arguments, and positional arguments with escaped names
(define (safe-llist-keyword-args lst)
(let ((kwargs (apply nconc
(map cdr
(filter (lambda (a) (and (pair? a) (eq? (car a) 'parameters)))
lst)))))
(append
(safe-arg-names kwargs #f)
(safe-arg-names kwargs #t)
;; count escaped argument names as "keywords" to prevent renaming
(safe-llist-positional-args lst #t))))

;; resolve-expansion-vars-with-new-env, but turn on `inarg` once we get inside
;; the formal argument list. `e` in general might be e.g. `(f{T}(x)::T) where T`,
;; and we want `inarg` to be true for the `(x)` part.
(define (resolve-in-function-lhs e env m inarg)
(define (recur x) (resolve-in-function-lhs x env m inarg))
(define (other x) (resolve-expansion-vars-with-new-env x env m inarg))
(case (car e)
((where) `(where ,(recur (cadr e)) ,@(map other (cddr e))))
((|::|) `(|::| ,(recur (cadr e)) ,(other (caddr e))))
((call) `(call ,(other (cadr e))
,@(map (lambda (x)
(resolve-expansion-vars-with-new-env x env m #t))
(cddr e))))
(else (other e))))

(define (new-expansion-env-for x env (outermost #f))
(let ((introduced (pattern-expand1 vars-introduced-by-patterns x)))
(if (or (atom? x)
Expand Down Expand Up @@ -252,12 +325,9 @@
(cdr e))))

((= function)
(if (and (pair? (cadr e)) (eq? (caadr e) 'call))
(if (and (pair? (cadr e)) (function-def? e))
;; in (kw x 1) inside an arglist, the x isn't actually a kwarg
`(,(car e) (call ,(resolve-expansion-vars-with-new-env (cadadr e) env m inarg)
,@(map (lambda (x)
(resolve-expansion-vars-with-new-env x env m #t))
(cddr (cadr e))))
`(,(car e) ,(resolve-in-function-lhs (cadr e) env m inarg)
,(resolve-expansion-vars-with-new-env (caddr e) env m inarg))
`(,(car e) ,@(map (lambda (x)
(resolve-expansion-vars-with-new-env x env m inarg))
Expand Down Expand Up @@ -308,6 +378,8 @@
((eq? (car e) 'call) (decl-var* (cadr e)))
((eq? (car e) '=) (decl-var* (cadr e)))
((eq? (car e) 'curly) (decl-var* (cadr e)))
((eq? (car e) '|::|) (decl-var* (cadr e)))
((eq? (car e) 'where) (decl-var* (cadr e)))
(else (decl-var e))))

(define (decl-vars* e)
Expand All @@ -318,7 +390,7 @@
(define (function-def? e)
(and (pair? e) (or (eq? (car e) 'function) (eq? (car e) '->)
(and (eq? (car e) '=) (length= e 3)
(pair? (cadr e)) (eq? (caadr e) 'call)))))
(eventually-call (cadr e))))))

(define (find-declared-vars-in-expansion e decl (outer #t))
(cond ((or (not (pair? e)) (quoted? e)) '())
Expand All @@ -335,11 +407,11 @@
((eq? (car e) 'escape) '())
((and (not outer) (function-def? e))
;; pick up only function name
(let ((fname (cond ((eq? (car e) '=) (cadr (cadr e)))
(let ((fname (cond ((eq? (car e) '=) (decl-var* (cadr e)))
((eq? (car e) 'function)
(cond ((atom? (cadr e)) (cadr e))
((eq? (car (cadr e)) 'tuple) #f)
(else (cadr (cadr e)))))
(else (decl-var* (cadr e)))))
(else #f))))
(if (symbol? fname)
(list fname)
Expand Down
62 changes: 62 additions & 0 deletions test/core.jl
Original file line number Diff line number Diff line change
Expand Up @@ -5018,3 +5018,65 @@ for i in 1:10
@test ptr1 === ptr2
@test ptr1 % 16 == 0
end

# issue #21581
global function f21581()::Int
return 2.0
end
@test f21581() === 2
global g21581()::Int = 2.0
@test g21581() === 2
module M21581
macro bar()
:(foo21581(x)::Int = x)
end
M21581.@bar
end
@test M21581.foo21581(1) === 1

module N21581
macro foo(var)
quote
function f(x::T = 1) where T
($(esc(var)), x)
end
f()
end
end
end
let x = 8
@test @N21581.foo(x) === (8, 1)
end

# issue #22122
let
global @inline function f22122(x::T) where {T}
T
end
end
@test f22122(1) === Int

# issue #22026
module M22026

macro foo(TYP)
quote
global foofunction
foofunction(x::Type{T}) where {T<:Number} = x
end
end
struct Foo end
@foo Foo

macro foo2()
quote
global foofunction2
(foofunction2(x::T)::Float32) where {T<:Number} = 2x
end
end

@foo2

end
@test M22026.foofunction(Int16) === Int16
@test M22026.foofunction2(3) === 6.0f0
20 changes: 20 additions & 0 deletions test/parse.jl
Original file line number Diff line number Diff line change
Expand Up @@ -762,6 +762,22 @@ end
let ex = expand(:(@M16096.iter))
@test !(isa(ex,Expr) && ex.head === :error)
end
macro f16096()
quote
g16096($(esc(:x))) = 2x
end
end
let g = @f16096
@test g(3) == 6
end
macro f16096_2()
quote
g16096_2(;$(esc(:x))=2) = 2x
end
end
let g = @f16096_2
@test g() == 4
end

# issue #15838
module A15838
Expand Down Expand Up @@ -1195,3 +1211,7 @@ end
# issue #16937
@test expand(:(f(2, a=1, w=3, c=3, w=4, b=2))) == Expr(:error,
"keyword argument \"w\" repeated in call to \"f\"")

# issue #19351
# adding return type decl should not affect parse of function body
@test :(t(abc) = 3).args[2] == :(t(abc)::Int = 3).args[2]
4 changes: 4 additions & 0 deletions test/staged.jl
Original file line number Diff line number Diff line change
Expand Up @@ -224,3 +224,7 @@ g10178(x) = f10178(x)
end
g10178(x) = f10178(x)
@test g10178(5) == 10

# issue #22135
@generated f22135(x::T) where T = x
@test f22135(1) === Int