+ Added a simple version of weak-tables. Only tail weak for now.
+ Replaced forgotten vector-ref in newports.scm
This commit is contained in:
parent
bae809c6ab
commit
4351c22d9f
|
@ -9,25 +9,6 @@
|
|||
; This stuff is _weak_.
|
||||
; Vector of weak pointers mapping fd -> fdport.
|
||||
|
||||
(define (weak-table-set! table number set-me)
|
||||
(table-set! table number (make-weak-pointer set-me)))
|
||||
|
||||
(define (weak-table-ref table number)
|
||||
(let ((ref (table-ref table number)))
|
||||
(if (weak-pointer? ref) (weak-pointer-ref ref) ref)))
|
||||
|
||||
(define (weak-table-walk proc table)
|
||||
(table-walk
|
||||
(lambda (number value)
|
||||
(if (weak-pointer? value) (weak-pointer-ref value) value))
|
||||
table))
|
||||
|
||||
(define (strengthen-weak-table-ref table number)
|
||||
(table-set! table number (weak-table-ref vector number)))
|
||||
|
||||
(define (weaken-weak-table-ref table number)
|
||||
(weak-table-set! table number (weak-table-ref vector number)))
|
||||
|
||||
(define fdports (make-integer-table))
|
||||
|
||||
(define (install-fdport fdport)
|
||||
|
@ -522,7 +503,7 @@
|
|||
(let* ((fdport* (fdport-data port))
|
||||
(ch (fdport-data:channel fdport*))
|
||||
(old-fd (channel-os-index ch))
|
||||
(old-vector-ref (vector-ref fdports old-fd)))
|
||||
(old-vector-ref (table-ref fdports old-fd)))
|
||||
(set-fdport-data:revealed fdport* new-revealed)
|
||||
(table-set! fdports old-fd #f)
|
||||
(close-channel ch)
|
||||
|
|
|
@ -58,18 +58,6 @@
|
|||
(define (process-table-set! n val)
|
||||
(weak-table-set! (auto-init-value process-table) n val))
|
||||
|
||||
(define (weak-table-ref t n)
|
||||
(let ((r (table-ref t n)))
|
||||
(if (weak-pointer? r)
|
||||
(weak-pointer-ref r)
|
||||
(error "there was a non-weak-pointer" r))))
|
||||
|
||||
(define (weak-table-set! t n s)
|
||||
(table-set! t n (make-weak-pointer s)))
|
||||
|
||||
;(define (weaken-table-ref! t n)
|
||||
; (weak-table-set! t n (weak-table-ref t n)))
|
||||
|
||||
(define (maybe-pid->proc pid)
|
||||
(process-table-ref pid))
|
||||
|
||||
|
|
|
@ -592,6 +592,10 @@
|
|||
deposit-bit-field
|
||||
real->exact-integer))
|
||||
|
||||
(define-interface weak-tables-interface
|
||||
(export make-weak-table weak-table-set! weak-table-ref weak-table-walk
|
||||
strengthen-weak-table-ref weaken-weak-table-ref))
|
||||
|
||||
;;; semi-standard network magic numbers
|
||||
;;; should be available on all platforms
|
||||
;;; if not, tell us, and we'll move it
|
||||
|
|
|
@ -38,6 +38,11 @@
|
|||
; (optimize auto-integrate)
|
||||
)
|
||||
|
||||
(define-structure weak-tables weak-tables-interface
|
||||
(open scheme
|
||||
weak
|
||||
tables)
|
||||
(files weaktables))
|
||||
|
||||
;;; This guy goes into the FOR-SYNTAX part of scsh's syntax exports.
|
||||
(define-structure scsh-syntax-helpers
|
||||
|
@ -158,7 +163,7 @@
|
|||
scsh-utilities
|
||||
handle
|
||||
fluids
|
||||
weak
|
||||
weak-tables
|
||||
|
||||
scsh-char-set-low-level-lib ; rdelim.scm needs it.
|
||||
; scsh-regexp-package
|
||||
|
|
|
@ -0,0 +1,24 @@
|
|||
;;; Tail-weak tables. This is for internal use only, for real life
|
||||
;;; applications we have to provide a more general interface with the
|
||||
;;; 3 combinations of head and tail weakness.
|
||||
|
||||
(define make-weak-table make-table)
|
||||
|
||||
(define (weak-table-set! table number set-me)
|
||||
(table-set! table number (make-weak-pointer set-me)))
|
||||
|
||||
(define (weak-table-ref table number)
|
||||
(let ((ref (table-ref table number)))
|
||||
(if (weak-pointer? ref) (weak-pointer-ref ref) ref)))
|
||||
|
||||
(define (weak-table-walk proc table)
|
||||
(table-walk
|
||||
(lambda (number value)
|
||||
(if (weak-pointer? value) (weak-pointer-ref value) value))
|
||||
table))
|
||||
|
||||
(define (strengthen-weak-table-ref table number)
|
||||
(table-set! table number (weak-table-ref table number)))
|
||||
|
||||
(define (weaken-weak-table-ref table number)
|
||||
(weak-table-set! table number (weak-table-ref table number)))
|
Loading…
Reference in New Issue