Commit f768db10 authored by Juergen Nickelsen's avatar Juergen Nickelsen
Browse files

dolist ok, canceled doseq (and related test cases); list* and 026

parent 610654dc

Fundamental.lisp

+16 −24
Original line number Diff line number Diff line
@@ -140,31 +140,16 @@ 
    poparg-item))



(defspecial dolist (formargs &rest body)

  "(dolist (loopvar listform resultform) . body)"

  (let ((var (car formargs))

        (list (eval (cadr formargs)))

        resultform)

    (when (consp (cddr formargs))

      (setq resultform (caddr formargs)))

    (while (consp list)

      (set var (pop list))

  "(dolist (loopvar listform [resultform [start [end]]]) . body)"

  (let* ((dolist-loopvar (car formargs))

         (dolist-start (or (eval (cadddr formargs)) 0))

         (dolist-end (eval (car (cddddr formargs))))

         (dolist-list (sublist (eval (cadr formargs)) dolist-start dolist-end))

         (dolist-resultform (caddr formargs)))

    ;; (format t "dolist-list %s\n" dolist-list)

    (while (set dolist-loopvar (pop dolist-list))

      (eval-list body))

    (eval resultform)))



(defspecial doseq (formargs &rest body)

  "(doseq (loopvar seq [resultform [start [end]]]) . body)"

  (let* ((var (car formargs))

         (start (or (cadddr formargs) 0))

         (end (car (cddddr formargs)))

         (seq (eval (subseq (cadr formargs) start )))

         ((resultform (caddr formargs)))

         ((doseq-list (if (stringp seq)

                          (split-string "" seq)

                        seq))))

      (while (consp doseq-list)

        (set var (pop doseq-list))

        (eval-list body))

      (eval resultform)))

    (eval dolist-resultform)))



(defun sequencep (object)

  "return t if OBJECT is a sequence (list or string), nil else"
@@ -294,6 +279,13 @@ 
      0

    (1+ (length (cdr l)))))



(defun list* (&rest args+)

  "list of all args, with last arg as the cdr of the last pair constructed"

  (if (null (cdr args+))

      (car args+)

    (cons (car args+)

          (apply #'list* (cdr args+)))))



(defun head (l n)

  "of list L, take the first N elements"

  (if (null l)

tests/025-dolist.lisp

+15 −15
Original line number Diff line number Diff line
@@ -15,18 +15,18 @@ 
             (push el result)))

         '(d e f))



(testcmp "doseq 0"

         '(let (result)

           (doseq (el "abcdefghi" (apply #'string (nreverse result)))

             (push el result)))

         "abcdefghi")

(testcmp "doseq 1"

         '(let (result)

           (doseq (el "abcdefghi" (apply #'string (nreverse result)) 3)

             (push el result)))

         "defghi")

(testcmp "doseq 2"

         '(let (result)

           (doseq (el "abcdefghi" (apply #'string (nreverse result)) 3 6)

             (push el result)))

         "def")
 
;; (testcmp "doseq 0"

;;          '(let (result)

;;            (doseq (el "abcdefghi" (apply #'string (nreverse result)))

;;              (push el result)))

;;          "abcdefghi")

;; (testcmp "doseq 1"

;;          '(let (result)

;;            (doseq (el "abcdefghi" (apply #'string (nreverse result)) 3)

;;              (push el result)))

;;          "defghi")

;; (testcmp "doseq 2"

;;          '(let (result)

;;            (doseq (el "abcdefghi" (apply #'string (nreverse result)) 3 6)

;;              (push el result)))

;;          "def")

tests/034-subseq.lisp

+24 −0
Original line number Diff line number Diff line
@@ -47,3 +47,27 @@ 
(testcmp "substr 2 15" '(substr "madrigal" 2 15) "drigal")

(testcmp "substr 10 15" '(substr "madrigal" 10 15) "")



(testcmp "subseq 0" '(subseq "madrigal" 0) "madrigal")

(testcmp "subseq 2" '(subseq "madrigal" 2) "drigal")

(testcmp "subseq 10" '(subseq "madrigal" 10) "")



(testcmp "subseq 0 0" '(subseq "madrigal" 0 0) "")

(testcmp "subseq 2 0" '(subseq "madrigal" 2 0) "")

(testcmp "subseq 10 0" '(subseq "madrigal" 10 0) "")



(testcmp "subseq 0 1" '(subseq "madrigal" 0 1) "m")

(testcmp "subseq 2 1" '(subseq "madrigal" 2 1) "")

(testcmp "subseq 10 1" '(subseq "madrigal" 10 1) "")



(testcmp "subseq 0 2" '(subseq "madrigal" 0 2) "ma")

(testcmp "subseq 2 2" '(subseq "madrigal" 2 2) "")

(testcmp "subseq 10 2" '(subseq "madrigal" 10 2) "")



(testcmp "subseq 0 5" '(subseq "madrigal" 0 5) "madri")

(testcmp "subseq 2 5" '(subseq "madrigal" 2 5) "dri")

(testcmp "subseq 10 5" '(subseq "madrigal" 10 5) "")



(testcmp "subseq 0 15" '(subseq "madrigal" 0 15) "madrigal")

(testcmp "subseq 2 15" '(subseq "madrigal" 2 15) "drigal")

(testcmp "subseq 10 15" '(subseq "madrigal" 10 15) "")