From 59cc1f2df83eb24e5cfc0abedb7a6fed57b59ebf Mon Sep 17 00:00:00 2001 From: Marius Gerbershagen Date: Sat, 20 Mar 2021 20:48:50 +0100 Subject: [PATCH] cmp: fix compiler macro for nth and nthcdr We were doing no error checking that we got the right number of arguments. Also remove the manual creation of forms with a backquote for better readability. --- src/cmp/cmpopt-cons.lsp | 40 ++++++++++++++++++++-------------------- 1 file changed, 20 insertions(+), 20 deletions(-) diff --git a/src/cmp/cmpopt-cons.lsp b/src/cmp/cmpopt-cons.lsp index 7858365ff..fbf43a085 100644 --- a/src/cmp/cmpopt-cons.lsp +++ b/src/cmp/cmpopt-cons.lsp @@ -88,28 +88,28 @@ ;;; NTH / NTHCDR ;;; -(define-compiler-macro nth (&whole whole &rest args) - (case (car args) - (0 (cons 'CAR (cdr args))) - (1 (cons 'CADR (cdr args))) - (2 (cons 'CADDR (cdr args))) - (3 (cons 'CADDDR (cdr args))) - (4 (list 'CAR (cons 'CDDDDR (cdr args)))) - (5 (list 'CADR (cons 'CDDDDR (cdr args)))) - (6 (list 'CADDR (cons 'CDDDDR (cdr args)))) - (7 (list 'CADDDR (cons 'CDDDDR (cdr args)))) +(define-compiler-macro nth (&whole whole n list) + (case n + (0 `(car ,list)) + (1 `(cadr ,list)) + (2 `(caddr ,list)) + (3 `(cadddr ,list)) + (4 `(car (cddddr ,list))) + (5 `(cadr (cddddr ,list))) + (6 `(caddr (cddddr ,list))) + (7 `(cadddr (cddddr ,list))) (t whole))) -(define-compiler-macro nthcdr (&whole whole &rest args) - (case (car args) - (0 (second args)) - (1 (cons 'CDR (cdr args))) - (2 (cons 'CDDR (cdr args))) - (3 (cons 'CDDDR (cdr args))) - (4 (cons 'CDDDDR (cdr args))) - (5 (list 'CDR (cons 'CDDDDR (cdr args)))) - (6 (list 'CDDR (cons 'CDDDDR (cdr args)))) - (7 (list 'CDDDR (cons 'CDDDDR (cdr args)))) +(define-compiler-macro nthcdr (&whole whole n list) + (case n + (0 list) + (1 `(cdr ,list)) + (2 `(cddr ,list)) + (3 `(cdddr ,list)) + (4 `(cddddr ,list)) + (5 `(cdr (cddddr ,list))) + (6 `(cddr (cddddr ,list))) + (7 `(cdddr (cddddr ,list))) (t whole))) ;;;