diff --git a/changelog b/changelog index 4e9cd29..22041ea 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,7 @@ +20090825 tpd src/axiom-website/patches.html 20090825.01.tpd.patch +20090825 tpd src/interp/Makefile move posit.boot to posit.lisp +20090825 tpd src/interp/posit.lisp added, rewritten from posit.boot +20090825 tpd src/interp/posit.boot removed, rewritten to posit.lisp 20090824 tpd src/axiom-website/patches.html 20090824.11.tpd.patch 20090824 tpd src/interp/Makefile move pile.boot to pile.lisp 20090824 tpd src/interp/pile.lisp added, rewritten from pile.boot diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 9ed2881..c093ae5 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -1886,5 +1886,7 @@ pathname.lisp rewrite from boot to lisp
pf2sex.lisp rewrite from boot to lisp
20090824.11.tpd.patch pile.lisp rewrite from boot to lisp
+20090825.01.tpd.patch +posit.lisp rewrite from boot to lisp
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index 96fd388..d799c4f 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -4888,44 +4888,26 @@ ${DOC}/serror.boot.dvi: ${IN}/serror.boot.pamphlet @ -\subsection{posit.boot} +\subsection{posit.lisp} <>= -${OUT}/posit.${O}: ${MID}/posit.clisp - @ echo 540 making ${OUT}/posit.${O} from ${MID}/posit.clisp - @ if [ -z "${NOISE}" ] ; then \ - echo '(progn (compile-file "${MID}/posit.clisp"' \ - ':output-file "${OUT}/posit.${O}") (${BYE}))' | ${DEPSYS} ; \ +${OUT}/posit.${O}: ${MID}/posit.lisp + @ echo 136 making ${OUT}/posit.${O} from ${MID}/posit.lisp + @ ( cd ${MID} ; \ + if [ -z "${NOISE}" ] ; then \ + echo '(progn (compile-file "${MID}/posit.lisp"' \ + ':output-file "${OUT}/posit.${O}") (${BYE}))' | ${DEPSYS} ; \ else \ - echo '(progn (compile-file "${MID}/posit.clisp"' \ + echo '(progn (compile-file "${MID}/posit.lisp"' \ ':output-file "${OUT}/posit.${O}") (${BYE}))' | ${DEPSYS} \ >${TMP}/trace ; \ - fi + fi ) @ -<>= -${MID}/posit.clisp: ${IN}/posit.boot.pamphlet - @ echo 541 making ${MID}/posit.clisp from ${IN}/posit.boot.pamphlet +<>= +${MID}/posit.lisp: ${IN}/posit.lisp.pamphlet + @ echo 137 making ${MID}/posit.lisp from ${IN}/posit.lisp.pamphlet @ (cd ${MID} ; \ - ${TANGLE} ${IN}/posit.boot.pamphlet >posit.boot ; \ - if [ -z "${NOISE}" ] ; then \ - echo '(progn (boottran::boottocl "${MID}/posit.boot") (${BYE}))' \ - | ${BOOTSYS} ; \ - else \ - echo '(progn (boottran::boottocl "${MID}/posit.boot") (${BYE}))' \ - | ${BOOTSYS} >${TMP}/trace ; \ - fi ; \ - rm posit.boot ) - -@ -<>= -${DOC}/posit.boot.dvi: ${IN}/posit.boot.pamphlet - @echo 542 making ${DOC}/posit.boot.dvi from ${IN}/posit.boot.pamphlet - @(cd ${DOC} ; \ - cp ${IN}/posit.boot.pamphlet ${DOC} ; \ - ${DOCUMENT} ${NOISE} posit.boot ; \ - rm -f ${DOC}/posit.boot.pamphlet ; \ - rm -f ${DOC}/posit.boot.tex ; \ - rm -f ${DOC}/posit.boot ) + ${TANGLE} ${IN}/posit.lisp.pamphlet >posit.lisp ) @ @@ -6172,8 +6154,7 @@ clean: <> <> -<> -<> +<> <> <> diff --git a/src/interp/posit.boot.pamphlet b/src/interp/posit.boot.pamphlet deleted file mode 100644 index 72adfa0..0000000 --- a/src/interp/posit.boot.pamphlet +++ /dev/null @@ -1,200 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp posit.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" - -poNoPosition() == $nopos -pfNoPosition() == poNoPosition() - -poNoPosition? pos == EQCAR(pos,'noposition) -pfNoPosition? pos == poNoPosition? pos - -pfSourceText pf == - lnString poGetLineObject pfPosn pf - -pfPosOrNopos pf == - poIsPos? (pos := pfSourcePosition pf) => pos - poNoPosition() - -poIsPos? pos == - PAIRP pos and PAIRP CAR pos and LENGTH CAR pos = 5 - -lnCreate(extBl, st, gNo, :optFileStuff) == - lNo := - num := IFCAR optFileStuff => num - 0 - fN := IFCAR IFCDR optFileStuff - [extBl, st, gNo, lNo, fN] - -lnString lineObject == - lineObject.1 - -lnExtraBlanks lineObject == - lineObject.0 - -lnGlobalNum lineObject == - lineObject.2 - -lnSetGlobalNum(lineObject, num) == - lineObject.2 := num - -lnLocalNum lineObject == - lineObject.3 - -lnFileName lineObject == - (fN := lnFileName? lineObject) => fN - ncBug('"there is no file name in %1", [lineObject] ) - -lnFileName? lineObject == - NOT PAIRP (fN := lineObject.4) => NIL - fN - -lnPlaceOfOrigin lineObject == - lineObject.4 - -lnImmediate? lineObject == - not lnFileName? lineObject - -poGetLineObject posn == - CAR posn -pfGetLineObject posn == poGetLineObject posn - -pfSourceToken form == - if pfLeaf? form - then pfLeafToken form - else if null pfParts form - then 'NoToken - else pfSourceToken(pfFirst form) - -pfPosn pf == pfSourcePosition pf - -pfSourcePosition form == - --null form => pfNoPosition() - pfLeaf? form => pfLeafPosition form - parts := pfParts form - pos := $nopos - for p in parts while poNoPosition? pos repeat - pos := pfSourcePosition p - pos - -pfSourcePositions form == - if pfLeaf? form - then - a:=tokPosn form - if null a - then nil - else [a] - else pfSourcePositionlist pfParts form - -pfSourcePositionlist x== - if null x - then nil - else APPEND(pfSourcePositions first x,pfSourcePositionlist rest x) - - -poCharPosn posn == CDR posn -pfCharPosn posn == poCharPosn posn - -poLinePosn posn == - posn => lnLocalNum poGetLineObject posn --VECP posn => - CDAR posn -pfLinePosn posn == poLinePosn posn - -poGlobalLinePosn posn == - posn => lnGlobalNum poGetLineObject posn - ncBug('"old style pos objects have no global positions",[]) -pfGlobalLinePosn posn == poGlobalLinePosn posn - -poFileName posn == - posn => lnFileName poGetLineObject posn - CAAR posn -pfFileName posn == poFileName posn - -poFileName? posn == - posn = ['noposition] => NIL - posn => lnFileName? poGetLineObject posn - CAAR posn -pfFileName? posn == poFileName? posn - -poPlaceOfOrigin posn == - lnPlaceOfOrigin poGetLineObject posn -pfPlaceOfOrigin posn == poPlaceOfOrigin posn - -poNopos? posn == - posn = ['noposition] -pfNopos? posn == poNopos? posn -poPosImmediate? txp== - poNopos? txp => NIL - lnImmediate? poGetLineObject txp -pfPosImmediate? txp == poPosImmediate? txp - -poImmediate? txp== - lnImmediate? poGetLineObject txp -pfImmediate? txp == poImmediate? txp - - -compareposns(a,b)== - c:=poGlobalLinePosn a - d:=poGlobalLinePosn b - if c=d then poCharPosn a>=poCharPosn b else c>=d - -pfPrintSrcLines(pf) == - lines := pfSourcePositions pf - lno := 0 - for l in lines repeat - line := car l - if lno < lnGlobalNum(line) then - FORMAT(true, '" ~A~%", lnString line) - lno := lnGlobalNum(line) - -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/posit.lisp.pamphlet b/src/interp/posit.lisp.pamphlet new file mode 100644 index 0000000..3fca939 --- /dev/null +++ b/src/interp/posit.lisp.pamphlet @@ -0,0 +1,407 @@ +\documentclass{article} +\usepackage{axiom} +\begin{document} +\title{\$SPAD/src/interp posit.lisp} +\author{The Axiom Team} +\maketitle +\begin{abstract} +\end{abstract} +\eject +\tableofcontents +\eject +<<*>>= +(IN-PACKAGE "BOOT") + +;poNoPosition() == $nopos + +(DEFUN |poNoPosition| () + (PROG () (DECLARE (SPECIAL |$nopos|)) (RETURN |$nopos|))) + +;pfNoPosition() == poNoPosition() + +(DEFUN |pfNoPosition| () (PROG () (RETURN (|poNoPosition|)))) + +;poNoPosition? pos == EQCAR(pos,'noposition) + +(DEFUN |poNoPosition?| (|pos|) + (PROG () (RETURN (EQCAR |pos| '|noposition|)))) + +;pfNoPosition? pos == poNoPosition? pos + +(DEFUN |pfNoPosition?| (|pos|) + (PROG () (RETURN (|poNoPosition?| |pos|)))) + +;pfSourceText pf == +; lnString poGetLineObject pfPosn pf + +(DEFUN |pfSourceText| (|pf|) + (PROG () (RETURN (|lnString| (|poGetLineObject| (|pfPosn| |pf|)))))) + +;pfPosOrNopos pf == +; poIsPos? (pos := pfSourcePosition pf) => pos +; poNoPosition() + +(DEFUN |pfPosOrNopos| (|pf|) + (PROG (|pos|) + (RETURN + (COND + ((|poIsPos?| (SETQ |pos| (|pfSourcePosition| |pf|))) |pos|) + ('T (|poNoPosition|)))))) + +;poIsPos? pos == +; PAIRP pos and PAIRP CAR pos and LENGTH CAR pos = 5 + +(DEFUN |poIsPos?| (|pos|) + (PROG () + (RETURN + (AND (CONSP |pos|) (CONSP (CAR |pos|)) + (EQL (LENGTH (CAR |pos|)) 5))))) + +;lnCreate(extBl, st, gNo, :optFileStuff) == +; lNo := +; num := IFCAR optFileStuff => num +; 0 +; fN := IFCAR IFCDR optFileStuff +; [extBl, st, gNo, lNo, fN] + +(DEFUN |lnCreate| (|extBl| |st| |gNo| &REST |optFileStuff|) + (PROG (|fN| |lNo| |num|) + (RETURN + (PROGN + (SETQ |lNo| + (COND + ((SETQ |num| (IFCAR |optFileStuff|)) |num|) + ('T 0))) + (SETQ |fN| (IFCAR (IFCDR |optFileStuff|))) + (LIST |extBl| |st| |gNo| |lNo| |fN|))))) + +;lnString lineObject == +; lineObject.1 + +(DEFUN |lnString| (|lineObject|) + (PROG () (RETURN (ELT |lineObject| 1)))) + +;lnExtraBlanks lineObject == +; lineObject.0 + +(DEFUN |lnExtraBlanks| (|lineObject|) + (PROG () (RETURN (ELT |lineObject| 0)))) + +;lnGlobalNum lineObject == +; lineObject.2 + +(DEFUN |lnGlobalNum| (|lineObject|) + (PROG () (RETURN (ELT |lineObject| 2)))) + +;lnSetGlobalNum(lineObject, num) == +; lineObject.2 := num + +(DEFUN |lnSetGlobalNum| (|lineObject| |num|) + (PROG () (RETURN (SETF (ELT |lineObject| 2) |num|)))) + +;lnLocalNum lineObject == +; lineObject.3 + +(DEFUN |lnLocalNum| (|lineObject|) + (PROG () (RETURN (ELT |lineObject| 3)))) + +;lnFileName lineObject == +; (fN := lnFileName? lineObject) => fN +; ncBug('"there is no file name in %1", [lineObject] ) + +(DEFUN |lnFileName| (|lineObject|) + (PROG (|fN|) + (RETURN + (COND + ((SETQ |fN| (|lnFileName?| |lineObject|)) |fN|) + ('T + (|ncBug| "there is no file name in %1" (LIST |lineObject|))))))) + +;lnFileName? lineObject == +; NOT PAIRP (fN := lineObject.4) => NIL +; fN + +(DEFUN |lnFileName?| (|lineObject|) + (PROG (|fN|) + (RETURN + (COND + ((NULL (CONSP (SETQ |fN| (ELT |lineObject| 4)))) NIL) + ('T |fN|))))) + +;lnPlaceOfOrigin lineObject == +; lineObject.4 + +(DEFUN |lnPlaceOfOrigin| (|lineObject|) + (PROG () (RETURN (ELT |lineObject| 4)))) + +;lnImmediate? lineObject == +; not lnFileName? lineObject + +(DEFUN |lnImmediate?| (|lineObject|) + (PROG () (RETURN (NULL (|lnFileName?| |lineObject|))))) + +;poGetLineObject posn == +; CAR posn + +(DEFUN |poGetLineObject| (|posn|) (PROG () (RETURN (CAR |posn|)))) + +;pfGetLineObject posn == poGetLineObject posn + +(DEFUN |pfGetLineObject| (|posn|) + (PROG () (RETURN (|poGetLineObject| |posn|)))) + +;pfSourceToken form == +; if pfLeaf? form +; then pfLeafToken form +; else if null pfParts form +; then 'NoToken +; else pfSourceToken(pfFirst form) + +(DEFUN |pfSourceToken| (|form|) + (PROG () + (RETURN + (COND + ((|pfLeaf?| |form|) (|pfLeafToken| |form|)) + ((NULL (|pfParts| |form|)) '|NoToken|) + ('T (|pfSourceToken| (|pfFirst| |form|))))))) + +;pfPosn pf == pfSourcePosition pf + +(DEFUN |pfPosn| (|pf|) (PROG () (RETURN (|pfSourcePosition| |pf|)))) + +;pfSourcePosition form == +; --null form => pfNoPosition() +; pfLeaf? form => pfLeafPosition form +; parts := pfParts form +; pos := $nopos +; for p in parts while poNoPosition? pos repeat +; pos := pfSourcePosition p +; pos + +(DEFUN |pfSourcePosition| (|form|) + (PROG (|pos| |parts|) + (DECLARE (SPECIAL |$nopos|)) + (RETURN + (COND + ((|pfLeaf?| |form|) (|pfLeafPosition| |form|)) + ('T + (PROGN + (SETQ |parts| (|pfParts| |form|)) + (SETQ |pos| |$nopos|) + ((LAMBDA (|bfVar#1| |p|) + (LOOP + (COND + ((OR (ATOM |bfVar#1|) + (PROGN (SETQ |p| (CAR |bfVar#1|)) NIL) + (NOT (|poNoPosition?| |pos|))) + (RETURN NIL)) + ('T (SETQ |pos| (|pfSourcePosition| |p|)))) + (SETQ |bfVar#1| (CDR |bfVar#1|)))) + |parts| NIL) + |pos|)))))) + +;pfSourcePositions form == +; if pfLeaf? form +; then +; a:=tokPosn form +; if null a +; then nil +; else [a] +; else pfSourcePositionlist pfParts form + +(DEFUN |pfSourcePositions| (|form|) + (PROG (|a|) + (RETURN + (COND + ((|pfLeaf?| |form|) (SETQ |a| (|tokPosn| |form|)) + (COND ((NULL |a|) NIL) ('T (LIST |a|)))) + ('T (|pfSourcePositionlist| (|pfParts| |form|))))))) + +;pfSourcePositionlist x== +; if null x +; then nil +; else APPEND(pfSourcePositions first x,pfSourcePositionlist rest x) + +(DEFUN |pfSourcePositionlist| (|x|) + (PROG () + (RETURN + (COND + ((NULL |x|) NIL) + ('T + (APPEND (|pfSourcePositions| (CAR |x|)) + (|pfSourcePositionlist| (CDR |x|)))))))) + +;poCharPosn posn == CDR posn + +(DEFUN |poCharPosn| (|posn|) (PROG () (RETURN (CDR |posn|)))) + +;pfCharPosn posn == poCharPosn posn + +(DEFUN |pfCharPosn| (|posn|) (PROG () (RETURN (|poCharPosn| |posn|)))) + +;poLinePosn posn == +; posn => lnLocalNum poGetLineObject posn --VECP posn => +; CDAR posn + +(DEFUN |poLinePosn| (|posn|) + (PROG () + (RETURN + (COND + (|posn| (|lnLocalNum| (|poGetLineObject| |posn|))) + ('T (CDAR |posn|)))))) + +;pfLinePosn posn == poLinePosn posn + +(DEFUN |pfLinePosn| (|posn|) (PROG () (RETURN (|poLinePosn| |posn|)))) + +;poGlobalLinePosn posn == +; posn => lnGlobalNum poGetLineObject posn +; ncBug('"old style pos objects have no global positions",[]) + +(DEFUN |poGlobalLinePosn| (|posn|) + (PROG () + (RETURN + (COND + (|posn| (|lnGlobalNum| (|poGetLineObject| |posn|))) + ('T + (|ncBug| "old style pos objects have no global positions" NIL)))))) + +;pfGlobalLinePosn posn == poGlobalLinePosn posn + +(DEFUN |pfGlobalLinePosn| (|posn|) + (PROG () (RETURN (|poGlobalLinePosn| |posn|)))) + +;poFileName posn == +; posn => lnFileName poGetLineObject posn +; CAAR posn + +(DEFUN |poFileName| (|posn|) + (PROG () + (RETURN + (COND + (|posn| (|lnFileName| (|poGetLineObject| |posn|))) + ('T (CAAR |posn|)))))) + +;pfFileName posn == poFileName posn + +(DEFUN |pfFileName| (|posn|) (PROG () (RETURN (|poFileName| |posn|)))) + +;poFileName? posn == +; posn = ['noposition] => NIL +; posn => lnFileName? poGetLineObject posn +; CAAR posn + +(DEFUN |poFileName?| (|posn|) + (PROG () + (RETURN + (COND + ((EQUAL |posn| (LIST '|noposition|)) NIL) + (|posn| (|lnFileName?| (|poGetLineObject| |posn|))) + ('T (CAAR |posn|)))))) + +;pfFileName? posn == poFileName? posn + +(DEFUN |pfFileName?| (|posn|) + (PROG () (RETURN (|poFileName?| |posn|)))) + +;poPlaceOfOrigin posn == +; lnPlaceOfOrigin poGetLineObject posn + +(DEFUN |poPlaceOfOrigin| (|posn|) + (PROG () (RETURN (|lnPlaceOfOrigin| (|poGetLineObject| |posn|))))) + +;pfPlaceOfOrigin posn == poPlaceOfOrigin posn + +(DEFUN |pfPlaceOfOrigin| (|posn|) + (PROG () (RETURN (|poPlaceOfOrigin| |posn|)))) + +;poNopos? posn == +; posn = ['noposition] + +(DEFUN |poNopos?| (|posn|) + (PROG () (RETURN (EQUAL |posn| (LIST '|noposition|))))) + +;pfNopos? posn == poNopos? posn + +(DEFUN |pfNopos?| (|posn|) (PROG () (RETURN (|poNopos?| |posn|)))) + +;poPosImmediate? txp== +; poNopos? txp => NIL +; lnImmediate? poGetLineObject txp + +(DEFUN |poPosImmediate?| (|txp|) + (PROG () + (RETURN + (COND + ((|poNopos?| |txp|) NIL) + ('T (|lnImmediate?| (|poGetLineObject| |txp|))))))) + +;pfPosImmediate? txp == poPosImmediate? txp + +(DEFUN |pfPosImmediate?| (|txp|) + (PROG () (RETURN (|poPosImmediate?| |txp|)))) + +;poImmediate? txp== +; lnImmediate? poGetLineObject txp + +(DEFUN |poImmediate?| (|txp|) + (PROG () (RETURN (|lnImmediate?| (|poGetLineObject| |txp|))))) + +;pfImmediate? txp == poImmediate? txp + +(DEFUN |pfImmediate?| (|txp|) + (PROG () (RETURN (|poImmediate?| |txp|)))) + +;compareposns(a,b)== +; c:=poGlobalLinePosn a +; d:=poGlobalLinePosn b +; if c=d then poCharPosn a>=poCharPosn b else c>=d + +(DEFUN |compareposns| (|a| |b|) + (PROG (|d| |c|) + (RETURN + (PROGN + (SETQ |c| (|poGlobalLinePosn| |a|)) + (SETQ |d| (|poGlobalLinePosn| |b|)) + (COND + ((EQUAL |c| |d|) + (NOT (< (|poCharPosn| |a|) (|poCharPosn| |b|)))) + ('T (NOT (< |c| |d|)))))))) + +;pfPrintSrcLines(pf) == +; lines := pfSourcePositions pf +; lno := 0 +; for l in lines repeat +; line := car l +; if lno < lnGlobalNum(line) then +; FORMAT(true, '" ~A~%", lnString line) +; lno := lnGlobalNum(line) + +(DEFUN |pfPrintSrcLines| (|pf|) + (PROG (|line| |lno| |lines|) + (RETURN + (PROGN + (SETQ |lines| (|pfSourcePositions| |pf|)) + (SETQ |lno| 0) + ((LAMBDA (|bfVar#2| |l|) + (LOOP + (COND + ((OR (ATOM |bfVar#2|) + (PROGN (SETQ |l| (CAR |bfVar#2|)) NIL)) + (RETURN NIL)) + ('T + (PROGN + (SETQ |line| (CAR |l|)) + (COND + ((< |lno| (|lnGlobalNum| |line|)) + (FORMAT T " ~A~%" (|lnString| |line|)) + (SETQ |lno| (|lnGlobalNum| |line|))))))) + (SETQ |bfVar#2| (CDR |bfVar#2|)))) + |lines| NIL))))) + +@ +\eject +\begin{thebibliography}{99} +\bibitem{1} nothing +\end{thebibliography} +\end{document}