From 5b2fca49e6db2a2240a3f0a0367dce85f4da252b Mon Sep 17 00:00:00 2001
From: Abdulaziz Ghuloum <aghuloum@cs.indiana.edu>
Date: Mon, 27 Apr 2009 09:59:23 +0300
Subject: [PATCH] =?UTF-8?q?fixed=20bug=20in=20expansion=20of=20expressions?=
 =?UTF-8?q?=20in=20interaction=20environment=20where=20id->label=20was=20p?=
 =?UTF-8?q?rematurely=20interning=20identifiers=20in=20the=20environment.?=
 =?UTF-8?q?=20=20Now,=20there=20is=20id->label/intern=20that=20does=20that?=
 =?UTF-8?q?=20and=20it's=20only=20used=20when=20an=20identifier's=20type?=
 =?UTF-8?q?=20is=20resolved=20and=20not=20at=20other=20times=20(like=20in?=
 =?UTF-8?q?=20free-id=3D=3F=20and=20bount-id=3D=3F).?=

---
 scheme/ikarus.string-to-number.ss |  2 +-
 scheme/last-revision              |  2 +-
 scheme/psyntax.expander.ss        | 12 ++++++------
 3 files changed, 8 insertions(+), 8 deletions(-)

diff --git a/scheme/ikarus.string-to-number.ss b/scheme/ikarus.string-to-number.ss
index bd2ac4d..ebab559 100755
--- a/scheme/ikarus.string-to-number.ss
+++ b/scheme/ikarus.string-to-number.ss
@@ -335,7 +335,7 @@
     (sign-inf. (r ex sn)
       [(#\0) (next sign-inf.0 r ex sn)])
     (sign-inf.0 (r ex sn)
-      [(eof) (* sn +inf.0)]
+      [(eof) (if (= sn 1) +inf.0 -inf.0)] ;(* sn +inf.0)
       [(#\+) (next im:sign r (* sn +inf.0) ex +1)]
       [(#\-) (next im:sign r (* sn +inf.0) ex -1)]
       [(#\@) (next polar r (* sn +inf.0) ex)]
diff --git a/scheme/last-revision b/scheme/last-revision
index 2bdd710..77de926 100644
--- a/scheme/last-revision
+++ b/scheme/last-revision
@@ -1 +1 @@
-1766
+1767
diff --git a/scheme/psyntax.expander.ss b/scheme/psyntax.expander.ss
index 90a37fa..2731599 100644
--- a/scheme/psyntax.expander.ss
+++ b/scheme/psyntax.expander.ss
@@ -507,7 +507,7 @@
   ;;; same label or if both are unbound and they have the same name.
   (define free-id=?
     (lambda (i j)
-      (let ((t0 (id->real-label i)) (t1 (id->real-label j)))
+      (let ((t0 (id->label i)) (t1 (id->label j)))
         (if (or t0 t1)
             (eq? t0 t1)
             (eq? (id->sym i) (id->sym j))))))
@@ -584,8 +584,8 @@
   ;;; id->label takes an id (that's a sym x marks x substs) and
   ;;; searches the substs for a label associated with the same sym
   ;;; and marks.
-  (define (id->label id)
-    (or (id->real-label id)
+  (define (id->label/intern id)
+    (or (id->label id)
         (cond
           ((top-level-context) =>
            (lambda (env)
@@ -596,7 +596,7 @@
                  lab))))
           (else #f))))
           
-  (define id->real-label
+  (define id->label
     (lambda (id)
       (let ((sym (id->sym id)))
         (let search ((subst* (stx-subst* id)) (mark* (stx-mark* id)))
@@ -679,7 +679,7 @@
       (cond
         ((id? e)
          (let ((id e))
-           (let* ((label (id->label id))
+           (let* ((label (id->label/intern id))
                   (b (label->binding label r))
                   (type (binding-type b)))
              (unless label ;;; fail early.
@@ -694,7 +694,7 @@
         ((syntax-pair? e)
          (let ((id (syntax-car e)))
            (if (id? id)
-               (let* ((label (id->label id))
+               (let* ((label (id->label/intern id))
                       (b (label->binding label r))
                       (type (binding-type b)))
                  (unless label ;;; fail early.