~ chicken-core (chicken-5) db3d4f5f3de9a0adacbb70fef5d2ba6e4817de32

commit db3d4f5f3de9a0adacbb70fef5d2ba6e4817de32
Author:     Peter Bex <peter@more-magic.net>
AuthorDate: Tue Jun 20 16:57:44 2023 +0200
Commit:     Peter Bex <peter@more-magic.net>
CommitDate: Fri Jun 23 13:42:35 2023 +0200

    Convert line number db hash table to use weak alists for form lookup
    
    This doesn't turn it into a proper weak hash table (where the keys
    would be weak), but the entries themselves are alists which are used
    for further lookup of the source expression.  The symbol which is in
    the car of an expression is used as the key in the hash table.
    
    This means that the source expression may be collected.  This will
    happen for instance when the symbol is redefined, like when reloading
    a source file.  This means the majority of memory will be reclaimable,
    and storing source locations in the interpreter will be safe.
    
    We also clean out broken weak pointers whenever entries get added or
    looked up so it doesn't grow out of proportion.  This is suboptimal,
    as expressions can be added *without* traversing the alist.  This
    turns O(1) entry addition into O(n) addition, or quadratic behaviour
    over the number of added entries with the same car.  However, it *has*
    to be done there, otherwise reloading code over and over still results
    in an ever-expanding line number db.
    
    To improve this, perhaps we can come up with some sort of "expression
    hash" instead, which hashes the entire source expression, to avoid
    alist usage?

diff --git a/eval.scm b/eval.scm
index b5671e9a..86792a7a 100644
--- a/eval.scm
+++ b/eval.scm
@@ -121,7 +121,8 @@
       (define (emit-syntax-trace-info tf info cntr) 
 	(when tf
 	  (##core#inline
-	   "C_emit_syntax_trace_info"
+	   "C_emit_trace_info"
+	   (or (get-line-number info) "<syntax>")
 	   info
 	   cntr
            (thread-id ##sys#current-thread) ) ) )
diff --git a/expand.scm b/expand.scm
index 0567e8d5..d809c4f8 100644
--- a/expand.scm
+++ b/expand.scm
@@ -718,15 +718,30 @@
 
 ;;; Hook for source information
 
+(define (alist-weak-cons k v lst)
+  (cons (##core#inline_allocate ("C_a_i_weak_cons" 3) k v) lst))
+
+(define (assq/drop-bwp! x lst)
+  (let lp ((lst lst)
+	   (prev #f))
+    (cond ((null? lst) #f)
+	  ((eq? x (caar lst)) (car lst))
+	  ((and prev
+		(##core#inline "C_bwpp" (caar lst)))
+	   (set-cdr! prev (cdr lst))
+	   (lp (cdr lst) prev))
+	  (else (lp (cdr lst) lst)))))
+
 (define (##sys#read/source-info-hook class data val)	; Used here, in core.scm and in csi.scm
   (when (and (eq? 'list-info class) (symbol? (car data)))
-    (hash-table-set!
-     ##sys#line-number-database
-     (car data)
-     (alist-cons 
-      data (conc ##sys#current-source-filename ":" val)
-      (or (hash-table-ref ##sys#line-number-database (car data))
-	  '() ) ) ) )
+    (let ((old-value (or (hash-table-ref ##sys#line-number-database (car data)) '())))
+      (assq/drop-bwp! (car data) old-value) ;; Hack to clean out garbage values
+      (hash-table-set!
+       ##sys#line-number-database
+       (car data)
+       (alist-weak-cons
+	data (conc ##sys#current-source-filename ":" val)
+	old-value ) )) )
   data)
 
 ;; TODO: Should we export this, or something like it?
@@ -741,7 +756,7 @@
 	 (and (symbol? head)
 	      (cond ((hash-table-ref ##sys#line-number-database head)
 		     => (lambda (pl)
-			  (let ((a (assq sexp pl)))
+			  (let ((a (assq/drop-bwp! sexp pl)))
 			    (and a (cdr a)))))
 		    (else #f))))))
 
@@ -749,7 +764,7 @@
 (define (##sys#get-line-2 exp)
   (let* ((name (car exp))
 	 (lst (hash-table-ref ##sys#line-number-database name)))
-    (cond ((and lst (assq exp (cdr lst)))
+    (cond ((and lst (assq/drop-bwp! exp (cdr lst)))
 	   => (lambda (a) (values (car lst) (cdr a))) )
 	  (else (values name #f)) ) ) )
 
@@ -864,7 +879,7 @@
 		    (cur (or (hash-table-ref ##sys#line-number-database name) '())) )
 	   (unless (assq new cur)
 	     (hash-table-set! ##sys#line-number-database name
-			      (alist-cons new ln cur))))
+			      (alist-weak-cons new ln cur))))
 	 new)
        (assert (list? se) "not a list" se) ;XXX remove later
        (define (rename sym)