Merge remote-tracking branch 'origin/stable-2.0'
[bpt/guile.git] / module / ice-9 / boot-9.scm
index c8a56e0..1780b84 100644 (file)
@@ -884,15 +884,11 @@ VALUE."
 ;; properties within the object itself.
 
 (define (make-object-property)
-  (define-syntax-rule (with-mutex lock exp)
-    (dynamic-wind (lambda () (lock-mutex lock))
-                  (lambda () exp)
-                  (lambda () (unlock-mutex lock))))
-  (let ((prop (make-weak-key-hash-table))
-        (lock (make-mutex)))
+  ;; Weak tables are thread-safe.
+  (let ((prop (make-weak-key-hash-table)))
     (make-procedure-with-setter
-     (lambda (obj) (with-mutex lock (hashq-ref prop obj)))
-     (lambda (obj val) (with-mutex lock (hashq-set! prop obj val))))))
+     (lambda (obj) (hashq-ref prop obj))
+     (lambda (obj val) (hashq-set! prop obj val)))))
 
 
 \f
@@ -971,16 +967,13 @@ VALUE."
 
 ;; 0: type-name, 1: fields, 2: constructor
 (define record-type-vtable
-  ;; FIXME: This should just call make-vtable, not make-vtable-vtable; but for
-  ;; that we need to expose the bare vtable-vtable to Scheme.
-  (make-vtable-vtable "prprpw" 0
-                      (lambda (s p)
-                        (cond ((eq? s record-type-vtable)
-                               (display "#<record-type-vtable>" p))
-                              (else
-                               (display "#<record-type " p)
-                               (display (record-type-name s) p)
-                               (display ">" p))))))
+  (let ((s (make-vtable (string-append standard-vtable-fields "prprpw")
+                        (lambda (s p)
+                          (display "#<record-type " p)
+                          (display (record-type-name s) p)
+                          (display ">" p)))))
+    (set-struct-vtable-name! s 'record-type)
+    s))
 
 (define (record-type? obj)
   (and (struct? obj) (eq? record-type-vtable (struct-vtable obj))))
@@ -1596,7 +1589,7 @@ VALUE."
     ((define-record-type
        (lambda (x)
          (define (make-id scope . fragments)
-           (datum->syntax #'scope
+           (datum->syntax scope
                           (apply symbol-append
                                  (map (lambda (x)
                                         (if (symbol? x) x (syntax->datum x)))
@@ -2073,33 +2066,6 @@ VALUE."
 (define (module-define-submodule! module name submodule)
   (hashq-set! (module-submodules module) name submodule))
 
-;; It used to be, however, that module names were also present in the
-;; value namespace. When we enable deprecated code, we preserve this
-;; legacy behavior.
-;;
-;; These shims are defined here instead of in deprecated.scm because we
-;; need their definitions before loading other modules.
-;;
-(begin-deprecated
- (define (module-ref-submodule module name)
-   (or (hashq-ref (module-submodules module) name)
-       (and (module-submodule-binder module)
-            ((module-submodule-binder module) module name))
-       (let ((var (module-local-variable module name)))
-         (and var (variable-bound? var) (module? (variable-ref var))
-              (begin
-                (warn "module" module "not in submodules table")
-                (variable-ref var))))))
-
- (define (module-define-submodule! module name submodule)
-   (let ((var (module-local-variable module name)))
-     (if (and var
-              (or (not (variable-bound? var))
-                  (not (module? (variable-ref var)))))
-         (warn "defining module" module ": not overriding local definition" var)
-         (module-define! module name submodule)))
-   (hashq-set! (module-submodules module) name submodule)))
-
 \f
 
 ;;; {Module-based Loading}
@@ -3292,13 +3258,6 @@ module '(ice-9 q) '(make-q q-length))}."
              (process-use-modules (list quoted-args ...))
              *unspecified*))))))
 
-(define-syntax-rule (use-syntax spec ...)
-  (begin
-    (eval-when (eval load compile expand)
-      (issue-deprecation-warning
-       "`use-syntax' is deprecated. Please contact guile-devel for more info."))
-    (use-modules spec ...)))
-
 (include-from-path "ice-9/r6rs-libraries")
 
 (define-syntax-rule (define-private foo bar)