diff options
Diffstat (limited to 'module/ice-9/psyntax.scm')
-rw-r--r-- | module/ice-9/psyntax.scm | 32 |
1 files changed, 29 insertions, 3 deletions
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm index 8232ad9f2..14b89f9a6 100644 --- a/module/ice-9/psyntax.scm +++ b/module/ice-9/psyntax.scm @@ -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)) |