diff --git a/changelog b/changelog index 9ed93c3..4e9cd29 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,7 @@ +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 +20090824 tpd src/interp/pile.boot removed, rewritten to pile.lisp 20090824 tpd src/axiom-website/patches.html 20090824.10.tpd.patch 20090824 tpd src/interp/Makefile move pf2sex.boot to pf2sex.lisp 20090824 tpd src/interp/pf2sex.lisp added, rewritten from pf2sex.boot diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index feec491..9ed2881 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -1884,5 +1884,7 @@ packtran.lisp rewrite from boot to lisp
pathname.lisp rewrite from boot to lisp
20090824.10.tpd.patch pf2sex.lisp rewrite from boot to lisp
+20090824.11.tpd.patch +pile.lisp rewrite from boot to lisp
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index 25cb04f..96fd388 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -4604,44 +4604,26 @@ ${DOC}/scan.boot.dvi: ${IN}/scan.boot.pamphlet @ -\subsection{pile.boot} +\subsection{pile.lisp} <>= -${OUT}/pile.${O}: ${MID}/pile.clisp - @ echo 510 making ${OUT}/pile.${O} from ${MID}/pile.clisp - @ if [ -z "${NOISE}" ] ; then \ - echo '(progn (compile-file "${MID}/pile.clisp"' \ - ':output-file "${OUT}/pile.${O}") (${BYE}))' | ${DEPSYS} ; \ - else \ - echo '(progn (compile-file "${MID}/pile.clisp"' \ - ':output-file "${OUT}/pile.${O}") (${BYE}))' | ${DEPSYS} \ - >${TMP}/trace ; \ - fi - -@ -<>= -${MID}/pile.clisp: ${IN}/pile.boot.pamphlet - @ echo 511 making ${MID}/pile.clisp from ${IN}/pile.boot.pamphlet - @ (cd ${MID} ; \ - ${TANGLE} ${IN}/pile.boot.pamphlet >pile.boot ; \ +${OUT}/pile.${O}: ${MID}/pile.lisp + @ echo 136 making ${OUT}/pile.${O} from ${MID}/pile.lisp + @ ( cd ${MID} ; \ if [ -z "${NOISE}" ] ; then \ - echo '(progn (boottran::boottocl "${MID}/pile.boot") (${BYE}))' \ - | ${BOOTSYS} ; \ + echo '(progn (compile-file "${MID}/pile.lisp"' \ + ':output-file "${OUT}/pile.${O}") (${BYE}))' | ${DEPSYS} ; \ else \ - echo '(progn (boottran::boottocl "${MID}/pile.boot") (${BYE}))' \ - | ${BOOTSYS} >${TMP}/trace ; \ - fi ; \ - rm pile.boot ) + echo '(progn (compile-file "${MID}/pile.lisp"' \ + ':output-file "${OUT}/pile.${O}") (${BYE}))' | ${DEPSYS} \ + >${TMP}/trace ; \ + fi ) @ -<>= -${DOC}/pile.boot.dvi: ${IN}/pile.boot.pamphlet - @echo 512 making ${DOC}/pile.boot.dvi from ${IN}/pile.boot.pamphlet - @(cd ${DOC} ; \ - cp ${IN}/pile.boot.pamphlet ${DOC} ; \ - ${DOCUMENT} ${NOISE} pile.boot ; \ - rm -f ${DOC}/pile.boot.pamphlet ; \ - rm -f ${DOC}/pile.boot.tex ; \ - rm -f ${DOC}/pile.boot ) +<>= +${MID}/pile.lisp: ${IN}/pile.lisp.pamphlet + @ echo 137 making ${MID}/pile.lisp from ${IN}/pile.lisp.pamphlet + @ (cd ${MID} ; \ + ${TANGLE} ${IN}/pile.lisp.pamphlet >pile.lisp ) @ @@ -6187,8 +6169,7 @@ clean: <> <> -<> -<> +<> <> <> diff --git a/src/interp/pile.boot.pamphlet b/src/interp/pile.boot.pamphlet deleted file mode 100644 index 2b457fd..0000000 --- a/src/interp/pile.boot.pamphlet +++ /dev/null @@ -1,176 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp pile.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" - --- insertpiles converts a line-list to a line-forest where - --- a line is a token-dequeue and has a column which is an integer. --- an A-forest is an A-tree-list --- an A-tree has a root which is an A, and subtrees which is an A-forest. - --- A forest with more than one tree corresponds to a Scratchpad pile --- structure (t1;t2;t3;...;tn), and a tree corresponds to a pile item. --- The ( ; and ) tokens are inserted into a >1-forest, otherwise --- the root of the first tree is concatenated with its forest. --- column t is the number of spaces before the first non-space in line t - -pileColumn t==CDR tokPosn CAAR t -pileComment t== EQ(tokType CAAR t,"negcomment") -pilePlusComment t== EQ(tokType CAAR t,"comment") - --- insertpile is used by next so s is non-null --- bite off a line-tree, return it and the remaining line-list. - -insertpile (s)== - if npNull s - then [false,0,[],s] - else - [h,t]:=[car s,cdr s] - if pilePlusComment h - then - [h1,t1]:=pilePlusComments s - a:=pileTree(-1,t1) - cons([pileCforest [:h1,a.2]],a.3) - else - stream:=CADAR s - a:=pileTree(-1,s) - cons([[a.2,stream]],a.3) - -pilePlusComments s== - if npNull s - then [[],s] - else - [h,t]:=[car s,cdr s] - if pilePlusComment h - then - [h1,t1]:=pilePlusComments t - [cons(h,h1),t1] - else [[],s] - -pileTree(n,s)== - if npNull s - then [false,n,[],s] - else - [h,t]:=[car s,cdr s] - hh:=pileColumn CAR h - if hh > n - then pileForests(CAR h,hh,t) - else [false,n,[],s] - -eqpileTree(n,s)== - if npNull s - then [false,n,[],s] - else - [h,t]:=[car s,cdr s] - hh:=pileColumn CAR h - if hh = n - then pileForests(CAR h,hh,t) - else [false,n,[],s] - -pileForest(n,s)== - [b,hh,h,t]:= pileTree(n,s) - if b - then - [h1,t1]:=pileForest1(hh,t) - [cons(h,h1),t1] - else [[],s] - -pileForest1(n,s)== - [b,n1,h,t]:= eqpileTree(n,s) - if b - then - [h1,t1]:=pileForest1(n,t) - [cons(h,h1),t1] - else [[],s] - -pileForests(h,n,s)== - [h1,t1]:=pileForest(n,s) - if npNull h1 - then [true,n,h,s] - else pileForests(pileCtree(h,h1),n,t1) - -pileCtree(x,y)==dqAppend(x,pileCforest y) - --- only enpiles forests with >=2 trees - -pileCforest x== - if null x - then [] - else if null cdr x - then - f:= car x - if EQ(tokPart CAAR f,"IF") - then enPile f - else f - else enPile separatePiles x - -firstTokPosn t== tokPosn CAAR t -lastTokPosn t== tokPosn CADR t - -separatePiles x== - if null x - then [] - else if null cdr x - then car x - else - a:=car x - semicolon:=dqUnit tokConstruct("key", "BACKSET",lastTokPosn a) - dqConcat [a,semicolon,separatePiles cdr x] - -enPile x== - dqConcat [dqUnit tokConstruct("key","SETTAB",firstTokPosn x), - x, _ - dqUnit tokConstruct("key","BACKTAB",lastTokPosn x)] - -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/pile.lisp.pamphlet b/src/interp/pile.lisp.pamphlet new file mode 100644 index 0000000..92e1ffe --- /dev/null +++ b/src/interp/pile.lisp.pamphlet @@ -0,0 +1,295 @@ +\documentclass{article} +\usepackage{axiom} +\begin{document} +\title{\$SPAD/src/interp pile.lisp} +\author{The Axiom Team} +\maketitle +\begin{abstract} +\end{abstract} +\eject +\tableofcontents +\eject +<<*>>= +(IN-PACKAGE "BOOT") + +;-- insertpiles converts a line-list to a line-forest where +; +;-- a line is a token-dequeue and has a column which is an integer. +;-- an A-forest is an A-tree-list +;-- an A-tree has a root which is an A, and subtrees which is an A-forest. +; +;-- A forest with more than one tree corresponds to a Scratchpad pile +;-- structure (t1;t2;t3;...;tn), and a tree corresponds to a pile item. +;-- The ( ; and ) tokens are inserted into a >1-forest, otherwise +;-- the root of the first tree is concatenated with its forest. +;-- column t is the number of spaces before the first non-space in line t +; +;pileColumn t==CDR tokPosn CAAR t + +(DEFUN |pileColumn| (|t|) + (PROG () (RETURN (CDR (|tokPosn| (CAAR |t|)))))) + +;pileComment t== EQ(tokType CAAR t,"negcomment") + +(DEFUN |pileComment| (|t|) + (PROG () (RETURN (EQ (|tokType| (CAAR |t|)) '|negcomment|)))) + +;pilePlusComment t== EQ(tokType CAAR t,"comment") + +(DEFUN |pilePlusComment| (|t|) + (PROG () (RETURN (EQ (|tokType| (CAAR |t|)) '|comment|)))) + +;-- insertpile is used by next so s is non-null +;-- bite off a line-tree, return it and the remaining line-list. +; +;insertpile (s)== +; if npNull s +; then [false,0,[],s] +; else +; [h,t]:=[car s,cdr s] +; if pilePlusComment h +; then +; [h1,t1]:=pilePlusComments s +; a:=pileTree(-1,t1) +; cons([pileCforest [:h1,a.2]],a.3) +; else +; stream:=CADAR s +; a:=pileTree(-1,s) +; cons([[a.2,stream]],a.3) + +(DEFUN |insertpile| (|s|) + (PROG (|stream| |a| |t1| |h1| |t| |h| |LETTMP#1|) + (RETURN + (COND + ((|npNull| |s|) (LIST NIL 0 NIL |s|)) + ('T (SETQ |LETTMP#1| (LIST (CAR |s|) (CDR |s|))) + (SETQ |h| (CAR |LETTMP#1|)) (SETQ |t| (CADR |LETTMP#1|)) + (COND + ((|pilePlusComment| |h|) + (SETQ |LETTMP#1| (|pilePlusComments| |s|)) + (SETQ |h1| (CAR |LETTMP#1|)) (SETQ |t1| (CADR |LETTMP#1|)) + (SETQ |a| (|pileTree| (- 1) |t1|)) + (CONS (LIST (|pileCforest| + (APPEND |h1| (CONS (ELT |a| 2) NIL)))) + (ELT |a| 3))) + ('T (SETQ |stream| (CADAR |s|)) + (SETQ |a| (|pileTree| (- 1) |s|)) + (CONS (LIST (LIST (ELT |a| 2) |stream|)) (ELT |a| 3))))))))) + +;pilePlusComments s== +; if npNull s +; then [[],s] +; else +; [h,t]:=[car s,cdr s] +; if pilePlusComment h +; then +; [h1,t1]:=pilePlusComments t +; [cons(h,h1),t1] +; else [[],s] + +(DEFUN |pilePlusComments| (|s|) + (PROG (|t1| |h1| |t| |h| |LETTMP#1|) + (RETURN + (COND + ((|npNull| |s|) (LIST NIL |s|)) + ('T (SETQ |LETTMP#1| (LIST (CAR |s|) (CDR |s|))) + (SETQ |h| (CAR |LETTMP#1|)) (SETQ |t| (CADR |LETTMP#1|)) + (COND + ((|pilePlusComment| |h|) + (SETQ |LETTMP#1| (|pilePlusComments| |t|)) + (SETQ |h1| (CAR |LETTMP#1|)) (SETQ |t1| (CADR |LETTMP#1|)) + (LIST (CONS |h| |h1|) |t1|)) + ('T (LIST NIL |s|)))))))) + +;pileTree(n,s)== +; if npNull s +; then [false,n,[],s] +; else +; [h,t]:=[car s,cdr s] +; hh:=pileColumn CAR h +; if hh > n +; then pileForests(CAR h,hh,t) +; else [false,n,[],s] + +(DEFUN |pileTree| (|n| |s|) + (PROG (|hh| |t| |h| |LETTMP#1|) + (RETURN + (COND + ((|npNull| |s|) (LIST NIL |n| NIL |s|)) + ('T (SETQ |LETTMP#1| (LIST (CAR |s|) (CDR |s|))) + (SETQ |h| (CAR |LETTMP#1|)) (SETQ |t| (CADR |LETTMP#1|)) + (SETQ |hh| (|pileColumn| (CAR |h|))) + (COND + ((< |n| |hh|) (|pileForests| (CAR |h|) |hh| |t|)) + ('T (LIST NIL |n| NIL |s|)))))))) + +;eqpileTree(n,s)== +; if npNull s +; then [false,n,[],s] +; else +; [h,t]:=[car s,cdr s] +; hh:=pileColumn CAR h +; if hh = n +; then pileForests(CAR h,hh,t) +; else [false,n,[],s] + +(DEFUN |eqpileTree| (|n| |s|) + (PROG (|hh| |t| |h| |LETTMP#1|) + (RETURN + (COND + ((|npNull| |s|) (LIST NIL |n| NIL |s|)) + ('T (SETQ |LETTMP#1| (LIST (CAR |s|) (CDR |s|))) + (SETQ |h| (CAR |LETTMP#1|)) (SETQ |t| (CADR |LETTMP#1|)) + (SETQ |hh| (|pileColumn| (CAR |h|))) + (COND + ((EQUAL |hh| |n|) (|pileForests| (CAR |h|) |hh| |t|)) + ('T (LIST NIL |n| NIL |s|)))))))) + +;pileForest(n,s)== +; [b,hh,h,t]:= pileTree(n,s) +; if b +; then +; [h1,t1]:=pileForest1(hh,t) +; [cons(h,h1),t1] +; else [[],s] + +(DEFUN |pileForest| (|n| |s|) + (PROG (|t1| |h1| |t| |h| |hh| |b| |LETTMP#1|) + (RETURN + (PROGN + (SETQ |LETTMP#1| (|pileTree| |n| |s|)) + (SETQ |b| (CAR |LETTMP#1|)) + (SETQ |hh| (CADR |LETTMP#1|)) + (SETQ |h| (CADDR |LETTMP#1|)) + (SETQ |t| (CADDDR |LETTMP#1|)) + (COND + (|b| (SETQ |LETTMP#1| (|pileForest1| |hh| |t|)) + (SETQ |h1| (CAR |LETTMP#1|)) + (SETQ |t1| (CADR |LETTMP#1|)) + (LIST (CONS |h| |h1|) |t1|)) + ('T (LIST NIL |s|))))))) + +;pileForest1(n,s)== +; [b,n1,h,t]:= eqpileTree(n,s) +; if b +; then +; [h1,t1]:=pileForest1(n,t) +; [cons(h,h1),t1] +; else [[],s] + +(DEFUN |pileForest1| (|n| |s|) + (PROG (|t1| |h1| |t| |h| |n1| |b| |LETTMP#1|) + (RETURN + (PROGN + (SETQ |LETTMP#1| (|eqpileTree| |n| |s|)) + (SETQ |b| (CAR |LETTMP#1|)) + (SETQ |n1| (CADR |LETTMP#1|)) + (SETQ |h| (CADDR |LETTMP#1|)) + (SETQ |t| (CADDDR |LETTMP#1|)) + (COND + (|b| (SETQ |LETTMP#1| (|pileForest1| |n| |t|)) + (SETQ |h1| (CAR |LETTMP#1|)) + (SETQ |t1| (CADR |LETTMP#1|)) + (LIST (CONS |h| |h1|) |t1|)) + ('T (LIST NIL |s|))))))) + +;pileForests(h,n,s)== +; [h1,t1]:=pileForest(n,s) +; if npNull h1 +; then [true,n,h,s] +; else pileForests(pileCtree(h,h1),n,t1) + +(DEFUN |pileForests| (|h| |n| |s|) + (PROG (|t1| |h1| |LETTMP#1|) + (RETURN + (PROGN + (SETQ |LETTMP#1| (|pileForest| |n| |s|)) + (SETQ |h1| (CAR |LETTMP#1|)) + (SETQ |t1| (CADR |LETTMP#1|)) + (COND + ((|npNull| |h1|) (LIST T |n| |h| |s|)) + ('T (|pileForests| (|pileCtree| |h| |h1|) |n| |t1|))))))) + +;pileCtree(x,y)==dqAppend(x,pileCforest y) + +(DEFUN |pileCtree| (|x| |y|) + (PROG () (RETURN (|dqAppend| |x| (|pileCforest| |y|))))) + +;-- only enpiles forests with >=2 trees +; +;pileCforest x== +; if null x +; then [] +; else if null cdr x +; then +; f:= car x +; if EQ(tokPart CAAR f,"IF") +; then enPile f +; else f +; else enPile separatePiles x + +(DEFUN |pileCforest| (|x|) + (PROG (|f|) + (RETURN + (COND + ((NULL |x|) NIL) + ((NULL (CDR |x|)) (SETQ |f| (CAR |x|)) + (COND + ((EQ (|tokPart| (CAAR |f|)) 'IF) (|enPile| |f|)) + ('T |f|))) + ('T (|enPile| (|separatePiles| |x|))))))) + +;firstTokPosn t== tokPosn CAAR t + +(DEFUN |firstTokPosn| (|t|) (PROG () (RETURN (|tokPosn| (CAAR |t|))))) + +;lastTokPosn t== tokPosn CADR t + +(DEFUN |lastTokPosn| (|t|) (PROG () (RETURN (|tokPosn| (CADR |t|))))) + +;separatePiles x== +; if null x +; then [] +; else if null cdr x +; then car x +; else +; a:=car x +; semicolon:=dqUnit tokConstruct("key", "BACKSET",lastTokPosn a) +; dqConcat [a,semicolon,separatePiles cdr x] + +(DEFUN |separatePiles| (|x|) + (PROG (|semicolon| |a|) + (RETURN + (COND + ((NULL |x|) NIL) + ((NULL (CDR |x|)) (CAR |x|)) + ('T (SETQ |a| (CAR |x|)) + (SETQ |semicolon| + (|dqUnit| + (|tokConstruct| '|key| 'BACKSET (|lastTokPosn| |a|)))) + (|dqConcat| + (LIST |a| |semicolon| (|separatePiles| (CDR |x|))))))))) + +;enPile x== +; dqConcat [dqUnit tokConstruct("key","SETTAB",firstTokPosn x), +; x, _ +; dqUnit tokConstruct("key","BACKTAB",lastTokPosn x)] + +(DEFUN |enPile| (|x|) + (PROG () + (RETURN + (|dqConcat| + (LIST (|dqUnit| + (|tokConstruct| '|key| 'SETTAB + (|firstTokPosn| |x|))) + |x| + (|dqUnit| + (|tokConstruct| '|key| 'BACKTAB + (|lastTokPosn| |x|)))))))) + +@ +\eject +\begin{thebibliography}{99} +\bibitem{1} nothing +\end{thebibliography} +\end{document}