~ chicken-core (chicken-5) 4a813f3d47549cf8f9b0293a3268d98859b7e27f
commit 4a813f3d47549cf8f9b0293a3268d98859b7e27f
Author: Evan Hanson <evhan@foldling.org>
AuthorDate: Wed Jul 26 16:47:58 2017 +1200
Commit: Peter Bex <peter@more-magic.net>
CommitDate: Sun Aug 6 15:47:23 2017 +0200
Add chicken.blob module
Signed-off-by: Peter Bex <peter@more-magic.net>
diff --git a/README b/README
index e8df7e3a..3f97e813 100644
--- a/README
+++ b/README
@@ -285,6 +285,7 @@ _/ _/ _/ _/ _/ _/ _/ _/ _/ _/_/
| | `-- 9
| | |-- chicken.import.so
| | |-- chicken.bitwise.import.so
+ | | |-- chicken.blob.import.so
| | |-- chicken.compiler.user-pass.import.so
| | |-- chicken.condition.import.so
| | |-- chicken.continuation.import.so
diff --git a/c-platform.scm b/c-platform.scm
index c46aae61..100cccb9 100644
--- a/c-platform.scm
+++ b/c-platform.scm
@@ -159,9 +159,9 @@
chicken.bitwise#bitwise-ior chicken.bitwise#bitwise-xor
chicken.bitwise#arithmetic-shift chicken.bitwise#bit-set?
add1 sub1 exact-integer? nan? finite? infinite?
- void flush-output print print* error call/cc blob-size
- identity blob=? equal=? make-polar make-rectangular real-part imag-part
- string->symbol symbol-append foldl foldr setter
+ void flush-output print print* error call/cc chicken.blob#blob-size
+ identity chicken.blob#blob=? equal=? make-polar make-rectangular
+ real-part imag-part string->symbol symbol-append foldl foldr setter
current-error-port current-thread chicken.keyword#get-keyword
srfi-4#u8vector-length srfi-4#s8vector-length
srfi-4#u16vector-length srfi-4#s16vector-length
@@ -852,7 +852,7 @@
(rewrite '##sys#foreign-ranged-integer-argument 17 2 "C_i_foreign_ranged_integer_argumentp")
(rewrite '##sys#foreign-unsigned-ranged-integer-argument 17 2 "C_i_foreign_unsigned_ranged_integer_argumentp")
-(rewrite 'blob-size 2 1 "C_block_size" #f)
+(rewrite 'chicken.blob#blob-size 2 1 "C_block_size" #f)
;; TODO: Move this stuff to types.db
(rewrite 'srfi-4#u8vector-ref 2 2 "C_u_i_u8vector_ref" #f)
diff --git a/chicken.import.scm b/chicken.import.scm
index 4b1da7ae..806d2820 100644
--- a/chicken.import.scm
+++ b/chicken.import.scm
@@ -40,10 +40,6 @@
argc+argv
argv
bignum?
- blob->string
- blob-size
- blob?
- blob=?
(build-platform . chicken.platform#build-platform)
call/cc
case-sensitive
@@ -133,7 +129,6 @@
(load-verbose . chicken.load#load-verbose)
(machine-byte-order . chicken.platform#machine-byte-order)
(machine-type . chicken.platform#machine-type)
- make-blob
(make-composite-condition . chicken.condition#make-composite-condition)
make-parameter
make-promise
@@ -181,7 +176,6 @@
sleep
(software-type . chicken.platform#software-type)
(software-version . chicken.platform#software-version)
- string->blob
string->uninterned-symbol
(strip-syntax . chicken.syntax#strip-syntax)
sub1
diff --git a/defaults.make b/defaults.make
index 69ca7330..0504b93d 100644
--- a/defaults.make
+++ b/defaults.make
@@ -265,7 +265,7 @@ CHICKEN_PROGRAM_OPTIONS += $(if $(PROFILE_OBJECTS),-profile)
PRIMITIVE_IMPORT_LIBRARIES = chicken chicken.condition chicken.csi chicken.foreign
DYNAMIC_IMPORT_LIBRARIES = srfi-4
-DYNAMIC_CHICKEN_IMPORT_LIBRARIES = bitwise errno file.posix \
+DYNAMIC_CHICKEN_IMPORT_LIBRARIES = bitwise blob errno file.posix \
fixnum flonum format gc io keyword load locative memory \
platform posix pretty-print process process.signal \
process-context random syntax time time.posix
diff --git a/distribution/manifest b/distribution/manifest
index 02bde929..57f19f46 100644
--- a/distribution/manifest
+++ b/distribution/manifest
@@ -266,6 +266,8 @@ chicken.import.scm
chicken.import.c
chicken.bitwise.import.scm
chicken.bitwise.import.c
+chicken.blob.import.scm
+chicken.blob.import.c
chicken.compiler.user-pass.import.scm
chicken.compiler.user-pass.import.c
chicken.condition.import.scm
diff --git a/eval.scm b/eval.scm
index 0aca904c..69182c00 100644
--- a/eval.scm
+++ b/eval.scm
@@ -53,6 +53,7 @@
;; Exclude bindings defined within this module.
(import (except scheme eval interaction-environment null-environment scheme-report-environment)
(except chicken eval-handler)
+ chicken.blob
chicken.internal
chicken.keyword
chicken.syntax)
diff --git a/expand.scm b/expand.scm
index 8e89530e..d405656e 100644
--- a/expand.scm
+++ b/expand.scm
@@ -960,7 +960,7 @@
;;; Macro definitions:
-(import chicken chicken.syntax chicken.internal)
+(import chicken chicken.blob chicken.syntax chicken.internal)
(##sys#extend-macro-environment
'import-syntax '()
diff --git a/library.scm b/library.scm
index 7cfb8b00..e4ed6312 100644
--- a/library.scm
+++ b/library.scm
@@ -2138,6 +2138,11 @@ EOF
;;; Blob:
+(module chicken.blob
+ (blob->string string->blob blob? blob=? blob-size make-blob)
+
+(import scheme chicken)
+
(define (##sys#make-blob size)
(let ([bv (##sys#allocate-vector size #t #f #t)])
(##core#inline "C_string_to_bytevector" bv)
@@ -2176,6 +2181,8 @@ EOF
(and (eq? (##sys#size b2) n)
(zero? (##core#inline "C_string_compare" b1 b2 n)))))
+) ; chicken.blob
+
;;; Vectors:
diff --git a/rules.make b/rules.make
index 14212cbc..c425f855 100644
--- a/rules.make
+++ b/rules.make
@@ -506,6 +506,7 @@ $(eval $(call declare-emitted-import-lib-dependency,chicken.time.posix,$(POSIXFI
$(eval $(call declare-emitted-import-lib-dependency,chicken.process,$(POSIXFILE)))
$(eval $(call declare-emitted-import-lib-dependency,chicken.process.signal,$(POSIXFILE)))
$(eval $(call declare-emitted-import-lib-dependency,chicken.bitwise,library))
+$(eval $(call declare-emitted-import-lib-dependency,chicken.blob,library))
$(eval $(call declare-emitted-import-lib-dependency,chicken.fixnum,library))
$(eval $(call declare-emitted-import-lib-dependency,chicken.flonum,library))
$(eval $(call declare-emitted-import-lib-dependency,chicken.gc,library))
@@ -603,6 +604,7 @@ chicken-ffi-syntax.c: chicken-ffi-syntax.scm \
chicken.format.import.scm
support.c: support.scm mini-srfi-1.scm \
chicken.bitwise.import.scm \
+ chicken.blob.import.scm \
chicken.condition.import.scm \
chicken.data-structures.import.scm \
chicken.file.import.scm \
@@ -720,6 +722,7 @@ data-structures.c: data-structures.scm \
chicken.condition.import.scm \
chicken.foreign.import.scm
expand.c: expand.scm \
+ chicken.blob.import.scm \
chicken.condition.import.scm \
chicken.keyword.import.scm \
chicken.platform.import.scm \
@@ -728,6 +731,7 @@ extras.c: extras.scm \
chicken.data-structures.import.scm \
chicken.time.import.scm
eval.c: eval.scm \
+ chicken.blob.import.scm \
chicken.condition.import.scm \
chicken.foreign.import.scm \
chicken.internal.import.scm \
@@ -770,6 +774,7 @@ library.c: $(SRCDIR)library.scm $(SRCDIR)banner.scm $(SRCDIR)common-declarations
$(bootstrap-lib) \
-no-module-registration \
-emit-import-library chicken.bitwise \
+ -emit-import-library chicken.blob \
-emit-import-library chicken.fixnum \
-emit-import-library chicken.flonum \
-emit-import-library chicken.gc \
diff --git a/support.scm b/support.scm
index 0f8f4029..8a343315 100644
--- a/support.scm
+++ b/support.scm
@@ -77,6 +77,7 @@
(import chicken scheme
chicken.bitwise
+ chicken.blob
chicken.condition
chicken.data-structures
chicken.file
diff --git a/tests/library-tests.scm b/tests/library-tests.scm
index ed2b4b09..6e43068e 100644
--- a/tests/library-tests.scm
+++ b/tests/library-tests.scm
@@ -1,6 +1,6 @@
;;;; library-tests.scm
-(use bitwise flonum keyword port)
+(use chicken.blob bitwise flonum keyword port)
(define-syntax assert-fail
(syntax-rules ()
diff --git a/tests/typematch-tests.scm b/tests/typematch-tests.scm
index b97edaf8..9f1f70c7 100644
--- a/tests/typematch-tests.scm
+++ b/tests/typematch-tests.scm
@@ -1,7 +1,7 @@
;;;; typematch-tests.scm
-(use chicken.memory data-structures locative)
+(use chicken.blob chicken.memory data-structures locative)
(define (make-list n x)
diff --git a/types.db b/types.db
index e5daf7af..a0f6e212 100644
--- a/types.db
+++ b/types.db
@@ -934,14 +934,17 @@
(#(procedure #:clean #:enforce #:foldable) chicken.bitwise#bitwise-not (integer) integer)
((* *) (##core#inline_allocate ("C_s_a_i_bitwise_not" 5) #(1))))
-(blob->string (#(procedure #:clean #:enforce) blob->string (blob) string))
+;; blob
-(blob-size (#(procedure #:clean #:enforce #:foldable) blob-size (blob) fixnum)
+(chicken.blob#blob? (#(procedure #:pure #:predicate blob) chicken.blob#blob? (*) boolean))
+(chicken.blob#blob=? (#(procedure #:clean #:enforce #:foldable) chicken.blob#blob=? (blob blob) boolean))
+(chicken.blob#blob-size (#(procedure #:clean #:enforce #:foldable) chicken.blob#blob-size (blob) fixnum)
((blob) (##sys#size #(1))))
+(chicken.blob#blob->string (#(procedure #:clean #:enforce) chicken.blob#blob->string (blob) string))
+(chicken.blob#make-blob (#(procedure #:clean #:enforce) chicken.blob#make-blob (fixnum) blob)
+ ((fixnum) (##sys#make-blob #(1))))
+(chicken.blob#string->blob (#(procedure #:clean #:enforce) chicken.blob#string->blob (string) blob))
-(blob? (#(procedure #:pure #:predicate blob) blob? (*) boolean))
-
-(blob=? (#(procedure #:clean #:enforce #:foldable) blob=? (blob blob) boolean))
(call/cc (#(procedure #:enforce) call/cc ((procedure (*) . *)) . *))
(case-sensitive (#(procedure #:clean) case-sensitive (#!optional *) *))
(char-name (#(procedure #:clean #:enforce) char-name ((or char symbol) #!optional char) *)) ;XXX -> (or char symbol) ?
@@ -1250,9 +1253,6 @@
(keyword-style (#(procedure #:clean) keyword-style (#!optional symbol) symbol))
-(make-blob (#(procedure #:clean #:enforce) make-blob (fixnum) blob)
- ((fixnum) (##sys#make-blob #(1))))
-
(make-parameter (#(procedure #:clean #:enforce) make-parameter (* #!optional procedure) procedure))
(chicken.flonum#maximum-flonum float)
(chicken.flonum#minimum-flonum float)
@@ -1323,7 +1323,6 @@
((cplxnum) ((or float cplxnum)) (##sys#extended-signum #(1))))
(sleep (#(procedure #:clean #:enforce) sleep (fixnum) undefined))
-(string->blob (#(procedure #:clean #:enforce) string->blob (string) blob))
(string->uninterned-symbol (#(procedure #:clean #:enforce) string->uninterned-symbol (string) symbol))
(sub1 (#(procedure #:clean #:enforce #:foldable) sub1 (number) number)
Trap