puck/zilch
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Initial commit

Browse source
This commit is contained in:
puck 2024-10-03 23:57:22 +00:00
commit 55a1efa08f
60 changed files with 5485 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

49
aux/r7rs.patch Normal file
View file

@ -0,0 +1,49 @@
diff --git a/scheme.base.scm b/scheme.base.scm
index 763e50c..35e90a0 100644
--- a/scheme.base.scm
+++ b/scheme.base.scm
@@ -43,7 +43,7 @@
(import (rename (only srfi-4 make-u8vector subu8vector u8vector
u8vector? u8vector-length u8vector-ref
u8vector-set! read-u8vector read-u8vector!
- write-u8vector)
+ write-u8vector u8vector->blob/shared)
(u8vector bytevector)
(u8vector-length bytevector-length)
(u8vector-ref bytevector-u8-ref)
@@ -51,7 +51,8 @@
(u8vector? bytevector?)
(make-u8vector make-bytevector)
(read-u8vector read-bytevector)
- (write-u8vector write-bytevector)))
+ (write-u8vector write-bytevector)
+ (u8vector->blob/shared %u8vector->blob/shared)))
;; u8-ready?
(import (rename (only scheme char-ready?)
@@ -597,10 +598,8 @@
(##sys#check-range start 0 (fx+ end 1) 'utf8->string)
(##sys#check-range end start (fx+ len 1) 'utf8->string)
(let ((s (##sys#make-string (fx- end start))))
- (do ((si 0 (fx+ si 1))
- (vi start (fx+ vi 1)))
- ((fx= vi end) s)
- (##sys#setbyte s si (bytevector-u8-ref bv vi))))))))
+ (##sys#copy-bytes (%u8vector->blob/shared bv) s start 0 (fx- end start))
+ s)))))
(case-lambda
((bv) (bv->s bv 0))
((bv start) (bv->s bv start))
@@ -614,10 +613,8 @@
(##sys#check-range start 0 (fx+ end 1) 'string->utf8)
(##sys#check-range end start (fx+ len 1) 'string->utf8)
(let ((bv (make-bytevector (fx- end start))))
- (do ((vi 0 (fx+ vi 1))
- (si start (fx+ si 1)))
- ((fx= si end) bv)
- (bytevector-u8-set! bv vi (##sys#byte s si))))))))
+ (##sys#copy-bytes s (%u8vector->blob/shared bv) start 0 (fx- end start))
+ bv)))))
(case-lambda
((s) (s->bv s 0))
((s start) (s->bv s start))