From c75b5923cb35d83910e45f13e9d15c981ea25387 Mon Sep 17 00:00:00 2001 From: dos-reis Date: Thu, 20 Sep 2007 04:57:39 +0000 Subject: remove pamphlets - part 7 --- src/interp/pathname.boot.pamphlet | 165 -------------------------------------- 1 file changed, 165 deletions(-) delete mode 100644 src/interp/pathname.boot.pamphlet (limited to 'src/interp/pathname.boot.pamphlet') diff --git a/src/interp/pathname.boot.pamphlet b/src/interp/pathname.boot.pamphlet deleted file mode 100644 index 300d2c41..00000000 --- a/src/interp/pathname.boot.pamphlet +++ /dev/null @@ -1,165 +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. - -@ -<<*>>= -<> - -)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 - -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(LispKeyword '"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 GETL(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} -- cgit v1.2.3