diff --git a/changelog b/changelog index 8199b07..291ba40 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,7 @@ +20090816 tpd src/axiom-website/patches.html 20090816.05.tpd.patch +20090816 tpd src/interp/Makefile move g-error.boot to g-error.lisp +20090816 tpd src/interp/g-error.lisp added, rewritten from g-error.boot +20090816 tpd src/interp/g-error.boot removed, rewritten to g-error.lisp 20090816 tpd src/axiom-website/patches.html 20090816.04.tpd.patch 20090816 tpd Makefile change make assignments from = to := 20090816 tpd src/axiom-website/patches.html 20090816.03.tpd.patch diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 162473c..95bfd8e 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -1804,6 +1804,8 @@ g-boot.lisp rewrite from boot to lisp
g-cndata.lisp rewrite from boot to lisp
20090816.04.tpd.patch Makefile change make assignments from = to :=
+20090816.05.tpd.patch +g-error.lisp rewrite from boot to lisp
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index 086c681..867e70c 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -424,7 +424,6 @@ DOCFILES=${DOC}/as.boot.dvi \ ${DOC}/foam_l.lisp.dvi \ ${DOC}/fortcall.boot.dvi \ ${DOC}/functor.boot.dvi \ - ${DOC}/g-error.boot.dvi \ ${DOC}/g-opt.boot.dvi \ ${DOC}/g-timer.boot.dvi \ ${DOC}/g-util.boot.dvi ${DOC}/hashcode.boot.dvi \ @@ -2930,46 +2929,26 @@ ${MID}/g-cndata.lisp: ${IN}/g-cndata.lisp.pamphlet @ -\subsection{g-error.boot} +\subsection{g-error.lisp} <>= -${OUT}/g-error.${O}: ${MID}/g-error.clisp - @ echo 263 making ${OUT}/g-error.${O} from ${MID}/g-error.clisp - @ (cd ${MID} ; \ +${OUT}/g-error.${O}: ${MID}/g-error.lisp + @ echo 136 making ${OUT}/g-error.${O} from ${MID}/g-error.lisp + @ ( cd ${MID} ; \ if [ -z "${NOISE}" ] ; then \ - echo '(progn (compile-file "${MID}/g-error.clisp"' \ + echo '(progn (compile-file "${MID}/g-error.lisp"' \ ':output-file "${OUT}/g-error.${O}") (${BYE}))' | ${DEPSYS} ; \ else \ - echo '(progn (compile-file "${MID}/g-error.clisp"' \ + echo '(progn (compile-file "${MID}/g-error.lisp"' \ ':output-file "${OUT}/g-error.${O}") (${BYE}))' | ${DEPSYS} \ >${TMP}/trace ; \ fi ) @ -<>= -${MID}/g-error.clisp: ${IN}/g-error.boot.pamphlet - @ echo 264 making ${MID}/g-error.clisp from ${IN}/g-error.boot.pamphlet +<>= +${MID}/g-error.lisp: ${IN}/g-error.lisp.pamphlet + @ echo 137 making ${MID}/g-error.lisp from ${IN}/g-error.lisp.pamphlet @ (cd ${MID} ; \ - ${TANGLE} ${IN}/g-error.boot.pamphlet >g-error.boot ; \ - if [ -z "${NOISE}" ] ; then \ - echo '(progn (boottran::boottocl "g-error.boot") (${BYE}))' \ - | ${DEPSYS} ; \ - else \ - echo '(progn (boottran::boottocl "g-error.boot") (${BYE}))' \ - | ${DEPSYS} >${TMP}/trace ; \ - fi ; \ - rm g-error.boot ) - -@ -<>= -${DOC}/g-error.boot.dvi: ${IN}/g-error.boot.pamphlet - @echo 265 making ${DOC}/g-error.boot.dvi \ - from ${IN}/g-error.boot.pamphlet - @(cd ${DOC} ; \ - cp ${IN}/g-error.boot.pamphlet ${DOC} ; \ - ${DOCUMENT} ${NOISE} g-error.boot ; \ - rm -f ${DOC}/g-error.boot.pamphlet ; \ - rm -f ${DOC}/g-error.boot.tex ; \ - rm -f ${DOC}/g-error.boot ) + ${TANGLE} ${IN}/g-error.lisp.pamphlet >g-error.lisp ) @ @@ -6710,8 +6689,7 @@ clean: <> <> -<> -<> +<> <> <> diff --git a/src/interp/g-error.boot.pamphlet b/src/interp/g-error.boot.pamphlet deleted file mode 100644 index d2292e0..0000000 --- a/src/interp/g-error.boot.pamphlet +++ /dev/null @@ -1,218 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp g-error.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. - -@ -<<*>>= -<> - --- This file contains the error printing code used in BOOT and SPAD. --- While SPAD only calls "error" (which is then labeled as an algebra --- error, BOOT calls "userError" and "systemError" when a problem is --- found. --- --- The variable $BreakMode is set using the system command )set breakmode --- and can have one of the values: --- break -- always enter a lisp break when an error is signalled --- nobreak -- do not enter lisp break mode --- query -- ask the user if break mode should be entered - -SETANDFILEQ($SystemError,'SystemError) -SETANDFILEQ($UserError,'UserError) -SETANDFILEQ($AlgebraError,'AlgebraError) - --- REDERR is used in BFLOAT LISP, should be a macro --- REDERR msg == error msg - --- BFLERRMSG func == --- errorSupervisor($AlgebraError,STRCONC( --- '"BigFloat: invalid argument to ",func)) - -argumentDataError(argnum, condit, funname) == - msg := ['"The test",:bright pred2English condit,'"evaluates to", - :bright '"false",'%l,'" for argument",:bright argnum,_ - '"to the function",:bright funname,'"and this indicates",'%l,_ - '" that the argument is not appropriate."] - errorSupervisor($AlgebraError,msg) - -queryUser msg == - -- display message and return reply - sayBrightly msg - READ_-LINE _*TERMINAL_-IO_* - --- errorSupervisor is the old style error message trapper - -errorSupervisor(errorType,errorMsg) == - errorSupervisor1(errorType,errorMsg,$BreakMode) - -errorSupervisor1(errorType,errorMsg,$BreakMode) == - $cclSystem and $BreakMode = 'trapNumerics => - THROW('trapNumerics,$numericFailure) - BUMPCOMPERRORCOUNT() - errorLabel := - errorType = $SystemError => '"System error" - errorType = $UserError => '"Apparent user error" - errorType = $AlgebraError => - '"Error detected within library code" - STRINGP errorType => errorType - '"Error with unknown classification" - msg := - errorMsg is ['mathprint, :.] => errorMsg - not PAIRP errorMsg => ['" ", errorMsg] - splitmsg := true - if MEMBER('%b,errorMsg) then splitmsg := nil - else if MEMBER('%d,errorMsg) then splitmsg := nil - else if MEMBER('%l,errorMsg) then splitmsg := nil - splitmsg => CDR [:['%l,'" ",u] for u in errorMsg] - ['" ",:errorMsg] - sayErrorly(errorLabel, msg) - handleLispBreakLoop($BreakMode) - -handleLispBreakLoop($BreakMode) == - TERPRI() - -- The next line is to try to deal with some reported cases of unwanted - -- backtraces appearing, MCD. - ENABLE_-BACKTRACE(nil) - $BreakMode = 'break => - sayBrightly '" " - BREAK() - $BreakMode = 'query => - gotIt := nil - while not gotIt repeat - gotIt := true - msgQ := - $cclSystem => - ['%l,'" You have two options. Enter:",'%l,_ - '" ",:bright '"top ",'" to return to top level, or",'%l,_ - '" ",:bright '"break ",'" to enter a LISP break loop.",'%l,_ - '%l,'" Please enter your choice now:"] - ['%l,'" You have three options. Enter:",'%l,_ - '" ",:bright '"continue",'" to continue processing,",'%l,_ - '" ",:bright '"top ",'" to return to top level, or",'%l,_ - '" ",:bright '"break ",'" to enter a LISP break loop.",'%l,_ - '%l,'" Please enter your choice now:"] - x := STRING2ID_-N(queryUser msgQ,1) - x := - $cclSystem => - selectOptionLC(x,'(top break),NIL) - selectOptionLC(x,'(top break continue),NIL) - null x => - sayBrightly bright '" That was not one of your choices!" - gotIt := NIL - x = 'top => returnToTopLevel() - x = 'break => - $BreakMode := 'break - if not $cclSystem then - sayBrightly ['" Enter",:bright '":C", - '"when you are ready to continue processing where you ",'%l,_ - '" interrupted the system, enter",:bright '"(TOP)",_ - '"when you wish to return",'%l,'" to top level.",'%l,'%l] - BREAK() - sayBrightly - '" Processing will continue where it was interrupted." - THROW('SPAD__READER, nil) - $BreakMode = 'resume => - returnToReader() - returnToTopLevel() - -TOP() == returnToTopLevel() - -returnToTopLevel() == - SETQ(CHR, "ENDOFLINECHR") - SETQ(TOK, 'END__UNIT) - TOPLEVEL() - -returnToReader() == - ^$ReadingFile => returnToTopLevel() - sayBrightly ['" Continuing to read the file...", '%l] - THROW('SPAD__READER, nil) - -sayErrorly(errorLabel, msg) == - $saturn => saturnSayErrorly(errorLabel, msg) - sayErrorly1(errorLabel, msg) - -saturnSayErrorly(errorLabel, msg) == - _*STANDARD_-OUTPUT_* : fluid := $texOutputStream - old := pushSatOutput("line") - sayString '"\bgroup\color{red}" - sayString '"\begin{verbatim}" - sayErrorly1(errorLabel, msg) - sayString '"\end{verbatim}" - sayString '"\egroup" - popSatOutput(old) - -sayErrorly1(errorLabel, msg) == - sayBrightly '" " - if $testingSystem then sayMSG $testingErrorPrefix - sayBrightly ['" >> ",errorLabel,'":"] - m := msg - msg is ['mathprint, mathexpr] => - mathprint mathexpr - sayBrightly msg - --- systemError is being phased out. Please use keyedSystemError. -systemError(:x) == errorSupervisor($SystemError,IFCAR x) - --- unexpectedSystemError() == --- systemError '"Oh, no. Unexpected internal error." - -userError x == errorSupervisor($UserError,x) - -error(x) == errorSupervisor($AlgebraError,x) - -IdentityError(op) == - error(["No identity element for reduce of empty list using operation",op]) - -throwMessage(:msg) == - if $compilingMap then clearCache $mapName - msg' := mkMessage concatList msg - sayMSG msg' - if $printMsgsToFile then sayMSG2File msg' - spadThrow() - -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/g-error.lisp.pamphlet b/src/interp/g-error.lisp.pamphlet new file mode 100644 index 0000000..35eab97 --- /dev/null +++ b/src/interp/g-error.lisp.pamphlet @@ -0,0 +1,475 @@ +\documentclass{article} +\usepackage{axiom} +\begin{document} +\title{\$SPAD/src/interp g-error.lisp} +\author{The Axiom Team} +\maketitle +\begin{abstract} +\end{abstract} +\eject +\tableofcontents +\eject +<<*>>= +(IN-PACKAGE "BOOT" ) + +;SETANDFILEQ($SystemError,'SystemError) + +(SETANDFILEQ |$SystemError| (QUOTE |SystemError|)) + +;SETANDFILEQ($UserError,'UserError) + +(SETANDFILEQ |$UserError| (QUOTE |UserError|)) + +;SETANDFILEQ($AlgebraError,'AlgebraError) + +(SETANDFILEQ |$AlgebraError| (QUOTE |AlgebraError|)) + +;-- REDERR is used in BFLOAT LISP, should be a macro +;-- REDERR msg == error msg +;-- BFLERRMSG func == +;-- errorSupervisor($AlgebraError,STRCONC( +;-- '"BigFloat: invalid argument to ",func)) +;argumentDataError(argnum, condit, funname) == +; msg := ['"The test",:bright pred2English condit,'"evaluates to", +; :bright '"false",'%l,'" for argument",:bright argnum,_ +; '"to the function",:bright funname,'"and this indicates",'%l,_ +; '" that the argument is not appropriate."] +; errorSupervisor($AlgebraError,msg) + +(DEFUN |argumentDataError| (|argnum| |condit| |funname|) + (PROG (|msg|) + (RETURN + (PROGN + (SPADLET |msg| + (CONS + "The test" + (APPEND + (|bright| (|pred2English| |condit|)) + (CONS + "evaluates to" + (APPEND + (|bright| "false") + (CONS + (QUOTE |%l|) + (CONS + " for argument" + (APPEND + (|bright| |argnum|) + (CONS + "to the function" + (APPEND + (|bright| |funname|) + (CONS + "and this indicates" + (CONS + (QUOTE |%l|) + (CONS + " that the argument is not appropriate." + NIL))))))))))))) + (|errorSupervisor| |$AlgebraError| |msg|))))) + +;queryUser msg == +; -- display message and return reply +; sayBrightly msg +; READ_-LINE _*TERMINAL_-IO_* + +(DEFUN |queryUser| (|msg|) + (PROGN (|sayBrightly| |msg|) (|read-line| *TERMINAL-IO*))) + +;-- errorSupervisor is the old style error message trapper +;errorSupervisor(errorType,errorMsg) == +; errorSupervisor1(errorType,errorMsg,$BreakMode) + +(DEFUN |errorSupervisor| (|errorType| |errorMsg|) + (|errorSupervisor1| |errorType| |errorMsg| |$BreakMode|)) + +;errorSupervisor1(errorType,errorMsg,$BreakMode) == +; $cclSystem and $BreakMode = 'trapNumerics => +; THROW('trapNumerics,$numericFailure) +; BUMPCOMPERRORCOUNT() +; errorLabel := +; errorType = $SystemError => '"System error" +; errorType = $UserError => '"Apparent user error" +; errorType = $AlgebraError => +; '"Error detected within library code" +; STRINGP errorType => errorType +; '"Error with unknown classification" +; msg := +; errorMsg is ['mathprint, :.] => errorMsg +; not PAIRP errorMsg => ['" ", errorMsg] +; splitmsg := true +; if MEMBER('%b,errorMsg) then splitmsg := nil +; else if MEMBER('%d,errorMsg) then splitmsg := nil +; else if MEMBER('%l,errorMsg) then splitmsg := nil +; splitmsg => CDR [:['%l,'" ",u] for u in errorMsg] +; ['" ",:errorMsg] +; sayErrorly(errorLabel, msg) +; handleLispBreakLoop($BreakMode) + +(DEFUN |errorSupervisor1| (|errorType| |errorMsg| |$BreakMode|) + (DECLARE (SPECIAL |$BreakMode|)) + (PROG (|errorLabel| |splitmsg| |msg|) + (RETURN + (SEQ + (COND + ((AND |$cclSystem| (BOOT-EQUAL |$BreakMode| (QUOTE |trapNumerics|))) + (THROW (QUOTE |trapNumerics|) |$numericFailure|)) + ((QUOTE T) + (BUMPCOMPERRORCOUNT) + (SPADLET |errorLabel| + (COND + ((BOOT-EQUAL |errorType| |$SystemError|) "System error") + ((BOOT-EQUAL |errorType| |$UserError|) "Apparent user error") + ((BOOT-EQUAL |errorType| |$AlgebraError|) + "Error detected within library code") + ((STRINGP |errorType|) |errorType|) + ((QUOTE T) "Error with unknown classification"))) + (SPADLET |msg| + (COND + ((AND (PAIRP |errorMsg|) (EQ (QCAR |errorMsg|) (QUOTE |mathprint|))) + |errorMsg|) + ((NULL (PAIRP |errorMsg|)) + (CONS (MAKESTRING " ") (CONS |errorMsg| NIL))) + ((QUOTE T) + (SPADLET |splitmsg| (QUOTE T)) + (COND + ((|member| (QUOTE |%b|) |errorMsg|) (SPADLET |splitmsg| NIL)) + ((|member| (QUOTE |%d|) |errorMsg|) (SPADLET |splitmsg| NIL)) + ((|member| (QUOTE |%l|) |errorMsg|) (SPADLET |splitmsg| NIL)) + ((QUOTE T) NIL)) + (COND + (|splitmsg| + (CDR + (PROG (#0=#:G166072) + (SPADLET #0# NIL) + (RETURN + (DO ((#1=#:G166077 |errorMsg| (CDR #1#)) (|u| NIL)) + ((OR (ATOM #1#) (PROGN (SETQ |u| (CAR #1#)) NIL)) #0#) + (SEQ + (EXIT + (SETQ #0# + (APPEND #0# + (CONS (QUOTE |%l|) (CONS " " (CONS |u| NIL)))))))))))) + ((QUOTE T) (CONS (MAKESTRING " ") |errorMsg|)))))) + (|sayErrorly| |errorLabel| |msg|) + (|handleLispBreakLoop| |$BreakMode|))))))) + +;handleLispBreakLoop($BreakMode) == +; TERPRI() +; -- The next line is to try to deal with some reported cases of unwanted +; -- backtraces appearing, MCD. +; ENABLE_-BACKTRACE(nil) +; $BreakMode = 'break => +; sayBrightly '" " +; BREAK() +; $BreakMode = 'query => +; gotIt := nil +; while not gotIt repeat +; gotIt := true +; msgQ := +; $cclSystem => +; ['%l,'" You have two options. Enter:",'%l,_ +; '" ",:bright '"top ",'" to return to top level, or",'%l,_ +; '" ",:bright '"break ",'" to enter a LISP break loop.",'%l,_ +; '%l,'" Please enter your choice now:"] +; ['%l,'" You have three options. Enter:",'%l,_ +; '" ",:bright '"continue",'" to continue processing,",'%l,_ +; '" ",:bright '"top ",'" to return to top level, or",'%l,_ +; '" ",:bright '"break ",'" to enter a LISP break loop.",'%l,_ +; '%l,'" Please enter your choice now:"] +; x := STRING2ID_-N(queryUser msgQ,1) +; x := +; $cclSystem => +; selectOptionLC(x,'(top break),NIL) +; selectOptionLC(x,'(top break continue),NIL) +; null x => +; sayBrightly bright '" That was not one of your choices!" +; gotIt := NIL +; x = 'top => returnToTopLevel() +; x = 'break => +; $BreakMode := 'break +; if not $cclSystem then +; sayBrightly ['" Enter",:bright '":C", +; '"when you are ready to continue processing where you ",'%l,_ +; '" interrupted the system, enter",:bright '"(TOP)",_ +; '"when you wish to return",'%l,'" to top level.",'%l,'%l] +; BREAK() +; sayBrightly +; '" Processing will continue where it was interrupted." +; THROW('SPAD__READER, nil) +; $BreakMode = 'resume => +; returnToReader() +; returnToTopLevel() + +(DEFUN |handleLispBreakLoop| (|$BreakMode|) + (DECLARE (SPECIAL |$BreakMode|)) + (PROG (|msgQ| |x| |gotIt|) + (RETURN + (SEQ + (PROGN + (TERPRI) + (ENABLE-BACKTRACE NIL) + (COND + ((BOOT-EQUAL |$BreakMode| (QUOTE |break|)) + (|sayBrightly| (MAKESTRING " ")) (BREAK)) + ((BOOT-EQUAL |$BreakMode| (QUOTE |query|)) + (SPADLET |gotIt| NIL) + (DO () + ((NULL (NULL |gotIt|)) NIL) + (SEQ + (EXIT + (PROGN + (SPADLET |gotIt| (QUOTE T)) + (SPADLET |msgQ| + (COND + (|$cclSystem| + (CONS + (QUOTE |%l|) + (CONS + " You have two options. Enter:" + (CONS + (QUOTE |%l|) + (CONS + " " + (APPEND + (|bright| "top ") + (CONS + " to return to top level, or" + (CONS + (QUOTE |%l|) + (CONS + " " + (APPEND + (|bright| "break ") + (CONS + " to enter a LISP break loop." + (CONS + (QUOTE |%l|) + (CONS + (QUOTE |%l|) + (CONS + " Please enter your choice now:" + NIL)))))))))))))) + ((QUOTE T) + (CONS + (QUOTE |%l|) + (CONS + " You have three options. Enter:" + (CONS + (QUOTE |%l|) + (CONS + " " + (APPEND + (|bright| "continue") + (CONS + " to continue processing," + (CONS + (QUOTE |%l|) + (CONS + " " + (APPEND + (|bright| "top ") + (CONS + " to return to top level, or" + (CONS + (QUOTE |%l|) + (CONS + " " + (APPEND + (|bright| "break ") + (CONS + " to enter a LISP break loop." + (CONS + (QUOTE |%l|) + (CONS + (QUOTE |%l|) + (CONS + " Please enter your choice now:" + NIL)))))))))))))))))))) + (SPADLET |x| (STRING2ID-N (|queryUser| |msgQ|) 1)) + (SPADLET |x| + (COND + (|$cclSystem| (|selectOptionLC| |x| (QUOTE (|top| |break|)) NIL)) + ((QUOTE T) + (|selectOptionLC| |x| (QUOTE (|top| |break| |continue|)) NIL)))) + (COND + ((NULL |x|) + (|sayBrightly| (|bright| " That was not one of your choices!")) + (SPADLET |gotIt| NIL)) + ((BOOT-EQUAL |x| (QUOTE |top|)) (|returnToTopLevel|)) + ((BOOT-EQUAL |x| (QUOTE |break|)) + (SPADLET |$BreakMode| (QUOTE |break|)) + (COND + ((NULL |$cclSystem|) + (|sayBrightly| + (CONS + " Enter" + (APPEND + (|bright| ":C") + (CONS + "when you are ready to continue processing where you " + (CONS + (QUOTE |%l|) + (CONS + " interrupted the system, enter" + (APPEND + (|bright| "(TOP)") + (CONS + "when you wish to return" + (CONS + (QUOTE |%l|) + (CONS + " to top level." + (CONS + (QUOTE |%l|) + (CONS (QUOTE |%l|) NIL)))))))))))))) + (BREAK)) + ((QUOTE T) + (|sayBrightly| + " Processing will continue where it was interrupted.") + (THROW (QUOTE SPAD_READER) NIL)))))))) + ((BOOT-EQUAL |$BreakMode| (QUOTE |resume|)) (|returnToReader|)) + ((QUOTE T) (|returnToTopLevel|)))))))) + +;TOP() == returnToTopLevel() + +(DEFUN TOP NIL (|returnToTopLevel|)) + +;returnToTopLevel() == +; SETQ(CHR, "ENDOFLINECHR") +; SETQ(TOK, 'END__UNIT) +; TOPLEVEL() + +(DEFUN |returnToTopLevel| () + (PROGN + (SETQ CHR (QUOTE ENDOFLINECHR)) + (SETQ TOK (QUOTE END_UNIT)) + (TOPLEVEL))) + +;returnToReader() == +; ^$ReadingFile => returnToTopLevel() +; sayBrightly ['" Continuing to read the file...", '%l] +; THROW('SPAD__READER, nil) + +(DEFUN |returnToReader| () + (COND + ((NULL |$ReadingFile|) (|returnToTopLevel|)) + ((QUOTE T) + (|sayBrightly| + (CONS + " Continuing to read the file..." + (CONS (QUOTE |%l|) NIL))) + (THROW (QUOTE SPAD_READER) NIL)))) + +;sayErrorly(errorLabel, msg) == +; $saturn => saturnSayErrorly(errorLabel, msg) +; sayErrorly1(errorLabel, msg) + +(DEFUN |sayErrorly| (|errorLabel| |msg|) + (COND + (|$saturn| (|saturnSayErrorly| |errorLabel| |msg|)) + ((QUOTE T) (|sayErrorly1| |errorLabel| |msg|)))) + +;saturnSayErrorly(errorLabel, msg) == +; _*STANDARD_-OUTPUT_* : fluid := $texOutputStream +; old := pushSatOutput("line") +; sayString '"\bgroup\color{red}" +; sayString '"\begin{verbatim}" +; sayErrorly1(errorLabel, msg) +; sayString '"\end{verbatim}" +; sayString '"\egroup" +; popSatOutput(old) + +(DEFUN |saturnSayErrorly| (|errorLabel| |msg|) + (PROG (*STANDARD-OUTPUT* |old|) + (DECLARE (SPECIAL *STANDARD-OUTPUT*)) + (RETURN + (PROGN + (SPADLET *STANDARD-OUTPUT* |$texOutputStream|) + (SPADLET |old| (|pushSatOutput| (QUOTE |line|))) + (|sayString| (MAKESTRING "\\bgroup\\color{red}")) + (|sayString| (MAKESTRING "\\begin{verbatim}")) + (|sayErrorly1| |errorLabel| |msg|) + (|sayString| (MAKESTRING "\\end{verbatim}")) + (|sayString| (MAKESTRING "\\egroup")) + (|popSatOutput| |old|))))) + +;sayErrorly1(errorLabel, msg) == +; sayBrightly '" " +; if $testingSystem then sayMSG $testingErrorPrefix +; sayBrightly ['" >> ",errorLabel,'":"] +; m := msg +; msg is ['mathprint, mathexpr] => +; mathprint mathexpr +; sayBrightly msg + +(DEFUN |sayErrorly1| (|errorLabel| |msg|) + (PROG (|m| |ISTMP#1| |mathexpr|) + (RETURN + (PROGN + (|sayBrightly| (MAKESTRING " ")) + (COND (|$testingSystem| (|sayMSG| |$testingErrorPrefix|))) + (|sayBrightly| (CONS " >> " (CONS |errorLabel| (CONS ":" NIL)))) + (SPADLET |m| |msg|) + (COND + ((AND (PAIRP |msg|) + (EQ (QCAR |msg|) (QUOTE |mathprint|)) + (PROGN + (SPADLET |ISTMP#1| (QCDR |msg|)) + (AND + (PAIRP |ISTMP#1|) + (EQ (QCDR |ISTMP#1|) NIL) + (PROGN (SPADLET |mathexpr| (QCAR |ISTMP#1|)) (QUOTE T))))) + (|mathprint| |mathexpr|)) + ((QUOTE T) (|sayBrightly| |msg|))))))) + +;-- systemError is being phased out. Please use keyedSystemError. +;systemError(:x) == errorSupervisor($SystemError,IFCAR x) + +(DEFUN |systemError| (&REST #0=#:G166161 &AUX |x|) + (DSETQ |x| #0#) + (|errorSupervisor| |$SystemError| (IFCAR |x|))) + +;-- unexpectedSystemError() == +;-- systemError '"Oh, no. Unexpected internal error." +;userError x == errorSupervisor($UserError,x) + +(DEFUN |userError| (|x|) (|errorSupervisor| |$UserError| |x|)) + +;error(x) == errorSupervisor($AlgebraError,x) + +(DEFUN |error| (|x|) (|errorSupervisor| |$AlgebraError| |x|)) + +;IdentityError(op) == +; error(["No identity element for reduce of empty list using operation",op]) + +(DEFUN |IdentityError| (|op|) + (|error| + (CONS + (QUOTE |No identity element for reduce of empty list using operation|) + (CONS |op| NIL)))) + +;throwMessage(:msg) == +; if $compilingMap then clearCache $mapName +; msg' := mkMessage concatList msg +; sayMSG msg' +; if $printMsgsToFile then sayMSG2File msg' +; spadThrow() + +(DEFUN |throwMessage| (&REST #0=#:G166176 &AUX |msg|) + (DSETQ |msg| #0#) + (PROG (|msg'|) + (RETURN + (PROGN + (COND (|$compilingMap| (|clearCache| |$mapName|))) + (SPADLET |msg'| (|mkMessage| (|concatList| |msg|))) + (|sayMSG| |msg'|) + (COND (|$printMsgsToFile| (|sayMSG2File| |msg'|))) + (|spadThrow|))))) + +@ +\eject +\begin{thebibliography}{99} +\bibitem{1} nothing +\end{thebibliography} +\end{document}