diff --git a/changelog b/changelog index 5978543..48ca34d 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,8 @@ +20090428 tpd src/axiom-website/patches.html 20090428.01.tpd.patch +20090428 tpd src/interp/util.lisp remove autoload properites for apply +20090428 tpd add src/interp/Makefile rewrite apply.boot to apply.lisp +20090428 tpd src/interp/apply.lisp rewritten from boot +20090428 tpd src/interp/apply.boot deleted, rewritten in lisp 20090427 tpd src/axiom-website/patches.html 20090427.01.tpd.patch 20090427 tpd books/tangle.lisp lisp version of tangle command 20090420 tpd src/axiom-website/patches.html 20090420.01.tpd.patch diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index f6181a8..5830890 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -1110,5 +1110,7 @@ bookvol10.3 convert FRAC to +-> syntax
parsing.lisp consolidate parsing, remove autoload
20090427.01.tpd.patch tangle.lisp common lisp literate tangle function
+20090428.01.tpd.patch +apply.boot removed, rewritten into lisp, not autoloaded
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index 69b845e..c2d9a16 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -12,18 +12,6 @@ \section{Notes} Notes for understanding this makefile: -Postpar and Parse contain clisp stanzas which is common lisp code -that is generated during the translation from boot to common lisp. -We need to cache the clisp code so the boot compiler can be bootstrapped. - -If you create a system from scratch for a new platform you need to add -``:oldboot'' to the *features* list BEFORE util.lisp is loaded. -You also must load the postpar and parse files into the depsys -along with the other depsys files. - -If these two things are done then a obootsys image can be bootstrapped -to a new platform. - IMPORTANT: all source file names in this Makefile must be lowercase This is for cross-platform compatibility and also makes getting them into Lisp much easier at the Makefile level. @@ -247,7 +235,14 @@ OBJS= ${OUT}/vmlisp.${O} ${OUT}/hash.${O} \ ${OUT}/union.${O} ${OUT}/daase.${O} \ ${OUT}/fortcall.${O} \ ${OUT}/parsing.${O} ${OUT}/fnewmeta.${O} \ - ${OUT}/postprop.${LISP} + ${OUT}/postprop.${LISP} \ + ${OUT}/apply.${O} ${OUT}/c-doc.${O} \ + ${OUT}/c-util.${O} ${OUT}/profile.${O} \ + ${OUT}/category.${O} ${OUT}/compiler.${O} \ + ${OUT}/define.${O} ${OUT}/functor.${O} \ + ${OUT}/info.${O} ${OUT}/iterator.${O} \ + ${OUT}/modemap.${O} ${OUT}/nruncomp.${O} \ + ${OUT}/package.${O} ${OUT}/htcheck.${O} @ @@ -285,14 +280,7 @@ OPOBJS= The {\bf OCOBJS} list contains files from the old compiler. Again, ``old'' is meaningless. These files should probably be autoloaded. <>= -OCOBJS= ${AUTO}/apply.${O} ${AUTO}/c-doc.${O} \ - ${AUTO}/c-util.${O} ${AUTO}/profile.${O} \ - ${AUTO}/category.${O} ${AUTO}/compiler.${O} \ - ${AUTO}/define.${O} ${AUTO}/functor.${O} \ - ${AUTO}/info.${O} ${AUTO}/iterator.${O} \ - ${AUTO}/modemap.${O} ${AUTO}/nruncomp.${O} \ - ${AUTO}/package.${O} ${AUTO}/htcheck.${O} - +OCOBJS= @ The {\bf BROBJS} list contains files only used by the hypertex @@ -443,7 +431,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}/alql.boot.dvi \ - ${DOC}/apply.boot.dvi ${DOC}/as.boot.dvi \ + ${DOC}/as.boot.dvi \ ${DOC}/astr.boot.dvi ${DOC}/ax.boot.dvi \ ${DOC}/axext_l.lisp.dvi \ ${DOC}/bc-matrix.boot.dvi ${DOC}/bc-misc.boot.dvi \ @@ -844,7 +832,7 @@ compiler::*suppress-compiler-notes* to true in order to reduce the noise. <>= ${SAVESYS}: ${DEPSYS} ${OBJS} ${OUT}/bookvol5.${O} ${OUT}/util.${O} \ ${OUT}/nocompil.${LISP} ${OUT}/sys-pkg.${LISP} \ - ${OUTINTERP} ${OCOBJS} ${BROBJS} ${OUT}/obey.${O} \ + ${OUTINTERP} ${BROBJS} ${OUT}/obey.${O} \ ${OUT}/database.date ${INOBJS} ${ASCOMP} ${ASAUTO} \ ${NAGBROBJS} ${TRANOBJS} \ ${LOADSYS} \ @@ -878,7 +866,7 @@ ${SAVESYS}: ${DEPSYS} ${OBJS} ${OUT}/bookvol5.${O} ${OUT}/util.${O} \ '(quote ($(patsubst %, "%", ${ASCOMP})))' \ '(quote ($(patsubst %, "%", ${INOBJS}))))' \ nil \ - '(quote ($(patsubst %, "%", ${OCOBJS})))' \ + nil \ '(quote ($(patsubst %, "%", ${BROBJS})))' \ '(quote ($(patsubst %, "%", ${TRANOBJS})))' \ '(quote ($(patsubst %, "%", ${NAGBROBJS})))' \ @@ -924,51 +912,25 @@ ${DEBUGSYS}: ${MID}/debugsys.lisp \section{The Interpreter files} -\subsection{apply.boot \cite{7}} -<>= -${AUTO}/apply.${O}: ${OUT}/apply.${O} - @ echo 9 making ${AUTO}/apply.${O} from ${OUT}/apply.${O} - @ cp ${OUT}/apply.${O} ${AUTO} - -@ <>= -${OUT}/apply.${O}: ${MID}/apply.clisp - @ echo 10 making ${OUT}/apply.${O} from ${MID}/apply.clisp +${OUT}/apply.${O}: ${MID}/apply.lisp + @ echo 10 making ${OUT}/apply.${O} from ${MID}/apply.lisp @ (cd ${MID} ; \ if [ -z "${NOISE}" ] ; then \ - echo '(progn (compile-file "${MID}/apply.clisp"' \ + echo '(progn (compile-file "${MID}/apply.lisp"' \ ':output-file "${OUT}/apply.${O}") (${BYE}))' | ${DEPSYS} ; \ else \ - echo '(progn (compile-file "${MID}/apply.clisp"' \ + echo '(progn (compile-file "${MID}/apply.lisp"' \ ':output-file "${OUT}/apply.${O}") (${BYE}))' | ${DEPSYS} \ >${TMP}/trace ; \ fi ) @ -<>= -${MID}/apply.clisp: ${IN}/apply.boot.pamphlet - @ echo 11 making ${MID}/apply.clisp from ${IN}/apply.boot.pamphlet +<>= +${MID}/apply.lisp: ${IN}/apply.lisp.pamphlet + @ echo 11 making ${MID}/apply.lisp from ${IN}/apply.lisp.pamphlet @( cd ${MID} ; \ - ${TANGLE} ${IN}/apply.boot.pamphlet >apply.boot ; \ - if [ -z "${NOISE}" ] ; then \ - echo '(progn (boottran::boottocl "apply.boot") (${BYE}))' \ - | ${DEPSYS} ; \ - else \ - echo '(progn (boottran::boottocl "apply.boot") (${BYE}))' \ - | ${DEPSYS} >${TMP}/trace ; \ - fi ; \ - rm apply.boot ) - -@ -<>= -${DOC}/apply.boot.dvi: ${IN}/apply.boot.pamphlet - @echo 12 making ${DOC}/apply.boot.dvi from ${IN}/apply.boot.pamphlet - @(cd ${DOC} ; \ - cp ${IN}/apply.boot.pamphlet ${DOC} ; \ - ${DOCUMENT} ${NOISE} apply.boot ; \ - rm -f ${DOC}/apply.boot.pamphlet ; \ - rm -f ${DOC}/apply.boot.tex ; \ - rm -f ${DOC}/apply.boot ) + ${TANGLE} ${IN}/apply.lisp.pamphlet >apply.lisp ) @ @@ -1032,53 +994,6 @@ ${DOC}/bootfuns.lisp.dvi: ${IN}/bootfuns.lisp.pamphlet @ -\subsection{bootlex.lisp \cite{9}} -<>= -${AUTO}/bootlex.${O}: ${OUT}/bootlex.${O} - @ echo 19 making ${AUTO}/bootlex.${O} from ${OUT}/bootlex.${O} - @ cp ${OUT}/bootlex.${O} ${AUTO} - -@ -<>= -${OUT}/bootlex.${O}: ${MID}/bootlex.lisp - @ echo 20 making ${OUT}/bootlex.${O} from ${MID}/bootlex.lisp - @ ( cd ${MID} ; \ - if [ -z "${NOISE}" ] ; then \ - echo '(progn (compile-file "${MID}/bootlex.lisp"' \ - ':output-file "${OUT}/bootlex.${O}") (${BYE}))' | ${DEPSYS} ; \ - else \ - echo '(progn (compile-file "${MID}/bootlex.lisp"' \ - ':output-file "${OUT}/bootlex.${O}") (${BYE}))' | ${DEPSYS} \ - >${TMP}/trace ; \ - fi ) - -@ -<>= -${OUT}/bootlex.${LISP}: ${MID}/bootlex.lisp - @ echo 21 making ${OUT}/bootlex.${LISP} from ${MID}/bootlex.lisp - @cp ${MID}/bootlex.lisp ${OUT}/bootlex.${LISP} - -@ -<>= -${MID}/bootlex.lisp: ${IN}/bootlex.lisp.pamphlet - @ echo 22 making ${MID}/bootlex.lisp from ${IN}/bootlex.lisp.pamphlet - @ ( cd ${MID} ; \ - ${TANGLE} ${IN}/bootlex.lisp.pamphlet >bootlex.lisp ) - -@ -<>= -${DOC}/bootlex.lisp.dvi: ${IN}/bootlex.lisp.pamphlet - @echo 23 making ${DOC}/bootlex.lisp.dvi \ - from ${IN}/bootlex.lisp.pamphlet - @(cd ${DOC} ; \ - cp ${IN}/bootlex.lisp.pamphlet ${DOC} ; \ - ${DOCUMENT} ${NOISE} bootlex.lisp ; \ - rm -f ${DOC}/bootlex.lisp.pamphlet ; \ - rm -f ${DOC}/bootlex.lisp.tex ; \ - rm -f ${DOC}/bootlex.lisp ) - -@ - \subsection{cfuns.lisp \cite{10}} <>= ${OUT}/cfuns.${O}: ${MID}/cfuns.lisp @@ -1277,53 +1192,6 @@ ${DOC}/debugsys.lisp.dvi: ${IN}/debugsys.lisp.pamphlet @ -\subsection{def.lisp \cite{15}} -<>= -${AUTO}/def.${O}: ${OUT}/def.${O} - @ echo 41 making ${AUTO}/def.${O} from ${OUT}/def.${O} - @ cp ${OUT}/def.${O} ${AUTO} - -@ -<>= -${OUT}/def.${O}: ${MID}/def.lisp - @ echo 42 making ${OUT}/def.${O} from ${MID}/def.lisp - @ ( cd ${MID} ; \ - if [ -z "${NOISE}" ] ; then \ - echo '(progn (compile-file "${MID}/def.lisp"' \ - ':output-file "${OUT}/def.${O}") (${BYE}))' | ${DEPSYS} ; \ - else \ - echo '(progn (compile-file "${MID}/def.lisp"' \ - ':output-file "${OUT}/def.${O}") (${BYE}))' | ${DEPSYS} \ - >${TMP}/trace ; \ - fi ) - -@ -<>= -${OUT}/def.${LISP}: ${MID}/def.lisp - @ echo 43 making ${OUT}/def.${LISP} from ${MID}/def.lisp - @ rm -f ${OUT}/def.${O} - @ cp ${MID}/def.lisp ${OUT}/def.${LISP} - -@ -<>= -${MID}/def.lisp: ${IN}/def.lisp.pamphlet - @ echo 44 making ${MID}/def.lisp from ${IN}/def.lisp.pamphlet - @ ( cd ${MID} ; \ - ${TANGLE} ${IN}/def.lisp.pamphlet >def.lisp ) - -@ -<>= -${DOC}/def.lisp.dvi: ${IN}/def.lisp.pamphlet - @echo 45 making ${DOC}/def.lisp.dvi from ${IN}/def.lisp.pamphlet - @(cd ${DOC} ; \ - cp ${IN}/def.lisp.pamphlet ${DOC} ; \ - ${DOCUMENT} ${NOISE} def.lisp ; \ - rm -f ${DOC}/def.lisp.pamphlet ; \ - rm -f ${DOC}/def.lisp.tex ; \ - rm -f ${DOC}/def.lisp ) - -@ - \subsection{fname.lisp \cite{17}} <>= ${OUT}/fname.${O}: ${MID}/fname.lisp @@ -1554,53 +1422,6 @@ ${DOC}/macros.lisp.dvi: ${IN}/macros.lisp.pamphlet @ -\subsection{metalex.lisp \cite{22}} -<>= -${AUTO}/metalex.${O}: ${OUT}/metalex.${O} - @ echo 66 making ${AUTO}/metalex.${O} from ${OUT}/metalex.${O} - @ cp ${OUT}/metalex.${O} ${AUTO} - -@ -<>= -${OUT}/metalex.${O}: ${MID}/metalex.lisp - @ echo 67 making ${OUT}/metalex.${O} from ${MID}/metalex.lisp - @ ( cd ${MID} ; \ - if [ -z "${NOISE}" ] ; then \ - echo '(progn (compile-file "${MID}/metalex.lisp"' \ - ':output-file "${OUT}/metalex.${O}") (${BYE}))' | ${DEPSYS} ; \ - else \ - echo '(progn (compile-file "${MID}/metalex.lisp"' \ - ':output-file "${OUT}/metalex.${O}") (${BYE}))' | ${DEPSYS} \ - >${TMP}/trace ; \ - fi ) - -@ -<>= -${OUT}/metalex.${LISP}: ${MID}/metalex.lisp - @ echo 68 making ${OUT}/metalex.${LISP} from ${MID}/metalex.lisp - @cp ${MID}/metalex.lisp ${OUT}/metalex.${LISP} - -@ -<>= -${MID}/metalex.lisp: ${IN}/metalex.lisp.pamphlet - @ echo 69 making ${MID}/metalex.lisp from ${IN}/metalex.lisp.pamphlet - @ ( cd ${MID} ; \ - ${TANGLE} ${IN}/metalex.lisp.pamphlet >metalex.lisp ) - -@ -<>= -${DOC}/metalex.lisp.dvi: ${IN}/metalex.lisp.pamphlet - @echo 70 making ${DOC}/metalex.lisp.dvi \ - from ${IN}/metalex.lisp.pamphlet - @(cd ${DOC} ; \ - cp ${IN}/metalex.lisp.pamphlet ${DOC} ; \ - ${DOCUMENT} ${NOISE} metalex.lisp ; \ - rm -f ${DOC}/metalex.lisp.pamphlet ; \ - rm -f ${DOC}/metalex.lisp.tex ; \ - rm -f ${DOC}/metalex.lisp ) - -@ - \subsection{monitor.lisp \cite{24}} <>= ${OUT}/monitor.${O}: ${MID}/monitor.lisp @@ -1901,55 +1722,6 @@ ${DOC}/postprop.lisp.dvi: ${IN}/postprop.lisp.pamphlet @ -\subsection{preparse.lisp \cite{31}} -<>= -${AUTO}/preparse.${O}: ${OUT}/preparse.${O} - @ echo 106 making ${AUTO}/preparse.${O} from ${OUT}/preparse.${O} - @ cp ${OUT}/preparse.${O} ${AUTO} - -@ -<>= -${OUT}/preparse.${O}: ${MID}/preparse.lisp - @ echo 107 making ${OUT}/preparse.${O} from ${MID}/preparse.lisp - @ ( cd ${MID} ; \ - if [ -z "${NOISE}" ] ; then \ - echo '(progn (compile-file "${MID}/preparse.lisp"' \ - ':output-file "${OUT}/preparse.${O}") (${BYE}))' | ${DEPSYS} ; \ - else \ - echo '(progn (compile-file "${MID}/preparse.lisp"' \ - ':output-file "${OUT}/preparse.${O}") (${BYE}))' | ${DEPSYS} \ - >${TMP}/trace ; \ - fi ) - -@ -<>= -${OUT}/preparse.${LISP}: ${MID}/preparse.lisp - @ echo 108 making ${OUT}/preparse.${LISP} from ${MID}/preparse.lisp - @ rm -f ${OUT}/preparse.${O} - @ cp ${MID}/preparse.lisp ${OUT}/preparse.${LISP} - -@ -<>= -${MID}/preparse.lisp: ${IN}/preparse.lisp.pamphlet - @ echo 109 making ${MID}/preparse.lisp \ - from ${IN}/preparse.lisp.pamphlet - @ ( cd ${MID} ; \ - ${TANGLE} ${IN}/preparse.lisp.pamphlet >preparse.lisp ) - -@ -<>= -${DOC}/preparse.lisp.dvi: ${IN}/preparse.lisp.pamphlet - @echo 110 making ${DOC}/preparse.lisp.dvi \ - from ${IN}/preparse.lisp.pamphlet - @(cd ${DOC} ; \ - cp ${IN}/preparse.lisp.pamphlet ${DOC} ; \ - ${DOCUMENT} ${NOISE} preparse.lisp ; \ - rm -f ${DOC}/preparse.lisp.pamphlet ; \ - rm -f ${DOC}/preparse.lisp.tex ; \ - rm -f ${DOC}/preparse.lisp ) - -@ - \subsection{property.lisp \cite{32}} <>= ${OUT}/property.${LISP}: ${MID}/property.lisp @@ -5368,75 +5140,6 @@ ${DOC}/package.boot.dvi: ${IN}/package.boot.pamphlet @ -\subsection{parse.boot} -note: this is used to build a bootsys on a virgin copy of the system -notice that the file placed in \verb+${OUT}+ is a .lisp file -this is to allow the depsys to be built even if the \verb+.${O}+ file does -not exist on the new system -<>= -${AUTO}/parse.${O}: ${OUT}/parse.${O} - @ echo 374 making ${AUTO}/parse.${O} from ${OUT}/parse.${O} - @ cp ${OUT}/parse.${O} ${AUTO} - -@ -<>= -${OUT}/parse.${O}: ${MID}/parse.clisp - @ echo 375 making ${OUT}/parse.${O} from ${MID}/parse.clisp - @ (cd ${MID} ; \ - if [ -z "${NOISE}" ] ; then \ - echo '(progn (compile-file "${MID}/parse.clisp"' \ - ':output-file "${OUT}/parse.${O}") (${BYE}))' | ${DEPSYS} ; \ - else \ - echo '(progn (compile-file "${MID}/parse.clisp"' \ - ':output-file "${OUT}/parse.${O}") (${BYE}))' | ${DEPSYS} \ - >${TMP}/trace ; \ - fi ) - -@ -Note that the {\bf parse.boot.pamphlet} file contains both the -original {\bf boot} code and a saved copy of the {\bf parse.clisp} -code. We need to keep the translated code around so we can bootstrap -the system. In other words, we need this boot code translated so we -can build the boot translator. - -{\bf note: if you change the boot code in parse.boot.pamphlet -you must translate this code to lisp and store the resulting lisp -code back into the parse.boot.pamphlet file. this is not automated.} -<>= -${OUT}/parse.${LISP}: ${IN}/parse.boot.pamphlet - @ echo 376 making ${OUT}/parse.${LISP} from ${IN}/parse.boot.pamphlet - @ rm -f ${OUT}/parse.${O} - @( cd ${OUT} ; \ - ${TANGLE} -Rparse.clisp ${IN}/parse.boot.pamphlet >parse.${LISP} ) - -@ -<>= -${MID}/parse.clisp: ${IN}/parse.boot.pamphlet - @ echo 377 making ${MID}/parse.clisp from ${IN}/parse.boot.pamphlet - @ (cd ${MID} ; \ - ${TANGLE} ${IN}/parse.boot.pamphlet >parse.boot ; \ - if [ -z "${NOISE}" ] ; then \ - echo '(progn (boottran::boottocl "parse.boot") (${BYE}))' \ - | ${DEPSYS} ; \ - else \ - echo '(progn (boottran::boottocl "parse.boot") (${BYE}))' \ - | ${DEPSYS} >${TMP}/trace ; \ - fi ; \ - rm parse.boot ) - -@ -<>= -${DOC}/parse.boot.dvi: ${IN}/parse.boot.pamphlet - @echo 378 making ${DOC}/parse.boot.dvi from ${IN}/parse.boot.pamphlet - @(cd ${DOC} ; \ - cp ${IN}/parse.boot.pamphlet ${DOC} ; \ - ${DOCUMENT} ${NOISE} parse.boot ; \ - rm -f ${DOC}/parse.boot.pamphlet ; \ - rm -f ${DOC}/parse.boot.tex ; \ - rm -f ${DOC}/parse.boot ) - -@ - \subsection{pathname.boot} <>= ${OUT}/pathname.${O}: ${MID}/pathname.clisp @@ -5481,90 +5184,6 @@ ${DOC}/pathname.boot.dvi: ${IN}/pathname.boot.pamphlet @ -\subsection{postpar.boot} -note: this is used to build bootsys on a virgin copy of the system -notice that the file placed in \verb+${OUT}+ is a .lisp file -this allows the depsys to be built even if the \verb+.${O}+ file does -not exist on the new system -<>= -${AUTO}/postpar.${O}: ${OUT}/postpar.${O} - @ echo 382 making ${AUTO}/postpar.${O} from ${OUT}/postpar.${O} - @ cp ${OUT}/postpar.${O} ${AUTO} - -@ -Note that the {\bf postpar.boot.pamphlet} file contains both the -original {\bf boot} code and a saved copy of the {\bf postpar.clisp} -code. We need to keep the translated code around so we can bootstrap -the system. In other words, we need this boot code translated so we -can build the boot translator. - -{\bf note: if you change the boot code in postpar.boot.pamphlet -you must translate this code to lisp and store the resulting lisp -code back into the postpar.boot.pamphlet file. this is not automated.} -<>= -${OUT}/postpar.${LISP}: ${IN}/postpar.boot.pamphlet - @ echo 383 making ${OUT}/postpar.${LISP} \ - from ${IN}/postpar.boot.pamphlet - @ rm -f ${OUT}/postpar.${O} - @( cd ${OUT} ; \ - ${TANGLE} -Rpostpar.clisp ${IN}/postpar.boot.pamphlet \ - >postpar.${LISP} ) - -@ -<>= -${OUT}/postpar.${O}: ${MID}/postpar.clisp - @ echo 384 making ${OUT}/postpar.${O} from ${MID}/postpar.clisp - @ (cd ${MID} ; \ - if [ -z "${NOISE}" ] ; then \ - echo '(progn (compile-file "${MID}/postpar.clisp"' \ - ':output-file "${OUT}/postpar.${O}") (${BYE}))' | ${DEPSYS} ; \ - else \ - echo '(progn (compile-file "${MID}/postpar.clisp"' \ - ':output-file "${OUT}/postpar.${O}") (${BYE}))' \ - | ${DEPSYS} >${TMP}/trace ; \ - fi ) - -@ -NOTE: the .clisp file is copied back into the src directory making -it is possible to create a new DEPSYS system from scratch for a -new platform. parse.clisp needs to be compiled in a depsys. -two things need to be done to create an DEPSYS by hand: -\begin{itemize} -\item :oldboot must be on the *features* list BEFORE util.lisp is loaded -\item parse and postpar must be loaded along with the depsys files -into a bare lisp system. -\end{itemize} -If these two things are done then a DEPSYS image can be bootstrapped -to a new platform. - -<>= -${MID}/postpar.clisp: ${IN}/postpar.boot.pamphlet - @ echo 385 making ${MID}/postpar.clisp from ${IN}/postpar.boot.pamphlet - @ (cd ${MID} ; \ - ${TANGLE} ${IN}/postpar.boot.pamphlet >postpar.boot ; \ - if [ -z "${NOISE}" ] ; then \ - echo '(progn (boottran::boottocl "postpar.boot") (${BYE}))' \ - | ${DEPSYS} ; \ - else \ - echo '(progn (boottran::boottocl "postpar.boot") (${BYE}))' \ - | ${DEPSYS} >${TMP}/trace ; \ - fi ; \ - rm postpar.boot ) - -@ -<>= -${DOC}/postpar.boot.dvi: ${IN}/postpar.boot.pamphlet - @echo 386 making ${DOC}/postpar.boot.dvi \ - from ${IN}/postpar.boot.pamphlet - @(cd ${DOC} ; \ - cp ${IN}/postpar.boot.pamphlet ${DOC} ; \ - ${DOCUMENT} ${NOISE} postpar.boot ; \ - rm -f ${DOC}/postpar.boot.pamphlet ; \ - rm -f ${DOC}/postpar.boot.tex ; \ - rm -f ${DOC}/postpar.boot ) - -@ - \subsection{regress.lisp} <>= ${OUT}/regress.${O}: ${MID}/regress.${LISP} @@ -8391,10 +8010,8 @@ clean: <> <> -<> <> -<> -<> +<> <> <> @@ -8441,12 +8058,6 @@ clean: <> <> -<> -<> -<> -<> -<> - <> <> <> @@ -8572,12 +8183,6 @@ clean: <> <> -<> -<> -<> -<> -<> - <> <> <> @@ -8798,12 +8403,6 @@ clean: <> <> -<> -<> -<> -<> -<> - <> <> <> @@ -8960,12 +8559,6 @@ clean: <> <> -<> -<> -<> -<> -<> - <> <> <> @@ -8992,23 +8585,11 @@ clean: <> <> -<> -<> -<> -<> -<> - <> <> <> <> -<> -<> -<> -<> -<> - <> <> <> @@ -9156,7 +8737,6 @@ pp \bibitem{4} {\bf \$SPAD/src/interp/setq.lisp.pamphlet} \bibitem{5} {\bf \$SPAD/src/interp/patches.lisp.pamphlet} \bibitem{6} {\bf www.aldor.org} -\bibitem{7} {\bf \$SPAD/src/interp/apply.boot.pamphlet} \bibitem{8} {\bf \$SPAD/src/interp/bits.lisp.pamphlet} \bibitem{10} {\bf \$SPAD/src/interp/cfuns.lisp.pamphlet} \bibitem{11} {\bf \$SPAD/src/interp/comp.lisp.pamphlet} diff --git a/src/interp/apply.boot.pamphlet b/src/interp/apply.boot.pamphlet deleted file mode 100644 index 3ea39bb..0000000 --- a/src/interp/apply.boot.pamphlet +++ /dev/null @@ -1,270 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp apply.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. - -@ -<<*>>= -<> - -oldCompilerAutoloadOnceTrigger() == nil - -compAtomWithModemap(x,m,e,v) == - Tl := - [[transImplementation(x,map,fn),target,e] - for map in v | map is [[.,target],[.,fn]]] => - --accept only monadic operators - T:= or/[t for (t:= [.,target,.]) in Tl | modeEqual(m,target)] => T - 1=#(Tl:= [y for t in Tl | (y:= convert(t,m))]) => first Tl - 0<#Tl and m=$NoValueMode => first Tl - nil - -transImplementation(op,map,fn) == ---+ - fn := genDeltaEntry [op,:map] - fn is ["XLAM",:.] => [fn] - ["call",fn] - -compApply(sig,varl,body,argl,m,e) == - argTl:= [[.,.,e]:= comp(x,$EmptyMode,e) for x in argl] - contour:= - [Pair(x,[["mode",m'],["value",removeEnv comp(a,m',e)]]) - for x in varl for m' in sig.source for a in argl] - code:= [["LAMBDA",varl,body'],:[T.expr for T in argTl]] - m':= resolve(m,sig.target) - body':= (comp(body,m',addContour(contour,e))).expr - [code,m',e] - -compToApply(op,argl,m,e) == - T:= compNoStacking(op,$EmptyMode,e) or return nil - m1:= T.mode - T.expr is ["QUOTE", =m1] => nil - compApplication(op,argl,m,T.env,T) - -compApplication(op,argl,m,e,T) == - T.mode is ['Mapping, retm, :argml] => - #argl ^= #argml => nil - retm := resolve(m, retm) - retm = $Category or isCategoryForm(retm,e) => nil -- not handled - argTl := [[.,.,e] := comp(x,m,e) or return "failed" - for x in argl for m in argml] - argTl = "failed" => nil - form:= - not (MEMBER(op,$formalArgList) or MEMBER(T.expr,$formalArgList)) and ATOM T.expr => - nprefix := $prefix or - -- following needed for referencing local funs at capsule level - getAbbreviation($op,#rest $form) - [op',:[a.expr for a in argTl],"$"] where - op':= INTERN STRCONC(encodeItem nprefix,";",encodeItem T.expr) - ['call, ['applyFun, T.expr], :[a.expr for a in argTl]] - coerce([form, retm, e],resolve(retm,m)) - op = 'elt => nil - eltForm := ['elt, op, :argl] - comp(eltForm, m, e) - -compFormWithModemap(form is [op,:argl],m,e,modemap) == - [map:= [.,target,:.],[pred,impl]]:= modemap - -- this fails if the subsuming modemap is conditional - --impl is ['Subsumed,:.] => nil - if isCategoryForm(target,e) and isFunctor op then - [modemap,e]:= substituteIntoFunctorModemap(argl,modemap,e) or return nil - [map:= [.,target,:.],:cexpr]:= modemap - sv:=listOfSharpVars map - if sv then - -- SAY [ "compiling ", op, " in compFormWithModemap, - -- mode= ",map," sharp vars=",sv] - for x in argl for ss in $FormalMapVariableList repeat - if ss in sv then - [map:= [.,target,:.],:cexpr]:= modemap :=SUBST(x,ss,modemap) - -- SAY ["new map is",map] - not (target':= coerceable(target,m,e)) => nil - map:= [target',:rest map] - [f,Tl,sl]:= compApplyModemap(form,modemap,e,nil) or return nil - - --generate code; return - T:= - [x',m',e'] where - m':= SUBLIS(sl,map.(1)) - x':= - form':= [f,:[t.expr for t in Tl]] - m'=$Category or isCategoryForm(m',e) => form' - -- try to deal with new-style Unions where we know the conditions - op = "elt" and f is ['XLAM,:.] and IDENTP(z:=CAR argl) and - (c:=get(z,'condition,e)) and - c is [['case,=z,c1]] and - (c1 is ['_:,=(CADR argl),=m] or EQ(c1,CADR argl) ) => --- first is a full tag, as placed by getInverseEnvironment --- second is what getSuccessEnvironment will place there - ["CDR",z] - ["call",:form'] - e':= - Tl => (LAST Tl).env - e - convert(T,m) - --- This version tends to give problems with #1 and categories --- applyMapping([op,:argl],m,e,ml) == --- #argl^=#ml-1 => nil --- mappingHasCategoryTarget := --- isCategoryForm(first ml,e) => --is op a functor? --- form:= [op,:argl'] --- pairlis:= [[v,:a] for a in argl for v in $FormalMapVariableList] --- ml:= SUBLIS(pairlis,ml) --- true --- false --- argl':= --- [T.expr for x in argl for m' in rest ml] where --- T() == [.,.,e]:= comp(x,m',e) or return "failed" --- if argl'="failed" then return nil --- mappingHasCategoryTarget => convert([form,first ml,e],m) --- form:= --- not MEMBER(op,$formalArgList) and ATOM op => --- [op',:argl',"$"] where --- op':= INTERN STRCONC(STRINGIMAGE $prefix,";",STRINGIMAGE op) --- ["call",["applyFun",op],:argl'] --- pairlis:= [[v,:a] for a in argl' for v in $FormalMapVariableList] --- convert([form,SUBLIS(pairlis,first ml),e],m) - -applyMapping([op,:argl],m,e,ml) == - #argl^=#ml-1 => nil - isCategoryForm(first ml,e) => - --is op a functor? - pairlis:= [[v,:a] for a in argl for v in $FormalMapVariableList] - ml' := SUBLIS(pairlis, ml) - argl':= - [T.expr for x in argl for m' in rest ml'] where - T() == [.,.,e]:= comp(x,m',e) or return "failed" - if argl'="failed" then return nil - form:= [op,:argl'] - convert([form,first ml',e],m) - argl':= - [T.expr for x in argl for m' in rest ml] where - T() == [.,.,e]:= comp(x,m',e) or return "failed" - if argl'="failed" then return nil - form:= - not MEMBER(op,$formalArgList) and ATOM op and not get(op,'value,e) => - nprefix := $prefix or - -- following needed for referencing local funs at capsule level - getAbbreviation($op,#rest $form) - [op',:argl',"$"] where - op':= INTERN STRCONC(encodeItem nprefix,";",encodeItem op) - ['call,['applyFun,op],:argl'] - pairlis:= [[v,:a] for a in argl' for v in $FormalMapVariableList] - convert([form,SUBLIS(pairlis,first ml),e],m) - ---% APPLY MODEMAPS - -compApplyModemap(form,modemap,$e,sl) == - [op,:argl] := form --form to be compiled - [[mc,mr,:margl],:fnsel] := modemap --modemap we are testing - - -- $e is the current environment - -- sl substitution list, nil means bottom-up, otherwise top-down - - -- 0. fail immediately if #argl=#margl - - if #argl^=#margl then return nil - - -- 1. use modemap to evaluate arguments, returning failed if - -- not possible - - lt:= - [[.,m',$e]:= - comp(y,g,$e) or return "failed" where - g:= SUBLIS(sl,m) where - sl:= pmatchWithSl(m',m,sl) for y in argl for m in margl] - lt="failed" => return nil - - -- 2. coerce each argument to final domain, returning failed - -- if not possible - - lt':= [coerce(y,d) or return "failed" - for y in lt for d in SUBLIS(sl,margl)] - lt'="failed" => return nil - - -- 3. obtain domain-specific function, if possible, and return - - --$bindings is bound by compMapCond - [f,$bindings]:= compMapCond(op,mc,sl,fnsel) or return nil - ---+ can no longer trust what the modemap says for a reference into ---+ an exterior domain (it is calculating the displacement based on view ---+ information which is no longer valid; thus ignore this index and ---+ store the signature instead. - ---$NRTflag=true and f is [op1,d,.] and NE(d,'$) and MEMBER(op1,'(ELT CONST)) => - f is [op1,d,.] and MEMBER(op1,'(ELT CONST Subsumed)) => - [genDeltaEntry [op,:modemap],lt',$bindings] - [f,lt',$bindings] - -compMapCond(op,mc,$bindings,fnsel) == - or/[compMapCond'(u,op,mc,$bindings) for u in fnsel] - -compMapCond'([cexpr,fnexpr],op,dc,bindings) == - compMapCond''(cexpr,dc) => compMapCondFun(fnexpr,op,dc,bindings) - stackMessage ["not known that",'%b,dc,'%d,"has",'%b,cexpr,'%d] - -compMapCond''(cexpr,dc) == - cexpr=true => true - --cexpr = "true" => true - cexpr is ["AND",:l] => and/[compMapCond''(u,dc) for u in l] - cexpr is ["OR",:l] => or/[compMapCond''(u,dc) for u in l] - cexpr is ["not",u] => not compMapCond''(u,dc) - cexpr is ["has",name,cat] => (knownInfo cexpr => true; false) - --for the time being we'll stop here - shouldn't happen so far - --$disregardConditionIfTrue => true - --stackSemanticError(("not known that",'%b,name, - -- '%d,"has",'%b,cat,'%d),nil) - --now it must be an attribute - MEMBER(["ATTRIBUTE",dc,cexpr],get("$Information","special",$e)) => true - --for the time being we'll stop here - shouldn't happen so far - stackMessage ["not known that",'%b,dc,'%d,"has",'%b,cexpr,'%d] - false - -compMapCondFun(fnexpr,op,dc,bindings) == [fnexpr,bindings] - -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/apply.lisp.pamphlet b/src/interp/apply.lisp.pamphlet new file mode 100644 index 0000000..09e326d --- /dev/null +++ b/src/interp/apply.lisp.pamphlet @@ -0,0 +1,443 @@ +\documentclass{article} +\usepackage{axiom} +\begin{document} +\title{\$SPAD/src/interp apply.lisp} +\author{The Axiom Team} +\maketitle +\begin{abstract} +\end{abstract} +\eject +\tableofcontents +\eject +<<*>>= + +(in-package "BOOT" ) + +;oldCompilerAutoloadOnceTrigger() == nil + +(defun |oldCompilerAutoloadOnceTrigger| () nil) + +;compAtomWithModemap(x,m,e,v) == +; Tl := +; [[transImplementation(x,map,fn),target,e] +; for map in v | map is [[.,target],[.,fn]]] => +; --accept only monadic operators +; T:= or/[t for (t:= [.,target,.]) in Tl | modeEqual(m,target)] => T +; 1=#(Tl:= [y for t in Tl | (y:= convert(t,m))]) => first Tl +; 0<#Tl and m=$NoValueMode => first Tl +; nil + +(DEFUN |compAtomWithModemap| (|x| |m| |e| |v|) + (PROG (tmp1 tmp2 tmp3 tmp4 tmp5 |fn| |target| T$ |y| transimp) + (RETURN + (SEQ + (COND + ((setq transimp + (PROG (t0) + (setq t0 NIL) + (RETURN + (DO ((t1 |v| (CDR t1)) (|map| NIL)) + ((OR (ATOM t1) (PROGN (SETQ |map| (CAR t1)) NIL)) + (NREVERSE0 t0)) + (SEQ + (EXIT + (COND + ((AND (PAIRP |map|) + (PROGN + (setq tmp1 (QCAR |map|)) + (AND + (PAIRP tmp1) + (PROGN + (setq tmp2 (QCDR tmp1)) + (AND + (PAIRP tmp2) + (EQ (QCDR tmp2) NIL) + (PROGN (setq |target| (QCAR tmp2)) t))))) + (PROGN + (setq tmp3 (QCDR |map|)) + (AND + (PAIRP tmp3) + (EQ (QCDR tmp3) NIL) + (PROGN + (setq tmp4 (QCAR tmp3)) + (AND (PAIRP tmp4) + (PROGN + (setq tmp5 (QCDR tmp4)) + (AND (PAIRP tmp5) + (EQ (QCDR tmp5) NIL) + (PROGN (setq |fn| (QCAR tmp5)) t)))))))) + (SETQ t0 + (CONS + (CONS + (|transImplementation| |x| |map| |fn|) + (CONS |target| (CONS |e| NIL))) + t0)))))))))) + (EXIT + (COND + ((setq T$ (PROG (t2) (setq t2 NIL) (RETURN (DO ((t3 NIL t2) (t4 transimp (CDR t4)) (|t| NIL)) ((OR t3 (ATOM t4) (PROGN (SETQ |t| (CAR t4)) NIL) (PROGN (PROGN (setq |target| (CADR |t|)) |t|) NIL)) t2) (SEQ (EXIT (COND ((|modeEqual| |m| |target|) (SETQ t2 (OR t2 |t|)))))))))) T$) + ((EQL 1 + (|#| + (setq transimp + (PROG (t5) + (setq t5 NIL) + (RETURN + (DO ((t6 transimp (CDR t6)) (|t| NIL)) + ((OR (ATOM t6) (PROGN (SETQ |t| (CAR t6)) NIL)) + (NREVERSE0 t5)) + (SEQ + (EXIT + (COND + ((setq |y| (|convert| |t| |m|)) + (setq t5 (cons |y| t5)))))))))))) + (car transimp)) + ((and (qslessp 0 (|#| transimp)) (boot-equal |m| |$NoValueMode|)) + (car transimp)) + (t nil))))))))) + + +;transImplementation(op,map,fn) == +;--+ +; fn := genDeltaEntry [op,:map] +; fn is ["XLAM",:.] => [fn] +; ["call",fn] + +(defun |transImplementation| (op map fn) + (setq fn (|genDeltaEntry| (cons op map))) + (cond + ((and (pairp fn) (eq (qcar fn) 'xlam)) (cons fn nil)) + (t (cons '|call| (cons fn nil))))) + + +;compApply(sig,varl,body,argl,m,e) == +; argTl:= [[.,.,e]:= comp(x,$EmptyMode,e) for x in argl] +; contour:= +; [Pair(x,[["mode",m'],["value",removeEnv comp(a,m',e)]]) +; for x in varl for m' in sig.source for a in argl] +; code:= [["LAMBDA",varl,body'],:[T.expr for T in argTl]] +; m':= resolve(m,sig.target) +; body':= (comp(body,m',addContour(contour,e))).expr +; [code,m',e] + +(defun |compApply| (sig varl body argl m e) + (let (temp1 argTl contour code mq bodyq) + (setq argTl + (prog (t0) + (setq t0 nil) + (return + (do ((t1 argl (cdr t1)) (|x| nil)) + ((or (atom t1) (progn (setq |x| (car t1)) nil)) (nreverse0 t0)) + (seq + (exit + (setq t0 + (cons + (progn + (setq temp1 (|comp| |x| |$EmptyMode| e)) + (setq e (caddr temp1)) + temp1) + t0)))))))) + (setq contour + (prog (t2) + (setq t2 NIL) + (return + (do ((t3 varl (cdr t3)) + (|x| nil) + (t4 (cdr sig) (cdr t4)) + (mq nil) + (t5 argl (cdr t5)) + (|a| nil)) + ((or (atom t3) + (progn (setq |x| (car t3)) nil) + (atom t4) + (progn (setq mq (car t4)) nil) + (atom t5) + (progn (setq |a| (car t5)) nil)) + (nreverse0 t2)) + (setq t2 + (cons + (|Pair| |x| + (cons + (cons '|mode| (cons mq nil)) + (cons + (cons '|value| (cons (|removeEnv| (|comp| |a| mq e)) nil)) + nil))) + t2)))))) + (setq code + (cons + (cons 'lambda (cons varl (cons bodyq nil))) + (prog (t6) + (setq t6 nil) + (return + (do ((t7 argTl (cdr t7)) (T$ nil)) + ((or (atom t7) (progn (setq T$ (car t7)) nil)) (nreverse0 t6)) + (setq t6 (cons (car T$) t6))))))) + (setq mq (|resolve| m (car sig))) + (setq bodyq (car (|comp| body mq (|addContour| contour e)))) + (cons code (cons mq (cons e nil))))) + + +;compToApply(op,argl,m,e) == +; T:= compNoStacking(op,$EmptyMode,e) or return nil +; m1:= T.mode +; T.expr is ["QUOTE", =m1] => nil +; compApplication(op,argl,m,T.env,T) + +(DEFUN |compToApply| (|op| |argl| |m| |e|) (PROG (T$ |m1| tmp1 tmp2) (RETURN (PROGN (setq T$ (OR (|compNoStacking| |op| |$EmptyMode| |e|) (RETURN NIL))) (setq |m1| (CADR T$)) (COND ((PROGN (setq tmp1 (CAR T$)) (AND (PAIRP tmp1) (EQ (QCAR tmp1) (QUOTE QUOTE)) (PROGN (setq tmp2 (QCDR tmp1)) (AND (PAIRP tmp2) (EQ (QCDR tmp2) NIL) (EQUAL (QCAR tmp2) |m1|))))) NIL) (t (|compApplication| |op| |argl| |m| (CADDR T$) T$))))))) + + +;compApplication(op,argl,m,e,T) == +; T.mode is ['Mapping, retm, :argml] => +; #argl ^= #argml => nil +; retm := resolve(m, retm) +; retm = $Category or isCategoryForm(retm,e) => nil -- not handled +; argTl := [[.,.,e] := comp(x,m,e) or return "failed" +; for x in argl for m in argml] +; argTl = "failed" => nil +; form:= +; not (MEMBER(op,$formalArgList) or MEMBER(T.expr,$formalArgList)) and ATOM T.expr => +; nprefix := $prefix or +; -- following needed for referencing local funs at capsule level +; getAbbreviation($op,#rest $form) +; [op',:[a.expr for a in argTl],"$"] where +; op':= INTERN STRCONC(encodeItem nprefix,";",encodeItem T.expr) +; ['call, ['applyFun, T.expr], :[a.expr for a in argTl]] +; coerce([form, retm, e],resolve(retm,m)) +; op = 'elt => nil +; eltForm := ['elt, op, :argl] +; comp(eltForm, m, e) + +(DEFUN |compApplication| (|op| |argl| |m| |e| T$) (PROG (tmp1 tmp2 |argml| |retm| temp1 |argTl| |nprefix| |op'| |form| |eltForm|) (RETURN (SEQ (COND ((PROGN (setq tmp1 (CADR T$)) (AND (PAIRP tmp1) (EQ (QCAR tmp1) (QUOTE |Mapping|)) (PROGN (setq tmp2 (QCDR tmp1)) (AND (PAIRP tmp2) (PROGN (setq |retm| (QCAR tmp2)) (setq |argml| (QCDR tmp2)) t))))) (COND ((NEQUAL (|#| |argl|) (|#| |argml|)) NIL) (t (setq |retm| (|resolve| |m| |retm|)) (COND ((OR (BOOT-EQUAL |retm| |$Category|) (|isCategoryForm| |retm| |e|)) NIL) (t (setq |argTl| (PROG (t0) (setq t0 NIL) (RETURN (DO ((t1 |argl| (CDR t1)) (|x| NIL) (t2 |argml| (CDR t2)) (|m| NIL)) ((OR (ATOM t1) (PROGN (SETQ |x| (CAR t1)) NIL) (ATOM t2) (PROGN (SETQ |m| (CAR t2)) NIL)) (NREVERSE0 t0)) (SEQ (EXIT (SETQ t0 (CONS (PROGN (setq temp1 (OR (|comp| |x| |m| |e|) (RETURN (QUOTE |failed|)))) (setq |e| (CADDR temp1)) temp1) t0)))))))) (COND ((BOOT-EQUAL |argTl| (QUOTE |failed|)) NIL) (t (setq |form| (COND ((AND (NULL (OR (|member| |op| |$formalArgList|) (|member| (CAR T$) |$formalArgList|))) (ATOM (CAR T$))) (setq |nprefix| (OR |$prefix| (|getAbbreviation| |$op| (|#| (CDR |$form|))))) (setq |op'| (INTERN (STRCONC (|encodeItem| |nprefix|) (QUOTE |;|) (|encodeItem| (CAR T$))))) (CONS |op'| (APPEND (PROG (t3) (setq t3 NIL) (RETURN (DO ((t4 |argTl| (CDR t4)) (|a| NIL)) ((OR (ATOM t4) (PROGN (SETQ |a| (CAR t4)) NIL)) (NREVERSE0 t3)) (SEQ (EXIT (SETQ t3 (CONS (CAR |a|) t3))))))) (CONS (QUOTE $) NIL)))) (t (CONS (QUOTE |call|) (CONS (CONS (QUOTE |applyFun|) (CONS (CAR T$) NIL)) (PROG (t5) (setq t5 NIL) (RETURN (DO ((t6 |argTl| (CDR t6)) (|a| NIL)) ((OR (ATOM t6) (PROGN (SETQ |a| (CAR t6)) NIL)) (NREVERSE0 t5)) (SEQ (EXIT (SETQ t5 (CONS (CAR |a|) t5)))))))))))) (|coerce| (CONS |form| (CONS |retm| (CONS |e| NIL))) (|resolve| |retm| |m|))))))))) ((BOOT-EQUAL |op| (QUOTE |elt|)) NIL) (t (setq |eltForm| (CONS (QUOTE |elt|) (CONS |op| |argl|))) (|comp| |eltForm| |m| |e|))))))) + + +;compFormWithModemap(form is [op,:argl],m,e,modemap) == +; [map:= [.,target,:.],[pred,impl]]:= modemap +; -- this fails if the subsuming modemap is conditional +; --impl is ['Subsumed,:.] => nil +; if isCategoryForm(target,e) and isFunctor op then +; [modemap,e]:= substituteIntoFunctorModemap(argl,modemap,e) or return nil +; [map:= [.,target,:.],:cexpr]:= modemap +; sv:=listOfSharpVars map +; if sv then +; -- SAY [ "compiling ", op, " in compFormWithModemap, +; -- mode= ",map," sharp vars=",sv] +; for x in argl for ss in $FormalMapVariableList repeat +; if ss in sv then +; [map:= [.,target,:.],:cexpr]:= modemap :=SUBST(x,ss,modemap) +; -- SAY ["new map is",map] +; not (target':= coerceable(target,m,e)) => nil +; map:= [target',:rest map] +; [f,Tl,sl]:= compApplyModemap(form,modemap,e,nil) or return nil +; --generate code; return +; T:= +; [x',m',e'] where +; m':= SUBLIS(sl,map.(1)) +; x':= +; form':= [f,:[t.expr for t in Tl]] +; m'=$Category or isCategoryForm(m',e) => form' +; -- try to deal with new-style Unions where we know the conditions +; op = "elt" and f is ['XLAM,:.] and IDENTP(z:=CAR argl) and +; (c:=get(z,'condition,e)) and +; c is [['case,=z,c1]] and +; (c1 is ['_:,=(CADR argl),=m] or EQ(c1,CADR argl) ) => +;-- first is a full tag, as placed by getInverseEnvironment +;-- second is what getSuccessEnvironment will place there +; ["CDR",z] +; ["call",:form'] +; e':= +; Tl => (LAST Tl).env +; e +; convert(T,m) + +(DEFUN |compFormWithModemap| (|form| |m| |e| |modemap|) (PROG (|op| |argl| |pred| |impl| |sv| |target| |cexpr| |target'| |map| temp1 |f| transimp |sl| |m'| |form'| |z| |c| tmp3 |c1| tmp1 tmp2 |x'| |e'| T$) (RETURN (SEQ (PROGN (setq |op| (CAR |form|)) (setq |argl| (CDR |form|)) (setq |map| (CAR |modemap|)) (setq |target| (CADAR |modemap|)) (setq |pred| (CAADR |modemap|)) (setq |impl| (CADADR |modemap|)) (COND ((AND (|isCategoryForm| |target| |e|) (|isFunctor| |op|)) (setq temp1 (OR (|substituteIntoFunctorModemap| |argl| |modemap| |e|) (RETURN NIL))) (setq |modemap| (CAR temp1)) (setq |e| (CADR temp1)) (setq |map| (CAR |modemap|)) (setq |target| (CADAR |modemap|)) (setq |cexpr| (CDR |modemap|)) |modemap|)) (setq |sv| (|listOfSharpVars| |map|)) (COND (|sv| (DO ((t0 |argl| (CDR t0)) (|x| NIL) (t1 |$FormalMapVariableList| (CDR t1)) (|ss| NIL)) ((OR (ATOM t0) (PROGN (SETQ |x| (CAR t0)) NIL) (ATOM t1) (PROGN (SETQ |ss| (CAR t1)) NIL)) NIL) (SEQ (EXIT (COND ((|member| |ss| |sv|) (setq |modemap| (MSUBST |x| |ss| |modemap|)) (setq |map| (CAR |modemap|)) (setq |target| (CADAR |modemap|)) (setq |cexpr| (CDR |modemap|)) |modemap|) (t NIL))))))) (COND ((NULL (setq |target'| (|coerceable| |target| |m| |e|))) NIL) (t (setq |map| (CONS |target'| (CDR |map|))) (setq temp1 (OR (|compApplyModemap| |form| |modemap| |e| NIL) (RETURN NIL))) (setq |f| (CAR temp1)) (setq transimp (CADR temp1)) (setq |sl| (CADDR temp1)) (setq |m'| (SUBLIS |sl| (ELT |map| 1))) (setq |x'| (PROGN (setq |form'| (CONS |f| (PROG (t2) (setq t2 NIL) (RETURN (DO ((t3 transimp (CDR t3)) (|t| NIL)) ((OR (ATOM t3) (PROGN (SETQ |t| (CAR t3)) NIL)) (NREVERSE0 t2)) (SEQ (EXIT (SETQ t2 (CONS (CAR |t|) t2))))))))) (COND ((OR (BOOT-EQUAL |m'| |$Category|) (|isCategoryForm| |m'| |e|)) |form'|) ((AND (BOOT-EQUAL |op| (QUOTE |elt|)) (PAIRP |f|) (EQ (QCAR |f|) (QUOTE XLAM)) (IDENTP (setq |z| (CAR |argl|))) (setq |c| (|get| |z| (QUOTE |condition|) |e|)) (PAIRP |c|) (EQ (QCDR |c|) NIL) (PROGN (setq tmp1 (QCAR |c|)) (AND (PAIRP tmp1) (EQ (QCAR tmp1) (QUOTE |case|)) (PROGN (setq tmp2 (QCDR tmp1)) (AND (PAIRP tmp2) (EQUAL (QCAR tmp2) |z|) (PROGN (setq tmp3 (QCDR tmp2)) (AND (PAIRP tmp3) (EQ (QCDR tmp3) NIL) (PROGN (setq |c1| (QCAR tmp3)) t))))))) (OR (AND (PAIRP |c1|) (EQ (QCAR |c1|) (QUOTE |:|)) (PROGN (setq tmp1 (QCDR |c1|)) (AND (PAIRP tmp1) (EQUAL (QCAR tmp1) (CADR |argl|)) (PROGN (setq tmp2 (QCDR tmp1)) (AND (PAIRP tmp2) (EQ (QCDR tmp2) NIL) (EQUAL (QCAR tmp2) |m|)))))) (EQ |c1| (CADR |argl|)))) (CONS (QUOTE CDR) (CONS |z| NIL))) (t (CONS (QUOTE |call|) |form'|))))) (setq |e'| (COND (transimp (CADDR (|last| transimp))) (t |e|))) (setq T$ (CONS |x'| (CONS |m'| (CONS |e'| NIL)))) (|convert| T$ |m|)))))))) + + +;-- This version tends to give problems with #1 and categories +;-- applyMapping([op,:argl],m,e,ml) == +;-- #argl^=#ml-1 => nil +;-- mappingHasCategoryTarget := +;-- isCategoryForm(first ml,e) => --is op a functor? +;-- form:= [op,:argl'] +;-- pairlis:= [[v,:a] for a in argl for v in $FormalMapVariableList] +;-- ml:= SUBLIS(pairlis,ml) +;-- true +;-- false +;-- argl':= +;-- [T.expr for x in argl for m' in rest ml] where +;-- T() == [.,.,e]:= comp(x,m',e) or return "failed" +;-- if argl'="failed" then return nil +;-- mappingHasCategoryTarget => convert([form,first ml,e],m) +;-- form:= +;-- not MEMBER(op,$formalArgList) and ATOM op => +;-- [op',:argl',"$"] where +;-- op':= INTERN STRCONC(STRINGIMAGE $prefix,";",STRINGIMAGE op) +;-- ["call",["applyFun",op],:argl'] +;-- pairlis:= [[v,:a] for a in argl' for v in $FormalMapVariableList] +;-- convert([form,SUBLIS(pairlis,first ml),e],m) + + +;applyMapping([op,:argl],m,e,ml) == +; #argl^=#ml-1 => nil +; isCategoryForm(first ml,e) => +; --is op a functor? +; pairlis:= [[v,:a] for a in argl for v in $FormalMapVariableList] +; ml' := SUBLIS(pairlis, ml) +; argl':= +; [T.expr for x in argl for m' in rest ml'] where +; T() == [.,.,e]:= comp(x,m',e) or return "failed" +; if argl'="failed" then return nil +; form:= [op,:argl'] +; convert([form,first ml',e],m) +; argl':= +; [T.expr for x in argl for m' in rest ml] where +; T() == [.,.,e]:= comp(x,m',e) or return "failed" +; if argl'="failed" then return nil +; form:= +; not MEMBER(op,$formalArgList) and ATOM op and not get(op,'value,e) => +; nprefix := $prefix or +; -- following needed for referencing local funs at capsule level +; getAbbreviation($op,#rest $form) +; [op',:argl',"$"] where +; op':= INTERN STRCONC(encodeItem nprefix,";",encodeItem op) +; ['call,['applyFun,op],:argl'] +; pairlis:= [[v,:a] for a in argl' for v in $FormalMapVariableList] +; convert([form,SUBLIS(pairlis,first ml),e],m) + +(DEFUN |applyMapping| (t0 |m| |e| |ml|) (PROG (|op| |argl| |ml'| temp1 |argl'| |nprefix| |op'| |form| |pairlis|) (RETURN (SEQ (PROGN (setq |op| (CAR t0)) (setq |argl| (CDR t0)) (COND ((NEQUAL (|#| |argl|) (SPADDIFFERENCE (|#| |ml|) 1)) NIL) ((|isCategoryForm| (CAR |ml|) |e|) (setq |pairlis| (PROG (t1) (setq t1 NIL) (RETURN (DO ((t2 |argl| (CDR t2)) (|a| NIL) (t3 |$FormalMapVariableList| (CDR t3)) (|v| NIL)) ((OR (ATOM t2) (PROGN (SETQ |a| (CAR t2)) NIL) (ATOM t3) (PROGN (SETQ |v| (CAR t3)) NIL)) (NREVERSE0 t1)) (SEQ (EXIT (SETQ t1 (CONS (CONS |v| |a|) t1)))))))) (setq |ml'| (SUBLIS |pairlis| |ml|)) (setq |argl'| (PROG (t4) (setq t4 NIL) (RETURN (DO ((t5 |argl| (CDR t5)) (|x| NIL) (t6 (CDR |ml'|) (CDR t6)) (|m'| NIL)) ((OR (ATOM t5) (PROGN (SETQ |x| (CAR t5)) NIL) (ATOM t6) (PROGN (SETQ |m'| (CAR t6)) NIL)) (NREVERSE0 t4)) (SEQ (EXIT (SETQ t4 (CONS (CAR (PROGN (setq temp1 (OR (|comp| |x| |m'| |e|) (RETURN (QUOTE |failed|)))) (setq |e| (CADDR temp1)) temp1)) t4)))))))) (COND ((BOOT-EQUAL |argl'| (QUOTE |failed|)) (RETURN NIL))) (setq |form| (CONS |op| |argl'|)) (|convert| (CONS |form| (CONS (CAR |ml'|) (CONS |e| NIL))) |m|)) (t (setq |argl'| (PROG (t7) (setq t7 NIL) (RETURN (DO ((t8 |argl| (CDR t8)) (|x| NIL) (t9 (CDR |ml|) (CDR t9)) (|m'| NIL)) ((OR (ATOM t8) (PROGN (SETQ |x| (CAR t8)) NIL) (ATOM t9) (PROGN (SETQ |m'| (CAR t9)) NIL)) (NREVERSE0 t7)) (SEQ (EXIT (SETQ t7 (CONS (CAR (PROGN (setq temp1 (OR (|comp| |x| |m'| |e|) (RETURN (QUOTE |failed|)))) (setq |e| (CADDR temp1)) temp1)) t7)))))))) (COND ((BOOT-EQUAL |argl'| (QUOTE |failed|)) (RETURN NIL))) (setq |form| (COND ((AND (NULL (|member| |op| |$formalArgList|)) (ATOM |op|) (NULL (|get| |op| (QUOTE |value|) |e|))) (setq |nprefix| (OR |$prefix| (|getAbbreviation| |$op| (|#| (CDR |$form|))))) (setq |op'| (INTERN (STRCONC (|encodeItem| |nprefix|) (QUOTE |;|) (|encodeItem| |op|)))) (CONS |op'| (APPEND |argl'| (CONS (QUOTE $) NIL)))) (t (CONS (QUOTE |call|) (CONS (CONS (QUOTE |applyFun|) (CONS |op| NIL)) |argl'|))))) (setq |pairlis| (PROG (t10) (setq t10 NIL) (RETURN (DO ((t11 |argl'| (CDR t11)) (|a| NIL) (t12 |$FormalMapVariableList| (CDR t12)) (|v| NIL)) ((OR (ATOM t11) (PROGN (SETQ |a| (CAR t11)) NIL) (ATOM t12) (PROGN (SETQ |v| (CAR t12)) NIL)) (NREVERSE0 t10)) (SEQ (EXIT (SETQ t10 (CONS (CONS |v| |a|) t10)))))))) (|convert| (CONS |form| (CONS (SUBLIS |pairlis| (CAR |ml|)) (CONS |e| NIL))) |m|)))))))) + + +;--% APPLY MODEMAPS +;compApplyModemap(form,modemap,$e,sl) == +; [op,:argl] := form --form to be compiled +; [[mc,mr,:margl],:fnsel] := modemap --modemap we are testing +; -- $e is the current environment +; -- sl substitution list, nil means bottom-up, otherwise top-down +; -- 0. fail immediately if #argl=#margl +; if #argl^=#margl then return nil +; -- 1. use modemap to evaluate arguments, returning failed if +; -- not possible +; lt:= +; [[.,m',$e]:= +; comp(y,g,$e) or return "failed" where +; g:= SUBLIS(sl,m) where +; sl:= pmatchWithSl(m',m,sl) for y in argl for m in margl] +; lt="failed" => return nil +; -- 2. coerce each argument to final domain, returning failed +; -- if not possible +; lt':= [coerce(y,d) or return "failed" +; for y in lt for d in SUBLIS(sl,margl)] +; lt'="failed" => return nil +; -- 3. obtain domain-specific function, if possible, and return +; --$bindings is bound by compMapCond +; [f,$bindings]:= compMapCond(op,mc,sl,fnsel) or return nil +;--+ can no longer trust what the modemap says for a reference into +;--+ an exterior domain (it is calculating the displacement based on view +;--+ information which is no longer valid; thus ignore this index and +;--+ store the signature instead. +;--$NRTflag=true and f is [op1,d,.] and NE(d,'$) and MEMBER(op1,'(ELT CONST)) => +; f is [op1,d,.] and MEMBER(op1,'(ELT CONST Subsumed)) => +; [genDeltaEntry [op,:modemap],lt',$bindings] +; [f,lt',$bindings] + +(DEFUN |compApplyModemap| (|form| |modemap| |$e| |sl|) (DECLARE (SPECIAL |$e|)) (PROG (|op| |argl| |mc| |mr| |margl| |fnsel| |g| |m'| |lt| |lt'| temp1 |f| |op1| tmp1 |d| tmp2) (RETURN (SEQ (PROGN (setq |op| (CAR |form|)) (setq |argl| (CDR |form|)) (setq |mc| (CAAR |modemap|)) (setq |mr| (CADAR |modemap|)) (setq |margl| (CDDAR |modemap|)) (setq |fnsel| (CDR |modemap|)) (COND ((NEQUAL (|#| |argl|) (|#| |margl|)) (RETURN NIL))) (setq |lt| (PROG (t0) (setq t0 NIL) (RETURN (DO ((t1 |argl| (CDR t1)) (|y| NIL) (t2 |margl| (CDR t2)) (|m| NIL)) ((OR (ATOM t1) (PROGN (SETQ |y| (CAR t1)) NIL) (ATOM t2) (PROGN (SETQ |m| (CAR t2)) NIL)) (NREVERSE0 t0)) (SEQ (EXIT (SETQ t0 (CONS (PROGN (setq |sl| (|pmatchWithSl| |m'| |m| |sl|)) (setq |g| (SUBLIS |sl| |m|)) (setq temp1 (OR (|comp| |y| |g| |$e|) (RETURN (QUOTE |failed|)))) (setq |m'| (CADR temp1)) (setq |$e| (CADDR temp1)) temp1) t0)))))))) (COND ((BOOT-EQUAL |lt| (QUOTE |failed|)) (RETURN NIL)) (t (setq |lt'| (PROG (t3) (setq t3 NIL) (RETURN (DO ((t4 |lt| (CDR t4)) (|y| NIL) (t5 (SUBLIS |sl| |margl|) (CDR t5)) (|d| NIL)) ((OR (ATOM t4) (PROGN (SETQ |y| (CAR t4)) NIL) (ATOM t5) (PROGN (SETQ |d| (CAR t5)) NIL)) (NREVERSE0 t3)) (SEQ (EXIT (SETQ t3 (CONS (OR (|coerce| |y| |d|) (RETURN (QUOTE |failed|))) t3)))))))) (COND ((BOOT-EQUAL |lt'| (QUOTE |failed|)) (RETURN NIL)) (t (setq temp1 (OR (|compMapCond| |op| |mc| |sl| |fnsel|) (RETURN NIL))) (setq |f| (CAR temp1)) (setq |$bindings| (CADR temp1)) (COND ((AND (PAIRP |f|) (PROGN (setq |op1| (QCAR |f|)) (setq tmp1 (QCDR |f|)) (AND (PAIRP tmp1) (PROGN (setq |d| (QCAR tmp1)) (setq tmp2 (QCDR tmp1)) (AND (PAIRP tmp2) (EQ (QCDR tmp2) NIL))))) (|member| |op1| (QUOTE (ELT CONST |Subsumed|)))) (CONS (|genDeltaEntry| (CONS |op| |modemap|)) (CONS |lt'| (CONS |$bindings| NIL)))) (t (CONS |f| (CONS |lt'| (CONS |$bindings| NIL)))))))))))))) + + +;compMapCond(op,mc,$bindings,fnsel) == +; or/[compMapCond'(u,op,mc,$bindings) for u in fnsel] + +(defun |compMapCond| (op mc |$bindings| fnsel) + (declare (special |$bindings|)) + (let (t0) + (do ((t1 nil t0) (t2 fnsel (cdr t2)) (|u| nil)) + ((or t1 (atom t2) (progn (setq |u| (car t2)) nil)) t0) + (setq t0 (or t0 (|compMapCond'| |u| op mc |$bindings|)))))) + + +;compMapCond'([cexpr,fnexpr],op,dc,bindings) == +; compMapCond''(cexpr,dc) => compMapCondFun(fnexpr,op,dc,bindings) +; stackMessage ["not known that",'%b,dc,'%d,"has",'%b,cexpr,'%d] + +(defun |compMapCond'| (t0 op dc bindings) + (let ((cexpr (car t0)) (fnexpr (cadr t0))) + (if (|compMapCond''| cexpr dc) + (|compMapCondFun| fnexpr op dc bindings) + (|stackMessage| `("not known that" %b ,dc %d "has" %b ,cexpr %d))))) + +;compMapCond''(cexpr,dc) == +; cexpr=true => true +; --cexpr = "true" => true +; cexpr is ["AND",:l] => and/[compMapCond''(u,dc) for u in l] +; cexpr is ["OR",:l] => or/[compMapCond''(u,dc) for u in l] +; cexpr is ["not",u] => not compMapCond''(u,dc) +; cexpr is ["has",name,cat] => (knownInfo cexpr => true; false) +; --for the time being we'll stop here - shouldn't happen so far +; --$disregardConditionIfTrue => true +; --stackSemanticError(("not known that",'%b,name, +; -- '%d,"has",'%b,cat,'%d),nil) +; --now it must be an attribute +; MEMBER(["ATTRIBUTE",dc,cexpr],get("$Information","special",$e)) => true +; --for the time being we'll stop here - shouldn't happen so far +; stackMessage ["not known that",'%b,dc,'%d,"has",'%b,cexpr,'%d] +; false + +(defun |compMapCond''| (cexpr dc) + (let (l u tmp1 tmp2) + (declare (special |$Information|)) + (cond + ((boot-equal cexpr t) t) + ((and (pairp cexpr) + (eq (qcar cexpr) 'and) + (progn (setq l (qcdr cexpr)) t)) + (prog (t0) + (setq t0 t) + (return + (do ((t1 nil (null t0)) (t2 l (cdr t2)) (u nil)) + ((or t1 (atom t2) (progn (setq u (car t2)) nil)) t0) + (setq t0 (and t0 (|compMapCond''| u dc))))))) + ((and (pairp cexpr) + (eq (qcar cexpr) 'or) + (progn (setq l (qcdr cexpr)) t)) + (prog (t3) + (setq t3 nil) + (return + (do ((t4 nil t3) (t5 l (cdr t5)) (u nil)) + ((or t4 (atom t5) (progn (setq u (car t5)) nil)) t3) + (setq t3 (or t3 (|compMapCond''| u dc))))))) + ((and (pairp cexpr) + (eq (qcar cexpr) '|not|) + (progn + (setq tmp1 (qcdr cexpr)) + (and (pairp tmp1) + (eq (qcdr tmp1) nil) + (progn (setq u (qcar tmp1)) t)))) + (null (|compMapCond''| u dc))) + ((and (pairp cexpr) + (eq (qcar cexpr) '|has|) + (progn + (setq tmp1 (qcdr cexpr)) + (and (pairp tmp1) + (progn + (setq tmp2 (qcdr tmp1)) + (and (pairp tmp2) + (eq (qcdr tmp2) nil)))))) + (cond + ((|knownInfo| cexpr) t) + (t nil))) + ((|member| + (cons 'attribute (cons dc (cons cexpr nil))) + (|get| '|$Information| '|special| |$e|)) + t) + (t + (|stackMessage| `("not known that" %b ,dc %d "has" %b ,cexpr %d)) + nil)))) + +;compMapCondFun(fnexpr,op,dc,bindings) == [fnexpr,bindings] + +(defun |compMapCondFun| (fnexpr op dc bindings) + (declare (ignore op) (ignore dc)) + (cons fnexpr (cons bindings nil))) + +@ +\eject +\begin{thebibliography}{99} +\bibitem{1} nothing +\end{thebibliography} +\end{document} diff --git a/src/interp/util.lisp.pamphlet b/src/interp/util.lisp.pamphlet index 14e9ffe..d7126d7 100644 --- a/src/interp/util.lisp.pamphlet +++ b/src/interp/util.lisp.pamphlet @@ -148,7 +148,7 @@ After this function is called the image is clean and can be saved. #+:CCL (resethashtables) (setq *load-verbose* nil) - (|setBootAutloadProperties| comp-functions comp-files) +; (|setBootAutloadProperties| comp-functions comp-files) ; (|setBootAutloadProperties| parse-functions parse-files) (|setBootAutloadProperties| browse-functions browse-files) (|setBootAutloadProperties| translate-functions translate-files) @@ -369,17 +369,17 @@ developers who translate boot code to Common Lisp. This is the {\bf spad compiler} subsystem. It is only needed by developers who write or modify algebra code. <>= -(setq comp-functions - '( -;; loadcompiler - |oldCompilerAutoloadOnceTrigger| -;; |compileSpad2Cmd| - |convertSpadToAsFile| - |compilerDoit| - |compilerDoitWithScreenedLisplib| - |mkCategory| - |cons5| - |sublisV|)) +;(setq comp-functions +; '( +;;; loadcompiler +; |oldCompilerAutoloadOnceTrigger| +;;; |compileSpad2Cmd| +; |convertSpadToAsFile| +; |compilerDoit| +; |compilerDoitWithScreenedLisplib| +; |mkCategory| +; |cons5| +; |sublisV|)) @ \subsubsection{browse-functions}