added a "warning" procedure, that's like assertion-violation and

error except that it throws a warning via raise-continuable.

scheme/ikarus.exceptions.ss

@@ -16,14 +16,14 @@
 
 (library (ikarus exceptions)
   (export with-exception-handler raise raise-continuable 
-    error assertion-violation die)
+    error warning assertion-violation die)
   (import 
     (only (rnrs) condition make-non-continuable-violation
           make-message-condition make-error make-who-condition
           make-irritants-condition make-assertion-violation)
     (except (ikarus)
       with-exception-handler raise raise-continuable 
-      error assertion-violation die))
+      error warning assertion-violation die))
 
   (define handlers
     (make-parameter
@@ -60,28 +60,24 @@
               (make-non-continuable-violation)
               (make-message-condition "handler returned")))))))
 
+  (define (err who* raise* cond* who msg irritants)
+    (unless (string? msg)
+      (assertion-violation who* "message is not a string" msg))
+    (raise*
+       (condition
+         (cond*)
+         (if who (make-who-condition who) (condition))
+         (make-message-condition msg)
+         (make-irritants-condition irritants))))
+
   (define (error who msg . irritants)
-    (unless (string? msg) 
+    (err 'error raise make-error who msg irritants))
-      (assertion-violation 'error "message is not a string" msg))
-    (raise
-       (condition
-         (make-error)
-         (if who (make-who-condition who) (condition))
-         (make-message-condition msg)
-         (make-irritants-condition irritants))))
-
   (define (assertion-violation who msg . irritants)
-    (unless (string? msg) 
+    (err 'assertion-violation raise make-assertion-violation who msg irritants))
-      (assertion-violation 'assertion-violation "message is not a string" msg))
+  (define (warning who msg . irritants)
-    (raise
+    (err 'warning raise-continuable make-warning who msg irritants))
-       (condition
+  (define (die who msg . irritants)
-         (make-assertion-violation)
+    (err 'die raise make-assertion-violation who msg irritants))
-         (if who (make-who-condition who) (condition))
-         (make-message-condition msg)
-         (make-irritants-condition irritants))))
-
-  (define die assertion-violation)
-  
 
 )
 

scheme/ikarus.reader.ss

@@ -29,7 +29,8 @@
           input-port-column-number)
     (except (ikarus) read-char read read-token comment-handler get-datum
       read-annotated read-script-annotated annotation?
-      annotation-expression annotation-source annotation-stripped))
+      annotation-expression annotation-source annotation-stripped
+      input-port-column-number))
 
   (define (die/lex id pos who msg arg*)
     (raise 

scheme/ikarus.writer.ss

@@ -790,10 +790,6 @@
     (lambda (who fmt . args)
       (display-error "Error" who fmt args)))
 
-  (define warning 
-    (lambda (who fmt . args)
-      (display-error "Warning" who fmt args)))
-
   (define (assert-open-textual-output-port p who)
     (unless (output-port? p) 
       (die who "not an output port" p))

scheme/last-revision

@@ -1 +1 @@
-1841
+1842

scheme/makefile.ss

@@ -735,6 +735,7 @@
     [equal?                                      i r ba se]
     [eqv?                                        i r ba se]
     [error                                       i r ba]
+    [warning                                     i]
     [die                                         i]
     [even?                                       i r ba se]
     [exact                                       i r ba]