mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 12:20:26 +02:00
Code Activity

fix free-id=? for module-bound keywords

Browse source 
* module/ice-9/psyntax.scm (free-id=?): For identifiers that are
  resolved to the toplevel, check that the variables that they would
  resolve to are equal, instead of simply checking that the symbolic
  identifier names are equal.  Allows keywords to be bound, renamed,
  exported, excluded, etc.

* module/ice-9/psyntax-pp.scm: Regenerate.
This commit is contained in:
Andy Wingo 2011-04-29 13:07:15 +02:00
parent aa5698fb53
commit 04b04af85a
2 changed files with 8196 additions and 9878 deletions
Download patch file Download diff file Expand all files Collapse all files

18042
module/ice-9/psyntax-pp.scm
View file

File diff suppressed because it is too large Load diff

32
module/ice-9/psyntax.scm
View file

@ -821,9 +821,35 @@
(define free-id=?
(lambda (i j)
(and (eq? (id-sym-name i) (id-sym-name j)) ; accelerator
(eq? (id-var-name i empty-wrap) (id-var-name j empty-wrap)))))
(let ((ni (id-var-name i empty-wrap))
(nj (id-var-name j empty-wrap)))
(define (id-module-binding id)
(let ((mod (and (syntax-object? id) (syntax-object-module id))))
(module-variable
(if mod
;; The normal case.
(resolve-module (cdr mod))
;; Either modules have not been booted, or we have a
;; raw symbol coming in, which is possible.
(current-module))
(id-sym-name id))))
(if (eq? ni (id-sym-name i))
;; `i' is not lexically bound. Assert that `j' is free,
;; and if so, compare their bindings, that they are either
;; bound to the same variable, or both unbound and have
;; the same name.
(and (eq? nj (id-sym-name j))
(let ((bi (id-module-binding i)))
(if bi
(eq? bi (id-module-binding j))
(and (not (id-module-binding j))
(eq? ni nj))))
(eq? (id-module-binding i) (id-module-binding j)))
;; Otherwise `i' is bound, so check that `j' is bound, and
;; bound to the same thing.
(and (eq? ni nj)
(not (eq? nj (id-sym-name j))))))))
;; bound-id=? may be passed unwrapped (or partially wrapped) ids as
;; long as the missing portion of the wrap is common to both of the ids
;; since (bound-id=? x y) iff (bound-id=? (wrap x w) (wrap y w))