From 2ae6347fa6b9cc33d09cb752831190150f763b20 Mon Sep 17 00:00:00 2001 From: Jeff Bezanson Date: Wed, 2 Aug 2017 17:16:55 -0400 Subject: [PATCH] fix #9535, evaluate positional and keyword args strictly left-to-right --- src/ast.scm | 4 ++ src/julia-syntax.scm | 102 ++++++++++++++++++++++--------------------- test/keywordargs.jl | 15 +++++++ 3 files changed, 72 insertions(+), 49 deletions(-) diff --git a/src/ast.scm b/src/ast.scm index c821de9496b5e..b9fc4c7e90bb0 100644 --- a/src/ast.scm +++ b/src/ast.scm @@ -239,6 +239,10 @@ (define (simple-atom? x) (or (number? x) (string? x) (char? x) (eq? x 'true) (eq? x 'false))) +;; identify some expressions that are safe to repeat +(define (effect-free? e) + (or (not (pair? e)) (ssavalue? e) (sym-dot? e) (quoted? e) (equal? e '(null)))) + ;; get the variable name part of a declaration, x::int => x (define (decl-var v) (if (decl? v) (cadr v) v)) diff --git a/src/julia-syntax.scm b/src/julia-syntax.scm index 0e02d9e4eedfb..fa689fdae0580 100644 --- a/src/julia-syntax.scm +++ b/src/julia-syntax.scm @@ -20,10 +20,6 @@ (fill-missing-argname a unused)))) l)) -;; identify some expressions that are safe to repeat -(define (effect-free? e) - (or (not (pair? e)) (ssavalue? e) (sym-dot? e) (quoted? e) (equal? e '(null)))) - ;; expanding comparison chains: (comparison a op b op c ...) ;; accumulate a series of comparisons, with the given "and" constructor, @@ -1447,30 +1443,52 @@ ;; retuns a pair (expr . assignments) ;; where 'assignments' is a list of needed assignment statements (define (remove-argument-side-effects e) - (let ((a '())) - (cond - ((not (pair? e)) - (cons e '())) - (else - (cons (map (lambda (x) - (cond - ((not (effect-free? x)) - (let ((g (make-ssavalue))) - (if (or (eq? (car x) '...) (eq? (car x) '&)) - (if (and (pair? (cadr x)) - (not (quoted? (cadr x)))) - (begin (set! a (cons `(= ,g ,(cadr x)) a)) - `(,(car x) ,g)) - x) - (begin (set! a (cons `(= ,g ,x) a)) - g)))) + (if + (not (pair? e)) + (cons e '()) + (let ((a '())) + (cons + (cons + (car e) + (map (lambda (x) + (cond ((effect-free? x) x) + ((or (eq? (car x) '...) (eq? (car x) '&)) + (if (effect-free? (cadr x)) + x + (let ((g (make-ssavalue))) + (begin (set! a (cons `(= ,g ,(cadr x)) a)) + `(,(car x) ,g))))) + ((eq? (car x) 'kw) + (if (effect-free? (caddr x)) + x + (let ((g (make-ssavalue))) + (begin (set! a (cons `(= ,g ,(caddr x)) a)) + `(kw ,(cadr x) ,g))))) (else - x))) - e) - (reverse a)))))) + (let ((g (make-ssavalue))) + (begin (set! a (cons `(= ,g ,x) a)) + g))))) + (cdr e))) + (reverse a))))) + +(define (lower-kw-call f args) + (let* ((p (if (has-parameters? args) (car args) '(parameters))) + (args (if (has-parameters? args) (cdr args) args))) + (let* ((parg-stmts (remove-argument-side-effects `(call ,f ,@args))) + (call-ex (car parg-stmts)) + (fexpr (cadr call-ex)) + (cargs (cddr call-ex)) + (para-stmts (remove-argument-side-effects p)) + (pkws (cdr (car para-stmts)))) + `(block + ,.(cdr parg-stmts) + ,.(cdr para-stmts) + ,(receive + (kws pargs) (separate kwarg? cargs) + (lower-kw-call- fexpr (append! kws pkws) pargs)))))) ;; lower function call containing keyword arguments -(define (lower-kw-call fexpr kw0 pa) +(define (lower-kw-call- fexpr kw0 pa) ;; check for keyword arguments syntactically passed more than once (let ((dups (has-dups (map cadr (filter kwarg? kw0))))) @@ -1478,14 +1496,9 @@ (error (string "keyword argument \"" (car dups) "\" repeated in call to \"" (deparse fexpr) "\"")))) (define (kwcall-unless-empty f pa kw-container-test kw-container) - (let* ((expr_stmts (remove-argument-side-effects `(call ,f ,@pa))) - (pa (cddr (car expr_stmts))) - (stmts (cdr expr_stmts))) - `(block - ,@stmts - (if (call (top isempty) ,kw-container-test) - (call ,f ,@pa) - (call (call (core kwfunc) ,f) ,kw-container ,f ,@pa))))) + `(if (call (top isempty) ,kw-container-test) + (call ,f ,@pa) + (call (call (core kwfunc) ,f) ,kw-container ,f ,@pa))) (let ((f (if (sym-ref? fexpr) fexpr (make-ssavalue)))) `(block @@ -2121,23 +2134,14 @@ (expand-forms (lower-ccall name RT (cdr argtypes) args (if have-cconv cconv 'ccall)))))) - ((and (pair? (caddr e)) - (eq? (car (caddr e)) 'parameters)) - ;; (call f (parameters . kwargs) ...) - (expand-forms - (receive - (kws args) (separate kwarg? (cdddr e)) - (let ((kws (append kws (cdr (caddr e))))) - (if (null? kws) - ;; empty parameters block; issue #18845 - `(call ,f ,@args) - (lower-kw-call f kws args)))))) - ((any kwarg? (cddr e)) - ;; (call f ... (kw a b) ...) + ((any kwarg? (cddr e)) ;; f(..., a=b, ...) + (expand-forms (lower-kw-call f (cddr e)))) + ((has-parameters? (cddr e)) ;; f(...; ...) (expand-forms - (receive - (kws args) (separate kwarg? (cddr e)) - (lower-kw-call f kws args)))) + (if (null? (cdr (car (cddr e)))) + ;; empty parameters block; issue #18845 + `(call ,f ,@(cdddr e)) + (lower-kw-call f (cddr e))))) ((any vararg? (cddr e)) ;; call with splat (let ((argl (cddr e))) diff --git a/test/keywordargs.jl b/test/keywordargs.jl index e1dfe73e730a3..23ac6aa694e12 100644 --- a/test/keywordargs.jl +++ b/test/keywordargs.jl @@ -294,3 +294,18 @@ let a = 10 @test f17240(b=3) == (9, 3) @test f17240(a=2, b=1) == (2, 1) end + +# issue #9535 - evaluate all arguments left-to-right +let counter = 0 + function get_next() + counter += 1 + return counter + end + f(args...; kws...) = (args, kws) + @test f(get_next(), a=get_next(), get_next(), + b=get_next(), get_next(), + [get_next(), get_next()]...; c=get_next(), + [(:d, get_next()), (:f, get_next())]...) == + ((1,3,5,6,7), + Any[(:a,2), (:b,4), (:c,8), (:d,9), (:f,10)]) +end