assoc, assq, sassoc, sassq; tests 030 still fail

Fundamental.lisp

@@ -349,17 +349,17 @@
   (if (or (string= s "") (= 1 (strlen s)))
       s
     (let* ((len (strlen s))
-	   (half (div len 2))
-	   (s1 (substr s 0 half))
-	   (s2 (substr s half))
-	   (merge (lambda (s1 s2)
-		    (if (string= "" s1)
-			s2
-		      (if (string= "" s2)
-			  s1
-			(if (pred (substr s1 0 1) (substr s2 0 1))
-			    (string (substr s1 0 1) (merge (substr s1 1) s2))
-			  (string (substr s2 0 1) (merge s1 (substr s2 1)))))))))
+           (half (div len 2))
+           (s1 (substr s 0 half))
+           (s2 (substr s half))
+           (merge (lambda (s1 s2)
+                    (if (string= "" s1)
+                        s2
+                      (if (string= "" s2)
+                          s1
+                        (if (pred (substr s1 0 1) (substr s2 0 1))
+                            (string (substr s1 0 1) (merge (substr s1 1) s2))
+                          (string (substr s2 0 1) (merge s1 (substr s2 1)))))))))
       (merge (sort-string s1 pred) (sort-string s2 pred)))))
 
 (defun sort-list (l pred)
@@ -367,17 +367,17 @@
   (if (or (null l) (null (cdr l)))
       l
     (let* ((len (length l))
-	   (half (div len 2))
-	   (l1 (sublist l 0 half))
-	   (l2 (sublist l half))
-	   (merge (lambda (l1 l2)
-		    (if (null l1)
-			l2
-		      (if (null l2)
-			  l1
-			(if (pred (car l1) (car l2))
-			    (cons (car l1) (merge (cdr l1) l2))
-			  (cons (car l2) (merge l1 (cdr l2)))))))))
+           (half (div len 2))
+           (l1 (sublist l 0 half))
+           (l2 (sublist l half))
+           (merge (lambda (l1 l2)
+                    (if (null l1)
+                        l2
+                      (if (null l2)
+                          l1
+                        (if (pred (car l1) (car l2))
+                            (cons (car l1) (merge (cdr l1) l2))
+                          (cons (car l2) (merge l1 (cdr l2)))))))))
       (merge (sort-list l1 pred) (sort-list l2 pred)))))
 
 (defun sort (s pred)
@@ -617,3 +617,35 @@ list as appropriate."
     (+ (fib (- n 1))
        (fib (- n 2)))))
 
+(defun assoc (item alist)
+  "return the pair of ALIST whose car is equal to ITEM, or nil"
+  (if (null alist)
+      nil
+    (if (equal item (caar alist))
+        (car alist)
+      (assoc item (cdr alist)))))
+
+(defun assq (item alist)
+  "return the pair of ALIST whose car is eq to ITEM, or nil"
+  (if (null alist)
+      nil
+    (if (eq item (caar alist))
+        (car alist)
+      (assoc item (cdr alist)))))
+
+(defun sassoc (item alist func)
+    "return the pair of ALIST whose car is equal to ITEM, or call FUNC"
+  (if (null alist)
+      (func)
+    (if (equal item (caar alist))
+        (car alist)
+      (assoc item (cdr alist)))))
+
+(defun sassq (item alist func)
+    "return the pair of ALIST whose car is equal to ITEM, or call FUNC"
+  (if (null alist)
+      (func)
+    (if (eq item (caar alist))
+        (car alist)
+      (assoc item (cdr alist)))))
+

tests/030-assoc.lisp

+
+(defvar the-alist '((3 . 4)
+                    (7 . 5)
+                    (lala . humdi)
+                    (10 . 11)
+                    ((1 2 3) . 12)
+                    ("hudi" . :rudi)))
+
+(testcmp "assoc 0" '(assoc 'lala nil) nil)
+(testcmp "assoc 1" '(errset (assoc 'lala '(4))) nil)
+(testcmp "assoc 2" '(assoc 'lala the-alist) '(lala . humdi))
+(testcmp "assoc 3" '(assoc '(1 2 3) the-alist) '((1 2 3) . 12))
+(testcmp "assoc 4" '(assoc '(1 2 5) the-alist) nil)
+(testcmp "assoc 5" '(assoc 10 the-alist) '(10 . 11))
+
+(testcmp "assq 0" '(assq 'lala nil) nil)
+(testcmp "assq 1" '(errset (assq 'lala '(4))) nil)
+(testcmp "assq 2" '(assq 'lala the-alist) '(lala . humdi))
+(testcmp "assq 3" '(assq '(1 2 3) the-alist) nil)
+(testcmp "assq 4" '(assq '(1 2 5) the-alist) nil)
+
+(defun default () 'this)
+(defvar the-function 'default)
+
+(testcmp "sassoc 0" '(sassoc 'lala nil #'default) 'this)
+(testcmp "sassoc 1" '(errset (sassoc 'lala '(4) #'default)) nil)
+(testcmp "sassoc 2" '(sassoc 'lala the-alist #'default) '(lala . humdi))
+(testcmp "sassoc 3" '(sassoc '(1 2 3) the-alist #'default) '((1 2 3) . 12))
+(testcmp "sassoc 4" '(sassoc '(1 2 5) the-alist #'default) 'this)
+(testcmp "sassoc 5" '(sassoc 10 the-alist 'default) '(10 . 11))
+
+(testcmp "sassq 0" '(sassq 'lala nil #'default) 'this)
+(testcmp "sassq 1" '(errset (sassq 'lala '(4) #'default)) nil)
+(testcmp "sassq 2" '(sassq 'lala the-alist #'default) '(lala . humdi))
+(testcmp "sassq 3" '(sassq '(1 2 3) the-alist #'default) 'this)
+(testcmp "sassq 4" '(sassq '(1 2 5) the-alist the-function) 'this)
+