~ chicken-core (chicken-5) bc7299cef3cc4873278b7f7580354b2ff022ccf1
commit bc7299cef3cc4873278b7f7580354b2ff022ccf1
Author: Peter Bex <peter@more-magic.net>
AuthorDate: Fri Jun 30 09:01:36 2023 +0200
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Mon Jul 3 11:41:51 2023 +0200
Restore read/source-info in support.scm and export from (chicken syntax)
It turns out several eggs got broken by dropping
chicken.compiler.support#read/source-info because they are using it
directly, even though it's undocumented and supposed to be "internal".
So, restore it in support.scm as an alias for the one in
(chicken syntax) to fix those eggs, but mark it as deprecated.
Since several eggs make use of it, that settles the question of
whether it is useful to export it from (chicken syntax), so do this.
Also, since it's now an official API, make it safe to use by checking
the argument for being a port, and make the argument optional, like in
the regular (read) procedure.
Signed-off-by: felix <felix@call-with-current-continuation.org>
diff --git a/DEPRECATED b/DEPRECATED
index 7d9cffe7..6315e591 100644
--- a/DEPRECATED
+++ b/DEPRECATED
@@ -1,6 +1,11 @@
Deprecated functions and variables
==================================
+5.3.1
+- read/source-info was moved from the internal, undocumented module
+ (chicken compiler support) into (chicken syntax). Using it from
+ the former module is deprecated.
+
5.2.1
- current-milliseconds and its C implementations C_milliseconds and
C_a_i_current_milliseconds have been deprecated in favor of
diff --git a/NEWS b/NEWS
index 023d8939..68940ef5 100644
--- a/NEWS
+++ b/NEWS
@@ -21,6 +21,10 @@
filename. Previously, the directory part would be stripped.
- Added support for embedded strings and characters in SRFI-4 vector
literals.
+ - read/source-info is now documented and officially supported, from
+ the (chicken syntax) module. It is still exported from the
+ undocumented internal (chicken compiler support) module, but
+ using it from there is deprecated.
- Tools
- The -R option for csi and csc now accepts list-notation like
diff --git a/batch-driver.scm b/batch-driver.scm
index ee7ae28a..f0a5fc08 100644
--- a/batch-driver.scm
+++ b/batch-driver.scm
@@ -47,6 +47,7 @@
chicken.pretty-print
chicken.process-context
chicken.string
+ chicken.syntax
chicken.port
chicken.time
chicken.condition
@@ -608,7 +609,8 @@
(in (check-and-open-input-file f)) )
(fluid-let ((##sys#current-source-filename f))
(let loop ()
- (let ((x (##sys#read/source-info in)))
+ (let ((x (chicken.syntax#read/source-info in))) ; OBSOLETE - after bootstrapping we can get rid of this explicit namespacing
+
(cond ((eof-object? x)
(close-checked-input-file in f) )
(else
diff --git a/chicken.syntax.import.scm b/chicken.syntax.import.scm
index 7ce92fea..0aa5b36d 100644
--- a/chicken.syntax.import.scm
+++ b/chicken.syntax.import.scm
@@ -32,6 +32,7 @@
'expand
'((expand . chicken.syntax#expand)
(get-line-number . chicken.syntax#get-line-number)
+ (read/source-info . chicken.syntax#read/source-info)
(strip-syntax . chicken.syntax#strip-syntax)
(syntax-error . chicken.syntax#syntax-error)
(er-macro-transformer . chicken.syntax#er-macro-transformer)
diff --git a/csi.scm b/csi.scm
index fca1da4e..28ab16a0 100644
--- a/csi.scm
+++ b/csi.scm
@@ -280,7 +280,7 @@ EOF
(define default-evaluator
(let ((eval eval)
(load-noisily load-noisily)
- (read (lambda () (##sys#read/source-info (current-input-port))))
+ (read (lambda () (chicken.syntax#read/source-info (current-input-port)))) ; OBSOLETE - after bootstrapping we can get rid of this explicit namespacing
(read-line read-line)
(display display)
(string-split string-split)
@@ -1046,8 +1046,9 @@ EOF
((and home-fn (file-exists? home-fn))
(load home-fn) ) ) ) )
(define (evalstring str #!optional (rec (lambda _ (void))))
- (let ((in (open-input-string str)))
- (do ([x (##sys#read/source-info in) (##sys#read/source-info in)])
+ (let ((in (open-input-string str))
+ (read/source-info chicken.syntax#read/source-info)) ; OBSOLETE - after bootstrapping we can get rid of this explicit namespacing
+ (do ([x (read/source-info in) (read/source-info in)])
((eof-object? x))
(rec (receive (eval x))) ) ) )
(when (member* '("-h" "-help" "--help") args)
diff --git a/eval.scm b/eval.scm
index 7fa72028..d54be504 100644
--- a/eval.scm
+++ b/eval.scm
@@ -906,6 +906,7 @@
chicken.foreign
chicken.internal
chicken.platform
+ chicken.syntax
chicken.time)
(include "mini-srfi-1.scm")
@@ -1077,7 +1078,8 @@
(fluid-let ((##sys#read-error-with-line-number #t)
(##sys#current-load-filename fname)
(##sys#current-source-filename fname))
- (let ((in (if fname (open-input-file fname) input)))
+ (let ((in (if fname (open-input-file fname) input))
+ (read/source-info chicken.syntax#read/source-info)) ; OBSOLETE - after bootstrapping we can get rid of this explicit namespacing
(##sys#dynamic-wind
(lambda () #f)
(lambda ()
@@ -1089,8 +1091,8 @@
"unable to load compiled module - "
(or _dlerror "unknown reason"))
fname)))
- (let ((x1 (##sys#read/source-info in)))
- (do ((x x1 (##sys#read/source-info in)))
+ (let ((x1 (read/source-info in)))
+ (do ((x x1 (read/source-info in)))
((eof-object? x))
(when printer (printer x))
(##sys#call-with-values
@@ -1166,7 +1168,8 @@
(let ((call-with-input-file call-with-input-file)
(reverse reverse))
(lambda (filename source k)
- (let ((path (##sys#resolve-include-filename filename #t #f source)))
+ (let ((path (##sys#resolve-include-filename filename #t #f source))
+ (read/source-info chicken.syntax#read/source-info)) ; OBSOLETE - after bootstrapping we can get rid of this explicit namespacing
(when (not path)
(##sys#signal-hook #:file-error 'include "cannot open file" filename))
(when (load-verbose)
@@ -1174,7 +1177,7 @@
(call-with-input-file path
(lambda (in)
(fluid-let ((##sys#current-source-filename path))
- (do ((x (##sys#read/source-info in) (##sys#read/source-info in))
+ (do ((x (read/source-info in) (read/source-info in))
(xs '() (cons x xs)))
((eof-object? x)
(k (reverse xs)))))))))))
diff --git a/expand.scm b/expand.scm
index b1c82113..5041c665 100644
--- a/expand.scm
+++ b/expand.scm
@@ -37,6 +37,7 @@
(module chicken.syntax
(expand
get-line-number
+ read/source-info
strip-syntax
syntax-error
er-macro-transformer
@@ -746,11 +747,11 @@
(define-constant line-number-database-size 997) ; Copied from core.scm
-;; TODO: Should we export this, or something like it?
-(define (##sys#read/source-info in)
+(define (read/source-info #!optional (in ##sys#standard-input))
;; Initialize line number db on first use
(unless ##sys#line-number-database
(set! ##sys#line-number-database (make-vector line-number-database-size '())))
+ (##sys#check-input-port in #t 'read/source-info)
(##sys#read in read/source-info-hook) )
diff --git a/manual/Module (chicken syntax) b/manual/Module (chicken syntax)
index 127b1359..0c3c1e82 100644
--- a/manual/Module (chicken syntax)
+++ b/manual/Module (chicken syntax)
@@ -356,6 +356,18 @@ identifiers will not have been renamed (most often at toplevel), but
there may be other contexts in which identifiers ''will'' have been
renamed.
+==== read/source-info
+
+<procedure>(read/source-info [port])</procedure>
+
+Exactly like {{{read}}} from the {{{scheme}}} module, except it
+registers the expression it read into the line number database, so
+that if {{{(read/source-info)}}} returns {{{OBJ}}},
+{{{(get-line-number OBJ)}}} will return the line number in {{{port}}}.
+
+The port argument may be omitted, in which case it defaults to the
+value returned by {{current-input-port}}. It is an error to read from
+a closed port.
==== get-line-number
diff --git a/repl.scm b/repl.scm
index 523ddd34..8bf63d63 100644
--- a/repl.scm
+++ b/repl.scm
@@ -36,7 +36,8 @@
chicken.base
chicken.eval
chicken.foreign
- chicken.load)
+ chicken.load
+ chicken.syntax)
(include "common-declarations.scm")
@@ -150,8 +151,8 @@
(resetports)
(c #f)))))
(##sys#read-prompt-hook)
- (let* ((read (lambda () (##sys#read/source-info ##sys#standard-input)))
- (exp ((or ##sys#repl-read-hook read))))
+ ;; OBSOLETE - after bootstrapping we can get rid of this explicit namespacing
+ (let ((exp ((or ##sys#repl-read-hook chicken.syntax#read/source-info))))
(unless (eof-object? exp)
(when (eq? #\newline (##sys#peek-char-0 ##sys#standard-input))
(##sys#read-char-0 ##sys#standard-input))
diff --git a/rules.make b/rules.make
index f801bf9d..f7c22b7b 100644
--- a/rules.make
+++ b/rules.make
@@ -761,6 +761,7 @@ eval.c: eval.scm \
chicken.foreign.import.scm \
chicken.internal.import.scm \
chicken.keyword.import.scm \
+ chicken.syntax.import.scm \
chicken.platform.import.scm
repl.c: repl.scm \
chicken.eval.import.scm
diff --git a/support.scm b/support.scm
index 42e275ee..99e66aa9 100644
--- a/support.scm
+++ b/support.scm
@@ -63,7 +63,7 @@
real-name real-name2 display-real-name-table
source-info->string source-info->line source-info->name
call-info constant-form-eval maybe-constant-fold-call
- dump-nodes big-fixnum? small-bignum?
+ dump-nodes read/source-info big-fixnum? small-bignum?
hide-variable export-variable variable-hidden? variable-visible?
mark-variable variable-mark intrinsic? predicate? foldable?
load-identifier-database
@@ -1655,6 +1655,10 @@
(newline) )
+;; DEPRECATED
+(define (read/source-info in)
+ (chicken.syntax#read/source-info in) )
+
;;; "#> ... <#" syntax:
(set! ##sys#user-read-hook
diff --git a/types.db b/types.db
index 69405671..0e7cb859 100644
--- a/types.db
+++ b/types.db
@@ -2359,6 +2359,7 @@
chicken.syntax#ir-macro-transformer
((procedure (* (procedure (*) *) (procedure (* *) *)) *))
(struct transformer)))
+(chicken.syntax#read/source-info (#(procedure #:enforce) chicken.syntax#read/source-info (#!optional input-port) *))
(chicken.syntax#strip-syntax (#(procedure #:clean) chicken.syntax#strip-syntax (*) *))
(chicken.syntax#syntax-error (procedure chicken.syntax#syntax-error (* #!rest) noreturn))
@@ -2385,3 +2386,7 @@
(chicken.tcp#tcp-port-numbers (#(procedure #:clean #:enforce) chicken.tcp#tcp-port-numbers (port) fixnum fixnum))
(chicken.tcp#tcp-read-timeout (#(procedure #:clean #:enforce) chicken.tcp#tcp-read-timeout (#!optional (or false integer)) (or false integer)))
(chicken.tcp#tcp-write-timeout (#(procedure #:clean #:enforce) chicken.tcp#tcp-write-timeout (#!optional (or false integer)) (or false integer)))
+
+
+;; Undocumented internal module, only here to have the deprecation warning because some eggs use it
+(chicken.compiler.support#read/source-info deprecated)
Trap