diff --git a/books/bookvol5.pamphlet b/books/bookvol5.pamphlet index 1e3e748..1d38171 100644 --- a/books/bookvol5.pamphlet +++ b/books/bookvol5.pamphlet @@ -30789,6 +30789,117 @@ but the Axiom semantics are not the same. Because Axiom was originally written in Maclisp, then VMLisp, and then Common Lisp some of these old semantics survive. +\section{FileName} +\defun{fnameMake}{FileName filename function implementation} +\calls{fnameMake}{StringToDir} +<>= +(defun |fnameMake| (d n e) + (if (string= e "") (setq e nil)) + (make-pathname :directory (|StringToDir| d) :name n :type e)) + +@ + +\defun{StringToDir}{FileName filename support function} +\calls{StringToDir}{lastc} +<>= +(defun |StringToDir| (s) + (cond + ((string= s "/") '(:root)) + ((string= s "") nil) + (t + (let ((lastc (aref s (- (length s) 1)))) + (if (char= lastc #\/) + (pathname-directory (concat s "name.type")) + (pathname-directory (concat s "/name.type")) ))) )) +@ + +\defun{fnameDirectory}{FileName directory function implementation} +\calls{fnameDirectory}{DirToString} +<>= +(defun |fnameDirectory| (f) + (|DirToString| (pathname-directory f))) + +@ + +\defun{DirToString}{FileName directory function support} +For example, ``/'' ``/u/smwatt'' ``../src'' +<>= +(defun |DirToString| (d) + (cond + ((equal d '(:root)) "/") + ((null d) "") + ('t (string-right-trim "/" (namestring (make-pathname :directory d)))) )) + +@ + +\defun{fnameName}{FileName name function implementation} +<>= +(defun |fnameName| (f) + (let ((s (pathname-name f))) + (if s s "") )) + +@ + +\defun{fnameType}{FileName extension function implementation} +<>= +(defun |fnameType| (f) + (let ((s (pathname-type f))) + (if s s "") )) + +@ + +\defun{fnameExists?}{FileName exists? function implementation} +<>= +(defun |fnameExists?| (f) + (if (probe-file (namestring f)) 't nil)) + +@ + +\defun{fnameReadable?}{FileName readable? function implementation}} +<>= +(defun |fnameReadable?| (f) + (let ((s (open f :direction :input :if-does-not-exist nil))) + (cond (s (close s) t) (t nil)) )) + +@ + +\defun{fnameWritable?}{FileName writeable? function implementation}} +\calls{fnameWritable?}{myWriteable?} +<>= +(defun |fnameWritable?| (f) + (|myWritable?| (namestring f)) ) + +@ + +\defun{myWritable?}{FileName writeable? function support} +\calls{myWritable?}{error} +\calls{myWritable?}{fnameExists?} +\calls{myWritable?}{fnameDirectory} +\calls{myWritable?}{writeablep} +<>= +(defun |myWritable?| (s) + (if (not (stringp s)) (|error| "``myWritable?'' requires a string arg.")) + (if (string= s "") (setq s ".")) + (if (not (|fnameExists?| s)) (setq s (|fnameDirectory| s))) + (if (string= s "") (setq s ".")) + (if (> (|writeablep| s) 0) 't nil) ) + +@ + +\defun{fnameNew}{FileName new function implementation} +\calls{fnameNew}{fnameMake} +<>= +(defun |fnameNew| (d n e) + (if (not (|myWritable?| d)) + nil + (do ((fn)) + (nil) + (setq fn (|fnameMake| d (string (gensym n)) e)) + (if (not (probe-file (namestring fn))) + (return-from |fnameNew| fn)) ))) + +@ + \section{DoubleFloat} These macros wrap their arguments with strong type information in order to optimize doublefloat computatations. They are used directly @@ -31405,6 +31516,7 @@ See Steele Common Lisp 1990 pp305-307 <> <> <> +<> <> <> <> @@ -31460,6 +31572,14 @@ See Steele Common Lisp 1990 pp305-307 <> <> <> +<> +<> +<> +<> +<> +<> +<> +<> <> <> <> @@ -31700,6 +31820,7 @@ See Steele Common Lisp 1990 pp305-307 <> <> <> +<> <> <> @@ -32013,6 +32134,7 @@ See Steele Common Lisp 1990 pp305-307 <> <> <> +<> <> <> <> diff --git a/changelog b/changelog index 2c7a86c..df16911 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,7 @@ +20100119 tpd src/axiom-website/patches.html 20100119.01.tpd.patch +20100119 tpd src/interp/fname.lisp removed +20100119 tpd src/interp/Makefile remove fname.lisp +20100119 tpd books/bookvol5 merge and delete fname.lisp 20100118 tpd src/axiom-website/patches.html 20100118.05.tpd.patch 20100018 tpd books/bookvol5 update copyright date for 2010 20100118 tpd src/axiom-website/patches.html 20100118.04.tpd.patch diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 6816053..d775e17 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -2392,5 +2392,7 @@ books/bookvol5 merge and remove pathname.lisp
src/share/doc/msgs/s2-us.msgs removed unused file
20100118.05.tpd.patch books/bookvol5 update copyright date for 2010
+20100119.01.tpd.patch +books/bookvol5 merge and delete fname.lisp
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index a6a9d8d..0171791 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -147,7 +147,7 @@ OBJS= ${OUT}/vmlisp.${O} \ ${OUT}/compat.${O} ${OUT}/compress.${O} \ ${OUT}/cparse.${O} \ ${OUT}/database.${O} \ - ${OUT}/fname.${O} ${OUT}/format.${O} \ + ${OUT}/format.${O} \ ${OUT}/g-boot.${O} ${OUT}/g-cndata.${O} \ ${OUT}/g-error.${O} ${OUT}/g-opt.${O} \ ${OUT}/g-timer.${O} ${OUT}/g-util.${O} \ @@ -833,29 +833,6 @@ ${MID}/debugsys.lisp: ${IN}/debugsys.lisp.pamphlet @ -\subsection{fname.lisp \cite{17}} -<>= -${OUT}/fname.${O}: ${MID}/fname.lisp - @ echo 46 making ${OUT}/fname.${O} from ${MID}/fname.lisp - @ ( cd ${MID} ; \ - if [ -z "${NOISE}" ] ; then \ - echo '(progn (compile-file "${MID}/fname.lisp"' \ - ':output-file "${OUT}/fname.${O}") (${BYE}))' | ${DEPSYS} ; \ - else \ - echo '(progn (compile-file "${MID}/fname.lisp"' \ - ':output-file "${OUT}/fname.${O}") (${BYE}))' | ${DEPSYS} \ - >${TMP}/trace ; \ - fi ) - -@ -<>= -${MID}/fname.lisp: ${IN}/fname.lisp.pamphlet - @ echo 47 making ${MID}/fname.lisp from ${IN}/fname.lisp.pamphlet - @ (cd ${MID} ; \ - ${TANGLE} ${IN}/fname.lisp.pamphlet >fname.lisp ) - -@ - \subsection{fnewmeta.lisp \cite{18}} <>= ${AUTO}/fnewmeta.${O}: ${OUT}/fnewmeta.${O} @@ -3882,9 +3859,6 @@ clean: <> <> -<> -<> - <> <> <> diff --git a/src/interp/fname.lisp.pamphlet b/src/interp/fname.lisp.pamphlet deleted file mode 100644 index 0a6ccc0..0000000 --- a/src/interp/fname.lisp.pamphlet +++ /dev/null @@ -1,122 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp fname.lisp} -\author{Stephen M. Watt, Timothy Daly} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{License} -<>= -;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -;; All rights reserved. -;; -;; Redistribution and use in source and binary forms, with or without -;; modification, are permitted provided that the following conditions are -;; met: -;; -;; - Redistributions of source code must retain the above copyright -;; notice, this list of conditions and the following disclaimer. -;; -;; - Redistributions in binary form must reproduce the above copyright -;; notice, this list of conditions and the following disclaimer in -;; the documentation and/or other materials provided with the -;; distribution. -;; -;; - Neither the name of The Numerical ALgorithms Group Ltd. nor the -;; names of its contributors may be used to endorse or promote products -;; derived from this software without specific prior written permission. -;; -;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS -;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A -;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER -;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, -;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, -;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR -;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF -;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING -;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - -@ -<<*>>= -<> - -;; -;; Lisp support for cleaned up FileName domain. -;; -;; Created: June 20, 1991 (Stephen Watt) -;; - -(in-package "BOOT") - -;; E.g. "/" "/u/smwatt" "../src" -(defun |DirToString| (d) - (cond - ((equal d '(:root)) "/") - ((null d) "") - ('t (string-right-trim "/" (namestring (make-pathname :directory d)))) )) - -(defun |StringToDir| (s) - (cond - ((string= s "/") '(:root)) - ((string= s "") nil) - ('t - (let ((lastc (aref s (- (length s) 1)))) - (if (char= lastc #\/) - (pathname-directory (concat s "name.type")) - (pathname-directory (concat s "/name.type")) ))) )) - -(defun |myWritable?| (s) - (if (not (stringp s)) (|error| "``myWritable?'' requires a string arg.")) - (if (string= s "") (setq s ".")) - (if (not (|fnameExists?| s)) (setq s (|fnameDirectory| s))) - (if (string= s "") (setq s ".")) - (if (> (|writeablep| s) 0) 't nil) ) - -(defun |fnameMake| (d n e) - (if (string= e "") (setq e nil)) - (make-pathname :directory (|StringToDir| d) :name n :type e)) - -(defun |fnameDirectory| (f) - (|DirToString| (pathname-directory f))) - -(defun |fnameName| (f) - (let ((s (pathname-name f))) - (if s s "") )) - -(defun |fnameType| (f) - (let ((s (pathname-type f))) - (if s s "") )) - -(defun |fnameExists?| (f) - (if (probe-file (namestring f)) 't nil)) - -(defun |fnameReadable?| (f) -#+:CCL (file-readablep f) -#-:CCL - (let ((s (open f :direction :input :if-does-not-exist nil))) - (cond (s (close s) 't) ('t nil)) ) - ) - -(defun |fnameWritable?| (f) - (|myWritable?| (namestring f)) ) - -(defun |fnameNew| (d n e) - (if (not (|myWritable?| d)) - nil - (do ((fn)) - (nil) - (setq fn (|fnameMake| d (string (gensym n)) e)) - (if (not (probe-file (namestring fn))) - (return-from |fnameNew| fn)) ))) -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document}