~ chicken-core (chicken-5) 29748e690bc810ff9ef7f0d532a6568926d4cdfd
commit 29748e690bc810ff9ef7f0d532a6568926d4cdfd
Author: Evan Hanson <evhan@foldling.org>
AuthorDate: Tue Jan 19 16:02:47 2016 +1300
Commit: Evan Hanson <evhan@foldling.org>
CommitDate: Tue Mar 8 22:52:34 2016 +1300
Move reader-related procedures to new chicken.read-syntax module
This includes `define-reader-ctor` from the eval unit and the
reader-related procedures from the library unit, but not
`current-read-table` as `##sys#read` needs that at the top level.
diff --git a/README b/README
index 08740db8..3fcc9046 100644
--- a/README
+++ b/README
@@ -305,6 +305,7 @@
| | |-- chicken.pretty-print.import.so
| | |-- chicken.random.import.so
| | |-- chicken.repl.import.so
+ | | |-- chicken.read-syntax.import.so
| | |-- chicken.tcp.import.so
| | |-- chicken.utils.import.so
| | |-- csi.import.so
diff --git a/chicken-install.scm b/chicken-install.scm
index f5b5df26..73c60526 100644
--- a/chicken-install.scm
+++ b/chicken-install.scm
@@ -66,6 +66,7 @@
"chicken.pretty-print.import.so"
"chicken.random.import.so"
"chicken.repl.import.so"
+ "chicken.read-syntax.import.so"
"chicken.tcp.import.so"
"chicken.utils.import.so"
"csi.import.so"
diff --git a/chicken.import.scm b/chicken.import.scm
index a3a94b9e..c367c875 100644
--- a/chicken.import.scm
+++ b/chicken.import.scm
@@ -46,7 +46,6 @@
condition-property-accessor
condition?
condition->list
- copy-read-table
cplxnum?
cpu-time
current-error-port
@@ -54,7 +53,6 @@
current-milliseconds
current-read-table
current-seconds
- (define-reader-ctor . chicken.eval#define-reader-ctor)
delete-file
directory-exists?
(dynamic-load-libraries . chicken.eval#dynamic-load-libraries)
@@ -209,10 +207,7 @@
reset-handler
return-to-host
reverse-list->string
- set-parameterized-read-syntax!
set-port-name!
- set-read-syntax!
- set-sharp-read-syntax!
setter
signal
signum
diff --git a/defaults.make b/defaults.make
index 80325cdc..44e9cb81 100644
--- a/defaults.make
+++ b/defaults.make
@@ -265,7 +265,7 @@ 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
+ pretty-print random read-syntax
DYNAMIC_CHICKEN_UNIT_IMPORT_LIBRARIES = data-structures eval repl expand \
continuation files internal irregex lolevel ports tcp utils
diff --git a/eval.scm b/eval.scm
index 71ffc329..0cd126f5 100644
--- a/eval.scm
+++ b/eval.scm
@@ -47,7 +47,7 @@
<#
(module chicken.eval
- (chicken-home define-reader-ctor dynamic-load-libraries
+ (chicken-home dynamic-load-libraries
eval eval-handler extension-information
load load-library load-noisily load-relative load-verbose
interaction-environment null-environment scheme-report-environment
@@ -93,6 +93,7 @@
(chicken.pretty-print . extras)
(chicken.tcp . tcp)
(chicken.repl . repl)
+ (chicken.read-syntax . library)
(chicken.utils . utils)))
(define-constant core-library-units
@@ -1431,35 +1432,6 @@
fname) ) )
(else (loop (##sys#slot paths 1))) ) ) ) ) ) )
-
-;;; SRFI-10:
-
-(define sharp-comma-reader-ctors (make-vector 301 '()))
-
-(define (define-reader-ctor spec proc)
- (##sys#check-symbol spec 'define-reader-ctor)
- (##sys#hash-table-set! sharp-comma-reader-ctors spec proc))
-
-(set! ##sys#user-read-hook
- (let ((old ##sys#user-read-hook)
- (read-char read-char)
- (read read) )
- (lambda (char port)
- (cond ((char=? char #\,)
- (read-char port)
- (let* ((exp (read port))
- (err (lambda () (##sys#read-error port "invalid sharp-comma external form" exp))) )
- (if (or (null? exp) (not (list? exp)))
- (err)
- (let ([spec (##sys#slot exp 0)])
- (if (not (symbol? spec))
- (err)
- (let ((ctor (##sys#hash-table-ref sharp-comma-reader-ctors spec)))
- (if ctor
- (apply ctor (##sys#slot exp 1))
- (##sys#read-error port "undefined sharp-comma constructor" spec) ) ) ) ) ) ) )
- (else (old char port)) ) ) ) )
-
) ; eval module
;;; Simple invocation API:
diff --git a/library.scm b/library.scm
index f2337167..6a17c938 100644
--- a/library.scm
+++ b/library.scm
@@ -3752,7 +3752,15 @@ EOF
(loop lst h)))
(h (loop (cons (integer->char (fxior h (hex c))) lst) #f))
(else (loop lst (fxshl (hex c) 4)))))))
-
+
+
+;;; Read syntax:
+
+(module chicken.read-syntax
+ (copy-read-table define-reader-ctor set-read-syntax!
+ set-sharp-read-syntax! set-parameterized-read-syntax!)
+
+(import scheme chicken)
;;; Hooks for user-defined read-syntax:
;
@@ -3840,6 +3848,34 @@ EOF
(let ((t3 (##sys#slot rt 3)))
(and t3 (##sys#vector-resize t3 (##sys#size t3) #f) ) ) ))
+;;; SRFI-10:
+
+(define sharp-comma-reader-ctors (make-vector 301 '()))
+
+(define (define-reader-ctor spec proc)
+ (##sys#check-symbol spec 'define-reader-ctor)
+ (##sys#hash-table-set! sharp-comma-reader-ctors spec proc))
+
+(set! ##sys#user-read-hook
+ (let ((old ##sys#user-read-hook)
+ (read-char read-char)
+ (read read))
+ (lambda (char port)
+ (cond ((char=? char #\,)
+ (read-char port)
+ (let* ((exp (read port))
+ (err (lambda () (##sys#read-error port "invalid sharp-comma external form" exp))))
+ (if (or (null? exp) (not (list? exp)))
+ (err)
+ (let ([spec (##sys#slot exp 0)])
+ (if (not (symbol? spec))
+ (err)
+ (let ((ctor (##sys#hash-table-ref sharp-comma-reader-ctors spec)))
+ (if ctor
+ (apply ctor (##sys#slot exp 1))
+ (##sys#read-error port "undefined sharp-comma constructor" spec))))))))
+ (else (old char port)))))))
+
;;; Output:
diff --git a/manual/Unit library b/manual/Unit library
index 5abf9890..c824f120 100644
--- a/manual/Unit library
+++ b/manual/Unit library
@@ -1258,6 +1258,9 @@ procedure may be changed.
=== Reader extensions
+The following procedures are provided by the {{(chicken read-syntax)}}
+module.
+
==== define-reader-ctor
<procedure>(define-reader-ctor SYMBOL PROC)</procedure>
diff --git a/modules.scm b/modules.scm
index 7e12ea31..643c7f96 100644
--- a/modules.scm
+++ b/modules.scm
@@ -948,6 +948,7 @@
(##sys#register-module-alias 'pretty-print 'chicken.pretty-print)
(##sys#register-module-alias 'random 'chicken.random)
(##sys#register-module-alias 'repl 'chicken.repl)
+(##sys#register-module-alias 'read-syntax 'chicken.read-syntax)
(##sys#register-module-alias 'tcp 'chicken.tcp)
(##sys#register-module-alias 'utils 'chicken.utils)
diff --git a/rules.make b/rules.make
index cbd7f27f..ab51892a 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.read-syntax,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))
@@ -745,7 +746,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.read-syntax
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/tests/reader-tests.scm b/tests/reader-tests.scm
index 89bbf35c..954b3f2d 100644
--- a/tests/reader-tests.scm
+++ b/tests/reader-tests.scm
@@ -1,9 +1,8 @@
;;;; reader-tests.scm
-
(use (only io read-line read-string)
- (only ports with-input-from-string with-output-to-string))
-
+ (only ports with-input-from-string with-output-to-string)
+ (only read-syntax set-read-syntax! set-sharp-read-syntax!))
(set-sharp-read-syntax! #\& (lambda (p) (read p) (values)))
(set-sharp-read-syntax! #\^ (lambda (p) (read p)))
diff --git a/tests/runtests.sh b/tests/runtests.sh
index c2bc8dc0..c57f0fc8 100755
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -56,6 +56,7 @@ for x in \
chicken.pretty-print.import.so \
chicken.random.import.so \
chicken.repl.import.so \
+ chicken.read-syntax.import.so \
chicken.tcp.import.so \
chicken.utils.import.so
do
diff --git a/types.db b/types.db
index fc64f675..3fb8c28d 100644
--- a/types.db
+++ b/types.db
@@ -943,12 +943,31 @@
(condition->list (#(procedure #:clean #:enforce) condition->list ((struct condition)) (list-of (pair symbol *))))
+;; continuation
+
(chicken.continuation#continuation-capture (#(procedure #:enforce) chicken.continuation#continuation-capture ((procedure ((struct continuation)) . *)) *))
(chicken.continuation#continuation-graft (#(procedure #:clean #:enforce) chicken.continuation#continuation-graft ((struct continuation) (procedure () . *)) *))
(chicken.continuation#continuation-return (#(procedure #:enforce) chicken.continuation#continuation-return ((struct continuation) #!rest) . *)) ;XXX make return type more specific?
(chicken.continuation#continuation? (#(procedure #:pure #:predicate (struct continuation)) chicken.continuation#continuation? (*) boolean))
-(copy-read-table (#(procedure #:clean #:enforce) copy-read-table ((struct read-table)) (struct read-table)))
+;; read-syntax
+
+(chicken.read-syntax#copy-read-table (#(procedure #:clean #:enforce) chicken.read-syntax#copy-read-table ((struct read-table)) (struct read-table)))
+(chicken.read-syntax#define-reader-ctor (#(procedure #:clean #:enforce) chicken.read-syntax#define-reader-ctor (symbol procedure) undefined))
+
+(chicken.read-syntax#set-parameterized-read-syntax!
+ (#(procedure #:clean #:enforce) chicken.read-syntax#set-parameterized-read-syntax!
+ (char (or false (procedure (input-port fixnum) . *)))
+ undefined))
+
+(chicken.read-syntax#set-read-syntax!
+ (#(procedure #:clean #:enforce) chicken.read-syntax#set-read-syntax!
+ (char (or false (procedure (input-port) . *)))
+ undefined))
+
+(chicken.read-syntax#set-sharp-read-syntax!
+ (#(procedure #:clean #:enforce) chicken.read-syntax#set-sharp-read-syntax!
+ (char (or false (procedure (input-port) . *))) undefined))
(cplxnum? (#(procedure #:pure #:predicate cplxnum) cplxnum? (*) boolean))
@@ -974,7 +993,6 @@
(#(procedure #:clean) current-read-table (#!optional (struct read-table)) (struct read-table)))
(current-seconds (#(procedure #:clean) current-seconds () integer))
-(chicken.eval#define-reader-ctor (#(procedure #:clean #:enforce) chicken.eval#define-reader-ctor (symbol procedure) undefined))
(delete-file (#(procedure #:clean #:enforce) delete-file (string) string))
(enable-warnings (#(procedure #:clean) enable-warnings (#!optional *) *))
@@ -1258,23 +1276,9 @@
(chicken.repl#repl (#(procedure #:enforce) chicken.repl#repl (#!optional (procedure (*) . *)) undefined))
(chicken.repl#repl-prompt (#(procedure #:clean #:enforce) chicken.repl#repl-prompt (#!optional (procedure () string)) procedure))
-(set-parameterized-read-syntax!
- (#(procedure #:clean #:enforce) set-parameterized-read-syntax!
- (char (or false (procedure (input-port fixnum) . *)))
- undefined))
-
(set-port-name! (#(procedure #:clean #:enforce) set-port-name! (port string) undefined)
((port string) (##sys#setslot #(1) '3 #(2))))
-(set-read-syntax!
- (#(procedure #:clean #:enforce) set-read-syntax!
- (char (or false (procedure (input-port) . *)))
- undefined))
-
-(set-sharp-read-syntax!
- (#(procedure #:clean #:enforce) set-sharp-read-syntax!
- (char (or false (procedure (input-port) . *))) undefined))
-
(setter (#(procedure #:clean #:enforce) setter (procedure) procedure))
(signal (procedure signal (*) . *))
Trap