[cl-table-cvs] r3 -

[rklochkov at common-lisp.net]

Author: rklochkov
Date: Wed Mar 20 10:22:22 2013
New Revision: 3

Log:
Minor fixes

Modified:
   table.lisp
   test.lisp

Modified: table.lisp
==============================================================================
--- table.lisp	Thu Feb  9 08:05:54 2012	(r2)
+++ table.lisp	Wed Mar 20 10:22:22 2013	(r3)
@@ -60,78 +60,14 @@
         (when (equal f1 f2) (equal-rows (cdr cols) row1 row2)))
       t))
 
-(eval-when (:compile-toplevel :execute)
-
-  (defun list-of-forms? (x)
-    (and (consp x) (consp (car x))
-         (not (eq (caar x) 'lambda))))
-
-  (defun sharpL-reader (stream subchar n-args)
-    (declare (ignore subchar))
-    (let* ((form (read stream t nil t))
-	   (bang-vars (sort (bang-vars form) #'< :key #'bang-var-num))
-	   (bang-var-nums (mapcar #'bang-var-num bang-vars))
-	   (max-bv-num (if bang-vars
-			   (reduce #'max bang-var-nums :initial-value 0)
-			   0)))
-      (cond 
-	((null n-args)
-	 (setq n-args max-bv-num))
-	((< n-args max-bv-num)
-	 (error "#L: digit-string ~d specifies too few arguments" n-args)))
-      (let* ((bvars (let ((temp nil))
-		      (dotimes (i n-args (nreverse temp))
-			(push (make-bang-var (1+ i)) temp))))
-	     (args (mapcar #'(lambda (x) (declare (ignore x)) (gensym))
-			   bvars))
-	     (ignores (set-difference bvars bang-vars))
-	     (decl (if ignores `(declare (ignore .,ignores)) nil))
-	     (body (if (list-of-forms? form)
-		       (if decl (cons decl form) form)
-		       (if decl (list decl form) (list form))))
-	     (subbed-body (sublis (pairlis bvars args) body)))
-	`#'(lambda ,args ,.subbed-body))))
-
-  (defun make-bang-var (n)
-    (intern (format nil "!~d" n)))
-
-  (defun bang-vars (form)
-    (delete-duplicates (bang-vars-1 form '()) :test #'eq))
-
-  (defun bang-vars-1 (form vars)
-    (cond
-      ((consp form)
-       (bang-vars-1 (cdr form)
-		    (bang-vars-1 (car form) vars)))
-      ((and (symbolp form) (bang-var? form)) (cons form vars))
-      (t vars)))
-
-  (defun bang-var? (sym)
-    (char= (char (symbol-name sym) 0) #\!))
-
-  (defun bang-var-num (sym)
-    (let ((num (read-from-string (subseq (symbol-name sym) 1))))
-      (if (not (and (integerp num) (> num 0)))
-	  (error "#L: ~a is not a valid variable specifier" sym)
-	  num)))
-
-  (defun enable-sharpL-reader ()
-    (set-dispatch-macro-character #\# #\L #'sharpL-reader))
-
-  ;; According to CLHS, *readtable* must be rebound when compiling
-  ;; so we are free to reassign it to a copy and modify that copy.
-  (setf *readtable* (copy-readtable *readtable*))
-  (enable-sharpL-reader)
-
-  ) ; end eval-when
-
 
 (defun sort! (table columns)
   (setf (rows table)
         (stable-sort (rows table)
-                     #L(compare-rows columns #'generic-lessp 
-                                     (make-row :table table :data !1) 
-                                     (make-row :table table :data !2)))))
+                     (lambda (x y)
+                       (compare-rows columns #'generic-lessp 
+                                     (make-row :table table :data x) 
+                                     (make-row :table table :data y))))))
 
 ;; (defun add-columns (sum-columns dst-row src-row)
 ;;   (mapc (lambda (column)

Modified: test.lisp
==============================================================================
--- test.lisp	Thu Feb  9 08:05:54 2012	(r2)
+++ test.lisp	Wed Mar 20 10:22:22 2013	(r3)
@@ -15,8 +15,8 @@
         (setf (field str2 'a) "str21a"
               (field str2 'b) "str21b")))
     (list (field (path->row tab '(0)) 'b)
-                        (field (path->row tab 1) 'a)
-                        (field (path->row tab '(1 0)) 'b))
+          (field (path->row tab 1) 'a)
+          (field (path->row tab '(1 0)) 'b))
     (path->row tab '(1 0))))