- implemented uninstall-library.

scheme/last-revision

@@ -1 +1 @@
-1667
+1668

scheme/makefile.ss

@@ -415,6 +415,7 @@
     [wstatus-received-signal                     i]
     [kill                                        i]
     [installed-libraries                         i]
+    [uninstall-library                           i]
     [library-path                                i]
     [library-extensions                          i]
     [current-primitive-locations                 $boot]

scheme/psyntax.compat.ss

@@ -22,7 +22,8 @@
           annotation-stripped
           read-library-source-file
           library-version-mismatch-warning
-          file-locator-resolution-error)
+          file-locator-resolution-error
+          label-binding set-label-binding!)
   (import 
     (only (ikarus.compiler) eval-core)
     (only (ikarus.reader.annotated) read-library-source-file)
@@ -59,5 +60,10 @@
             (set-rtd-printer! (type-descriptor name)
               printer)))]
       [(_ name (field* ...))
-       (define-struct name (field* ...))])))
+       (define-struct name (field* ...))]))
+  
+  (define (set-label-binding! label binding)
+    (set-symbol-value! label binding))
+  (define (label-binding label)
+    (and (symbol-bound? label) (symbol-value label))))
 

scheme/psyntax.expander.ss

@@ -643,6 +643,7 @@
   (define label->binding
     (lambda (x r)
       (cond
+        ((not x) '(displaced-lexical))
         ((imported-label->binding x) =>
          (lambda (b) 
            (cond

scheme/psyntax.library-manager.ss

@@ -22,7 +22,7 @@
   (export imported-label->binding library-subst installed-libraries
     visit-library library-name library-version library-exists?
     find-library-by-name install-library library-spec invoke-library 
-    current-library-expander
+    current-library-expander uninstall-library
     current-library-collection library-path library-extensions
     serialize-all current-precompiled-library-loader)
   (import (rnrs) (psyntax compat) (rnrs r5rs))
@@ -35,7 +35,11 @@
           (else (cons x ls))))
       (case-lambda
         (() set)
-        ((x) (set! set (set-cons x set))))))
+        ((x) (set! set (set-cons x set)))
+        ((x del?)
+         (if del?
+             (set! set (remq x set))
+             (set! set (set-cons x set)))))))
 
   (define current-library-collection
     ;;; this works now because make-collection is a lambda
@@ -264,6 +268,21 @@
           (lambda (x) (equal? (library-name x) name)))
         (find-external-library name)))
 
+  (define uninstall-library
+    (case-lambda
+      [(name err?)
+       (define who 'uninstall-library)
+       ;;; FIXME: check that no other import is in progress
+       ;;; FIXME: need to unintern labels and locations of
+       ;;;        library bindings
+       (let ([lib 
+              (find-library-by
+                (lambda (x) (equal? (library-name x) name)))])
+         (when (and err? (not lib))
+           (assertion-violation who "library not installed" name))
+         ((current-library-collection) lib #t))]
+      [(name) (uninstall-library name #t)]))
+
   (define (library-exists? name)
     (and (find-library-by
            (lambda (x) (equal? (library-name x) name)))
@@ -276,7 +295,6 @@
           (assertion-violation #f 
             "cannot find library with required spec" spec))))
 
-  (define label->binding-table (make-eq-hashtable))
 
   (define (install-library-record lib)
     (let ((exp-env (library-env lib)))
@@ -292,7 +310,7 @@
                      ((global-macro!)
                       (cons 'global-macro! (cons lib (cdr binding))))
                      (else binding))))
-              (hashtable-set! label->binding-table label binding))))
+              (set-label-binding! label binding))))
         exp-env))
     ((current-library-collection) lib))
 
@@ -316,7 +334,7 @@
            (install-library-record lib))))))
 
   (define (imported-label->binding lab)
-    (hashtable-ref label->binding-table lab #f))
+    (label-binding lab))
 
   (define (invoke-library lib)
     (let ((invoke (library-invoke-state lib)))