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

Fundamental.lisp

@@ -307,24 +307,47 @@
   (if (null l)
       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

+
+(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

@@ -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.        ")