From: Owen Rodley Date: Sat, 4 May 2013 00:25:42 +0000 (+1200) Subject: PAIRLIS X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=37b1b658da3d73aa304df83cc3e8bf8aa6548a25;p=jscl.git PAIRLIS --- diff --git a/src/list.lisp b/src/list.lisp index 09092ad..b353700 100644 --- a/src/list.lisp +++ b/src/list.lisp @@ -187,6 +187,13 @@ (defun acons (key datum alist) (cons (cons key datum) alist)) +(defun pairlis (keys data &optional (alist ())) + (while keys + (setq alist (acons (car keys) (car data) alist)) + (setq keys (cdr keys)) + (setq data (cdr data))) + alist) + (define-setf-expander car (x) (let ((cons (gensym)) diff --git a/src/toplevel.lisp b/src/toplevel.lisp index c03f370..b238135 100644 --- a/src/toplevel.lisp +++ b/src/toplevel.lisp @@ -67,8 +67,8 @@ make-symbol mapcar member minusp mod multiple-value-bind multiple-value-call multiple-value-list multiple-value-prog1 nconc nil ninth not nreconc nth nthcdr null numberp or otherwise - package-name package-use-list packagep parse-integer plusp pop - prin1-to-string print proclaim prog1 prog2 progn psetq push + package-name package-use-list packagep pairlis parse-integer plusp + pop prin1-to-string print proclaim prog1 prog2 progn psetq push quote read-from-string remove remove-if remove-if-not return return-from revappend reverse rplaca rplacd second set setf seventh setq sixth some string string-upcase string= stringp subseq subst diff --git a/tests/list.lisp b/tests/list.lisp index 7969b0b..78cec44 100644 --- a/tests/list.lisp +++ b/tests/list.lisp @@ -44,6 +44,12 @@ (acons 1 2 (list (cons 3 4))))) (test (equal (list (cons 1 2)) (acons 1 2 ()))) +; PAIRLIS +(test (equal (list (cons 1 3) (cons 0 2)) + (pairlis '(0 1) '(2 3)))) +(test (equal (list (cons 1 2) (cons 'a 'b)) + (pairlis '(1) '(2) (list (cons 'a 'b))))) + ; SUBST ; Can't really test this until EQUAL works properly on lists