mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

Support weak vectors, arrays, and bitvectors in (system base types).

Browse source 
* module/system/base/types.scm (%tc7-wvect, %tc7-array, %tc7-bitvector):
  New variables.
  (cell->object): Add cases for weak vectors, arrays, and bitvectors.
This commit is contained in:
Mark H Weaver 2014-04-24 17:57:19 -04:00
parent 4755604501
commit e0da53b4fe
2 changed files with 17 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

9
module/system/base/types.scm
View file

@ -242,6 +242,7 @@ the matching bits, possibly with bitwise operations to extract it from BITS."
(define %tc3-struct 1) (define %tc3-struct 1)
(define %tc7-symbol 5) (define %tc7-symbol 5)
(define %tc7-vector 13) (define %tc7-vector 13)
(define %tc7-wvect 15)
(define %tc7-string 21) (define %tc7-string 21)
(define %tc7-number 23) (define %tc7-number 23)
(define %tc7-hashtable 29) (define %tc7-hashtable 29)
@ -255,6 +256,8 @@ the matching bits, possibly with bitwise operations to extract it from BITS."
(define %tc7-vm-continuation 71) (define %tc7-vm-continuation 71)
(define %tc7-bytevector 77) (define %tc7-bytevector 77)
(define %tc7-program 79) (define %tc7-program 79)
(define %tc7-array 85)
(define %tc7-bitvector 87)
(define %tc7-port 125) (define %tc7-port 125)
(define %tc7-smob 127) (define %tc7-smob 127)
@ -447,6 +450,8 @@ using BACKEND."
(bytevector->uint-list words (native-endianness) (bytevector->uint-list words (native-endianness)
%word-size))) %word-size)))
vector))) vector)))
(((_ & #x7f = %tc7-wvect))
(inferior-object 'weak-vector address)) ; TODO: show elements
((((n << 8) || %tc7-fluid) init-value) ((((n << 8) || %tc7-fluid) init-value)
(inferior-fluid n #f)) ; TODO: show current value (inferior-fluid n #f)) ; TODO: show current value
(((_ & #x7f = %tc7-dynamic-state)) (((_ & #x7f = %tc7-dynamic-state))
@ -474,6 +479,10 @@ using BACKEND."
(inferior-object 'vm address)) (inferior-object 'vm address))
(((_ & #x7f = %tc7-vm-continuation)) (((_ & #x7f = %tc7-vm-continuation))
(inferior-object 'vm-continuation address)) (inferior-object 'vm-continuation address))
(((_ & #x7f = %tc7-array))
(inferior-object 'array address))
(((_ & #x7f = %tc7-bitvector))
(inferior-object 'bitvector address))
((((smob-type << 8) || %tc7-smob) word1) ((((smob-type << 8) || %tc7-smob) word1)
(inferior-smob backend smob-type address)))))) (inferior-smob backend smob-type address))))))

8
test-suite/tests/types.test
View file

@ -22,6 +22,7 @@
#:use-module (rnrs io ports) #:use-module (rnrs io ports)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
#:use-module (ice-9 weak-vector)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-9) #:use-module (srfi srfi-9)
#:use-module (system foreign) #:use-module (system foreign)
@ -102,6 +103,13 @@
((open-input-string "hello") port (? integer?)) ((open-input-string "hello") port (? integer?))
((lambda () #t) program _) ((lambda () #t) program _)
((the-vm) vm _) ((the-vm) vm _)
((make-weak-vector 3 #t) weak-vector _)
((make-hash-table) hash-table _)
((make-weak-key-hash-table) hash-table _)
((make-weak-value-hash-table) hash-table _)
((make-doubly-weak-hash-table) hash-table _)
(#2((1 2 3) (4 5 6)) array _)
(#*00000110 bitvector _)
((expt 2 70) bignum _)) ((expt 2 70) bignum _))
(pass-if "fluid" (pass-if "fluid"