[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Axiom-developer] 20090428.01.tpd.patch (apply.boot, rewrite to lisp)
|
From: |
daly |
|
Subject: |
[Axiom-developer] 20090428.01.tpd.patch (apply.boot, rewrite to lisp) |
|
Date: |
Sat, 2 May 2009 20:07:56 -0500 |
The apply.boot code has been removed from the autoload list and
rewritten in lisp.
==================================================================
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 <br/>
parsing.lisp consolidate parsing, remove autoload <br/>
<a href="patches/20090427.01.tpd.patch">20090427.01.tpd.patch</a>
tangle.lisp common lisp literate tangle function <br/>
+<a href="patches/20090428.01.tpd.patch">20090428.01.tpd.patch</a>
+apply.boot removed, rewritten into lisp, not autoloaded <br/>
</body>
</html>
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.
<<environment>>=
-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.
<<environment>>=
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>>=
${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}}
-<<apply.o (AUTO from OUT)>>=
-${AUTO}/apply.${O}: ${OUT}/apply.${O}
- @ echo 9 making ${AUTO}/apply.${O} from ${OUT}/apply.${O}
- @ cp ${OUT}/apply.${O} ${AUTO}
-
-@
<<apply.o (OUT from MID)>>=
-${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 )
@
-<<apply.clisp (MID from IN)>>=
-${MID}/apply.clisp: ${IN}/apply.boot.pamphlet
- @ echo 11 making ${MID}/apply.clisp from ${IN}/apply.boot.pamphlet
+<<apply.lisp (MID from IN)>>=
+${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 )
-
-@
-<<apply.boot.dvi (DOC from IN)>>=
-${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}}
-<<bootlex.o (AUTO from OUT)>>=
-${AUTO}/bootlex.${O}: ${OUT}/bootlex.${O}
- @ echo 19 making ${AUTO}/bootlex.${O} from ${OUT}/bootlex.${O}
- @ cp ${OUT}/bootlex.${O} ${AUTO}
-
-@
-<<bootlex.o (OUT from MID)>>=
-${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 )
-
-@
-<<bootlex.lisp (OUT from MID)>>=
-${OUT}/bootlex.${LISP}: ${MID}/bootlex.lisp
- @ echo 21 making ${OUT}/bootlex.${LISP} from ${MID}/bootlex.lisp
- @cp ${MID}/bootlex.lisp ${OUT}/bootlex.${LISP}
-
-@
-<<bootlex.lisp (MID from IN)>>=
-${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 )
-
-@
-<<bootlex.lisp.dvi (DOC from IN)>>=
-${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}}
<<cfuns.o (OUT from MID)>>=
${OUT}/cfuns.${O}: ${MID}/cfuns.lisp
@@ -1277,53 +1192,6 @@ ${DOC}/debugsys.lisp.dvi: ${IN}/debugsys.lisp.pamphlet
@
-\subsection{def.lisp \cite{15}}
-<<def.o (AUTO from OUT)>>=
-${AUTO}/def.${O}: ${OUT}/def.${O}
- @ echo 41 making ${AUTO}/def.${O} from ${OUT}/def.${O}
- @ cp ${OUT}/def.${O} ${AUTO}
-
-@
-<<def.o (OUT from MID)>>=
-${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 )
-
-@
-<<def.lisp (OUT from MID)>>=
-${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}
-
-@
-<<def.lisp (MID from IN)>>=
-${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 )
-
-@
-<<def.lisp.dvi (DOC from IN)>>=
-${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}}
<<fname.o (OUT from MID)>>=
${OUT}/fname.${O}: ${MID}/fname.lisp
@@ -1554,53 +1422,6 @@ ${DOC}/macros.lisp.dvi: ${IN}/macros.lisp.pamphlet
@
-\subsection{metalex.lisp \cite{22}}
-<<metalex.o (AUTO from OUT)>>=
-${AUTO}/metalex.${O}: ${OUT}/metalex.${O}
- @ echo 66 making ${AUTO}/metalex.${O} from ${OUT}/metalex.${O}
- @ cp ${OUT}/metalex.${O} ${AUTO}
-
-@
-<<metalex.o (OUT from MID)>>=
-${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 )
-
-@
-<<metalex.lisp (OUT from MID)>>=
-${OUT}/metalex.${LISP}: ${MID}/metalex.lisp
- @ echo 68 making ${OUT}/metalex.${LISP} from ${MID}/metalex.lisp
- @cp ${MID}/metalex.lisp ${OUT}/metalex.${LISP}
-
-@
-<<metalex.lisp (MID from IN)>>=
-${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 )
-
-@
-<<metalex.lisp.dvi (DOC from IN)>>=
-${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}}
<<monitor.o (OUT from MID)>>=
${OUT}/monitor.${O}: ${MID}/monitor.lisp
@@ -1901,55 +1722,6 @@ ${DOC}/postprop.lisp.dvi: ${IN}/postprop.lisp.pamphlet
@
-\subsection{preparse.lisp \cite{31}}
-<<preparse.o (AUTO from OUT)>>=
-${AUTO}/preparse.${O}: ${OUT}/preparse.${O}
- @ echo 106 making ${AUTO}/preparse.${O} from ${OUT}/preparse.${O}
- @ cp ${OUT}/preparse.${O} ${AUTO}
-
-@
-<<preparse.o (OUT from MID)>>=
-${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 )
-
-@
-<<preparse.lisp (OUT from MID)>>=
-${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}
-
-@
-<<preparse.lisp (MID from IN)>>=
-${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 )
-
-@
-<<preparse.lisp.dvi (DOC from IN)>>=
-${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}}
<<property.lisp (OUT from MID)>>=
${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
-<<parse.o (AUTO from OUT)>>=
-${AUTO}/parse.${O}: ${OUT}/parse.${O}
- @ echo 374 making ${AUTO}/parse.${O} from ${OUT}/parse.${O}
- @ cp ${OUT}/parse.${O} ${AUTO}
-
-@
-<<parse.o (OUT from MID)>>=
-${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.}
-<<parse.lisp (OUT from IN)>>=
-${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} )
-
-@
-<<parse.clisp (MID from IN)>>=
-${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 )
-
-@
-<<parse.boot.dvi (DOC from IN)>>=
-${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}
<<pathname.o (OUT from MID)>>=
${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
-<<postpar.o (AUTO from OUT)>>=
-${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.}
-<<postpar.lisp (OUT from IN)>>=
-${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} )
-
-@
-<<postpar.o (OUT from MID)>>=
-${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.
-
-<<postpar.clisp (MID from IN)>>=
-${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 )
-
-@
-<<postpar.boot.dvi (DOC from IN)>>=
-${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}
<<regress.o (OUT from MID)>>=
${OUT}/regress.${O}: ${MID}/regress.${LISP}
@@ -8391,10 +8010,8 @@ clean:
<<alql.clisp (MID from IN)>>
<<alql.boot.dvi (DOC from IN)>>
-<<apply.o (AUTO from OUT)>>
<<apply.o (OUT from MID)>>
-<<apply.clisp (MID from IN)>>
-<<apply.boot.dvi (DOC from IN)>>
+<<apply.lisp (MID from IN)>>
<<as.o (OUT from MID)>>
<<as.clisp (MID from IN)>>
@@ -8441,12 +8058,6 @@ clean:
<<bootfuns.lisp (MID from IN)>>
<<bootfuns.lisp.dvi (DOC from IN)>>
-<<bootlex.o (AUTO from OUT)>>
-<<bootlex.o (OUT from MID)>>
-<<bootlex.lisp (OUT from MID)>>
-<<bootlex.lisp (MID from IN)>>
-<<bootlex.lisp.dvi (DOC from IN)>>
-
<<br-con.o (AUTO from OUT)>>
<<br-con.o (OUT from MID)>>
<<br-con.clisp (MID from IN)>>
@@ -8572,12 +8183,6 @@ clean:
<<debugsys.lisp (MID from IN)>>
<<debugsys.lisp.dvi (DOC from IN)>>
-<<def.o (AUTO from OUT)>>
-<<def.o (OUT from MID)>>
-<<def.lisp (OUT from MID)>>
-<<def.lisp (MID from IN)>>
-<<def.lisp.dvi (DOC from IN)>>
-
<<define.o (AUTO from OUT)>>
<<define.o (OUT from MID)>>
<<define.clisp (MID from IN)>>
@@ -8798,12 +8403,6 @@ clean:
<<match.clisp (MID from IN)>>
<<match.boot.dvi (DOC from IN)>>
-<<metalex.o (AUTO from OUT)>>
-<<metalex.o (OUT from MID)>>
-<<metalex.lisp (OUT from MID)>>
-<<metalex.lisp (MID from IN)>>
-<<metalex.lisp.dvi (DOC from IN)>>
-
<<modemap.o (AUTO from OUT)>>
<<modemap.o (OUT from MID)>>
<<modemap.clisp (MID from IN)>>
@@ -8960,12 +8559,6 @@ clean:
<<parini.clisp (MID from IN)>>
<<parini.boot.dvi (DOC from IN)>>
-<<parse.o (AUTO from OUT)>>
-<<parse.o (OUT from MID)>>
-<<parse.lisp (OUT from IN)>>
-<<parse.clisp (MID from IN)>>
-<<parse.boot.dvi (DOC from IN)>>
-
<<parsing.o (AUTO from OUT)>>
<<parsing.o (OUT from MID)>>
<<parsing.lisp (OUT from MID)>>
@@ -8992,23 +8585,11 @@ clean:
<<posit.clisp (MID from IN)>>
<<posit.boot.dvi (DOC from IN)>>
-<<postpar.o (AUTO from OUT)>>
-<<postpar.lisp (OUT from IN)>>
-<<postpar.o (OUT from MID)>>
-<<postpar.clisp (MID from IN)>>
-<<postpar.boot.dvi (DOC from IN)>>
-
<<postprop.lisp (AUTO from OUT)>>
<<postprop.lisp (OUT from MID)>>
<<postprop.lisp (MID from IN)>>
<<postprop.lisp.dvi (DOC from IN)>>
-<<preparse.o (AUTO from OUT)>>
-<<preparse.o (OUT from MID)>>
-<<preparse.lisp (OUT from MID)>>
-<<preparse.lisp (MID from IN)>>
-<<preparse.lisp.dvi (DOC from IN)>>
-
<<profile.o (AUTO from OUT)>>
<<profile.o (OUT from MID)>>
<<profile.clisp (MID from IN)>>
@@ -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}
-<<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.
-
-@
-<<*>>=
-<<license>>
-
-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| |$fo!
rmalArgList|) (|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|)
(s!
etq |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|)) (PRO!
GN (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) (RET!
URN (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.
<<comp-functions>>=
-(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}
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Axiom-developer] 20090428.01.tpd.patch (apply.boot, rewrite to lisp),
daly <=