diff --git a/changelog b/changelog index bf92696..382838b 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,7 @@ +20090824 tpd src/axiom-website/patches.html 20090824.09.tpd.patch +20090824 tpd src/interp/Makefile move pathname.boot to pathname.lisp +20090824 tpd src/interp/pathname.lisp added, rewritten from pathname.boot +20090824 tpd src/interp/pathname.boot removed, rewritten to pathname.lisp 20090824 tpd src/axiom-website/patches.html 20090824.08.tpd.patch 20090824 tpd src/interp/Makefile move packtran.boot to packtran.lisp 20090824 tpd src/interp/packtran.lisp added, rewritten from packtran.boot diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 2f65905..43d0b94 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -1880,5 +1880,7 @@ nrunopt.lisp rewrite from boot to lisp
osyscmd.lisp rewrite from boot to lisp
20090824.08.tpd.patch packtran.lisp rewrite from boot to lisp
+20090824.09.tpd.patch +pathname.lisp rewrite from boot to lisp
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index 0b59f14..4398ead 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -3826,47 +3826,27 @@ ${DOC}/package.boot.dvi: ${IN}/package.boot.pamphlet @ -\subsection{pathname.boot} +\subsection{pathname.lisp} <>= -${OUT}/pathname.${O}: ${MID}/pathname.clisp - @ echo 379 making ${OUT}/pathname.${O} from ${MID}/pathname.clisp - @ (cd ${MID} ; \ +${OUT}/pathname.${O}: ${MID}/pathname.lisp + @ echo 136 making ${OUT}/pathname.${O} from ${MID}/pathname.lisp + @ ( cd ${MID} ; \ if [ -z "${NOISE}" ] ; then \ - echo '(progn (compile-file "${MID}/pathname.clisp"' \ - ':output-file "${OUT}/pathname.${O}") (${BYE}))' | ${DEPSYS} ; \ + echo '(progn (compile-file "${MID}/pathname.lisp"' \ + ':output-file "${OUT}/pathname.${O}") (${BYE}))' | ${DEPSYS} ; \ else \ - echo '(progn (compile-file "${MID}/pathname.clisp"' \ - ':output-file "${OUT}/pathname.${O}") (${BYE}))' | ${DEPSYS} \ + echo '(progn (compile-file "${MID}/pathname.lisp"' \ + ':output-file "${OUT}/pathname.${O}") (${BYE}))' | ${DEPSYS} \ >${TMP}/trace ; \ fi ) @ -<>= -${MID}/pathname.clisp: ${IN}/pathname.boot.pamphlet - @ echo 380 making ${MID}/pathname.clisp \ - from ${IN}/pathname.boot.pamphlet +<>= +${MID}/pathname.lisp: ${IN}/pathname.lisp.pamphlet + @ echo 137 making ${MID}/pathname.lisp from \ + ${IN}/pathname.lisp.pamphlet @ (cd ${MID} ; \ - ${TANGLE} ${IN}/pathname.boot.pamphlet >pathname.boot ; \ - if [ -z "${NOISE}" ] ; then \ - echo '(progn (boottran::boottocl "pathname.boot") (${BYE}))' \ - | ${DEPSYS} ; \ - else \ - echo '(progn (boottran::boottocl "pathname.boot") (${BYE}))' \ - | ${DEPSYS} >${TMP}/trace ; \ - fi ; \ - rm pathname.boot ) - -@ -<>= -${DOC}/pathname.boot.dvi: ${IN}/pathname.boot.pamphlet - @echo 381 making ${DOC}/pathname.boot.dvi \ - from ${IN}/pathname.boot.pamphlet - @(cd ${DOC} ; \ - cp ${IN}/pathname.boot.pamphlet ${DOC} ; \ - ${DOCUMENT} ${NOISE} pathname.boot ; \ - rm -f ${DOC}/pathname.boot.pamphlet ; \ - rm -f ${DOC}/pathname.boot.tex ; \ - rm -f ${DOC}/pathname.boot ) + ${TANGLE} ${IN}/pathname.lisp.pamphlet >pathname.lisp ) @ @@ -6219,8 +6199,7 @@ clean: <> <> -<> -<> +<> <> <> diff --git a/src/interp/pathname.boot.pamphlet b/src/interp/pathname.boot.pamphlet deleted file mode 100644 index 86b364a..0000000 --- a/src/interp/pathname.boot.pamphlet +++ /dev/null @@ -1,163 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp pathname.boot} -\author{The Axiom Team} -\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. - -@ -<<*>>= -<> - --- This file implements the Common Lisp pathname functions for --- Lisp/VM. On VM, a filename is 3-list consisting of the filename, --- filetype and filemode. We also UPCASE everything. - --- This file also contains some other VM specific functions for --- dealing with files. - ---% Common Lisp Pathname Functions - -pathname? p == p=[] or PATHNAMEP p - -pathname p == - p = [] => p - PATHNAMEP p => p - not PAIRP p => PATHNAME p - if #p>2 then p:=[p.0,p.1] - PATHNAME APPLY(FUNCTION MAKE_-FILENAME, p) - -namestring p == NAMESTRING pathname p - -pathnameName p == PATHNAME_-NAME pathname p - -pathnameType p == PATHNAME_-TYPE pathname p - -pathnameTypeId p == UPCASE object2Identifier pathnameType p - -pathnameDirectory p == - NAMESTRING MAKE_-PATHNAME(KEYWORD'DIRECTORY,PATHNAME_-DIRECTORY pathname p) - -deleteFile f == _$ERASE pathname f - -isExistingFile f == --- p := pathname f - --member(p,$existingFiles) => true - if MAKE_-INPUT_-FILENAME f - then - --$existingFiles := [p,:$existingFiles] - true - else false - ---% Scratchpad II File Name Functions - -makePathname(name,type,dir) == - -- Common Lisp version of this will have to be written - -- using MAKE-PATHNAME and the optional args. - pathname [object2String name,object2String type] - -mergePathnames(a,b) == - (fn := pathnameName(a)) = '"*" => b - fn ^= pathnameName(b) => a - (ft := pathnameType(a)) = '"*" => b - ft ^= pathnameType(b) => a - (fm := pathnameDirectory(a)) = ['"*"] => b - a - -isSystemDirectory dir == EVERY(function CHAR_=,$SPADROOT,dir) - --- the next function is an improved version of the one in DEBUG LISP - -_/MKINFILENAM(infile) == CATCH('FILNAM, newMKINFILENAM infile) - -newMKINFILENAM(infile) == - NULL infile => nil - file := infile := pathname infile - repeat - fn := pathnameName file - nfile := $FINDFILE (file,$sourceFileTypes) - null nfile => - nfile := file - if fn = '"*" or fn = '"NIL" then sayKeyedMsg("S2IL0016",NIL) - else sayKeyedMsg("S2IL0003",[namestring file]) - ans := queryUserKeyedMsg("S2IL0017",NIL) - if (SIZE(ans) > 0) and ('")" = SUBSTRING(ans,0,1)) then n := 2 - else n := 1 - nfn := UPCASE STRING2ID_-N(ans,n) - (nfn = 0) or (nfn = 'QUIT) => - sayKeyedMsg("S2IL0018",NIL) - THROW('FILENAM,NIL) - nfn = 'CREATE => return 'fromThisLoop - file := pathname ans - return 'fromThisLoop - if nfile then pathname nfile - else NIL - - -getFunctionSourceFile fun == - null (f := getFunctionSourceFile1 fun) => NIL - if MAKE_-INPUT_-FILENAME(f) then updateSourceFiles f - f - -getFunctionSourceFile1 fun == - -- returns NIL or [fn,ft,fm] - (file := KDR GET(fun,'DEFLOC)) => pathname file - null ((fileinfo := FUNLOC fun) or - (fileinfo := FUNLOC unabbrev fun)) => - u := bootFind fun => getFunctionSourceFile1 SETQ($FUNCTION,INTERN u) - NIL - 3 = #fileinfo => - [fn,ft,$FUNCTION] := fileinfo - newMKINFILENAM pathname [fn,ft] - [fn,$FUNCTION] := fileinfo - newMKINFILENAM pathname [fn] - -updateSourceFiles p == - p := pathname p - p := pathname [pathnameName p, pathnameType p, '"*"] - if MAKE_-INPUT_-FILENAME p and pathnameTypeId p in '(BOOT LISP META) then - $sourceFiles := insert(p, $sourceFiles) - p -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/pathname.lisp.pamphlet b/src/interp/pathname.lisp.pamphlet new file mode 100644 index 0000000..8721723 --- /dev/null +++ b/src/interp/pathname.lisp.pamphlet @@ -0,0 +1,281 @@ +\documentclass{article} +\usepackage{axiom} +\begin{document} +\title{\$SPAD/src/interp pathname.lisp} +\author{The Axiom Team} +\maketitle +\begin{abstract} +\end{abstract} +\eject +\tableofcontents +\eject +<<*>>= +(IN-PACKAGE "BOOT" ) + +;-- This file implements the Common Lisp pathname functions for +;-- Lisp/VM. On VM, a filename is 3-list consisting of the filename, +;-- filetype and filemode. We also UPCASE everything. +; +;-- This file also contains some other VM specific functions for +;-- dealing with files. +; +;--% Common Lisp Pathname Functions +; +;pathname? p == p=[] or PATHNAMEP p + +(DEFUN |pathname?| (|p|) (OR (NULL |p|) (PATHNAMEP |p|))) + +;pathname p == +; p = [] => p +; PATHNAMEP p => p +; not PAIRP p => PATHNAME p +; if #p>2 then p:=[p.0,p.1] +; PATHNAME APPLY(FUNCTION MAKE_-FILENAME, p) + +(DEFUN |pathname| (|p|) + (COND + ((NULL |p|) |p|) + ((PATHNAMEP |p|) |p|) + ((NULL (PAIRP |p|)) (PATHNAME |p|)) + ('T + (COND + ((> (|#| |p|) 2) + (SPADLET |p| (CONS (ELT |p| 0) (CONS (ELT |p| 1) NIL))))) + (PATHNAME (APPLY #'MAKE-FILENAME |p|))))) + +;namestring p == NAMESTRING pathname p + +(DEFUN |namestring| (|p|) (NAMESTRING (|pathname| |p|))) + +;pathnameName p == PATHNAME_-NAME pathname p + +(DEFUN |pathnameName| (|p|) (PATHNAME-NAME (|pathname| |p|))) + +;pathnameType p == PATHNAME_-TYPE pathname p + +(DEFUN |pathnameType| (|p|) (PATHNAME-TYPE (|pathname| |p|))) + +;pathnameTypeId p == UPCASE object2Identifier pathnameType p + +(DEFUN |pathnameTypeId| (|p|) + (UPCASE (|object2Identifier| (|pathnameType| |p|)))) + +;pathnameDirectory p == +; NAMESTRING MAKE_-PATHNAME(KEYWORD'DIRECTORY,PATHNAME_-DIRECTORY pathname p) + +(DEFUN |pathnameDirectory| (|p|) + (NAMESTRING + (MAKE-PATHNAME :DIRECTORY (PATHNAME-DIRECTORY (|pathname| |p|))))) + +;deleteFile f == _$ERASE pathname f + +(DEFUN |deleteFile| (|f|) ($ERASE (|pathname| |f|))) + +;isExistingFile f == +;-- p := pathname f +; --member(p,$existingFiles) => true +; if MAKE_-INPUT_-FILENAME f +; then +; --$existingFiles := [p,:$existingFiles] +; true +; else false + +(DEFUN |isExistingFile| (|f|) + (COND ((MAKE-INPUT-FILENAME |f|) 'T) ('T NIL))) + +;--% Scratchpad II File Name Functions +; +;makePathname(name,type,dir) == +; -- Common Lisp version of this will have to be written +; -- using MAKE-PATHNAME and the optional args. +; pathname [object2String name,object2String type] + +(DEFUN |makePathname| (|name| |type| |dir|) + (|pathname| + (CONS (|object2String| |name|) + (CONS (|object2String| |type|) NIL)))) + +;mergePathnames(a,b) == +; (fn := pathnameName(a)) = '"*" => b +; fn ^= pathnameName(b) => a +; (ft := pathnameType(a)) = '"*" => b +; ft ^= pathnameType(b) => a +; (fm := pathnameDirectory(a)) = ['"*"] => b +; a + +(DEFUN |mergePathnames| (|a| |b|) + (PROG (|fn| |ft| |fm|) + (RETURN + (COND + ((BOOT-EQUAL (SPADLET |fn| (|pathnameName| |a|)) + (MAKESTRING "*")) + |b|) + ((NEQUAL |fn| (|pathnameName| |b|)) |a|) + ((BOOT-EQUAL (SPADLET |ft| (|pathnameType| |a|)) + (MAKESTRING "*")) + |b|) + ((NEQUAL |ft| (|pathnameType| |b|)) |a|) + ((BOOT-EQUAL (SPADLET |fm| (|pathnameDirectory| |a|)) + (CONS (MAKESTRING "*") NIL)) + |b|) + ('T |a|))))) + +;isSystemDirectory dir == EVERY(function CHAR_=,$SPADROOT,dir) + +(DEFUN |isSystemDirectory| (|dir|) + (EVERY (|function| CHAR=) $SPADROOT |dir|)) + +;-- the next function is an improved version of the one in DEBUG LISP +; +;_/MKINFILENAM(infile) == CATCH('FILNAM, newMKINFILENAM infile) + +(DEFUN /MKINFILENAM (|infile|) + (CATCH 'FILNAM (|newMKINFILENAM| |infile|))) + +;newMKINFILENAM(infile) == +; NULL infile => nil +; file := infile := pathname infile +; repeat +; fn := pathnameName file +; nfile := $FINDFILE (file,$sourceFileTypes) +; null nfile => +; nfile := file +; if fn = '"*" or fn = '"NIL" then sayKeyedMsg("S2IL0016",NIL) +; else sayKeyedMsg("S2IL0003",[namestring file]) +; ans := queryUserKeyedMsg("S2IL0017",NIL) +; if (SIZE(ans) > 0) and ('")" = SUBSTRING(ans,0,1)) then n := 2 +; else n := 1 +; nfn := UPCASE STRING2ID_-N(ans,n) +; (nfn = 0) or (nfn = 'QUIT) => +; sayKeyedMsg("S2IL0018",NIL) +; THROW('FILENAM,NIL) +; nfn = 'CREATE => return 'fromThisLoop +; file := pathname ans +; return 'fromThisLoop +; if nfile then pathname nfile +; else NIL + +(DEFUN |newMKINFILENAM| (|infile|) + (PROG (|fn| |nfile| |ans| |n| |nfn| |file|) + (RETURN + (SEQ (COND + ((NULL |infile|) NIL) + ('T + (SPADLET |file| (SPADLET |infile| (|pathname| |infile|))) + (DO () (NIL NIL) + (SEQ (EXIT (PROGN + (SPADLET |fn| (|pathnameName| |file|)) + (SPADLET |nfile| + ($FINDFILE |file| + |$sourceFileTypes|)) + (COND + ((NULL |nfile|) (SPADLET |nfile| |file|) + (COND + ((OR + (BOOT-EQUAL |fn| (MAKESTRING "*")) + (BOOT-EQUAL |fn| + (MAKESTRING "NIL"))) + (|sayKeyedMsg| 'S2IL0016 NIL)) + ('T + (|sayKeyedMsg| 'S2IL0003 + (CONS (|namestring| |file|) NIL)))) + (SPADLET |ans| + (|queryUserKeyedMsg| 'S2IL0017 + NIL)) + (COND + ((AND (> (SIZE |ans|) 0) + (BOOT-EQUAL (MAKESTRING ")") + (SUBSTRING |ans| 0 1))) + (SPADLET |n| 2)) + ('T (SPADLET |n| 1))) + (SPADLET |nfn| + (UPCASE + (STRING2ID-N |ans| |n|))) + (COND + ((OR (EQL |nfn| 0) + (BOOT-EQUAL |nfn| 'QUIT)) + (|sayKeyedMsg| 'S2IL0018 NIL) + (THROW 'FILENAM NIL)) + ((BOOT-EQUAL |nfn| 'CREATE) + (RETURN '|fromThisLoop|)) + ('T + (SPADLET |file| (|pathname| |ans|))))) + ('T (RETURN '|fromThisLoop|))))))) + (COND (|nfile| (|pathname| |nfile|)) ('T NIL)))))))) + +;getFunctionSourceFile fun == +; null (f := getFunctionSourceFile1 fun) => NIL +; if MAKE_-INPUT_-FILENAME(f) then updateSourceFiles f +; f + +(DEFUN |getFunctionSourceFile| (|fun|) + (PROG (|f|) + (RETURN + (COND + ((NULL (SPADLET |f| (|getFunctionSourceFile1| |fun|))) NIL) + ('T + (COND ((MAKE-INPUT-FILENAME |f|) (|updateSourceFiles| |f|))) + |f|))))) + +;getFunctionSourceFile1 fun == +; -- returns NIL or [fn,ft,fm] +; (file := KDR GET(fun,'DEFLOC)) => pathname file +; null ((fileinfo := FUNLOC fun) or +; (fileinfo := FUNLOC unabbrev fun)) => +; u := bootFind fun => getFunctionSourceFile1 SETQ($FUNCTION,INTERN u) +; NIL +; 3 = #fileinfo => +; [fn,ft,$FUNCTION] := fileinfo +; newMKINFILENAM pathname [fn,ft] +; [fn,$FUNCTION] := fileinfo +; newMKINFILENAM pathname [fn] + +(DEFUN |getFunctionSourceFile1| (|fun|) + (PROG (|file| |fileinfo| |u| |ft| |fn|) + (RETURN + (COND + ((SPADLET |file| (KDR (GETL |fun| 'DEFLOC))) + (|pathname| |file|)) + ((NULL (OR (SPADLET |fileinfo| (FUNLOC |fun|)) + (SPADLET |fileinfo| (FUNLOC (|unabbrev| |fun|))))) + (COND + ((SPADLET |u| (|bootFind| |fun|)) + (|getFunctionSourceFile1| (SETQ $FUNCTION (INTERN |u|)))) + ('T NIL))) + ((EQL 3 (|#| |fileinfo|)) (SPADLET |fn| (CAR |fileinfo|)) + (SPADLET |ft| (CADR |fileinfo|)) + (SPADLET $FUNCTION (CADDR |fileinfo|)) + (|newMKINFILENAM| (|pathname| (CONS |fn| (CONS |ft| NIL))))) + ('T (SPADLET |fn| (CAR |fileinfo|)) + (SPADLET $FUNCTION (CADR |fileinfo|)) + (|newMKINFILENAM| (|pathname| (CONS |fn| NIL)))))))) + +;updateSourceFiles p == +; p := pathname p +; p := pathname [pathnameName p, pathnameType p, '"*"] +; if MAKE_-INPUT_-FILENAME p and pathnameTypeId p in '(BOOT LISP META) then +; $sourceFiles := insert(p, $sourceFiles) +; p + +;;; *** |updateSourceFiles| REDEFINED + +(DEFUN |updateSourceFiles| (|p|) + (PROGN + (SPADLET |p| (|pathname| |p|)) + (SPADLET |p| + (|pathname| + (CONS (|pathnameName| |p|) + (CONS (|pathnameType| |p|) + (CONS (MAKESTRING "*") NIL))))) + (COND + ((AND (MAKE-INPUT-FILENAME |p|) + (|member| (|pathnameTypeId| |p|) '(BOOT LISP META))) + (SPADLET |$sourceFiles| (|insert| |p| |$sourceFiles|)))) + |p|)) + +@ +\eject +\begin{thebibliography}{99} +\bibitem{1} nothing +\end{thebibliography} +\end{document}