~ chicken-core (chicken-5) 4590834f75f7a6376d8aa501edc6a2716512778d
commit 4590834f75f7a6376d8aa501edc6a2716512778d
Author: Peter Bex <peter@more-magic.net>
AuthorDate: Fri Jun 23 14:11:09 2023 +0200
Commit: Peter Bex <peter@more-magic.net>
CommitDate: Fri Jun 23 14:40:02 2023 +0200
Move line number tracking from csi to repl proper and update docs
This means line number tracking is also enabled in user repls, not
just the "real" csi.
When adding the read expression to the line number database, make sure
the filename isn't "#f", as it's weird to see "#f:123" as a line
number. Instead use "<stdin>" if nothing is defined.
In the manual, drop the restriction that line-number info is only
available in the compiler.
Add a NEWS entry about the newly available line number info.
diff --git a/NEWS b/NEWS
index 9f519930..c9a62d28 100644
--- a/NEWS
+++ b/NEWS
@@ -51,6 +51,10 @@
- Default "cc" on BSD systems for building CHICKEN to avoid ABI problems
when linking with C++ code.
+- Runtime system
+ - Make line numbers available for error output and during syntax expansion
+ in the interpreter as well as the compiler.
+
5.3.0
- Core libraries
diff --git a/csi.scm b/csi.scm
index 26a956ea..e4a865d2 100644
--- a/csi.scm
+++ b/csi.scm
@@ -73,7 +73,6 @@ EOF
;;; Parameters:
(define-constant init-file "csirc")
-(define-constant line-number-database-size 997) ; Copied from core.scm
(set! ##sys#repl-print-length-limit 2048)
(set! ##sys#features (cons #:csi ##sys#features))
@@ -1158,7 +1157,5 @@ EOF
(let ((r (optional rs)))
(exit (if (fixnum? r) r 0)))))))))))))
-(set! ##sys#line-number-database (make-vector line-number-database-size '()))
-
(fluid-let ((##sys#default-read-info-hook ##sys#read/source-info-hook))
(run)))
diff --git a/expand.scm b/expand.scm
index 8966923c..adcb737d 100644
--- a/expand.scm
+++ b/expand.scm
@@ -740,7 +740,7 @@
##sys#line-number-database
(car data)
(alist-weak-cons
- data (conc ##sys#current-source-filename ":" val)
+ data (conc (or ##sys#current-source-filename "<stdin>") ":" val)
old-value ) )) )
data)
diff --git a/manual/Module (chicken syntax) b/manual/Module (chicken syntax)
index c20a7640..127b1359 100644
--- a/manual/Module (chicken syntax)
+++ b/manual/Module (chicken syntax)
@@ -365,8 +365,6 @@ If {{EXPR}} is a pair with the car being a symbol, and line-number
information is available for this expression, then this procedure
returns the associated source file and line number as a string. If
line-number information is not available, then {{#f}} is returned.
-Note that line-number information for expressions is only available in
-the compiler.
==== syntax-error
diff --git a/repl.scm b/repl.scm
index 1ddcaf23..87f26cf0 100644
--- a/repl.scm
+++ b/repl.scm
@@ -40,6 +40,8 @@
(include "common-declarations.scm")
+(define-constant line-number-database-size 997) ; Copied from core.scm
+
(define ##sys#repl-print-length-limit #f)
(define ##sys#repl-read-hook #f)
(define ##sys#repl-recent-call-chain #f) ; used in csi for ,c command
@@ -115,6 +117,9 @@
(set! quit-hook (lambda (result) (k result)))
(load-verbose #t)
(set! ##sys#notices-enabled #t)
+ ;; Make sure line number db is initialized but don't clear it if (repl) is called again
+ (unless ##sys#line-number-database
+ (set! ##sys#line-number-database (make-vector line-number-database-size '())))
(##sys#error-handler
(lambda (msg . args)
(resetports)
@@ -131,13 +136,13 @@
(write-err args)))
(set! ##sys#repl-recent-call-chain
(let ((ct (or (and-let* ((lexn ##sys#last-exception) ;XXX not really right
- ((##sys#structure? lexn 'condition))
- (a (member '(exn . call-chain) (##sys#slot lexn 2))))
+ ((##sys#structure? lexn 'condition))
+ (a (member '(exn . call-chain) (##sys#slot lexn 2))))
(cadr a))
(get-call-chain 0 ##sys#current-thread))))
(##sys#really-print-call-chain
- ##sys#standard-error ct
- "\n\tCall history:\n")
+ ##sys#standard-error ct
+ "\n\tCall history:\n")
ct))
(flush-output ##sys#standard-error))))
(lambda ()
@@ -151,39 +156,40 @@
(resetports)
(c #f)))))
(##sys#read-prompt-hook)
- (let ((exp ((or ##sys#repl-read-hook read))))
- (unless (eof-object? exp)
- (when (eq? #\newline (##sys#peek-char-0 ##sys#standard-input))
- (##sys#read-char-0 ##sys#standard-input))
- (foreign-code "C_clear_trace_buffer();")
- (set! ##sys#unbound-in-eval '())
- (receive result (evaluator exp)
- (when (and ##sys#warnings-enabled (pair? ##sys#unbound-in-eval))
- (let loop ((vars ##sys#unbound-in-eval)
- (u '()))
- (cond ((null? vars)
- (when (pair? u)
- (when ##sys#notices-enabled
- (##sys#notice
- "the following toplevel variables are referenced but unbound:\n")
- (for-each
- (lambda (v)
- (##sys#print " " #f ##sys#standard-error)
- (##sys#print (car v) #t ##sys#standard-error)
- (when (cdr v)
- (##sys#print " (in " #f ##sys#standard-error)
- (##sys#print (cdr v) #t ##sys#standard-error)
- (##sys#write-char-0 #\) ##sys#standard-error))
- (##sys#write-char-0 #\newline ##sys#standard-error))
- u)
- (##sys#flush-output ##sys#standard-error))))
- ((or (memq (caar vars) u)
- (##core#inline "C_u_i_namespaced_symbolp" (caar vars))
- (##sys#symbol-has-toplevel-binding? (caar vars)))
- (loop (cdr vars) u))
- (else (loop (cdr vars) (cons (car vars) u)))) 9))
- (write-results result)
- (loop))))))
+ (fluid-let ((##sys#default-read-info-hook ##sys#read/source-info-hook))
+ (let ((exp ((or ##sys#repl-read-hook read))))
+ (unless (eof-object? exp)
+ (when (eq? #\newline (##sys#peek-char-0 ##sys#standard-input))
+ (##sys#read-char-0 ##sys#standard-input))
+ (foreign-code "C_clear_trace_buffer();")
+ (set! ##sys#unbound-in-eval '())
+ (receive result (evaluator exp)
+ (when (and ##sys#warnings-enabled (pair? ##sys#unbound-in-eval))
+ (let loop ((vars ##sys#unbound-in-eval)
+ (u '()))
+ (cond ((null? vars)
+ (when (pair? u)
+ (when ##sys#notices-enabled
+ (##sys#notice
+ "the following toplevel variables are referenced but unbound:\n")
+ (for-each
+ (lambda (v)
+ (##sys#print " " #f ##sys#standard-error)
+ (##sys#print (car v) #t ##sys#standard-error)
+ (when (cdr v)
+ (##sys#print " (in " #f ##sys#standard-error)
+ (##sys#print (cdr v) #t ##sys#standard-error)
+ (##sys#write-char-0 #\) ##sys#standard-error))
+ (##sys#write-char-0 #\newline ##sys#standard-error))
+ u)
+ (##sys#flush-output ##sys#standard-error))))
+ ((or (memq (caar vars) u)
+ (##core#inline "C_u_i_namespaced_symbolp" (caar vars))
+ (##sys#symbol-has-toplevel-binding? (caar vars)))
+ (loop (cdr vars) u))
+ (else (loop (cdr vars) (cons (car vars) u)))) 9))
+ (write-results result)
+ (loop)))))))
(lambda ()
(load-verbose lv)
(set! quit-hook qh)
Trap