~ chicken-core (chicken-5) 895612ed2e69d244a17155ead360c71f2d483b6b
commit 895612ed2e69d244a17155ead360c71f2d483b6b
Author: Evan Hanson <evhan@foldling.org>
AuthorDate: Wed Jan 20 23:10:56 2016 +1300
Commit: Evan Hanson <evhan@foldling.org>
CommitDate: Tue Mar 8 22:52:34 2016 +1300
Move keyword-related procedures to new chicken.keyword module
diff --git a/c-platform.scm b/c-platform.scm
index b576d52e..bf025ab0 100644
--- a/c-platform.scm
+++ b/c-platform.scm
@@ -151,7 +151,7 @@
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
- current-error-port current-thread get-keyword
+ 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
srfi-4#u32vector-length srfi-4#u64vector-length
@@ -1033,7 +1033,7 @@
(rewrite 'chicken.data-structures#substring-index 23 2 '##sys#substring-index 0)
(rewrite 'chicken.data-structures#substring-index-ci 23 2 '##sys#substring-index-ci 0)
-(rewrite 'get-keyword 7 2 "C_i_get_keyword" #f #t)
+(rewrite 'chicken.keyword#get-keyword 7 2 "C_i_get_keyword" #f #t)
(rewrite '##sys#get-keyword 7 2 "C_i_get_keyword" #f #t)
)
diff --git a/chicken-install.scm b/chicken-install.scm
index a1f2d2c1..e752df4b 100644
--- a/chicken-install.scm
+++ b/chicken-install.scm
@@ -59,6 +59,7 @@
"chicken.internal.import.so"
"chicken.io.import.so"
"chicken.irregex.import.so"
+ "chicken.keyword.import.so"
"chicken.locative.import.so"
"chicken.lolevel.import.so"
"chicken.ports.import.so"
diff --git a/chicken.import.scm b/chicken.import.scm
index c367c875..60345fe1 100644
--- a/chicken.import.scm
+++ b/chicken.import.scm
@@ -150,7 +150,6 @@
get-call-chain
get-condition-property
get-environment-variable
- get-keyword
(get-line-number . chicken.expand#get-line-number)
get-output-string
get-properties
@@ -158,9 +157,7 @@
implicit-exit-handler
infinite?
(ir-macro-transformer . chicken.expand#ir-macro-transformer)
- keyword->string
keyword-style
- keyword?
(load-library . chicken.eval#load-library)
(load-noisily . chicken.eval#load-noisily)
(load-relative . chicken.eval#load-relative)
@@ -215,7 +212,6 @@
software-type
software-version
string->blob
- string->keyword
string->uninterned-symbol
(strip-syntax . chicken.expand#strip-syntax)
sub1
diff --git a/core.scm b/core.scm
index a3815b93..d9e12cb1 100644
--- a/core.scm
+++ b/core.scm
@@ -325,6 +325,7 @@
chicken.foreign
chicken.format
chicken.io
+ chicken.keyword
chicken.pretty-print)
(define (d arg1 . more)
diff --git a/defaults.make b/defaults.make
index a56e5514..8022aa6b 100644
--- a/defaults.make
+++ b/defaults.make
@@ -264,8 +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 gc io locative posix \
- pretty-print random
+DYNAMIC_CHICKEN_IMPORT_LIBRARIES = bitwise format gc io keyword locative \
+ posix pretty-print random
DYNAMIC_CHICKEN_UNIT_IMPORT_LIBRARIES = continuation data-structures \
eval expand files internal irregex lolevel ports read-syntax \
repl tcp utils
diff --git a/distribution/manifest b/distribution/manifest
index 10a4a68c..b1f81b7a 100644
--- a/distribution/manifest
+++ b/distribution/manifest
@@ -270,6 +270,8 @@ chicken.io.import.scm
chicken.io.import.c
chicken.irregex.import.scm
chicken.irregex.import.c
+chicken.keyword.import.scm
+chicken.keyword.import.c
chicken.locative.import.scm
chicken.locative.import.c
chicken.lolevel.import.scm
diff --git a/eval.scm b/eval.scm
index 445bd459..e74329da 100644
--- a/eval.scm
+++ b/eval.scm
@@ -59,6 +59,7 @@
(import chicken.internal
chicken.expand
+ chicken.keyword
chicken.foreign)
(include "common-declarations.scm")
@@ -86,6 +87,7 @@
(chicken.internal . internal)
(chicken.io . extras)
(chicken.irregex . irregex)
+ (chicken.keyword . library)
(chicken.locative . lolevel)
(chicken.lolevel . lolevel)
(chicken.ports . ports)
diff --git a/expand.scm b/expand.scm
index 0f67e38f..d035901a 100644
--- a/expand.scm
+++ b/expand.scm
@@ -44,7 +44,8 @@
er-macro-transformer
ir-macro-transformer)
-(import scheme chicken)
+(import scheme chicken
+ chicken.keyword)
(include "common-declarations.scm")
diff --git a/library.scm b/library.scm
index 5b0c8bcc..33035add 100644
--- a/library.scm
+++ b/library.scm
@@ -2041,6 +2041,11 @@ EOF
;;; Keywords:
+(module chicken.keyword
+ (keyword? get-keyword keyword->string string->keyword)
+
+(import scheme chicken)
+
(define (keyword? x)
(and (symbol? x) (fx= 0 (##sys#byte (##sys#slot x 1) 0))) )
@@ -2066,7 +2071,7 @@ EOF
(and thunk (thunk))
r)))))
-(define ##sys#get-keyword get-keyword)
+(define ##sys#get-keyword get-keyword))
;;; Blob:
@@ -4365,10 +4370,10 @@ EOF
(##sys#string-append s "-")
"") )
(lambda (x)
- (cond [(string? x) (string->keyword x)]
- [(keyword? x) x]
- [(symbol? x) (string->keyword (##sys#symbol->string x))]
- [else (err x)] ) ) ) )
+ (cond ((chicken.keyword#keyword? x) x)
+ ((string? x) (chicken.keyword#string->keyword x))
+ ((symbol? x) (chicken.keyword#string->keyword (##sys#symbol->string x)))
+ (else (err x))))))
(define ##sys#features
'(#:chicken #:srfi-6 #:srfi-23 #:srfi-30 #:srfi-39 #:srfi-62 #:srfi-17
diff --git a/manual/Unit library b/manual/Unit library
index b1b43dc7..26091dac 100644
--- a/manual/Unit library
+++ b/manual/Unit library
@@ -492,6 +492,9 @@ syntax, either compatible to Common LISP, or to DSSSL. As long as this
parameter is set to {{#:suffix}}, CHICKEN conforms to
[[http://srfi.schemers.org/srfi-88/srfi-88.html|SRFI-88]].
+The following procedures are provided by the {{(chicken keyword)}}
+module.
+
==== get-keyword
diff --git a/modules.scm b/modules.scm
index 643c7f96..d3451150 100644
--- a/modules.scm
+++ b/modules.scm
@@ -39,6 +39,8 @@
(define-syntax d (syntax-rules () ((_ . _) (void))))
+(import chicken.keyword)
+
(define-alias dd d)
(define-alias dm d)
(define-alias dx d)
@@ -941,6 +943,7 @@
(##sys#register-module-alias 'gc 'chicken.gc)
(##sys#register-module-alias 'io 'chicken.io)
(##sys#register-module-alias 'irregex 'chicken.irregex)
+(##sys#register-module-alias 'keyword 'chicken.keyword)
(##sys#register-module-alias 'locative 'chicken.locative)
(##sys#register-module-alias 'lolevel 'chicken.lolevel)
(##sys#register-module-alias 'ports 'chicken.ports)
diff --git a/rules.make b/rules.make
index 0b7b4d3c..aebbc8aa 100644
--- a/rules.make
+++ b/rules.make
@@ -520,6 +520,7 @@ $(foreach lib, $(filter-out chicken,$(COMPILER_OBJECTS_1)),\
$(eval $(call declare-emitted-import-lib-dependency,chicken.posix,$(POSIXFILE)))
$(eval $(call declare-emitted-import-lib-dependency,chicken.bitwise,library))
$(eval $(call declare-emitted-import-lib-dependency,chicken.gc,library))
+$(eval $(call declare-emitted-import-lib-dependency,chicken.keyword,library))
$(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))
@@ -569,6 +570,7 @@ core.c: core.scm mini-srfi-1.scm \
chicken.expand.import.scm \
chicken.format.import.scm \
chicken.io.import.scm \
+ chicken.keyword.import.scm \
chicken.pretty-print.import.scm
optimizer.c: optimizer.scm mini-srfi-1.scm \
chicken.compiler.support.import.scm \
@@ -603,10 +605,13 @@ support.c: support.scm mini-srfi-1.scm \
chicken.files.import.scm \
chicken.foreign.import.scm \
chicken.format.import.scm \
+ chicken.keyword.import.scm \
chicken.io.import.scm \
chicken.ports.import.scm \
chicken.pretty-print.import.scm \
chicken.random.import.scm
+modules.c: modules.scm \
+ chicken.keyword.import.scm
csc.c: csc.scm \
chicken.posix.import.scm \
chicken.data-structures.import.scm \
@@ -707,12 +712,15 @@ posixwin.c: posixwin.scm \
chicken.ports.import.scm
data-structures.c: data-structures.scm \
chicken.foreign.import.scm
+expand.c: expand.scm \
+ chicken.keyword.import.scm
extras.c: extras.scm \
chicken.data-structures.import.scm
eval.c: eval.scm \
chicken.expand.import.scm \
chicken.foreign.import.scm \
- chicken.internal.import.scm
+ chicken.internal.import.scm \
+ chicken.keyword.import.scm
repl.c: repl.scm \
chicken.eval.import.scm
files.c: files.scm \
@@ -745,7 +753,8 @@ bootstrap-lib = $(CHICKEN) $(call profile-flags, $@) $< $(CHICKEN_LIBRARY_OPTION
library.c: $(SRCDIR)library.scm $(SRCDIR)banner.scm $(SRCDIR)common-declarations.scm
$(bootstrap-lib) \
-emit-import-library chicken.bitwise \
- -emit-import-library chicken.gc
+ -emit-import-library chicken.gc \
+ -emit-import-library chicken.keyword
internal.c: $(SRCDIR)internal.scm $(SRCDIR)mini-srfi-1.scm
$(bootstrap-lib) -emit-import-library chicken.internal
eval.c: $(SRCDIR)eval.scm $(SRCDIR)common-declarations.scm $(SRCDIR)mini-srfi-1.scm
diff --git a/support.scm b/support.scm
index d1e92a68..b9122536 100644
--- a/support.scm
+++ b/support.scm
@@ -81,6 +81,7 @@
chicken.files
chicken.foreign
chicken.format
+ chicken.keyword
chicken.io
chicken.ports
chicken.pretty-print
diff --git a/tests/library-tests.scm b/tests/library-tests.scm
index 5ec4d088..d0d1e31d 100644
--- a/tests/library-tests.scm
+++ b/tests/library-tests.scm
@@ -1,6 +1,6 @@
;;;; library-tests.scm
-(use bitwise ports)
+(use bitwise keyword ports)
(define-syntax assert-fail
(syntax-rules ()
diff --git a/tests/runtests.sh b/tests/runtests.sh
index c57f0fc8..3a6ca023 100755
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -49,6 +49,7 @@ for x in \
chicken.internal.import.so \
chicken.io.import.so \
chicken.irregex.import.so \
+ chicken.keyword.import.so \
chicken.locative.import.so \
chicken.lolevel.import.so \
chicken.ports.import.so \
diff --git a/types.db b/types.db
index 670d9bee..ee0e761e 100644
--- a/types.db
+++ b/types.db
@@ -1185,10 +1185,16 @@
(get-call-chain (#(procedure #:clean #:enforce) get-call-chain (#!optional fixnum (struct thread)) (list-of vector)))
(get-condition-property (#(procedure #:clean #:enforce) get-condition-property ((struct condition) symbol symbol #!optional *) *))
(get-environment-variable (#(procedure #:clean #:enforce) get-environment-variable (string) *))
-(get-keyword (#(procedure #:clean #:enforce) get-keyword (symbol list #!optional *) *))
(get-output-string (#(procedure #:clean #:enforce) get-output-string (output-port) string))
(get-properties (#(procedure #:clean #:enforce) get-properties (symbol list) symbol * list))
+;; keyword
+
+(chicken.keyword#get-keyword (#(procedure #:clean #:enforce) chicken.keyword#get-keyword (symbol list #!optional *) *))
+(chicken.keyword#keyword->string (#(procedure #:clean #:enforce) chicken.keyword#keyword->string (symbol) string))
+(chicken.keyword#keyword? (#(procedure #:pure) chicken.keyword#keyword? (*) boolean))
+(chicken.keyword#string->keyword (#(procedure #:clean #:enforce) chicken.keyword#string->keyword (string) symbol))
+
(getter-with-setter
(#(procedure #:clean #:enforce)
getter-with-setter
@@ -1204,9 +1210,7 @@
((procedure (* (procedure (*) *) (procedure (* *) *)) *))
(struct transformer)))
-(keyword->string (#(procedure #:clean #:enforce) keyword->string (symbol) string))
(keyword-style (#(procedure #:clean) keyword-style (#!optional symbol) symbol))
-(keyword? (#(procedure #:pure) keyword? (*) boolean))
(chicken.eval#load-library (#(procedure #:enforce) chicken.eval#load-library (symbol #!optional string) undefined))
(chicken.eval#load-relative (#(procedure #:enforce) chicken.eval#load-relative (string #!optional (procedure (*) . *)) undefined))
(chicken.eval#load-verbose (#(procedure #:clean) chicken.eval#load-verbose (#!optional *) *))
@@ -1294,7 +1298,6 @@
(software-type (#(procedure #:pure) software-type () symbol))
(software-version (#(procedure #:pure) software-version () symbol))
(string->blob (#(procedure #:clean #:enforce) string->blob (string) blob))
-(string->keyword (#(procedure #:clean #:enforce) string->keyword (string) symbol))
(string->uninterned-symbol (#(procedure #:clean #:enforce) string->uninterned-symbol (string) symbol))
(chicken.expand#strip-syntax (#(procedure #:clean) chicken.expand#strip-syntax (*) *))
Trap