Commit 17a5d9d6 authored by Juergen Nickelsen's avatar Juergen Nickelsen

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

parent 38dfa894
......@@ -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)))))
(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)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment