diff --git a/changelog b/changelog index 8ce345e..8bf94c1 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,8 @@ +20090810 tpd src/axiom-website/patches.html 20090810.02.tpd.patch +20090810 tpd src/interp/Makefile move astr.boot to astr.lisp +20090810 tpd src/interp/debugsys.lisp change astr.clisp to astr.lisp +20090810 tpd src/interp/astr.lisp added, rewritten from astr.boot +20090810 tpd src/interp/astr.boot removed, rewritten to astr.lisp 20090810 tpd src/axiom-website/patches.html 20090810.01.tpd.patch 20090810 tpd src/interp/Makefile move alql.boot to alql.lisp 20090810 tpd src/interp/debugsys.lisp change alql.clisp to alql.lisp diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index eae5442..ce6e17c 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -1768,6 +1768,8 @@ vmlisp.lisp and property.lisp merged
vmlisp.lisp and unlisp.lisp merged
20090810.01.tpd.patch alql.lisp rewrite from boot to lisp
+20090810.02.tpd.patch +astr.lisp rewrite from boot to lisp
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index 6416278..2abadc6 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -410,7 +410,7 @@ the document files. In make's traditional "pull to the target" fashion we need to provide a list of target dvi files. <>= DOCFILES=${DOC}/as.boot.dvi \ - ${DOC}/astr.boot.dvi ${DOC}/ax.boot.dvi \ + ${DOC}/ax.boot.dvi \ ${DOC}/axext_l.lisp.dvi \ ${DOC}/bc-matrix.boot.dvi \ ${DOC}/br-con.boot.dvi \ @@ -5793,44 +5793,26 @@ ${DOC}/cstream.boot.dvi: ${IN}/cstream.boot.pamphlet @ -\subsection{astr.boot} +\subsection{astr.lisp} <>= -${OUT}/astr.${O}: ${MID}/astr.clisp - @ echo 531 making ${OUT}/astr.${O} from ${MID}/astr.clisp - @ if [ -z "${NOISE}" ] ; then \ - echo '(progn (compile-file "${MID}/astr.clisp"' \ +${OUT}/astr.${O}: ${MID}/astr.lisp + @ echo 531 making ${OUT}/astr.${O} from ${MID}/astr.lisp + @ ( cd ${MID} ; \ + if [ -z "${NOISE}" ] ; then \ + echo '(progn (compile-file "${MID}/astr.lisp"' \ ':output-file "${OUT}/astr.${O}") (${BYE}))' | ${DEPSYS} ; \ else \ - echo '(progn (compile-file "${MID}/astr.clisp"' \ + echo '(progn (compile-file "${MID}/astr.lisp"' \ ':output-file "${OUT}/astr.${O}") (${BYE}))' | ${DEPSYS} \ >${TMP}/trace ; \ - fi + fi ) @ -<>= -${MID}/astr.clisp: ${IN}/astr.boot.pamphlet - @ echo 532 making ${MID}/astr.clisp from ${IN}/astr.boot.pamphlet +<>= +${MID}/astr.lisp: ${IN}/astr.lisp.pamphlet + @ echo 532 making ${MID}/astr.lisp from ${IN}/astr.lisp.pamphlet @ (cd ${MID} ; \ - ${TANGLE} ${IN}/astr.boot.pamphlet >astr.boot ; \ - if [ -z "${NOISE}" ] ; then \ - echo '(progn (boottran::boottocl "${MID}/astr.boot") (${BYE}))' \ - | ${BOOTSYS} ; \ - else \ - echo '(progn (boottran::boottocl "${MID}/astr.boot") (${BYE}))' \ - | ${BOOTSYS} >${TMP}/trace ; \ - fi ; \ - rm astr.boot ) - -@ -<>= -${DOC}/astr.boot.dvi: ${IN}/astr.boot.pamphlet - @echo 533 making ${DOC}/astr.boot.dvi from ${IN}/astr.boot.pamphlet - @(cd ${DOC} ; \ - cp ${IN}/astr.boot.pamphlet ${DOC} ; \ - ${DOCUMENT} ${NOISE} astr.boot ; \ - rm -f ${DOC}/astr.boot.pamphlet ; \ - rm -f ${DOC}/astr.boot.tex ; \ - rm -f ${DOC}/astr.boot ) + ${TANGLE} ${IN}/astr.lisp.pamphlet >astr.lisp ) @ @@ -6893,8 +6875,7 @@ clean: <> <> -<> -<> +<> <> <> diff --git a/src/interp/astr.boot.pamphlet b/src/interp/astr.boot.pamphlet deleted file mode 100644 index b8f9eb0..0000000 --- a/src/interp/astr.boot.pamphlet +++ /dev/null @@ -1,99 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp astr.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" - ---% Attributed Structures (astr) --- For objects which are pairs where the CAR field is either just a tag --- (an identifier) or a pair which is the tag and an association list. - --- Pick off the tag -ncTag x == - not PAIRP x => ncBug('S2CB0031,[]) - x := QCAR x - IDENTP x => x - not PAIRP x => ncBug('S2CB0031,[]) - QCAR x - --- Pick off the property list -ncAlist x == - not PAIRP x => ncBug('S2CB0031,[]) - x := QCAR x - IDENTP x => NIL - not PAIRP x => ncBug('S2CB0031,[]) - QCDR x - - --- Get the entry for key k on x's association list -ncEltQ(x,k) == - r := QASSQ(k,ncAlist x) - NULL r => ncBug ('S2CB0007,[k]) - CDR r - --- Put (k . v) on the association list of x and return v --- case1: ncPutQ(x,k,v) where k is a key (an identifier), v a value --- put the pair (k . v) on the association list of x and return v --- case2: ncPutQ(x,k,v) where k is a list of keys, v a list of values --- equivalent to [ncPutQ(x,key,val) for key in k for val in v] -ncPutQ(x,k,v) == - LISTP k => - for key in k for val in v repeat ncPutQ(x,key,val) - v - r := QASSQ(k,ncAlist x) - if NULL r then - r := CONS( CONS(k,v), ncAlist x) - RPLACA(x,CONS(ncTag x,r)) - else - RPLACD(r,v) - v - -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/astr.lisp.pamphlet b/src/interp/astr.lisp.pamphlet new file mode 100644 index 0000000..c90ebf3 --- /dev/null +++ b/src/interp/astr.lisp.pamphlet @@ -0,0 +1,132 @@ +\documentclass{article} +\usepackage{axiom} +\begin{document} +\title{\$SPAD/src/interp astr.boot} +\author{The Axiom Team} +\maketitle +\begin{abstract} +\end{abstract} +\eject +\tableofcontents +\eject +<<*>>= + +(IN-PACKAGE "BOOT") + +;--% Attributed Structures (astr) +;-- For objects which are pairs where the CAR field is either just a tag +;-- (an identifier) or a pair which is the tag and an association list. +; +;-- Pick off the tag +;ncTag x == +; not PAIRP x => ncBug('S2CB0031,[]) +; x := QCAR x +; IDENTP x => x +; not PAIRP x => ncBug('S2CB0031,[]) +; QCAR x + + +(DEFUN |ncTag| (|x|) + (PROG NIL + (RETURN + (COND + ((NULL (CONSP |x|)) + (|ncBug| (QUOTE S2CB0031) NIL)) + (#0=(QUOTE T) + (PROGN + (SETQ |x| (QCAR |x|)) + (COND + ((IDENTP |x|) |x|) + ((NULL (CONSP |x|)) (|ncBug| (QUOTE S2CB0031) NIL)) + (#0# (QCAR |x|))))))))) + + +;-- Pick off the property list +;ncAlist x == +; not PAIRP x => ncBug('S2CB0031,[]) +; x := QCAR x +; IDENTP x => NIL +; not PAIRP x => ncBug('S2CB0031,[]) +; QCDR x + +(DEFUN |ncAlist| (|x|) + (PROG NIL + (RETURN + (COND + ((NULL (CONSP |x|)) (|ncBug| (QUOTE S2CB0031) NIL)) + (#0=(QUOTE T) + (PROGN + (SETQ |x| (QCAR |x|)) + (COND + ((IDENTP |x|) NIL) + ((NULL (CONSP |x|)) (|ncBug| (QUOTE S2CB0031) NIL)) + (#0# (QCDR |x|))))))))) + +;--- Get the entry for key k on x's association list +;ncEltQ(x,k) == +; r := QASSQ(k,ncAlist x) +; NULL r => ncBug ('S2CB0007,[k]) +; CDR r + +(DEFUN |ncEltQ| (|x| |k|) + (PROG (|r|) + (RETURN + (PROGN + (SETQ |r| (QASSQ |k| (|ncAlist| |x|))) + (COND + ((NULL |r|) (|ncBug| (QUOTE S2CB0007) (LIST |k|))) + ((QUOTE T) (CDR |r|))))))) + +;-- Put (k . v) on the association list of x and return v +;-- case1: ncPutQ(x,k,v) where k is a key (an identifier), v a value +;-- put the pair (k . v) on the association list of x and return v +;-- case2: ncPutQ(x,k,v) where k is a list of keys, v a list of values +;-- equivalent to [ncPutQ(x,key,val) for key in k for val in v] +;ncPutQ(x,k,v) == +; LISTP k => +; for key in k for val in v repeat ncPutQ(x,key,val) +; v +; r := QASSQ(k,ncAlist x) +; if NULL r then +; r := CONS( CONS(k,v), ncAlist x) +; RPLACA(x,CONS(ncTag x,r)) +; else +; RPLACD(r,v) +; v + +(DEFUN |ncPutQ| (|x| |k| |v|) + (PROG (|r|) + (RETURN + (COND + ((LISTP |k|) + (PROGN + ((LAMBDA (|bfVar#1| |key| |bfVar#2| |val|) + (LOOP + (COND + ((OR (ATOM |bfVar#1|) + (PROGN (SETQ |key| (CAR |bfVar#1|)) NIL) + (ATOM |bfVar#2|) + (PROGN (SETQ |val| (CAR |bfVar#2|)) NIL)) + (RETURN NIL)) + ((QUOTE T) + (|ncPutQ| |x| |key| |val|))) + (SETQ |bfVar#1| (CDR |bfVar#1|)) + (SETQ |bfVar#2| (CDR |bfVar#2|)))) + |k| NIL |v| NIL) + |v|)) + ((QUOTE T) + (PROGN + (SETQ |r| (QASSQ |k| (|ncAlist| |x|))) + (COND + ((NULL |r|) + (SETQ |r| (CONS (CONS |k| |v|) (|ncAlist| |x|))) + (RPLACA |x| (CONS (|ncTag| |x|) |r|))) + ((QUOTE T) (RPLACD |r| |v|))) + |v|)))))) + +@ +\eject +\begin{thebibliography}{99} +\bibitem{1} nothing +\end{thebibliography} +\end{document} diff --git a/src/interp/debugsys.lisp.pamphlet b/src/interp/debugsys.lisp.pamphlet index c76e383..dc016cb 100644 --- a/src/interp/debugsys.lisp.pamphlet +++ b/src/interp/debugsys.lisp.pamphlet @@ -85,7 +85,7 @@ loaded by hand we need to establish a value. (append (list (thesymb "/int/interp/vmlisp.lisp") - (thesymb "/int/interp/astr.clisp") + (thesymb "/int/interp/astr.lisp") (thesymb "/int/interp/alql.lisp") (thesymb "/int/interp/buildom.clisp") (thesymb "/int/interp/cattable.clisp")