diff --git a/changelog b/changelog index 1db9b1d..4dc898c 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,7 @@ +20090817 tpd src/axiom-website/patches.html 20090817.03.tpd.patch +20090817 tpd src/interp/Makefile move i-code.boot to i-code.lisp +20090817 tpd src/interp/i-code.lisp added, rewritten from i-code.boot +20090817 tpd src/interp/i-code.boot removed, rewritten to i-code.lisp 20090817 tpd src/axiom-website/patches.html 20090817.02.tpd.patch 20090817 tpd src/interp/Makefile move i-analy.boot to i-analy.lisp 20090817 tpd src/interp/i-analy.lisp added, rewritten from i-analy.boot diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 97d8bdd..78c2750 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -1816,6 +1816,8 @@ g-util.lisp rewrite from boot to lisp
hypertex.lisp rewrite from boot to lisp
20090817.02.tpd.patch i-analy.lisp rewrite from boot to lisp
+20090817.03.tpd.patch +i-code.lisp rewrite from boot to lisp
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index 6e470d8..3b37b45 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -427,7 +427,6 @@ DOCFILES=${DOC}/as.boot.dvi \ ${DOC}/hashcode.boot.dvi \ ${DOC}/htcheck.boot.dvi \ ${DOC}/ht-util.boot.dvi \ - ${DOC}/i-code.boot.dvi \ ${DOC}/i-coerce.boot.dvi ${DOC}/i-coerfn.boot.dvi \ ${DOC}/i-eval.boot.dvi ${DOC}/i-funsel.boot.dvi \ ${DOC}/i-intern.boot.dvi \ @@ -3052,45 +3051,26 @@ ${MID}/i-analy.lisp: ${IN}/i-analy.lisp.pamphlet @ -\subsection{i-code.boot} +\subsection{i-code.lisp} <>= -${OUT}/i-code.${O}: ${MID}/i-code.clisp - @ echo 282 making ${OUT}/i-code.${O} from ${MID}/i-code.clisp - @ (cd ${MID} ; \ +${OUT}/i-code.${O}: ${MID}/i-code.lisp + @ echo 136 making ${OUT}/i-code.${O} from ${MID}/i-code.lisp + @ ( cd ${MID} ; \ if [ -z "${NOISE}" ] ; then \ - echo '(progn (compile-file "${MID}/i-code.clisp"' \ + echo '(progn (compile-file "${MID}/i-code.lisp"' \ ':output-file "${OUT}/i-code.${O}") (${BYE}))' | ${DEPSYS} ; \ else \ - echo '(progn (compile-file "${MID}/i-code.clisp"' \ + echo '(progn (compile-file "${MID}/i-code.lisp"' \ ':output-file "${OUT}/i-code.${O}") (${BYE}))' | ${DEPSYS} \ >${TMP}/trace ; \ fi ) @ -<>= -${MID}/i-code.clisp: ${IN}/i-code.boot.pamphlet - @ echo 283 making ${MID}/i-code.clisp from ${IN}/i-code.boot.pamphlet +<>= +${MID}/i-code.lisp: ${IN}/i-code.lisp.pamphlet + @ echo 137 making ${MID}/i-code.lisp from ${IN}/i-code.lisp.pamphlet @ (cd ${MID} ; \ - ${TANGLE} ${IN}/i-code.boot.pamphlet >i-code.boot ; \ - if [ -z "${NOISE}" ] ; then \ - echo '(progn (boottran::boottocl "i-code.boot") (${BYE}))' \ - | ${DEPSYS} ; \ - else \ - echo '(progn (boottran::boottocl "i-code.boot") (${BYE}))' \ - | ${DEPSYS} >${TMP}/trace ; \ - fi ; \ - rm i-code.boot ) - -@ -<>= -${DOC}/i-code.boot.dvi: ${IN}/i-code.boot.pamphlet - @echo 284 making ${DOC}/i-code.boot.dvi from ${IN}/i-code.boot.pamphlet - @(cd ${DOC} ; \ - cp ${IN}/i-code.boot.pamphlet ${DOC} ; \ - ${DOCUMENT} ${NOISE} i-code.boot ; \ - rm -f ${DOC}/i-code.boot.pamphlet ; \ - rm -f ${DOC}/i-code.boot.tex ; \ - rm -f ${DOC}/i-code.boot ) + ${TANGLE} ${IN}/i-code.lisp.pamphlet >i-code.lisp ) @ @@ -6616,8 +6596,7 @@ clean: <> <> -<> -<> +<> <> <> diff --git a/src/interp/i-code.boot.pamphlet b/src/interp/i-code.boot.pamphlet deleted file mode 100644 index c58ff15..0000000 --- a/src/interp/i-code.boot.pamphlet +++ /dev/null @@ -1,164 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp i-code.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. - -@ -<<*>>= -<> - ---% Interpreter Code Generation Routines - ---Modified by JHD 9/9/93 to fix a problem with coerces inside ---interpreter functions being used as mappings. They were being ---handled with $useCoerceOrCroak being NIL, and therefore internal ---coercions were not correctly handled. Fix: remove dependence ---on $useCoerceOrCroak, and test explicitly for Mapping types. - ---% COERCE - -intCodeGenCOERCE(triple,t2) == - -- NOTE: returns a triple - t1 := objMode triple - t1 = $EmptyMode => NIL - t1 = t2 => triple - val := objVal triple - - -- if request is for a coerce to t2 from a coerce from - -- to to t1, and t1 = Void or canCoerce(t0,t2), then optimize - - (val is ['coerceOrCroak,trip,t1', .]) and - (t0 := objCodeMode trip) and ([.,val0] := objCodeVal trip) and - ( (t1 = $Void) or canCoerceFrom(removeQuote t0,t2) ) => - -- just generate code for coercion, don't coerce constants - -- might be too big - intCodeGenCOERCE(objNew(val0, removeQuote t0), t2) - - val is ['THROW,label,code] => - if label is ['QUOTE, l] then label := l - null($compilingMap) or (label ^= mapCatchName($mapName)) => - objNew(['THROW,label,wrapped2Quote objVal - intCodeGenCOERCE(objNew(code,t1),t2)],t2) - -- we have a return statement. just send it back as is - objNew(val,t2) - - val is ['PROGN,:code,lastCode] => - objNew(['PROGN,:code,wrapped2Quote objVal - intCodeGenCOERCE(objNew(lastCode,t1),t2)],t2) - - val is ['COND,:conds] => - objNew(['COND, - :[[p,wrapped2Quote objVal intCodeGenCOERCE(objNew(v,t1),t2)] - for [p,v] in conds]],t2) - - -- specially handle subdomain - absolutelyCanCoerceByCheating(t1,t2) => objNew(val,t2) - - -- specially handle coerce to Any - t2 = '(Any) => objNew(['CONS,MKQ t1,val],t2) - - -- optimize coerces from Any - (t1 = '(Any)) and (val is [ ='CONS,t1',val']) => - intCodeGenCOERCE(objNew(val',removeQuote t1'),t2) - - -- specially handle coerce from Equation to Boolean - (t1 is ['Equation,:.]) and (t2 = $Boolean) => - coerceByFunction(triple,t2) - - -- next is hack for if-then-elses - (t1 = '$NoValueMode) and (val is ['COND,pred]) => - code := - ['COND,pred, - [MKQ true,['throwKeyedMsg,MKQ "S2IM0016",MKQ $mapName]]] - objNew(code,t2) - - -- optimize coerces to Expression - t2 = $OutputForm => - coerceByFunction(triple,t2) - - isSubDomain(t1, $Integer) => - intCodeGenCOERCE(objNew(val, $Integer), t2) - - -- generate code - -- 1. See if the coercion will go through (absolutely) - -- Must be careful about variables or else things like - -- P I --> P[x] P I might not have the x in the original polynomial - -- put in the correct place - - (not containsVariables(t2)) and canCoerceByFunction(t1,t2) => - -- try coerceByFunction - (not canCoerceByMap(t1,t2)) and - (code := coerceByFunction(triple,t2)) => code - intCodeGenCoerce1(val,t1,t2) - - -- 2. Set up a failure point otherwise - - intCodeGenCoerce1(val,t1,t2) - -intCodeGenCoerce1(val,t1,t2) == - -- Internal function to previous one - -- designed to ensure that we don't use coerceOrCroak on mappings ---(t2 is ['Mapping,:.]) => THROW('coerceOrCroaker, 'croaked) - objNew(['coerceOrCroak,mkObjCode(['wrap,val],t1), - MKQ t2, MKQ $mapName],t2) - ---% Map components - -wrapMapBodyWithCatch body == - -- places a CATCH around the map body - -- note that we will someday have to fix up the catch identifier - -- to use the generated internal map name - $mapThrowCount = 0 => body - if body is ['failCheck,['coerceOrFail,trip,targ,mapn]] - then - trip is ['LIST,v,m,e] => - ['failCheck,['coerceOrFail, - ['LIST,['CATCH,MKQ mapCatchName $mapName, v],m,e],targ,mapn]] - keyedSystemError("S2GE0016",['"wrapMapBodyWithCatch", - '"bad CATCH for in function form"]) - else ['CATCH,MKQ mapCatchName $mapName,body] -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/i-code.lisp.pamphlet b/src/interp/i-code.lisp.pamphlet new file mode 100755 index 0000000..e0bf4fb --- /dev/null +++ b/src/interp/i-code.lisp.pamphlet @@ -0,0 +1,385 @@ +\documentclass{article} +\usepackage{axiom} +\begin{document} +\title{\$SPAD/src/interp i-code.lisp} +\author{The Axiom Team} +\maketitle +\begin{abstract} +\end{abstract} +\eject +\tableofcontents +\eject +<<*>>= +(IN-PACKAGE "BOOT" ) + +;--% Interpreter Code Generation Routines +;--Modified by JHD 9/9/93 to fix a problem with coerces inside +;--interpreter functions being used as mappings. They were being +;--handled with $useCoerceOrCroak being NIL, and therefore internal +;--coercions were not correctly handled. Fix: remove dependence +;--on $useCoerceOrCroak, and test explicitly for Mapping types. +;--% COERCE +;intCodeGenCOERCE(triple,t2) == +; -- NOTE: returns a triple +; t1 := objMode triple +; t1 = $EmptyMode => NIL +; t1 = t2 => triple +; val := objVal triple +; -- if request is for a coerce to t2 from a coerce from +; -- to to t1, and t1 = Void or canCoerce(t0,t2), then optimize +; (val is ['coerceOrCroak,trip,t1', .]) and +; (t0 := objCodeMode trip) and ([.,val0] := objCodeVal trip) and +; ( (t1 = $Void) or canCoerceFrom(removeQuote t0,t2) ) => +; -- just generate code for coercion, don't coerce constants +; -- might be too big +; intCodeGenCOERCE(objNew(val0, removeQuote t0), t2) +; val is ['THROW,label,code] => +; if label is ['QUOTE, l] then label := l +; null($compilingMap) or (label ^= mapCatchName($mapName)) => +; objNew(['THROW,label,wrapped2Quote objVal +; intCodeGenCOERCE(objNew(code,t1),t2)],t2) +; -- we have a return statement. just send it back as is +; objNew(val,t2) +; val is ['PROGN,:code,lastCode] => +; objNew(['PROGN,:code,wrapped2Quote objVal +; intCodeGenCOERCE(objNew(lastCode,t1),t2)],t2) +; val is ['COND,:conds] => +; objNew(['COND, +; :[[p,wrapped2Quote objVal intCodeGenCOERCE(objNew(v,t1),t2)] +; for [p,v] in conds]],t2) +; -- specially handle subdomain +; absolutelyCanCoerceByCheating(t1,t2) => objNew(val,t2) +; -- specially handle coerce to Any +; t2 = '(Any) => objNew(['CONS,MKQ t1,val],t2) +; -- optimize coerces from Any +; (t1 = '(Any)) and (val is [ ='CONS,t1',val']) => +; intCodeGenCOERCE(objNew(val',removeQuote t1'),t2) +; -- specially handle coerce from Equation to Boolean +; (t1 is ['Equation,:.]) and (t2 = $Boolean) => +; coerceByFunction(triple,t2) +; -- next is hack for if-then-elses +; (t1 = '$NoValueMode) and (val is ['COND,pred]) => +; code := +; ['COND,pred, +; [MKQ true,['throwKeyedMsg,MKQ "S2IM0016",MKQ $mapName]]] +; objNew(code,t2) +; -- optimize coerces to Expression +; t2 = $OutputForm => +; coerceByFunction(triple,t2) +; isSubDomain(t1, $Integer) => +; intCodeGenCOERCE(objNew(val, $Integer), t2) +; -- generate code +; -- 1. See if the coercion will go through (absolutely) +; -- Must be careful about variables or else things like +; -- P I --> P[x] P I might not have the x in the original polynomial +; -- put in the correct place +; (not containsVariables(t2)) and canCoerceByFunction(t1,t2) => +; -- try coerceByFunction +; (not canCoerceByMap(t1,t2)) and +; (code := coerceByFunction(triple,t2)) => code +; intCodeGenCoerce1(val,t1,t2) +; -- 2. Set up a failure point otherwise +; intCodeGenCoerce1(val,t1,t2) + +(DEFUN |intCodeGenCOERCE| (|triple| |t2|) + (PROG (|t1| |val| |trip| |ISTMP#3| |t0| |LETTMP#1| |val0| |l| |label| + |lastCode| |conds| |p| |v| |t1'| |ISTMP#2| |val'| |ISTMP#1| + |pred| |code|) + (RETURN + (SEQ + (PROGN + (SPADLET |t1| (|objMode| |triple|)) + (COND + ((BOOT-EQUAL |t1| |$EmptyMode|) NIL) + ((BOOT-EQUAL |t1| |t2|) |triple|) + ((QUOTE T) + (SPADLET |val| (|objVal| |triple|)) + (COND + ((AND (PAIRP |val|) + (EQ (QCAR |val|) (QUOTE |coerceOrCroak|)) + (PROGN + (SPADLET |ISTMP#1| (QCDR |val|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |trip| (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND + (PAIRP |ISTMP#2|) + (PROGN + (SPADLET |t1'| (QCAR |ISTMP#2|)) + (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) + (AND (PAIRP |ISTMP#3|) (EQ (QCDR |ISTMP#3|) NIL))))))) + (SPADLET |t0| (|objCodeMode| |trip|)) + (PROGN + (SPADLET |LETTMP#1| (|objCodeVal| |trip|)) + (SPADLET |val0| (CADR |LETTMP#1|)) + |LETTMP#1|) + (OR (BOOT-EQUAL |t1| |$Void|) + (|canCoerceFrom| (|removeQuote| |t0|) |t2|))) + (|intCodeGenCOERCE| (|objNew| |val0| (|removeQuote| |t0|)) |t2|)) + ((AND (PAIRP |val|) + (EQ (QCAR |val|) (QUOTE THROW)) + (PROGN + (SPADLET |ISTMP#1| (QCDR |val|)) + (AND + (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |label| (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND + (PAIRP |ISTMP#2|) + (EQ (QCDR |ISTMP#2|) NIL) + (PROGN (SPADLET |code| (QCAR |ISTMP#2|)) (QUOTE T))))))) + (COND + ((AND (PAIRP |label|) + (EQ (QCAR |label|) (QUOTE QUOTE)) + (PROGN + (SPADLET |ISTMP#1| (QCDR |label|)) + (AND + (PAIRP |ISTMP#1|) + (EQ (QCDR |ISTMP#1|) NIL) + (PROGN (SPADLET |l| (QCAR |ISTMP#1|)) (QUOTE T))))) + (SPADLET |label| |l|))) + (COND + ((OR (NULL |$compilingMap|) + (NEQUAL |label| (|mapCatchName| |$mapName|))) + (|objNew| + (CONS + (QUOTE THROW) + (CONS + |label| + (CONS + (|wrapped2Quote| + (|objVal| (|intCodeGenCOERCE| (|objNew| |code| |t1|) |t2|))) + NIL))) + |t2|)) + ((QUOTE T) (|objNew| |val| |t2|)))) + ((AND (PAIRP |val|) + (EQ (QCAR |val|) (QUOTE PROGN)) + (PROGN + (SPADLET |ISTMP#1| (QCDR |val|)) + (AND + (PAIRP |ISTMP#1|) + (PROGN (SPADLET |ISTMP#2| (REVERSE |ISTMP#1|)) (QUOTE T)) + (PAIRP |ISTMP#2|) + (PROGN + (SPADLET |lastCode| (QCAR |ISTMP#2|)) + (SPADLET |code| (QCDR |ISTMP#2|)) + (QUOTE T)) + (PROGN (SPADLET |code| (NREVERSE |code|)) (QUOTE T))))) + (|objNew| + (CONS + (QUOTE PROGN) + (APPEND + |code| + (CONS + (|wrapped2Quote| + (|objVal| (|intCodeGenCOERCE| (|objNew| |lastCode| |t1|) |t2|))) + NIL))) + |t2|)) + ((AND (PAIRP |val|) + (EQ (QCAR |val|) (QUOTE COND)) + (PROGN (SPADLET |conds| (QCDR |val|)) (QUOTE T))) + (|objNew| + (CONS + (QUOTE COND) + (PROG (#0=#:G166151) + (SPADLET #0# NIL) + (RETURN + (DO ((#1=#:G166157 |conds| (CDR #1#)) (#2=#:G166119 NIL)) + ((OR (ATOM #1#) + (PROGN (SETQ #2# (CAR #1#)) NIL) + (PROGN + (PROGN + (SPADLET |p| (CAR #2#)) + (SPADLET |v| (CADR #2#)) + #2#) + NIL)) + (NREVERSE0 #0#)) + (SEQ + (EXIT + (SETQ #0# + (CONS + (CONS + |p| + (CONS + (|wrapped2Quote| + (|objVal| (|intCodeGenCOERCE| (|objNew| |v| |t1|) |t2|))) + NIL)) + #0#)))))))) + |t2|)) + ((|absolutelyCanCoerceByCheating| |t1| |t2|) (|objNew| |val| |t2|)) + ((BOOT-EQUAL |t2| (QUOTE (|Any|))) + (|objNew| + (CONS (QUOTE CONS) (CONS (MKQ |t1|) (CONS |val| NIL))) |t2|)) + ((AND (BOOT-EQUAL |t1| (QUOTE (|Any|))) + (PAIRP |val|) + (EQUAL (QCAR |val|) (QUOTE CONS)) + (PROGN + (SPADLET |ISTMP#1| (QCDR |val|)) + (AND + (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |t1'| (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND + (PAIRP |ISTMP#2|) + (EQ (QCDR |ISTMP#2|) NIL) + (PROGN (SPADLET |val'| (QCAR |ISTMP#2|)) (QUOTE T))))))) + (|intCodeGenCOERCE| (|objNew| |val'| (|removeQuote| |t1'|)) |t2|)) + ((AND (PAIRP |t1|) + (EQ (QCAR |t1|) (QUOTE |Equation|)) + (BOOT-EQUAL |t2| |$Boolean|)) + (|coerceByFunction| |triple| |t2|)) + ((AND (BOOT-EQUAL |t1| (QUOTE |$NoValueMode|)) + (PAIRP |val|) + (EQ (QCAR |val|) (QUOTE COND)) + (PROGN + (SPADLET |ISTMP#1| (QCDR |val|)) + (AND + (PAIRP |ISTMP#1|) + (EQ (QCDR |ISTMP#1|) NIL) + (PROGN (SPADLET |pred| (QCAR |ISTMP#1|)) (QUOTE T))))) + (SPADLET |code| + (CONS + (QUOTE COND) + (CONS + |pred| + (CONS + (CONS + (MKQ (QUOTE T)) + (CONS + (CONS + (QUOTE |throwKeyedMsg|) + (CONS (MKQ (QUOTE S2IM0016)) (CONS (MKQ |$mapName|) NIL))) + NIL)) + NIL)))) + (|objNew| |code| |t2|)) + ((BOOT-EQUAL |t2| |$OutputForm|) (|coerceByFunction| |triple| |t2|)) + ((|isSubDomain| |t1| |$Integer|) + (|intCodeGenCOERCE| (|objNew| |val| |$Integer|) |t2|)) + ((AND (NULL (|containsVariables| |t2|)) + (|canCoerceByFunction| |t1| |t2|)) + (COND + ((AND (NULL (|canCoerceByMap| |t1| |t2|)) + (SPADLET |code| (|coerceByFunction| |triple| |t2|))) + |code|) + ((QUOTE T) (|intCodeGenCoerce1| |val| |t1| |t2|)))) + ((QUOTE T) (|intCodeGenCoerce1| |val| |t1| |t2|)))))))))) + +;intCodeGenCoerce1(val,t1,t2) == +; -- Internal function to previous one +; -- designed to ensure that we don't use coerceOrCroak on mappings +;--(t2 is ['Mapping,:.]) => THROW('coerceOrCroaker, 'croaked) +; objNew(['coerceOrCroak,mkObjCode(['wrap,val],t1), +; MKQ t2, MKQ $mapName],t2) + +(DEFUN |intCodeGenCoerce1| (|val| |t1| |t2|) + (|objNew| + (CONS + (QUOTE |coerceOrCroak|) + (CONS + (|mkObjCode| (CONS (QUOTE |wrap|) (CONS |val| NIL)) |t1|) + (CONS (MKQ |t2|) (CONS (MKQ |$mapName|) NIL)))) + |t2|)) + +;--% Map components +;wrapMapBodyWithCatch body == +; -- places a CATCH around the map body +; -- note that we will someday have to fix up the catch identifier +; -- to use the generated internal map name +; $mapThrowCount = 0 => body +; if body is ['failCheck,['coerceOrFail,trip,targ,mapn]] +; then +; trip is ['LIST,v,m,e] => +; ['failCheck,['coerceOrFail, +; ['LIST,['CATCH,MKQ mapCatchName $mapName, v],m,e],targ,mapn]] +; keyedSystemError("S2GE0016",['"wrapMapBodyWithCatch", +; '"bad CATCH for in function form"]) +; else ['CATCH,MKQ mapCatchName $mapName,body] + +(DEFUN |wrapMapBodyWithCatch| (|body|) + (PROG (|trip| |ISTMP#4| |targ| |ISTMP#5| |mapn| |ISTMP#1| |v| |ISTMP#2| + |m| |ISTMP#3| |e|) + (RETURN + (COND + ((EQL |$mapThrowCount| 0) |body|) + ((AND (PAIRP |body|) + (EQ (QCAR |body|) (QUOTE |failCheck|)) + (PROGN + (SPADLET |ISTMP#1| (QCDR |body|)) + (AND + (PAIRP |ISTMP#1|) + (EQ (QCDR |ISTMP#1|) NIL) + (PROGN + (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) + (AND + (PAIRP |ISTMP#2|) + (EQ (QCAR |ISTMP#2|) (QUOTE |coerceOrFail|)) + (PROGN + (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) + (AND + (PAIRP |ISTMP#3|) + (PROGN + (SPADLET |trip| (QCAR |ISTMP#3|)) + (SPADLET |ISTMP#4| (QCDR |ISTMP#3|)) + (AND + (PAIRP |ISTMP#4|) + (PROGN + (SPADLET |targ| (QCAR |ISTMP#4|)) + (SPADLET |ISTMP#5| (QCDR |ISTMP#4|)) + (AND + (PAIRP |ISTMP#5|) + (EQ (QCDR |ISTMP#5|) NIL) + (PROGN + (SPADLET |mapn| (QCAR |ISTMP#5|)) + (QUOTE T))))))))))))) + (COND + ((AND (PAIRP |trip|) + (EQ (QCAR |trip|) (QUOTE LIST)) + (PROGN + (SPADLET |ISTMP#1| (QCDR |trip|)) + (AND + (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |v| (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND + (PAIRP |ISTMP#2|) + (PROGN + (SPADLET |m| (QCAR |ISTMP#2|)) + (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) + (AND + (PAIRP |ISTMP#3|) + (EQ (QCDR |ISTMP#3|) NIL) + (PROGN (SPADLET |e| (QCAR |ISTMP#3|)) (QUOTE T))))))))) + (CONS + (QUOTE |failCheck|) + (CONS + (CONS + (QUOTE |coerceOrFail|) + (CONS + (CONS + (QUOTE LIST) + (CONS + (CONS + (QUOTE CATCH) + (CONS (MKQ (|mapCatchName| |$mapName|)) (CONS |v| NIL))) + (CONS |m| (CONS |e| NIL)))) + (CONS |targ| (CONS |mapn| NIL)))) + NIL))) + ((QUOTE T) + (|keyedSystemError| 'S2GE0016 + (CONS "wrapMapBodyWithCatch" + (CONS "bad CATCH for in function form" NIL)))))) + ((QUOTE T) + (CONS + (QUOTE CATCH) + (CONS (MKQ (|mapCatchName| |$mapName|)) (CONS |body| NIL)))))))) + +@ +\eject +\begin{thebibliography}{99} +\bibitem{1} nothing +\end{thebibliography} +\end{document}