~ chicken-core (chicken-5) 8c9d4d1ac564a334ad03d0585f503b9f940dc328
commit 8c9d4d1ac564a334ad03d0585f503b9f940dc328
Author: Evan Hanson <evhan@foldling.org>
AuthorDate: Tue Jan 19 20:02:34 2016 +1300
Commit: Evan Hanson <evhan@foldling.org>
CommitDate: Tue Mar 8 22:52:34 2016 +1300
Move read-syntax module into its own unit
diff --git a/defaults.make b/defaults.make
index 44e9cb81..a56e5514 100644
--- a/defaults.make
+++ b/defaults.make
@@ -265,9 +265,10 @@ 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 read-syntax
-DYNAMIC_CHICKEN_UNIT_IMPORT_LIBRARIES = data-structures eval repl expand \
- continuation files internal irregex lolevel ports tcp utils
+ pretty-print random
+DYNAMIC_CHICKEN_UNIT_IMPORT_LIBRARIES = continuation data-structures \
+ eval expand files internal irregex lolevel ports read-syntax \
+ repl tcp utils
# targets
diff --git a/distribution/manifest b/distribution/manifest
index 8771e47b..10a4a68c 100644
--- a/distribution/manifest
+++ b/distribution/manifest
@@ -36,6 +36,7 @@ irregex.c
posixunix.c
posixwin.c
profiler.c
+read-syntax.c
scheduler.c
srfi-4.c
stub.c
@@ -91,6 +92,7 @@ posixunix.scm
posixwin.scm
posix-common.scm
profiler.scm
+read-syntax.scm
repl.scm
runtime.c
scheduler.scm
diff --git a/eval.scm b/eval.scm
index 0cd126f5..445bd459 100644
--- a/eval.scm
+++ b/eval.scm
@@ -93,7 +93,7 @@
(chicken.pretty-print . extras)
(chicken.tcp . tcp)
(chicken.repl . repl)
- (chicken.read-syntax . library)
+ (chicken.read-syntax . read-syntax)
(chicken.utils . utils)))
(define-constant core-library-units
diff --git a/library.scm b/library.scm
index 6a17c938..71bd60f1 100644
--- a/library.scm
+++ b/library.scm
@@ -3754,14 +3754,6 @@ EOF
(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:
;
; - Redefine this to handle new read-syntaxes. If 'char' doesn't match
@@ -3776,107 +3768,6 @@ EOF
(else (##sys#read-error port "invalid sharp-sign read syntax" char) ) ) )
-;;; Table for specially handled read-syntax:
-;
-; - should be either #f or a 256-element vector containing procedures
-; - the procedure is called with two arguments, a char (peeked) and a port and should return an expression
-
-(define read-marks '())
-
-(define (##sys#set-read-mark! sym proc)
- (let ((a (assq sym read-marks)))
- (if a
- (##sys#setslot a 1 proc)
- (set! read-marks (cons (cons sym proc) read-marks)) ) ) )
-
-(define set-read-syntax!)
-(define set-sharp-read-syntax!)
-(define set-parameterized-read-syntax!)
-
-(let ((crt current-read-table))
-
- (define ((syntax-setter loc slot wrap) chr proc)
- (cond ((symbol? chr) (##sys#set-read-mark! chr proc))
- (else
- (let ((crt (crt)))
- (unless (##sys#slot crt slot)
- (##sys#setslot crt slot (##sys#make-vector 256 #f)) )
- (##sys#check-char chr loc)
- (let ((i (char->integer chr)))
- (##sys#check-range i 0 256 loc)
- (cond (proc
- (##sys#check-closure proc loc)
- (##sys#setslot (##sys#slot crt slot) i (wrap proc)))
- (else
- (##sys#setslot (##sys#slot crt slot) i #f))))))))
-
- (set! set-read-syntax!
- (syntax-setter
- 'set-read-syntax! 1
- (lambda (proc)
- (lambda (_ port)
- (##sys#read-char-0 port)
- (proc port) ) ) ) )
-
- (set! set-sharp-read-syntax!
- (syntax-setter
- 'set-sharp-read-syntax! 2
- (lambda (proc)
- (lambda (_ port)
- (##sys#read-char-0 port)
- (proc port) ) ) ) )
-
- (set! set-parameterized-read-syntax!
- (syntax-setter
- 'set-parameterized-read-syntax! 3
- (lambda (proc)
- (lambda (_ port num)
- (##sys#read-char-0 port)
- (proc port num) ) ) ) ) )
-
-
-;;; Read-table operations:
-
-(define (copy-read-table rt)
- (##sys#check-structure rt 'read-table 'copy-read-table)
- (##sys#make-structure
- 'read-table
- (let ((t1 (##sys#slot rt 1)))
- (and t1 (##sys#vector-resize t1 (##sys#size t1) #f) ) )
- (let ((t2 (##sys#slot rt 2)))
- (and t2 (##sys#vector-resize t2 (##sys#size t2) #f) ) )
- (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:
(define (##sys#write-char-0 c p)
@@ -4480,7 +4371,7 @@ EOF
[else (err x)] ) ) ) )
(define ##sys#features
- '(#:chicken #:srfi-6 #:srfi-10 #:srfi-23 #:srfi-30 #:srfi-39 #:srfi-62 #:srfi-17
+ '(#:chicken #:srfi-6 #:srfi-23 #:srfi-30 #:srfi-39 #:srfi-62 #:srfi-17
#:srfi-12 #:srfi-88 #:srfi-98
#:irregex-is-core-unit #:full-numeric-tower))
diff --git a/manual/Supported language b/manual/Supported language
index 20d0128c..3573a4af 100644
--- a/manual/Supported language
+++ b/manual/Supported language
@@ -28,6 +28,7 @@
* [[Unit tcp]] Basic TCP-sockets
* [[Unit lolevel]] Low-level operations
* [[Unit continuation]] Continuations
+* [[Unit read-syntax]] Reader extensions
---
Previous: [[Using the interpreter]]
diff --git a/manual/Unit continuation b/manual/Unit continuation
index 3ac54c9b..6c82d86a 100644
--- a/manual/Unit continuation
+++ b/manual/Unit continuation
@@ -59,4 +59,4 @@ be implemented like this:
----
Previous: [[Unit lolevel]]
-Next: [[Interface to external functions and variables]]
+Next: [[Unit read-syntax]]
diff --git a/manual/Unit library b/manual/Unit library
index c824f120..b1b43dc7 100644
--- a/manual/Unit library
+++ b/manual/Unit library
@@ -1256,88 +1256,5 @@ 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>
-
-Define new read-time constructor for {{#,}} read syntax. For further information, see
-the documentation for [[http://srfi.schemers.org/srfi-10/srfi-10.html|SRFI-10]].
-
-
-==== set-read-syntax!
-
-<procedure>(set-read-syntax! CHAR-OR-SYMBOL PROC)</procedure>
-
-When the reader encounters the non-whitespace character {{CHAR}} while reading
-an expression from a given port, then the procedure {{PROC}} will be called with
-that port as its argument. The procedure should return a value that will be returned
-to the reader:
-
-<enscript highlight=scheme>
- ; A simple RGB color syntax:
-
- (set-read-syntax! #\%
- (lambda (port)
- (apply vector
- (map (cut string->number <> 16)
- (string-chop (read-string 6 port) 2) ) ) ) )
-
- (with-input-from-string "(1 2 %f0f0f0 3)" read)
- ; ==> (1 2 #(240 240 240) 3)
-</enscript>
-
-If {{CHAR-OR-SYMBOL}} is a symbol, then a so-called ''read-mark'' handler is defined.
-In that case the handler procedure will be called when a character-sequence of the
-form {{#!SYMBOL}} is encountered.
-
-You can undo special handling of read-syntax by passing {{#f}} as the second argument
-(if the syntax was previously defined via {{set-read-syntax!}}).
-
-As a special case, your handler can return zero values, via {{(values)}}. This causes
-the reader to completely ignore whatever input you've read, rather than returning some
-possibly unspecified value. This can be useful in macro context, reading comments,
-conditional compilation, and so forth. Available in CHICKEN 4.6.6 and later.
-
-Note that all of CHICKEN's special non-standard read-syntax is handled directly by the reader.
-To disable built-in read-syntax, define a handler that triggers an error (for example).
-
-
-==== set-sharp-read-syntax!
-
-<procedure>(set-sharp-read-syntax! CHAR-OR-SYMBOL PROC)</procedure>
-
-Similar to {{set-read-syntax!}}, but allows defining new {{#<CHAR> ...}} reader syntax.
-If the first argument is a symbol, then this procedure is equivalent to {{set-read-syntax!}}.
-
-{{PROC}} may be {{#f}} to disable previously defined "sharp" read syntax.
-
-
-==== set-parameterized-read-syntax!
-
-<procedure>(set-parameterized-read-syntax! CHAR-OR-SYMBOL PROC)</procedure>
-
-Similar to {{set-sharp-read-syntax!}}, but intended for defining reader syntax of the
-form {{#<NUMBER><CHAR> ...}}. The handler procedure {{PROC}} will be called with two
-arguments: the input port and the number preceding
-the dispatching character.
-If the first argument is a symbol, then this procedure is equivalent to {{set-read-syntax!}}.
-
-{{PROC}} may be {{#f}} to disable previously defined parameterized read syntax.
-
-
-==== copy-read-table
-
-<procedure>(copy-read-table READ-TABLE)</procedure>
-
-Returns a copy of the given read-table. You can access the currently active read-table
-with {{(current-read-table)}}.
-
-
-
----
Previous: [[Exceptions]] Next: [[Unit eval]]
diff --git a/manual/Unit read-syntax b/manual/Unit read-syntax
new file mode 100644
index 00000000..861873a7
--- /dev/null
+++ b/manual/Unit read-syntax
@@ -0,0 +1,91 @@
+[[tags: manual]]
+[[toc:]]
+
+== Unit read-syntax
+
+=== Reader extensions
+
+The following procedures are provided by the {{(chicken read-syntax)}}
+module.
+
+==== define-reader-ctor
+
+<procedure>(define-reader-ctor SYMBOL PROC)</procedure>
+
+Define new read-time constructor for {{#,}} read syntax. For further information, see
+the documentation for [[http://srfi.schemers.org/srfi-10/srfi-10.html|SRFI-10]].
+
+
+==== set-read-syntax!
+
+<procedure>(set-read-syntax! CHAR-OR-SYMBOL PROC)</procedure>
+
+When the reader encounters the non-whitespace character {{CHAR}} while reading
+an expression from a given port, then the procedure {{PROC}} will be called with
+that port as its argument. The procedure should return a value that will be returned
+to the reader:
+
+<enscript highlight=scheme>
+ ; A simple RGB color syntax:
+
+ (set-read-syntax! #\%
+ (lambda (port)
+ (apply vector
+ (map (cut string->number <> 16)
+ (string-chop (read-string 6 port) 2) ) ) ) )
+
+ (with-input-from-string "(1 2 %f0f0f0 3)" read)
+ ; ==> (1 2 #(240 240 240) 3)
+</enscript>
+
+If {{CHAR-OR-SYMBOL}} is a symbol, then a so-called ''read-mark'' handler is defined.
+In that case the handler procedure will be called when a character-sequence of the
+form {{#!SYMBOL}} is encountered.
+
+You can undo special handling of read-syntax by passing {{#f}} as the second argument
+(if the syntax was previously defined via {{set-read-syntax!}}).
+
+As a special case, your handler can return zero values, via {{(values)}}. This causes
+the reader to completely ignore whatever input you've read, rather than returning some
+possibly unspecified value. This can be useful in macro context, reading comments,
+conditional compilation, and so forth. Available in CHICKEN 4.6.6 and later.
+
+Note that all of CHICKEN's special non-standard read-syntax is handled directly by the reader.
+To disable built-in read-syntax, define a handler that triggers an error (for example).
+
+
+==== set-sharp-read-syntax!
+
+<procedure>(set-sharp-read-syntax! CHAR-OR-SYMBOL PROC)</procedure>
+
+Similar to {{set-read-syntax!}}, but allows defining new {{#<CHAR> ...}} reader syntax.
+If the first argument is a symbol, then this procedure is equivalent to {{set-read-syntax!}}.
+
+{{PROC}} may be {{#f}} to disable previously defined "sharp" read syntax.
+
+
+==== set-parameterized-read-syntax!
+
+<procedure>(set-parameterized-read-syntax! CHAR-OR-SYMBOL PROC)</procedure>
+
+Similar to {{set-sharp-read-syntax!}}, but intended for defining reader syntax of the
+form {{#<NUMBER><CHAR> ...}}. The handler procedure {{PROC}} will be called with two
+arguments: the input port and the number preceding
+the dispatching character.
+If the first argument is a symbol, then this procedure is equivalent to {{set-read-syntax!}}.
+
+{{PROC}} may be {{#f}} to disable previously defined parameterized read syntax.
+
+
+==== copy-read-table
+
+<procedure>(copy-read-table READ-TABLE)</procedure>
+
+Returns a copy of the given read-table. You can access the currently active read-table
+with {{(current-read-table)}}.
+
+
+---
+Previous: [[Unit continuation]]
+
+Next: [[Interface to external functions and variables]]
diff --git a/read-syntax.scm b/read-syntax.scm
new file mode 100644
index 00000000..ced82d2d
--- /dev/null
+++ b/read-syntax.scm
@@ -0,0 +1,133 @@
+;;;; read-syntax.scm - CHICKEN reader extensions
+;
+; Copyright (c) 2008-2016, The CHICKEN Team
+; Copyright (c) 2000-2007, Felix L. Winkelmann
+; All rights reserved.
+;
+; Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following
+; conditions are met:
+;
+; Redistributions of source code must retain the above copyright notice, this list of conditions and the following
+; disclaimer.
+; Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following
+; disclaimer in the documentation and/or other materials provided with the distribution.
+; Neither the name of the author nor the names of its contributors may be used to endorse or promote
+; products derived from this software without specific prior written permission.
+;
+; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS
+; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
+; AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
+; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+; OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+; POSSIBILITY OF SUCH DAMAGE.
+
+(declare
+ (unit read-syntax)
+ (disable-interrupts))
+
+(module chicken.read-syntax
+ (copy-read-table define-reader-ctor set-read-syntax!
+ set-sharp-read-syntax! set-parameterized-read-syntax!)
+
+(import scheme chicken)
+
+(include "common-declarations.scm")
+
+;;; Table for specially-handled read-syntax:
+;
+; - entries should be #f or a 256-element vector containing procedures
+; - each procedure is called with two arguments, a char (peeked) and a
+; port, and should return an expression
+
+(define read-marks '())
+
+(define (set-read-mark! sym proc)
+ (let ((a (assq sym read-marks)))
+ (if a
+ (##sys#setslot a 1 proc)
+ (set! read-marks (cons (cons sym proc) read-marks)))))
+
+(define ((syntax-setter loc slot wrap) chr proc)
+ (if (symbol? chr)
+ (set-read-mark! chr proc)
+ (let ((crt (current-read-table)))
+ (unless (##sys#slot crt slot)
+ (##sys#setslot crt slot (##sys#make-vector 256 #f)))
+ (##sys#check-char chr loc)
+ (let ((i (char->integer chr)))
+ (##sys#check-range i 0 256 loc)
+ (cond (proc
+ (##sys#check-closure proc loc)
+ (##sys#setslot (##sys#slot crt slot) i (wrap proc)))
+ (else
+ (##sys#setslot (##sys#slot crt slot) i #f)))))))
+
+(define set-read-syntax!
+ (syntax-setter
+ 'set-read-syntax! 1
+ (lambda (proc)
+ (lambda (_ port)
+ (##sys#read-char-0 port)
+ (proc port)))))
+
+(define set-sharp-read-syntax!
+ (syntax-setter
+ 'set-sharp-read-syntax! 2
+ (lambda (proc)
+ (lambda (_ port)
+ (##sys#read-char-0 port)
+ (proc port)))))
+
+(define set-parameterized-read-syntax!
+ (syntax-setter
+ 'set-parameterized-read-syntax! 3
+ (lambda (proc)
+ (lambda (_ port num)
+ (##sys#read-char-0 port)
+ (proc port num)))))
+
+;;; Read-table operations:
+
+(define (copy-read-table rt)
+ (##sys#check-structure rt 'read-table 'copy-read-table)
+ (##sys#make-structure
+ 'read-table
+ (let ((t1 (##sys#slot rt 1)))
+ (and t1 (##sys#vector-resize t1 (##sys#size t1) #f)))
+ (let ((t2 (##sys#slot rt 2)))
+ (and t2 (##sys#vector-resize t2 (##sys#size t2) #f)))
+ (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))))))
+
+(register-feature! 'srfi-10))
diff --git a/rules.make b/rules.make
index ab51892a..0b7b4d3c 100644
--- a/rules.make
+++ b/rules.make
@@ -36,8 +36,8 @@ VPATH=$(SRCDIR)
SETUP_API_OBJECTS_1 = setup-api setup-download
LIBCHICKEN_SCHEME_OBJECTS_1 = \
- library eval repl data-structures ports files extras lolevel utils tcp srfi-4 \
- continuation $(POSIXFILE) internal irregex scheduler debugger-client \
+ library eval read-syntax repl data-structures ports files extras lolevel utils \
+ tcp srfi-4 continuation $(POSIXFILE) internal irregex scheduler debugger-client \
profiler stub expand modules chicken-syntax chicken-ffi-syntax build-version
LIBCHICKEN_OBJECTS_1 = $(LIBCHICKEN_SCHEME_OBJECTS_1) runtime
LIBCHICKEN_SHARED_OBJECTS = $(LIBCHICKEN_OBJECTS_1:=$(O))
@@ -520,7 +520,6 @@ $(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))
@@ -746,12 +745,13 @@ 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.read-syntax
+ -emit-import-library chicken.gc
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
$(bootstrap-lib) -emit-import-library chicken.eval
+read-syntax.c: $(SRCDIR)read-syntax.scm $(SRCDIR)common-declarations.scm
+ $(bootstrap-lib) -emit-import-library chicken.read-syntax
repl.c: $(SRCDIR)repl.scm $(SRCDIR)common-declarations.scm
$(bootstrap-lib) -emit-import-library chicken.repl
expand.c: $(SRCDIR)expand.scm $(SRCDIR)synrules.scm $(SRCDIR)common-declarations.scm
Trap