diff --git a/scheme/ikarus.symbols.ss b/scheme/ikarus.symbols.ss index 50792f4..9502048 100644 --- a/scheme/ikarus.symbols.ss +++ b/scheme/ikarus.symbols.ss @@ -23,12 +23,12 @@ $unintern-gensym reset-symbol-proc! system-value system-value-gensym) (import - (ikarus system $symbols) + (except (ikarus system $symbols) $unintern-gensym) (ikarus system $pairs) (ikarus system $fx) (except (ikarus) gensym gensym? gensym->unique-string gensym-prefix gensym-count print-gensym system-value - $unintern-gensym string->symbol symbol->string + string->symbol symbol->string getprop putprop remprop property-list top-level-value top-level-bound? set-top-level-value! symbol-value symbol-bound? set-symbol-value! reset-symbol-proc!)) diff --git a/scheme/last-revision b/scheme/last-revision index 9190a7f..0632d50 100644 --- a/scheme/last-revision +++ b/scheme/last-revision @@ -1 +1 @@ -1670 +1671 diff --git a/scheme/psyntax.compat.ss b/scheme/psyntax.compat.ss index 8440ec7..d78c723 100644 --- a/scheme/psyntax.compat.ss +++ b/scheme/psyntax.compat.ss @@ -23,7 +23,7 @@ read-library-source-file library-version-mismatch-warning file-locator-resolution-error - label-binding set-label-binding!) + label-binding set-label-binding! remove-location) (import (only (ikarus.compiler) eval-core) (only (ikarus.reader.annotated) read-library-source-file) @@ -64,6 +64,11 @@ (define (set-label-binding! label binding) (set-symbol-value! label binding)) - (define (label-binding label) - (and (symbol-bound? label) (symbol-value label)))) + + (define (label-binding label) + (and (symbol-bound? label) (symbol-value label))) + + (define (remove-location x) + (import (ikarus system $symbols)) + ($unintern-gensym x))) diff --git a/scheme/psyntax.library-manager.ss b/scheme/psyntax.library-manager.ss index 2373552..ac0515c 100644 --- a/scheme/psyntax.library-manager.ss +++ b/scheme/psyntax.library-manager.ss @@ -280,7 +280,14 @@ (lambda (x) (equal? (library-name x) name)))]) (when (and err? (not lib)) (assertion-violation who "library not installed" name)) - ((current-library-collection) lib #t))] + ((current-library-collection) lib #t) + (for-each + (lambda (x) + (let ((label (car x)) (binding (cdr x))) + (remove-location label) + (when (memq (car binding) '(global global-macro global-macro!)) + (remove-location (cdr binding))))) + (library-env lib)))] [(name) (uninstall-library name #t)])) (define (library-exists? name)