Skip to content

Commit

Permalink
fix some macro expander issues with new 0.6 syntax
Browse files Browse the repository at this point in the history 
fixes #22135, fixes #22122, fixes #22026, fixes #21581
  • Loading branch information
@JeffBezanson
JeffBezanson committed May 31, 2017
1 parent 88c21f4 commit 4881b57
Show file tree
Hide file tree
Showing 6 changed files with 122 additions and 22 deletions.
9 changes: 8 additions & 1 deletion base/essentials.jl
View file
Original file line number Diff line number Diff line change
Expand Up @@ -34,9 +34,16 @@ 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...)...)

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]))
f.head = :stagedfunction
return Expr(:escape, f)
else
Expand Down
2 changes: 1 addition & 1 deletion src/julia-parser.scm
View file
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
17 changes: 9 additions & 8 deletions src/julia-syntax.scm
View file
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 @@ -1330,7 +1330,7 @@
(expand-forms (expand-decls (car e) (cdr e) #f))))

(define (assigned-name e)
(if (and (pair? e) (memq (car e) '(call curly)))
(if (and (pair? e) (memq (car e) '(call curly where |::|)))
(assigned-name (cadr e))
e))

Expand Down Expand Up @@ -2428,7 +2428,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
50 changes: 38 additions & 12 deletions src/macroexpand.scm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -62,17 +62,22 @@
sparams)))))

;; function definition
(pattern-lambda (function (call name . argl) body)
(pattern-lambda (function (-$ (call name . argl) (|::| (call name . argl) _t)) body)
(cons 'varlist (llist-vars (fix-arglist argl))))
(pattern-lambda (function (where (-$ (call name . argl) (|::| (call name . argl) _t)) . wheres) body)
(cons 'varlist (append (llist-vars (fix-arglist argl))
(map typevar-expr-name 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)
Expand All @@ -82,6 +87,10 @@
(list a))))
(cons 'varlist (llist-vars (fix-arglist a)))))

;; where
(pattern-lambda (where ex . vars)
(cons 'varlist (map typevar-expr-name vars)))

;; let
(pattern-lambda (let ex . binds)
(let loop ((binds binds)
Expand Down Expand Up @@ -143,13 +152,17 @@
(pattern-lambda (function (call (curly name . sparams) . argl) body)
(cons 'varlist (llist-keywords (fix-arglist argl))))

(pattern-lambda (function (call name . argl) body)
(pattern-lambda (function (-$ (call name . argl) (|::| (call name . argl) _t)) body)
(cons 'varlist (llist-keywords (fix-arglist argl))))
(pattern-lambda (function (where (-$ (call name . argl) (|::| (call name . argl) _t)) . wheres) body)
(cons 'varlist (llist-keywords (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 +179,20 @@

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

;; 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`.
(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 +279,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 +332,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 +344,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 +361,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
View file
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
4 changes: 4 additions & 0 deletions test/staged.jl
View file
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

0 comments on commit 4881b57

Please sign in to comment.