X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=genutils.lisp;h=4565089ddd7f66baba8742dfacddf828e2046531;hb=c0fe2c8fed48e08ef1ebb324f50d13db0d6d5042;hp=09b14fa1be3382289f1ce0b1c88573794dfa879f;hpb=8646b9afb9979064c3b0b79990c064dce7cb12b7;p=kmrcl.git

diff --git a/genutils.lisp b/genutils.lisp
index 09b14fa..4565089 100644
--- a/genutils.lisp
+++ b/genutils.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: genutils.lisp,v 1.5 2002/10/12 06:10:17 kevin Exp $
+;;;; $Id: genutils.lisp,v 1.13 2002/12/14 18:51:53 kevin Exp $
 ;;;;
 ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -20,17 +20,13 @@
 (in-package :kmrcl)
 (declaim (optimize (speed 3) (safety 1) (compilation-speed 0) (debug 3)))
 
-(defmacro bind-when ((bind-var boundForm) &body body)
-  `(let ((,bind-var ,boundForm))
-      (declare (ignore-if-unused ,bind-var))
-      (when ,bind-var
-        ,@body)))
+(defmacro let-when ((var test-form) &body body)
+  `(let ((,var ,test-form))
+      (when ,var ,@body)))
   
-(defmacro bind-if ((bind-var boundForm) yup &optional nope)
-  `(let ((,bind-var ,boundForm))
-      (if ,bind-var
-         ,yup
-         ,nope)))
+(defmacro let-if ((var test-form) if-true &optional if-false)
+  `(let ((,var ,test-form))
+      (if ,var ,if-true ,if-false)))
 
 ;; Anaphoric macros
 
@@ -160,6 +156,12 @@
         (if val (push val acc))))
     (nreverse acc)))
 
+(defun appendnew (l1 l2)
+  "Append two lists, filtering out elem from second list that are already in first list"
+  (dolist (elem l2)
+    (unless (find elem l1)
+      (setq l1 (append l1 (list elem)))))
+  l1)
 
 ;; Functions
 
@@ -216,7 +218,23 @@
          ((> ,var ,gstop))
        ,@body)))
 
-
+(defmacro with-each-stream-line ((var stream) &body body)
+  (let ((eof (gensym))
+	(eof-value (gensym))
+	(strm (gensym)))
+    `(let ((,strm ,stream)
+	   (,eof ',eof-value))
+      (do ((,var (read-line ,strm nil ,eof) (read-line ,strm nil ,eof)))
+	  ((eql ,var ,eof))
+	,@body))))
+
+(defmacro with-each-file-line ((var file) &body body)
+  (let ((stream (gensym)))
+    `(with-open-file (,stream ,file :direction :input)
+      (with-each-stream-line (,var ,stream)
+	,@body))))
+
+		
 ;;; Keyword functions
 
 (defun remove-keyword (key arglist)
@@ -252,7 +270,7 @@
 
 
 (defun mapcar-append-string-nontailrec (func v)
-"Concatenate results of mapcar lambda calls"  
+  "Concatenate results of mapcar lambda calls"  
   (aif (car v)
        (concatenate 'string (funcall func it)
 		    (mapcar-append-string-nontailrec func (cdr v)))
@@ -260,7 +278,7 @@
 
 
 (defun mapcar-append-string (func v &optional (accum ""))
-"Concatenate results of mapcar lambda calls"  
+  "Concatenate results of mapcar lambda calls"  
   (aif (car v)
        (mapcar-append-string 
 	func 
@@ -268,9 +286,8 @@
 	(concatenate 'string accum (funcall func it)))
        accum))
 
-
 (defun mapcar2-append-string-nontailrec (func la lb)
-"Concatenate results of mapcar lambda call's over two lists"  
+  "Concatenate results of mapcar lambda call's over two lists"  
   (let ((a (car la))
 	(b (car lb)))
     (if (and a b)
@@ -279,7 +296,7 @@
       "")))
   
 (defun mapcar2-append-string (func la lb &optional (accum ""))
-"Concatenate results of mapcar lambda call's over two lists"  
+  "Concatenate results of mapcar lambda call's over two lists"  
   (let ((a (car la))
 	(b (car lb)))
     (if (and a b)
@@ -295,11 +312,12 @@
 
 (defun indent-spaces (n &optional (stream *standard-output*))
   "Indent n*2 spaces to output stream"
-  (let ((fmt (format nil "~~~DT" (+ n n))))
-    (format stream fmt)))
+  (when (numberp n)
+    (let ((fmt (format nil "~~~DT" (+ n n))))
+      (format stream fmt))))
 
 (defun print-list (l &optional (output *standard-output*))
-"Print a list to a stream"
+  "Print a list to a stream"
   (if (consp l)
     (progn
       (mapcar (lambda (x) (princ x output) (princ #\newline output)) l)
@@ -307,21 +325,12 @@
     nil))
 
 (defun print-rows (rows &optional (ostrm *standard-output*))
-"Print a list of list rows to a stream"  
+  "Print a list of list rows to a stream"  
   (dolist (r rows)
     (mapcar (lambda (a) (princ a ostrm) (princ #\space ostrm)) r)
     (terpri ostrm)))
 
 
-;;; Symbol functions
-
-(defmacro concat-symbol (&rest args)
-  `(intern (concatenate 'string ,@args)))
-
-(defmacro concat-symbol-pkg (pkg &rest args)
-  `(intern (concatenate 'string ,@args) ,pkg))
-
-
 ;;; IO
 
 
@@ -369,9 +378,9 @@
 
 (defun file-subst (old new file1 file2)
   (with-open-file (in file1 :direction :input)
-     (with-open-file (out file2 :direction :output
-                                :if-exists :supersede)
-       (stream-subst old new in out))))
+    (with-open-file (out file2 :direction :output
+			 :if-exists :supersede)
+      (stream-subst old new in out))))
 
 (defun stream-subst (old new in out)
   (declare (string old new))
@@ -444,30 +453,32 @@
   "Opens a reads a file. Returns the contents as a single string"
   (when (probe-file file)
     (with-open-file (in file :direction :input)
-		    (do ((line (read-line in nil 'eof) 
-			       (read-line in nil 'eof)))
-			((eql line 'eof))
-		      (format strm "~A~%" line)))))
+      (let ((eof (gensym)))		    
+	(do ((line (read-line in nil eof) 
+		   (read-line in nil eof)))
+	    ((eq line eof))
+	  (format strm "~A~%" line))))))
 
 (defun read-file-to-string (file)
   "Opens a reads a file. Returns the contents as a single string"
   (with-output-to-string (out)
     (with-open-file (in file :direction :input)
-      (do ((line (read-line in nil 'eof) 
-		 (read-line in nil 'eof)))
-	  ((eql line 'eof))
-	(format out "~A~%" line)))))
+      (let ((eof (gensym)))		    
+	(do ((line (read-line in nil eof) 
+		   (read-line in nil eof)))
+	    ((eq line eof))
+	  (format out "~A~%" line))))))
 
 (defun read-file-to-strings (file)
   "Opens a reads a file. Returns the contents as a list of strings"
   (let ((lines '()))
     (with-open-file (in file :direction :input)
-      (do ((line (read-line in nil 'eof) 
-		 (read-line in nil 'eof)))
-	  ((eql line 'eof))
-	(push line lines)))
-    (nreverse lines)))
-
+      (let ((eof (gensym)))		    
+	(do ((line (read-line in nil eof) 
+		   (read-line in nil eof)))
+	    ((eq line eof))
+	  (push line lines)))
+      (nreverse lines))))
 
 
 ;;; Formatting functions