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

when, unless, 027; 028: sort string still bombs

parent 64d0746e

Fundamental.lisp

+32 −9
Original line number Diff line number Diff line
@@ -308,23 +308,46 @@ 
      l

    (skip l (- (length l) n))))



(defun first (sequence)

  "return the first element of SEQUENCE"

  (cond ((stringp sequence) (substr sequence 0 1))

        ((listp sequence) (car sequence))

        (t (error "first: not a sequence: %s" sequence))))



(defun rest (sequence)

  "return all but the first element of SEQUENCE"

  (cond ((stringp sequence) (substr sequence 1))

        ((listp sequence) (cdr sequence))

        (t (error "rest: not a sequence: %s" sequence))))



(defun prepend (element sequence)

  "prepend ELEMENT to SEQUENCE and return the resulting sequence"

  (cond ((stringp sequence) (string element sequence))

        ((listp sequence) (cons element sequence))

        (t (error "prepend: not a sequence: %s" sequence))))



(defun empty (sequence)

  "return non-nil iff SEQUENCE is empty"

  (cond ((stringp sequence) (string= "" sequence))

        ((listp sequence) (null sequence))

        (t (error "empty: not a sequence: %s" sequence))))



(defun sort (l pred)

  "sort list L with predicate PRED and return the resulting list"

  (if (or (null l) (null (cdr l)))

  (if (or (empty l) (empty (rest l)))

      l

    (let* ((len (length l))

           (first (div len 2))

           (l1 (head l first))

           (l2 (tail l (- len first)))

           (l1 (subseq l 0 first))

           (l2 (subseq l (- len first)))

           (merge (lambda (l1 l2)

                    (if (null l1)

                    (if (empty l1)

                        l2

                      (if (null l2)

                      (if (empty l2)

                          l1

                        (if (pred (car l1) (car l2))

                            (cons (car l1) (merge (cdr l1) l2))

                          (cons (car l2) (merge l1 (cdr l2)))))))))

                        (if (pred (first l1) (first l2))

                            (prepend (first l1) (merge (rest l1) l2))

                          (prepend (first l2) (merge l1 (rest l2)))))))))

      (merge (sort l1 pred) (sort l2 pred)))))



(defun make-string (n el)

tests/027-when-unless.lisp

0 → 100644
+13 −0
Original line number Diff line number Diff line 


(defun false ()

  nil)



(defun true ()

  t)



(testcmp "when 0" '(when (false) (+ 13 14) (* 15 16) 332) nil)

(testcmp "when 1" '(when (true) (+ 13 14) (* 15 16) 332) 332)

(testcmp "when 2" '(let (a) (when (true) (setq a 115) 19) a) 115)

(testcmp "unless 0" '(unless (false) (+ 13 14) (* 15 16) 332) 332)

(testcmp "unless 1" '(unless (true) (+ 13 14) (* 15 16) 332) nil)

(testcmp "unless 2" '(let (a) (unless (false) (setq a 115) 19) a) 115)

tests/notyet/028-sort.lisp→tests/028-sort.lisp

+17 −0
Original line number Diff line number Diff line
@@ -7,18 +7,11 @@ 
                                21 38 31 46 28 29 67 21 20 36)  #'>)

         '(81 68 67 66 51 46 43 42 38 36 31 30 29 28 21 21 20 15 9 6))



(testcmp "sort vector 0" '(sort [] #'>) [])

(testcmp "sort vector 1" '(sort [60] #'>) [60])

(testcmp "sort vector 2" '(sort [60 94]  #'>) [94 60])

(testcmp "sort vector 3" '(sort [94 60]  #'>) [94 60])

(testcmp "sort vector 4" '(sort [66 43 42 68 6 15 9 30 51 81

                         21 38 31 46 28 29 67 21 20 36]  #'>)

         [81 68 67 66 51 46 43 42 38 36 31 30 29 28 21 21 20 15 9 6])



(testcmp "sort string 0" '(sort "" #'>) "")

(testcmp "sort string 1" '(sort "W" #'>) "W")

(testcmp "sort string 2" '(sort "TF"  #'>) "TF")

(testcmp "sort string 3" '(sort "FT"  #'>) "TF")

(testcmp "sort string 0" '(sort "" #'string>) "")

(testcmp "sort string 1" '(sort "W" #'string>) "W")

(testcmp "sort string 2" '(sort "TF"  #'string>) "TF")

(testcmp "sort string 3" '(sort "FT"  #'string>) "TF")

(testcmp "sort string 4" '(sort "The quick brown fox jumps over the lazy dog."

                           #'>)

                           #'string>)

         "zyxwvuutsrrqpoooonmlkjihhgfeeedcbaT.        ")