aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/interp/diagnostics.boot33
-rw-r--r--src/interp/macros.lisp.pamphlet23
2 files changed, 32 insertions, 24 deletions
diff --git a/src/interp/diagnostics.boot b/src/interp/diagnostics.boot
index b02f5eb2..0432ede7 100644
--- a/src/interp/diagnostics.boot
+++ b/src/interp/diagnostics.boot
@@ -1,5 +1,7 @@
-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
-- All rights reserved.
+-- Copyright (C) 2007, Gabriel Dos Reis
+-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
-- modification, are permitted provided that the following conditions are
@@ -29,7 +31,6 @@
-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
--
--- Copyright (C) 2007 Gabriel Dos Reis
--
--
@@ -63,5 +64,35 @@ ERRHUH() ==
MOAN(:x) ==
sayBrightly ['"%l", '"===> ", :x, '"%l"]
+CROAK(:x) ==
+ systemError x
+
THETA__ERROR op ==
userError ['"Sorry, do not know the identity element for ", op]
+
+SAY(:x) ==
+ MESSAGEPRINT x
+ TERPRI()
+
+MESSAGEPRINT x ==
+ MAPC(function MESSAGEPRINT_-1, x)
+
+MESSAGEPRINT_-1 x ==
+ x = "%l" or x = '"%l" => TERPRI()
+ STRINGP x => PRINC x
+ IDENTP x => PRINC x
+ ATOM x => PRINC x
+ PRINC '"("
+ MESSAGEPRINT_-1 car x
+ MESSAGEPRINT_-2 cdr x
+ PRINC '")"
+
+MESSAGEPRINT_-2 x ==
+ atom x =>
+ not null x =>
+ PRINC '" . "
+ MESSAGEPRINT_-1 x
+ PRINC '" "
+ MESSAGEPRINT_-1 car x
+ MESSAGEPRINT_-2 cdr x
+
diff --git a/src/interp/macros.lisp.pamphlet b/src/interp/macros.lisp.pamphlet
index 131c80b8..c9234dcd 100644
--- a/src/interp/macros.lisp.pamphlet
+++ b/src/interp/macros.lisp.pamphlet
@@ -652,23 +652,6 @@ This version is needed so that (COLLECT (IN X Y) ... (RETURN 'JUNK))=>JUNK."
;; --------------------> NEW DEFINITION (override in msgdb.boot.pamphlet)
(DEFUN BRIGHTPRINT-0 (x) (MESSAGEPRINT-1 X))
-(defun SAY (&rest x) (progn (MESSAGEPRINT X) (TERPRI)))
-
-(DEFUN MESSAGEPRINT (X) (mapc #'messageprint-1 X))
-
-(DEFUN MESSAGEPRINT-1 (X)
- (COND ((OR (EQ X '|%l|) (EQUAL X "%l")) (TERPRI))
- ((STRINGP X) (PRINC X))
- ((IDENTP X) (PRINC X))
- ((ATOM X) (PRINC X))
- ((PRINC "(") (MESSAGEPRINT-1 (CAR X))
- (MESSAGEPRINT-2 (CDR X)) (PRINC ")"))))
-
-(DEFUN MESSAGEPRINT-2 (X)
- (if (ATOM X)
- (if (NULL X) NIL (progn (PRINC " . ") (MESSAGEPRINT-1 X)))
- (progn (PRINC " ") (MESSAGEPRINT-1 (CAR X)) (MESSAGEPRINT-2 (CDR X)))))
-
(DEFUN BLANKS (N &optional (stream *standard-output*)) "Print N blanks."
(do ((i 1 (the fixnum(1+ i))))
((> i N))(declare (fixnum i n)) (princ " " stream)))
@@ -714,12 +697,6 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size
(SETQ *EOF* (STREAM-EOF STRM))
strm))
-; 24 ERRORS
-
-; 24.2 Specialized Error-Signalling Forms and Macros
-
-(defun CROAK (&rest x) (|systemError| x))
-
; 25 MISCELLANEOUS FEATURES
;; range tests and assertions