~ chicken-core (chicken-5) b24b03084e2b2214fdbfcdba5fe27bf3532b7277
commit b24b03084e2b2214fdbfcdba5fe27bf3532b7277
Author: Evan Hanson <evhan@foldling.org>
AuthorDate: Tue Jan 19 00:17:34 2016 +1300
Commit: Evan Hanson <evhan@foldling.org>
CommitDate: Tue Mar 8 22:52:34 2016 +1300
Move locative-related procedures to new chicken.locative module
diff --git a/README b/README
index d0c09447..4996042a 100644
--- a/README
+++ b/README
@@ -294,6 +294,7 @@
| | |-- chicken.files.import.so
| | |-- chicken.foreign.import.so
| | |-- chicken.format.import.so
+ | | |-- chicken.locative.import.so
| | |-- chicken.lolevel.import.so
| | |-- chicken.internal.import.so
| | |-- chicken.io.import.so
diff --git a/c-platform.scm b/c-platform.scm
index 082b9149..d748a179 100644
--- a/c-platform.scm
+++ b/c-platform.scm
@@ -179,8 +179,8 @@
chicken.lolevel#u16vector-set! chicken.lolevel#s16vector-set!
chicken.lolevel#u32vector-set! chicken.lolevel#s32vector-set!
chicken.lolevel#u64vector-set! chicken.lolevel#s64vector-set!
- chicken.lolevel#locative-ref chicken.lolevel#locative-set!
- chicken.lolevel#locative->object chicken.lolevel#locative?
+ chicken.locative#locative-ref chicken.locative#locative-set!
+ chicken.locative#locative->object chicken.locative#locative?
chicken.lolevel#pointer->object chicken.lolevel#pointer+
chicken.lolevel#address->pointer chicken.lolevel#pointer->address
chicken.lolevel#pointer=? chicken.lolevel#number-of-slots
@@ -413,7 +413,7 @@
(rewrite 'call-with-values 13 2 "C_call_with_values" #t)
(rewrite '##sys#call-with-values 13 2 "C_u_call_with_values" #f)
(rewrite '##sys#call-with-values 13 2 "C_call_with_values" #t)
-(rewrite 'chicken.lolevel#locative-ref 13 1 "C_locative_ref" #t)
+(rewrite 'chicken.locative#locative-ref 13 1 "C_locative_ref" #t)
(rewrite 'chicken.continuation#continuation-graft 13 2 "C_continuation_graft" #t)
(rewrite 'caar 2 1 "C_u_i_caar" #f)
@@ -464,7 +464,7 @@
(rewrite 'not 2 1 "C_i_not"#t )
(rewrite 'char? 2 1 "C_charp" #t)
(rewrite 'string? 2 1 "C_i_stringp" #t)
-(rewrite 'chicken.lolevel#locative? 2 1 "C_i_locativep" #t)
+(rewrite 'chicken.locative#locative? 2 1 "C_i_locativep" #t)
(rewrite 'symbol? 2 1 "C_i_symbolp" #t)
(rewrite 'vector? 2 1 "C_i_vectorp" #t)
(rewrite '##sys#vector? 2 1 "C_i_vectorp" #t)
@@ -829,8 +829,8 @@
(rewrite '##sys#permanent? 17 1 "C_permanentp")
(rewrite '##sys#null-pointer? 17 1 "C_null_pointerp" "C_null_pointerp")
(rewrite '##sys#immediate? 17 1 "C_immp")
-(rewrite 'chicken.lolevel#locative->object 17 1 "C_i_locative_to_object")
-(rewrite 'chicken.lolevel#locative-set! 17 2 "C_i_locative_set")
+(rewrite 'chicken.locative#locative->object 17 1 "C_i_locative_to_object")
+(rewrite 'chicken.locative#locative-set! 17 2 "C_i_locative_set")
(rewrite '##sys#foreign-fixnum-argument 17 1 "C_i_foreign_fixnum_argumentp")
(rewrite '##sys#foreign-char-argument 17 1 "C_i_foreign_char_argumentp")
(rewrite '##sys#foreign-flonum-argument 17 1 "C_i_foreign_flonum_argumentp")
@@ -956,8 +956,8 @@
(srfi-4#s64vector-ref . srfi-4#s64vector-set!)
(srfi-4#f32vector-ref . srfi-4#f32vector-set!)
(srfi-4#f64vector-ref . srfi-4#f64vector-set!)
+ (chicken.locative#locative-ref . chicken.locative#locative-set!)
(chicken.lolevel#block-ref . chicken.lolevel#block-set!)
- (chicken.lolevel#locative-ref . chicken.lolevel#locative-set!)
(chicken.lolevel#pointer-u8-ref . chicken.lolevel#pointer-u8-set!)
(chicken.lolevel#pointer-s8-ref . chicken.lolevel#pointer-s8-set!)
(chicken.lolevel#pointer-u16-ref . chicken.lolevel#pointer-u16-set!)
diff --git a/chicken-install.scm b/chicken-install.scm
index 5c1b7242..28209635 100644
--- a/chicken-install.scm
+++ b/chicken-install.scm
@@ -58,6 +58,7 @@
"chicken.internal.import.so"
"chicken.io.import.so"
"chicken.irregex.import.so"
+ "chicken.locative.import.so"
"chicken.lolevel.import.so"
"chicken.ports.import.so"
"chicken.posix.import.so"
diff --git a/defaults.make b/defaults.make
index e72030ab..ffe337fa 100644
--- a/defaults.make
+++ b/defaults.make
@@ -264,7 +264,8 @@ CHICKEN_PROGRAM_OPTIONS += $(if $(PROFILE_OBJECTS),-profile)
PRIMITIVE_IMPORT_LIBRARIES = chicken csi chicken.foreign
DYNAMIC_IMPORT_LIBRARIES = setup-api setup-download srfi-4
-DYNAMIC_CHICKEN_IMPORT_LIBRARIES = bitwise format io posix pretty-print random
+DYNAMIC_CHICKEN_IMPORT_LIBRARIES = bitwise format io locative posix \
+ pretty-print random
DYNAMIC_CHICKEN_UNIT_IMPORT_LIBRARIES = data-structures eval repl expand \
continuation files internal irregex lolevel ports tcp utils
diff --git a/distribution/manifest b/distribution/manifest
index e248e3a9..31a09946 100644
--- a/distribution/manifest
+++ b/distribution/manifest
@@ -266,6 +266,8 @@ chicken.io.import.scm
chicken.io.import.c
chicken.irregex.import.scm
chicken.irregex.import.c
+chicken.locative.import.scm
+chicken.locative.import.c
chicken.lolevel.import.scm
chicken.lolevel.import.c
chicken.ports.import.scm
diff --git a/eval.scm b/eval.scm
index 15445fe3..2225d2a4 100644
--- a/eval.scm
+++ b/eval.scm
@@ -85,6 +85,7 @@
(chicken.internal . internal)
(chicken.io . extras)
(chicken.irregex . irregex)
+ (chicken.locative . lolevel)
(chicken.lolevel . lolevel)
(chicken.ports . ports)
(chicken.posix . posix)
diff --git a/lolevel.scm b/lolevel.scm
index 0653903a..e10b446c 100644
--- a/lolevel.scm
+++ b/lolevel.scm
@@ -38,9 +38,8 @@ EOF
(module chicken.lolevel
(address->pointer align-to-word allocate block-ref block-set!
- extend-procedure extended-procedure? free locative->object
- locative-ref locative-set! locative? make-locative
- make-pointer-vector make-record-instance make-weak-locative
+ extend-procedure extended-procedure? free
+ make-pointer-vector make-record-instance
move-memory! mutate-procedure! number-of-bytes number-of-slots
object->pointer object-become! object-copy pointer+ pointer->address
pointer->object pointer-f32-ref pointer-f32-set! pointer-f64-ref
@@ -283,43 +282,6 @@ EOF
(##sys#error-hook (foreign-value "C_BAD_ARGUMENT_TYPE_NO_POINTER_ERROR" int) 'pointer-tag x) ) )
-;;; locatives:
-
-;; Locative layout:
-;
-; 0 Object-address + Byte-offset (address)
-; 1 Byte-offset (fixnum)
-; 2 Type (fixnum)
-; 0 vector or pair (C_SLOT_LOCATIVE)
-; 1 string (C_CHAR_LOCATIVE)
-; 2 u8vector or blob (C_U8_LOCATIVE)
-; 3 s8vector (C_S8_LOCATIVE)
-; 4 u16vector (C_U16_LOCATIVE)
-; 5 s16vector (C_S16_LOCATIVE)
-; 6 u32vector (C_U32_LOCATIVE)
-; 7 s32vector (C_S32_LOCATIVE)
-; 8 u64vector (C_U32_LOCATIVE)
-; 9 s64vector (C_S32_LOCATIVE)
-; 10 f32vector (C_F32_LOCATIVE)
-; 11 f64vector (C_F64_LOCATIVE)
-; 3 Object or #f, if weak (C_word)
-
-(define (make-locative obj . index)
- (##sys#make-locative obj (optional index 0) #f 'make-locative) )
-
-(define (make-weak-locative obj . index)
- (##sys#make-locative obj (optional index 0) #t 'make-weak-locative) )
-
-(define (locative-set! x y) (##core#inline "C_i_locative_set" x y))
-
-(define locative-ref
- (getter-with-setter
- (##core#primitive "C_locative_ref")
- locative-set!
- "(locative-ref loc)"))
-
-(define (locative->object x) (##core#inline "C_i_locative_to_object" x))
-(define (locative? x) (and (##core#inline "C_blockp" x) (##core#inline "C_locativep" x)))
;;; SRFI-4 number-vector:
@@ -588,4 +550,51 @@ EOF
(##sys#check-structure pv 'pointer-vector 'pointer-vector-length)
(##sys#slot pv 1))
-)
+) ; chicken.lolevel
+
+(module chicken.locative
+ (locative? make-locative make-weak-locative
+ locative-ref locative-set! locative->object)
+
+(import scheme chicken)
+
+;;; locatives:
+
+;; Locative layout:
+;
+; 0 Object-address + Byte-offset (address)
+; 1 Byte-offset (fixnum)
+; 2 Type (fixnum)
+; 0 vector or pair (C_SLOT_LOCATIVE)
+; 1 string (C_CHAR_LOCATIVE)
+; 2 u8vector or blob (C_U8_LOCATIVE)
+; 3 s8vector (C_S8_LOCATIVE)
+; 4 u16vector (C_U16_LOCATIVE)
+; 5 s16vector (C_S16_LOCATIVE)
+; 6 u32vector (C_U32_LOCATIVE)
+; 7 s32vector (C_S32_LOCATIVE)
+; 8 u64vector (C_U32_LOCATIVE)
+; 9 s64vector (C_S32_LOCATIVE)
+; 10 f32vector (C_F32_LOCATIVE)
+; 11 f64vector (C_F64_LOCATIVE)
+; 3 Object or #f, if weak (C_word)
+
+(define (make-locative obj . index)
+ (##sys#make-locative obj (optional index 0) #f 'make-locative))
+
+(define (make-weak-locative obj . index)
+ (##sys#make-locative obj (optional index 0) #t 'make-weak-locative))
+
+(define (locative-set! x y) (##core#inline "C_i_locative_set" x y))
+
+(define locative-ref
+ (getter-with-setter
+ (##core#primitive "C_locative_ref")
+ locative-set!
+ "(locative-ref loc)"))
+
+(define (locative->object x)
+ (##core#inline "C_i_locative_to_object" x))
+
+(define (locative? x)
+ (and (##core#inline "C_blockp" x) (##core#inline "C_locativep" x))))
diff --git a/manual/Unit lolevel b/manual/Unit lolevel
index 28d2b063..33ba4994 100644
--- a/manual/Unit lolevel
+++ b/manual/Unit lolevel
@@ -374,6 +374,8 @@ on the locative. The container object can be computed by calling the
Locatives may be passed to foreign procedures that expect pointer arguments.
+The following procedures are provided by the {{(chicken locative)}}
+module.
==== make-locative
diff --git a/modules.scm b/modules.scm
index 670e28ec..2bd739e7 100644
--- a/modules.scm
+++ b/modules.scm
@@ -940,6 +940,7 @@
(##sys#register-module-alias 'format 'chicken.format)
(##sys#register-module-alias 'io 'chicken.io)
(##sys#register-module-alias 'irregex 'chicken.irregex)
+(##sys#register-module-alias 'locative 'chicken.locative)
(##sys#register-module-alias 'lolevel 'chicken.lolevel)
(##sys#register-module-alias 'ports 'chicken.ports)
(##sys#register-module-alias 'posix 'chicken.posix)
diff --git a/rules.make b/rules.make
index d786be10..f66049a9 100644
--- a/rules.make
+++ b/rules.make
@@ -523,6 +523,7 @@ $(eval $(call declare-emitted-import-lib-dependency,chicken.format,extras))
$(eval $(call declare-emitted-import-lib-dependency,chicken.io,extras))
$(eval $(call declare-emitted-import-lib-dependency,chicken.pretty-print,extras))
$(eval $(call declare-emitted-import-lib-dependency,chicken.random,extras))
+$(eval $(call declare-emitted-import-lib-dependency,chicken.locative,lolevel))
chicken.c: chicken.scm mini-srfi-1.scm \
chicken.compiler.batch-driver.import.scm \
@@ -773,7 +774,9 @@ ports.c: $(SRCDIR)ports.scm $(SRCDIR)common-declarations.scm
files.c: $(SRCDIR)files.scm $(SRCDIR)common-declarations.scm
$(bootstrap-lib) -emit-import-library chicken.files
lolevel.c: $(SRCDIR)lolevel.scm $(SRCDIR)common-declarations.scm
- $(bootstrap-lib) -emit-import-library chicken.lolevel
+ $(bootstrap-lib) \
+ -emit-import-library chicken.locative \
+ -emit-import-library chicken.lolevel
tcp.c: $(SRCDIR)tcp.scm $(SRCDIR)common-declarations.scm
$(bootstrap-lib) -emit-import-library chicken.tcp
srfi-4.c: $(SRCDIR)srfi-4.scm $(SRCDIR)common-declarations.scm
diff --git a/tests/lolevel-tests.scm b/tests/lolevel-tests.scm
index f84cedd7..d43123ab 100644
--- a/tests/lolevel-tests.scm
+++ b/tests/lolevel-tests.scm
@@ -1,6 +1,6 @@
;;;; Unit lolevel testing
-(require-extension lolevel srfi-4 extras)
+(require-extension locative lolevel srfi-4)
(define-syntax assert-error
(syntax-rules ()
diff --git a/tests/runtests.sh b/tests/runtests.sh
index 5fdeb34b..41c60bfa 100755
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -48,6 +48,7 @@ for x in \
chicken.internal.import.so \
chicken.io.import.so \
chicken.irregex.import.so \
+ chicken.locative.import.so \
chicken.lolevel.import.so \
chicken.ports.import.so \
chicken.posix.import.so \
diff --git a/tests/typematch-tests.scm b/tests/typematch-tests.scm
index 507dea07..785691b6 100644
--- a/tests/typematch-tests.scm
+++ b/tests/typematch-tests.scm
@@ -1,7 +1,7 @@
;;;; typematch-tests.scm
-(use lolevel data-structures)
+(use locative lolevel data-structures)
(define (make-list n x)
diff --git a/types.db b/types.db
index a7912e03..95103c9d 100644
--- a/types.db
+++ b/types.db
@@ -1707,14 +1707,8 @@
(chicken.lolevel#extend-procedure (#(procedure #:clean #:enforce) chicken.lolevel#extend-procedure (procedure *) procedure))
(chicken.lolevel#extended-procedure? (#(procedure #:clean) chicken.lolevel#extended-procedure (*) boolean))
(chicken.lolevel#free (#(procedure #:clean #:enforce) chicken.lolevel#free (pointer) undefined))
-(chicken.lolevel#locative->object (#(procedure #:clean #:enforce) chicken.lolevel#locative->object (locative) *))
-(chicken.lolevel#locative-ref (#(procedure #:clean #:enforce) chicken.lolevel#locative-ref (locative) *))
-(chicken.lolevel#locative-set! (#(procedure #:enforce) chicken.lolevel#locative-set! (locative *) *))
-(chicken.lolevel#locative? (#(procedure #:pure #:predicate locative) chicken.lolevel#locative? (*) boolean))
-(chicken.lolevel#make-locative (#(procedure #:clean #:enforce) chicken.lolevel#make-locative (* #!optional fixnum) locative))
(chicken.lolevel#make-pointer-vector (#(procedure #:clean #:enforce) chicken.lolevel#make-pointer-vector (fixnum #!optional (or pointer false)) pointer-vector))
(chicken.lolevel#make-record-instance (#(procedure #:clean) chicken.lolevel#make-record-instance (symbol #!rest) *))
-(chicken.lolevel#make-weak-locative (#(procedure #:clean #:enforce) chicken.lolevel#make-weak-locative (* #!optional fixnum) locative))
(chicken.lolevel#move-memory! (#(procedure #:enforce) chicken.lolevel#move-memory! (* * #!optional fixnum fixnum fixnum) *))
@@ -1805,6 +1799,14 @@
(chicken.lolevel#tag-pointer (#(procedure #:clean #:enforce) chicken.lolevel#tag-pointer (pointer *) pointer))
(chicken.lolevel#tagged-pointer? (#(procedure #:clean #:enforce) chicken.lolevel#tagged-pointer? (* #!optional *) boolean))
+;; locative
+
+(chicken.locative#locative->object (#(procedure #:clean #:enforce) chicken.locative#locative->object (locative) *))
+(chicken.locative#locative-ref (#(procedure #:clean #:enforce) chicken.locative#locative-ref (locative) *))
+(chicken.locative#locative-set! (#(procedure #:enforce) chicken.locative#locative-set! (locative *) *))
+(chicken.locative#locative? (#(procedure #:pure #:predicate locative) chicken.locative#locative? (*) boolean))
+(chicken.locative#make-locative (#(procedure #:clean #:enforce) chicken.locative#make-locative (* #!optional fixnum) locative))
+(chicken.locative#make-weak-locative (#(procedure #:clean #:enforce) chicken.locative#make-weak-locative (* #!optional fixnum) locative))
;; ports
Trap