Merge pull request #89 from Strigoides/subseq

SUBSEQ implementation for lists

diff --git a/src/compiler.lisp b/src/compiler.lisp
index be10266..3fe2823 100644 (file)
--- a/src/compiler.lisp
+++ b/src/compiler.lisp
@@ -558,7 +558,7 @@
     ((floatp sexp) (float-to-string sexp))
     ((characterp sexp) (code "\"" (escape-string (string sexp)) "\""))
     (t
-     (or (cdr (assoc sexp *literal-table* :test #'equal))
+     (or (cdr (assoc sexp *literal-table* :test #'eql))
          (let ((dumped (typecase sexp
                          (symbol (dump-symbol sexp))
                          (string (dump-string sexp))

diff --git a/src/list.lisp b/src/list.lisp
index 7a4ca6d..d515e52 100644 (file)
--- a/src/list.lisp
+++ b/src/list.lisp
@@ -161,6 +161,13 @@
                (rplaca tail (cdar tail)))
              (collect (apply func elems))))))))
 
+(defun mapc (func &rest lists)
+  (do* ((elems (map1 #'car lists) (map1 #'car lists-rest))
+        (lists-rest (map1 #'cdr lists) (map1 #'cdr lists-rest)))
+       ((dolist (x elems) (when (null x) (return t)))
+        (car lists))
+    (apply func elems)))
+
 (defun last (x)
   (while (consp (cdr x))
     (setq x (cdr x)))

diff --git a/src/toplevel.lisp b/src/toplevel.lisp
index 544022f..0698a0b 100644 (file)
--- a/src/toplevel.lisp
+++ b/src/toplevel.lisp
@@ -65,7 +65,7 @@
           get-universal-time go identity if in-package incf integerp intern
           intersection keywordp labels lambda last length let let*
           lisp-implementation-type list list* list-all-packages listp loop
-          make-array make-package make-symbol mapcar member minusp mod
+          make-array make-package make-symbol mapc 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 pairlis

diff --git a/tests/list.lisp b/tests/list.lisp
index 2f1b57c..9bb2996 100644 (file)
--- a/tests/list.lisp
+++ b/tests/list.lisp
@@ -87,3 +87,9 @@
              (bar (pop foo)))
         (and (= bar 1)
              (= (car foo) 2))))
+
+;; MAPC
+(test (equal (mapc #'+ '(1 2) '(3) '(4 5 6)) '(1 2)))
+(test (let (foo)
+        (mapc (lambda (x y z) (print (list x y z)) (push (+ x y z) foo)) '(1 2) '(3) '(4 5 6))
+        (equal foo '(8))))