diff --git a/src/CHANGELOG b/src/CHANGELOG index ffcce4efc..a9e5f7ca9 100755 --- a/src/CHANGELOG +++ b/src/CHANGELOG @@ -25,10 +25,10 @@ ECL 10.4.2: on whether it is going to be processed by the interpreter or by the C compiler. (defun example () - (ext:with-backend (:bytecodes) (print 3)) - (ext:with-backend (:c/c++) (print 2))) - The two currently available backends are :bytecodes and :c/c++. Note that - when the backend does not match the value, the form is replaced with (VALUES). + (ext:with-backend + :bytecodes (print 3) + :c/c++ (print 2))) + The two currently available backends are :bytecodes and :c/c++. ECL 10.4.1: diff --git a/src/c/compiler.d b/src/c/compiler.d index dee7a2107..19779b197 100644 --- a/src/c/compiler.d +++ b/src/c/compiler.d @@ -1198,10 +1198,14 @@ c_until(cl_env_ptr env, cl_object body, int flags) { static int c_with_backend(cl_env_ptr env, cl_object args, int flags) { - cl_object backend = pop(&args); - if (!ecl_member_eq(@':bytecodes', backend)) - args = Cnil; - return compile_body(env, args, flags); + cl_object forms = Cnil; + while (!Null(args)) { + cl_object tag = pop(&args); + cl_object form = pop(&args); + if (tag == @':bytecodes') + forms = CONS(form, forms); + } + return compile_body(env, forms, flags); } static int diff --git a/src/cmp/cmpeval.lsp b/src/cmp/cmpeval.lsp index fb97a8a2d..003aa1a99 100644 --- a/src/cmp/cmpeval.lsp +++ b/src/cmp/cmpeval.lsp @@ -137,9 +137,11 @@ ) (defun c1with-backend (forms) - (destructuring-bind ((&rest conditions) &rest body) - forms - (c1progn (and (member :c/c++ conditions) body)))) + (c1progn (loop for tag = (pop forms) + for form = (pop forms) + while tag + when (eq tag :c/c++) + collect form))) (defun c1progn (forms) (cond ((endp forms) (t1/c1expr 'NIL)) diff --git a/src/new-cmp/cmpspecial.lsp b/src/new-cmp/cmpspecial.lsp index 1e5d78005..fe2c73432 100644 --- a/src/new-cmp/cmpspecial.lsp +++ b/src/new-cmp/cmpspecial.lsp @@ -29,11 +29,11 @@ (c1translate `(THE ,type ,destination) value))) (defun c1with-backend (destination forms) - (destructuring-bind ((&rest conditions) &rest body) - forms - (c1progn destination - (and (member :c-backend conditions) - body)))) + (c1progn destination (loop for tag = (pop forms) + for form = (pop forms) + while tag + when (eq tag :c/c++) + collect form))) (defun c1compiler-let (destination args &aux (symbols nil) (values nil)) (when (endp args) (too-few-args 'COMPILER-LET 1 0))