~ 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