X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=genutils.lisp;h=6125aba7262e95696eac18ee766088f75f42b406;hb=7249fcd884a04be929dc6895c91e82be747c9533;hp=09b14fa1be3382289f1ce0b1c88573794dfa879f;hpb=8646b9afb9979064c3b0b79990c064dce7cb12b7;p=kmrcl.git diff --git a/genutils.lisp b/genutils.lisp index 09b14fa..6125aba 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.8 2002/11/07 04:07:02 kevin Exp $ ;;;; ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -216,7 +216,21 @@ ((> ,var ,gstop)) ,@body))) - +(defmacro with-each-stream-line ((var stream) &body body) + (let ((eof (gensym)) + (strm (gensym))) + `(let ((,strm ,stream)) + (do ((,var (read-line stream nil ,eof) (read-line stream nil ,eof))) + (eq ,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 +266,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 +274,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 +282,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 +292,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 +308,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,7 +321,7 @@ 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))) @@ -444,30 +458,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