From b586d2e21a20be8c8e4312528067583de73fc15a Mon Sep 17 00:00:00 2001
From: Abdulaziz Ghuloum <aghuloum@cs.indiana.edu>
Date: Thu, 30 Jul 2009 21:46:11 +0300
Subject: [PATCH] some asserion violations in the reader are converted to
 &lexicals so that the repl displays them properly.  E.g., (read
 (open-string-input-port "#!r6rs |foo|")) shows an &assertion, but typing
 #!r6rs |foo| at the repl causes the repl to reset without a message.

---
 scheme/ikarus.reader.ss | 22 +++++++++++-----------
 scheme/last-revision    |  2 +-
 2 files changed, 12 insertions(+), 12 deletions(-)

diff --git a/scheme/ikarus.reader.ss b/scheme/ikarus.reader.ss
index 4e28a70..53e65ef 100644
--- a/scheme/ikarus.reader.ss
+++ b/scheme/ikarus.reader.ss
@@ -774,7 +774,7 @@
          (tokenize-dot p)]
         [($char= #\| c)
          (when (eq? (port-mode p) 'r6rs-mode)
-           (die 'tokenize "|symbol| syntax is invalid in #!r6rs mode"))
+           (die/p p 'tokenize "|symbol| syntax is invalid in #!r6rs mode"))
          (let ([ls (reverse (tokenize-bar p '()))])
            (cons 'datum (string->symbol (list->string ls))))]
         [($char= #\\ c)
@@ -785,7 +785,7 @@
         ;[($char= #\{ c) 'lbrace]
         [($char= #\@ c) 
          (when (eq? (port-mode p) 'r6rs-mode)
-           (die 'tokenize "@-expr syntax is invalid in #!r6rs mode"))
+           (die/p p 'tokenize "@-expr syntax is invalid in #!r6rs mode"))
          'at-expr]
         [else
          (die/p-1 p 'tokenize "invalid syntax" c)])))
@@ -1441,7 +1441,7 @@
                      (lambda (x)
                        (let ([loc (cdr x)])
                          (when (loc-set? loc) ;;; FIXME: pos
-                           (die 'read "duplicate mark" n))
+                           (die/p p 'read "duplicate mark" n))
                          (set-loc-value! loc expr)
                          (set-loc-value^! loc expr^)
                          (set-loc-set?! loc #t)
@@ -1460,7 +1460,7 @@
                    (let ([loc (make-loc #f 'unused #f)])
                      (let ([locs (cons (cons n loc) locs)])
                        (values loc 'unused locs k)))]))]
-             [else (die 'read "invalid token" t)])]
+             [else (die/p p 'read "invalid token" t)])]
           [else
            (die/p-1 p 'read 
              (format "unexpected ~s found" t))])))
@@ -1474,11 +1474,11 @@
           (parse-token p locs k t pos)))))
 
 
-  (define reduce-loc!
+  (define (reduce-loc! p)
     (lambda (x)
        (let ([loc (cdr x)])
          (unless (loc-set? loc)
-           (die 'read "referenced mark is not set" (car x)))
+           (die/p p 'read "referenced mark is not set" (car x)))
          (when (loc? (loc-value loc))
            (let f ([h loc] [t loc])
              (if (loc? h)
@@ -1486,7 +1486,7 @@
                    (if (loc? h1)
                        (begin
                          (when (eq? h1 t)
-                           (die 'read "circular marks"))
+                           (die/p p 'read "circular marks"))
                          (let ([v (f (loc-value h1) (loc-value t))])
                            (set-loc-value! h1 v)
                            (set-loc-value! h v)
@@ -1511,7 +1511,7 @@
         (cond
           [(null? locs) expr]
           [else
-           (for-each reduce-loc! locs)
+           (for-each (reduce-loc! p) locs)
            (k)
            (if (loc? expr)
                (loc-value expr)
@@ -1523,7 +1523,7 @@
         (cond
           [(null? locs) expr]
           [else
-           (for-each reduce-loc! locs)
+           (for-each (reduce-loc! p) locs)
            (k)
            (if (loc? expr)
                (loc-value expr)
@@ -1538,7 +1538,7 @@
          (cond
            [(null? locs) (return-annotated expr^)]
            [else
-            (for-each reduce-loc! locs)
+            (for-each (reduce-loc! p) locs)
             (k)
             (if (loc? expr)
                 (loc-value^ expr)
@@ -1551,7 +1551,7 @@
         (cond
           [(null? locs) (return-annotated expr^)]
           [else
-           (for-each reduce-loc! locs)
+           (for-each (reduce-loc! p) locs)
            (k)
            (if (loc? expr)
                (loc-value^ expr)
diff --git a/scheme/last-revision b/scheme/last-revision
index aae736a..12ac2f5 100644
--- a/scheme/last-revision
+++ b/scheme/last-revision
@@ -1 +1 @@
-1832
+1833