Merge branch 'master' of git:lis.pl

Fundamental.lisp

 ;; fundamental predefined Lisp functions
 ;(debug t)
 
+(defun symbols ()
+  "return a sorted list of all symbols"
+  (sort (apropos ".") #'string<))
+
 (defun caar (pair)
   "return the car of the car of PAIR"
   (car (car pair)))
@@ -281,6 +285,12 @@
       0
     (1+ (length (cdr sequence)))))
 
+(defun strlen (s)
+  "return the length of string S"
+  (if (string= "" s)
+      0
+    (1+ (strlen (substr s 1)))))
+
 (defun list* (&rest args+)
   "list of all args, with last arg as the cdr of the last pair constructed"
   (if (null (cdr args+))
@@ -334,31 +344,50 @@
         ((listp sequence) (null sequence))
         (t (error "empty: not a sequence: %s" sequence))))
 
-(defun sort (s pred)
-  "sort sequence S with predicate PRED and return the result"
-  (cond ((stringp s)
-         (apply #'string (sort-list (split-string s "") pred)))
-        ((listp s) (sort-list s pred))
-        (t (error "sort: not a sequence: %s" sequence))))
+(defun sort-string (s pred)
+  "sort string S with predicate PRED and return the resulting string"
+  (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)))))))))
+      (merge (sort-string s1 pred) (sort-string s2 pred)))))
 
 (defun sort-list (l pred)
   "sort list L with predicate PRED and return the resulting list"
   (if (or (null l) (null (cdr l)))
       l
     (let* ((len (length l))
-           (first (div len 2))
-           (l1 (sublist l 0 first))
-           (l2 (sublist l first))
-           (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)
+  "sort sequence S with predicate PRED and return the result"
+  (cond ((stringp s)
+         (apply #'string (sort-list (split-string s "") pred)))
+        ((listp s) (sort-list s pred))
+        (t (error "sort: not a sequence: %s" sequence))))
+
+
 (defun make-string (n el)
   "return a string of N occurences of element EL (may be a function)"
   (if (zerop n)
@@ -531,15 +560,6 @@
     (cons (car l1)
           (append (cdr l1) l2)))) 
 
-(defun filter (pred l)
-  "return a list of elements from list L for which PRED is true"
-  (if l
-      (let ((el (car l)))
-        (if (predicate el)
-            (cons el (filter predicate (cdr l)))
-          (filter predicate (cdr l))))
-    nil))
-
 (defun reverse (l)
   (if (null l)
       l