diff --git a/changelog b/changelog index 85ac62a..d2ba894 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,5 @@ +20091007 tpd src/axiom-website/patches.html 20091007.04.tpd.patch +20091007 tpd src/interp/g-error.lisp cleanup 20091007 tpd src/axiom-website/patches.html 20091007.03.tpd.patch 20091007 tpd src/interp/g-opt.lisp cleanup 20091007 tpd src/axiom-website/patches.html 20091007.02.tpd.patch diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 6aa0b56..56fcedc 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -2127,5 +2127,7 @@ src/interp/template.lisp cleanup
src/interp/g-timer.lisp cleanup
20091007.03.tpd.patch src/interp/g-opt.lisp cleanup
+20091007.04.tpd.patch +src/interp/g-error.lisp cleanup
diff --git a/src/interp/g-error.lisp.pamphlet b/src/interp/g-error.lisp.pamphlet index 35eab97..08382a3 100644 --- a/src/interp/g-error.lisp.pamphlet +++ b/src/interp/g-error.lisp.pamphlet @@ -12,17 +12,11 @@ <<*>>= (IN-PACKAGE "BOOT" ) -;SETANDFILEQ($SystemError,'SystemError) +(SETANDFILEQ |$SystemError| '|SystemError|) -(SETANDFILEQ |$SystemError| (QUOTE |SystemError|)) +(SETANDFILEQ |$UserError| '|UserError|) -;SETANDFILEQ($UserError,'UserError) - -(SETANDFILEQ |$UserError| (QUOTE |UserError|)) - -;SETANDFILEQ($AlgebraError,'AlgebraError) - -(SETANDFILEQ |$AlgebraError| (QUOTE |AlgebraError|)) +(SETANDFILEQ |$AlgebraError| '|AlgebraError|) ;-- REDERR is used in BFLOAT LISP, should be a macro ;-- REDERR msg == error msg @@ -37,36 +31,27 @@ ; 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|))))) + (PROG (|msg|) + (DECLARE (SPECIAL |$AlgebraError|)) + (RETURN + (PROGN + (SPADLET |msg| + (CONS "The test" + (APPEND (|bright| (|pred2English| |condit|)) + (CONS "evaluates to" + (APPEND (|bright| "false") + (CONS '|%l| + (CONS " for argument" + (APPEND (|bright| |argnum|) + (CONS "to the function" + (APPEND (|bright| |funname|) + (CONS "and this indicates" + (CONS '|%l| + (CONS + " that the argument is not appropriate." + NIL))))))))))))) + (|errorSupervisor| |$AlgebraError| |msg|))))) + ;queryUser msg == ; -- display message and return reply @@ -74,14 +59,15 @@ ; READ_-LINE _*TERMINAL_-IO_* (DEFUN |queryUser| (|msg|) - (PROGN (|sayBrightly| |msg|) (|read-line| *TERMINAL-IO*))) + (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|)) + (DECLARE (SPECIAL |$BreakMode|)) + (|errorSupervisor1| |errorType| |errorMsg| |$BreakMode|)) ;errorSupervisor1(errorType,errorMsg,$BreakMode) == ; $cclSystem and $BreakMode = 'trapNumerics => @@ -107,52 +93,69 @@ ; handleLispBreakLoop($BreakMode) (DEFUN |errorSupervisor1| (|errorType| |errorMsg| |$BreakMode|) - (DECLARE (SPECIAL |$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|))))))) + (DECLARE (SPECIAL |$AlgebraError| |$UserError| |$SystemError| + |$cclSystem| |$numericFailure|)) + (RETURN + (SEQ (COND + ((AND |$cclSystem| + (BOOT-EQUAL |$BreakMode| '|trapNumerics|)) + (THROW '|trapNumerics| |$numericFailure|)) + ('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|) + ('T "Error with unknown classification"))) + (SPADLET |msg| + (COND + ((AND (PAIRP |errorMsg|) + (EQ (QCAR |errorMsg|) '|mathprint|)) + |errorMsg|) + ((NULL (PAIRP |errorMsg|)) + (CONS (MAKESTRING " ") + (CONS |errorMsg| NIL))) + ('T (SPADLET |splitmsg| 'T) + (COND + ((|member| '|%b| |errorMsg|) + (SPADLET |splitmsg| NIL)) + ((|member| '|%d| |errorMsg|) + (SPADLET |splitmsg| NIL)) + ((|member| '|%l| |errorMsg|) + (SPADLET |splitmsg| NIL)) + ('T NIL)) + (COND + (|splitmsg| + (CDR (PROG (G166072) + (SPADLET G166072 NIL) + (RETURN + (DO + ((G166077 |errorMsg| + (CDR G166077)) + (|u| NIL)) + ((OR (ATOM G166077) + (PROGN + (SETQ |u| + (CAR G166077)) + NIL)) + G166072) + (SEQ + (EXIT + (SETQ G166072 + (APPEND G166072 + (CONS '|%l| + (CONS " " + (CONS |u| NIL)))))))))))) + ('T (CONS (MAKESTRING " ") |errorMsg|)))))) + (|sayErrorly| |errorLabel| |msg|) + (|handleLispBreakLoop| |$BreakMode|))))))) + ;handleLispBreakLoop($BreakMode) == ; TERPRI() @@ -202,138 +205,125 @@ ; 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|)) + (DECLARE (SPECIAL |$BreakMode|)) + (PROG (|msgQ| |x| |gotIt|) + (DECLARE (SPECIAL |$cclSystem|)) + (RETURN + (SEQ (PROGN + (TERPRI) + (ENABLE-BACKTRACE NIL) (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|)))))))) + ((BOOT-EQUAL |$BreakMode| '|break|) + (|sayBrightly| (MAKESTRING " ")) (BREAK)) + ((BOOT-EQUAL |$BreakMode| '|query|) + (SPADLET |gotIt| NIL) + (DO () ((NULL (NULL |gotIt|)) NIL) + (SEQ (EXIT (PROGN + (SPADLET |gotIt| 'T) + (SPADLET |msgQ| + (COND + (|$cclSystem| + (CONS '|%l| + (CONS + " You have two options. Enter:" + (CONS '|%l| + (CONS " " + (APPEND + (|bright| "top ") + (CONS + " to return to top level, or" + (CONS '|%l| + (CONS " " + (APPEND + (|bright| + "break ") + (CONS + " to enter a LISP break loop." + (CONS '|%l| + (CONS '|%l| + (CONS + " Please enter your choice now:" + NIL)))))))))))))) + ('T + (CONS '|%l| + (CONS + " You have three options. Enter:" + (CONS '|%l| + (CONS " " + (APPEND + (|bright| "continue") + (CONS + " to continue processing," + (CONS '|%l| + (CONS " " + (APPEND + (|bright| + "top ") + (CONS + " to return to top level, or" + (CONS '|%l| + (CONS " " + (APPEND + (|bright| + "break ") + (CONS + " to enter a LISP break loop." + (CONS '|%l| + (CONS '|%l| + (CONS + " Please enter your choice now:" + NIL)))))))))))))))))))) + (SPADLET |x| + (STRING2ID-N + (|queryUser| |msgQ|) 1)) + (SPADLET |x| + (COND + (|$cclSystem| + (|selectOptionLC| |x| + '(|top| |break|) NIL)) + ('T + (|selectOptionLC| |x| + '(|top| |break| |continue|) + NIL)))) + (COND + ((NULL |x|) + (|sayBrightly| + (|bright| + " That was not one of your choices!")) + (SPADLET |gotIt| NIL)) + ((BOOT-EQUAL |x| '|top|) + (|returnToTopLevel|)) + ((BOOT-EQUAL |x| '|break|) + (SPADLET |$BreakMode| '|break|) + (COND + ((NULL |$cclSystem|) + (|sayBrightly| + (CONS " Enter" + (APPEND (|bright| ":C") + (CONS + "when you are ready to continue processing where you " + (CONS '|%l| + (CONS + " interrupted the system, enter" + (APPEND (|bright| "(TOP)") + (CONS + "when you wish to return" + (CONS '|%l| + (CONS " to top level." + (CONS '|%l| + (CONS '|%l| NIL)))))))))))))) + (BREAK)) + ('T + (|sayBrightly| + " Processing will continue where it was interrupted.") + (THROW 'SPAD_READER NIL)))))))) + ((BOOT-EQUAL |$BreakMode| '|resume|) (|returnToReader|)) + ('T (|returnToTopLevel|)))))))) + ;TOP() == returnToTopLevel() -(DEFUN TOP NIL (|returnToTopLevel|)) +(DEFUN TOP () (|returnToTopLevel|)) ;returnToTopLevel() == ; SETQ(CHR, "ENDOFLINECHR") @@ -341,10 +331,7 @@ ; TOPLEVEL() (DEFUN |returnToTopLevel| () - (PROGN - (SETQ CHR (QUOTE ENDOFLINECHR)) - (SETQ TOK (QUOTE END_UNIT)) - (TOPLEVEL))) + (PROGN (SETQ CHR 'ENDOFLINECHR) (SETQ TOK 'END_UNIT) (TOPLEVEL))) ;returnToReader() == ; ^$ReadingFile => returnToTopLevel() @@ -352,23 +339,23 @@ ; 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)))) + (DECLARE (SPECIAL |$ReadingFile|)) + (COND + ((NULL |$ReadingFile|) (|returnToTopLevel|)) + ('T + (|sayBrightly| + (CONS " Continuing to read the file..." (CONS '|%l| NIL))) + (THROW '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|)))) + (DECLARE (SPECIAL |$saturn|)) + (COND + (|$saturn| (|saturnSayErrorly| |errorLabel| |msg|)) + ('T (|sayErrorly1| |errorLabel| |msg|)))) ;saturnSayErrorly(errorLabel, msg) == ; _*STANDARD_-OUTPUT_* : fluid := $texOutputStream @@ -381,18 +368,18 @@ ; 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|))))) + (PROG (*STANDARD-OUTPUT* |old|) + (DECLARE (SPECIAL *STANDARD-OUTPUT* |$texOutputStream|)) + (RETURN + (PROGN + (SPADLET *STANDARD-OUTPUT* |$texOutputStream|) + (SPADLET |old| (|pushSatOutput| '|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 '" " @@ -404,50 +391,54 @@ ; 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|))))))) + (PROG (|m| |ISTMP#1| |mathexpr|) + (DECLARE (SPECIAL |$testingErrorPrefix|)) + (RETURN + (PROGN + (|sayBrightly| (MAKESTRING " ")) + (COND (|$testingSystem| (|sayMSG| |$testingErrorPrefix|))) + (|sayBrightly| + (CONS " >> " (CONS |errorLabel| (CONS ":" NIL)))) + (SPADLET |m| |msg|) + (COND + ((AND (PAIRP |msg|) (EQ (QCAR |msg|) '|mathprint|) + (PROGN + (SPADLET |ISTMP#1| (QCDR |msg|)) + (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) + (PROGN + (SPADLET |mathexpr| (QCAR |ISTMP#1|)) + 'T)))) + (|mathprint| |mathexpr|)) + ('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|))) +(DEFUN |systemError| (&REST G166161 &AUX |x|) + (DECLARE (SPECIAL |$SystemError|)) + (DSETQ |x| G166161) + (|errorSupervisor| |$SystemError| (IFCAR |x|))) ;-- unexpectedSystemError() == ;-- systemError '"Oh, no. Unexpected internal error." ;userError x == errorSupervisor($UserError,x) -(DEFUN |userError| (|x|) (|errorSupervisor| |$UserError| |x|)) +(DEFUN |userError| (|x|) + (DECLARE (SPECIAL |$UserError|)) + (|errorSupervisor| |$UserError| |x|)) ;error(x) == errorSupervisor($AlgebraError,x) -(DEFUN |error| (|x|) (|errorSupervisor| |$AlgebraError| |x|)) +(DEFUN |error| (|x|) + (DECLARE (SPECIAL |$AlgebraError|)) + (|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)))) + (|error| (CONS '|No identity element for reduce of empty list using operation| + (CONS |op| NIL)))) ;throwMessage(:msg) == ; if $compilingMap then clearCache $mapName @@ -456,16 +447,17 @@ ; 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|))))) +(DEFUN |throwMessage| (&REST G166176 &AUX |msg|) + (DSETQ |msg| G166176) + (PROG (|msg'|) + (DECLARE (SPECIAL |$printMsgsToFile| |$mapName| |$compilingMap|)) + (RETURN + (PROGN + (COND (|$compilingMap| (|clearCache| |$mapName|))) + (SPADLET |msg'| (|mkMessage| (|concatList| |msg|))) + (|sayMSG| |msg'|) + (COND (|$printMsgsToFile| (|sayMSG2File| |msg'|))) + (|spadThrow|))))) @ \eject