>From dfef43f14abd25e7fe60f4b2cca27f64ae01f653 Mon Sep 17 00:00:00 2001 From: Evan Hanson Date: Wed, 26 Jul 2017 16:47:58 +1200 Subject: [PATCH] Add chicken.blob module --- README | 1 + c-platform.scm | 8 ++++---- chicken.import.scm | 6 ------ defaults.make | 2 +- distribution/manifest | 2 ++ eval.scm | 1 + expand.scm | 2 +- library.scm | 7 ++++++- rules.make | 5 +++++ support.scm | 1 + tests/library-tests.scm | 2 +- tests/typematch-tests.scm | 2 +- types.db | 17 ++++++++--------- 13 files changed, 32 insertions(+), 24 deletions(-) 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 7b0600a4..3e7eab2b 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 @@ -182,7 +177,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 91ab9a2c..38d543f2 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 7f0d60ad..fcc1bc6e 100644 --- a/library.scm +++ b/library.scm @@ -2140,6 +2140,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,7 +2181,7 @@ EOF (##sys#check-blob b2 'blob=?) (let ((n (##sys#size b1))) (and (eq? (##sys#size b2) n) - (zero? (##core#inline "C_string_compare" b1 b2 n))))) + (zero? (##core#inline "C_string_compare" b1 b2 n)))))) ;;; 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 1e33adcb..fefd2ed8 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 2b2fb1cc..b8b4cd95 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) @@ -1324,7 +1324,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) -- 2.11.0