Skip to content

Commit

Permalink
fix JuliaLang#28992, returning dot operator calls from macros (JuliaL…
Browse files Browse the repository at this point in the history
  • Loading branch information
JeffBezanson authored Apr 3, 2019
1 parent 965b73c commit 8200865
Show file tree
Hide file tree
Showing 4 changed files with 56 additions and 36 deletions.
39 changes: 22 additions & 17 deletions src/ast.scm
Original file line number Diff line number Diff line change
Expand Up @@ -41,6 +41,11 @@
(string head "\n" (indented-block lst ilvl)
(string.rep " " ilvl) "end"))

(define (deparse-colon-dot e)
(if (dotop? e)
(string ":" (deparse e))
(deparse e)))

(define (deparse e (ilvl 0))
(cond ((or (symbol? e) (number? e)) (string e))
((string? e) (print-to-string e))
Expand All @@ -57,9 +62,9 @@
((eq? (car e) '|.|)
(string (deparse (cadr e)) '|.|
(cond ((and (pair? (caddr e)) (memq (caaddr e) '(quote inert)))
(deparse (cadr (caddr e))))
(deparse-colon-dot (cadr (caddr e))))
((and (pair? (caddr e)) (eq? (caaddr e) 'copyast))
(deparse (cadr (cadr (caddr e)))))
(deparse-colon-dot (cadr (cadr (caddr e)))))
(else
(string #\( (deparse (caddr e)) #\))))))
((memq (car e) '(... |'|))
Expand Down Expand Up @@ -220,7 +225,7 @@
((const) (string "const " (deparse (cadr e))))
((top) (deparse (cadr e)))
((core) (string "Core." (deparse (cadr e))))
((globalref) (string (deparse (cadr e)) "." (deparse (caddr e))))
((globalref) (string (deparse (cadr e)) "." (deparse-colon-dot (caddr e))))
((outerref) (string (deparse (cadr e))))
((ssavalue) (string "SSAValue(" (cadr e) ")"))
((line) (if (length= e 2)
Expand Down Expand Up @@ -370,25 +375,25 @@
(cadr (caddr e))
e))

(define (dotop? o) (and (symbol? o) (eqv? (string.char (string o) 0) #\.)
(not (eq? o '|.|))
(not (eqv? (string.char (string o) 1) #\.))))
(define (identifier-name e)
(cond ((symbol? e) e)
((globalref? e) (caddr e))
(else e)))

(define (dotop-named? e) (dotop? (identifier-name e)))

; convert '.xx to 'xx
;; convert '.xx to 'xx
(define (undotop op)
(let ((str (string op)))
(assert (eqv? (string.char str 0) #\.))
(symbol (string.sub str 1 (length str)))))
(if (globalref? op)
`(globalref ,(cadr op) ,(undotop (caddr op)))
(let ((str (string op)))
(assert (eqv? (string.char str 0) #\.))
(symbol (string.sub str 1 (length str))))))

; convert '.xx to 'xx, and (|.| _ '.xx) to (|.| _ 'xx), and otherwise return #f
;; raise an error for using .op as a function name
(define (check-dotop e)
(if (symbol? e)
(let ((str (string e)))
(if (and (eqv? (string.char str 0) #\.)
(not (eq? e '|.|))
(not (eqv? (string.char str 1) #\.)))
(error (string "invalid function name \"" e "\""))))
(if (dotop-named? e)
(error (string "invalid function name \"" (deparse e) "\""))
(if (pair? e)
(if (eq? (car e) '|.|)
(check-dotop (caddr e))
Expand Down
11 changes: 9 additions & 2 deletions src/julia-parser.scm
Original file line number Diff line number Diff line change
Expand Up @@ -141,12 +141,19 @@

;; characters that can be in an operator
(define opchar? (Set op-chars))
(define operator? (SuffSet operators))

(define dot-operators (filter (lambda (o)
(and (not (eq? o '|.|))
(eqv? (string.char (string o) 0) #\.)
(not (eqv? (string.char (string o) 1) #\.))))
operators))
(define dotop? (SuffSet dot-operators))
;; characters that can follow . in an operator
(define dot-opchar? (Set
(delete-duplicates
(map (lambda (op) (string.char (string op) 1))
(cons `|..| (filter dotop? operators))))))
(define operator? (SuffSet operators))
(cons `|..| dot-operators)))))

(define initial-reserved-words '(begin while if for try return break continue
function macro quote let local global const do
Expand Down
34 changes: 17 additions & 17 deletions src/julia-syntax.scm
Original file line number Diff line number Diff line change
Expand Up @@ -46,10 +46,10 @@
(arg2 (if (and (pair? arg)
(pair? (cdddr e)))
(make-ssavalue) arg)))
(if (and (not (dotop? (cadr e)))
(if (and (not (dotop-named? (cadr e)))
(length> e 5)
(pair? (cadddr (cdr e)))
(dotop? (cadddr (cddr e))))
(dotop-named? (cadddr (cddr e))))
;; look ahead: if the 2nd argument of the next comparison is also
;; an argument to an eager (dot) op, make sure we don't skip the
;; initialization of its variable by short-circuiting
Expand All @@ -68,7 +68,7 @@
(define (expand-scalar-compare e)
(comp-accum e
(lambda (a b) `(&& ,a ,b))
(lambda (x) (or (not (length> x 2)) (dotop? (cadr x))))
(lambda (x) (or (not (length> x 2)) (dotop-named? (cadr x))))
compare-one))

;; convert a series of scalar and vector comparisons into & calls,
Expand All @@ -79,7 +79,7 @@
(lambda (a b) `(call .& ,a ,b))
(lambda (x) (not (length> x 2)))
(lambda (e)
(if (dotop? (cadr e))
(if (dotop-named? (cadr e))
(compare-one e)
(expand-scalar-compare e)))))

Expand Down Expand Up @@ -1598,7 +1598,7 @@
(if (and (null? splat)
(length= expr 3) (eq? (car expr) 'call)
(eq? (caddr expr) argname)
(not (dotop? (cadr expr)))
(not (dotop-named? (cadr expr)))
(not (expr-contains-eq argname (cadr expr))))
(cadr expr) ;; eta reduce `x->f(x)` => `f`
(let ((expr (cond ((and flat (pair? expr) (eq? (car expr) 'generator))
Expand Down Expand Up @@ -1669,18 +1669,18 @@
(cond ((or (atom? x) (eq? (car x) 'quote) (eq? (car x) 'inert) (eq? (car x) '$))
`(call (top getproperty) ,f ,x))
((eq? (car x) 'tuple)
(if (and (eq? f '^) (length= x 3) (integer? (caddr x)))
(make-fuse (expand-forms '(top literal_pow))
(list '^ (cadr x) (expand-forms `(call (call (core apply_type) (top Val) ,(caddr x))))))
(make-fuse f (cdr x))))
(if (and (eq? (identifier-name f) '^) (length= x 3) (integer? (caddr x)))
(make-fuse '(top literal_pow)
(list f (cadr x) (expand-forms `(call (call (core apply_type) (top Val) ,(caddr x))))))
(make-fuse f (cdr x))))
(else
(error (string "invalid syntax \"" (deparse e) "\"")))))
(if (and (pair? e) (eq? (car e) 'call) (dotop? (cadr e)))
(if (and (pair? e) (eq? (car e) 'call) (dotop-named? (cadr e)))
(let ((f (undotop (cadr e))) (x (cddr e)))
(if (and (eq? f '^) (length= x 2) (integer? (cadr x)))
(make-fuse (expand-forms '(top literal_pow))
(list '^ (car x) (expand-forms `(call (call (core apply_type) (top Val) ,(cadr x))))))
(make-fuse f x)))
(if (and (eq? (identifier-name f) '^) (length= x 2) (integer? (cadr x)))
(make-fuse '(top literal_pow)
(list f (car x) (expand-forms `(call (call (core apply_type) (top Val) ,(cadr x))))))
(make-fuse f x)))
e)))
(let ((e (dot-to-fuse rhs #t)) ; an expression '(fuse func args) if expr is a dot call
(lhs-view (ref-to-view lhs))) ; x[...] expressions on lhs turn in to view(x, ...) to update x in-place
Expand Down Expand Up @@ -2035,7 +2035,7 @@
(lambda (e)
(if (length> e 2)
(let ((f (cadr e)))
(cond ((dotop? f)
(cond ((dotop-named? f)
(expand-fuse-broadcast '() `(|.| ,(undotop f) (tuple ,@(cddr e)))))
((eq? f 'ccall)
(if (not (length> e 4)) (error "too few arguments to ccall"))
Expand Down Expand Up @@ -2085,9 +2085,9 @@
(expand-forms
`(call (core _apply) ,f ,@(tuple-wrap argl '())))))

((and (eq? f '^) (length= e 4) (integer? (cadddr e)))
((and (eq? (identifier-name f) '^) (length= e 4) (integer? (cadddr e)))
(expand-forms
`(call (top literal_pow) ^ ,(caddr e) (call (call (core apply_type) (top Val) ,(cadddr e))))))
`(call (top literal_pow) ,f ,(caddr e) (call (call (core apply_type) (top Val) ,(cadddr e))))))
(else
(map expand-forms e))))
(map expand-forms e)))
Expand Down
8 changes: 8 additions & 0 deletions test/syntax.jl
Original file line number Diff line number Diff line change
Expand Up @@ -1839,3 +1839,11 @@ end
# issue #31404
f31404(a, b; kws...) = (a, b, kws.data)
@test f31404(+, (Type{T} where T,); optimize=false) === (+, (Type,), (optimize=false,))

# issue #28992
macro id28992(x) x end
@test @id28992(1 .+ 2) == 3
@test Meta.isexpr(Meta.lower(@__MODULE__, :(@id28992((.+)(a,b) = 0))), :error)
@test @id28992([1] .< [2] .< [3]) == [true]
@test @id28992(2 ^ -2) == 0.25
@test @id28992(2 .^ -2) == 0.25

0 comments on commit 8200865

Please sign in to comment.