~ chicken-core (chicken-5) d80aeb64ae9e345dd987cfe2e1ce1b01f719f428


commit d80aeb64ae9e345dd987cfe2e1ce1b01f719f428
Author:     Peter Bex <peter@more-magic.net>
AuthorDate: Thu May 21 12:40:12 2020 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Mon Jul 6 14:33:43 2020 +0200

    Use set-record-printer! instead of define-record-printer internally
    
    define-record-printer is deprecated and apparently doesn't even work
    correctly(?!)
    
    Signed-off-by: felix <felix@call-with-current-continuation.org>

diff --git a/eval.scm b/eval.scm
index 7c9da9a0..344660dd 100644
--- a/eval.scm
+++ b/eval.scm
@@ -819,10 +819,11 @@
   (let ((e (##sys#make-structure 'environment 'interaction-environment #f #f)))
     (lambda () e)))
 
-(define-record-printer (environment e p)
-  (##sys#print "#<environment " #f p)
-  (##sys#print (##sys#slot e 1) #f p)
-  (##sys#write-char-0 #\> p))
+(set-record-printer! 'environment
+  (lambda (e p)
+    (##sys#print "#<environment " #f p)
+    (##sys#print (##sys#slot e 1) #f p)
+    (##sys#write-char-0 #\> p)))
 
 (let* ((r4s (chicken.module#module-environment 'r4rs 'scheme-report-environment/4))
        (r5s (chicken.module#module-environment 'scheme 'scheme-report-environment/5))
diff --git a/irregex-core.scm b/irregex-core.scm
index 9bcf7e0b..ece802a2 100644
--- a/irregex-core.scm
+++ b/irregex-core.scm
@@ -148,13 +148,14 @@
        (##sys#slot (##sys#slot m 1) (+ 3 (* n 4))))
      (define (%irregex-match-fail m) (##sys#slot m 4))
      (define (%irregex-match-fail-set! m x) (##sys#setslot m 4 x))
-     (define-record-printer (regexp-match m out)
-       (let ((n (irregex-match-num-submatches m)))
-	 (display "#<regexp-match (" out)
-	 (display n out)
-	 (display " submatch" out)
-	 (when (or (eq? n 0) (fx> n 1)) (display "es" out))
-	 (display ")>" out)))
+     (set-record-printer! 'regexp-match
+       (lambda (m out)
+	 (let ((n (irregex-match-num-submatches m)))
+	   (display "#<regexp-match (" out)
+	   (display n out)
+	   (display " submatch" out)
+	   (when (or (eq? n 0) (fx> n 1)) (display "es" out))
+	   (display ")>" out))))
      (define-inline (irregex-match-valid-numeric-index? m n)
        (let ((v (##sys#slot m 1)))
 	 (and (>= n 0) (< (* n 4) (- (##sys#size v) 4)))))
diff --git a/misc/chicken.el b/misc/chicken.el
index 2874b775..2c31f722 100644
--- a/misc/chicken.el
+++ b/misc/chicken.el
@@ -165,12 +165,13 @@
 	(select 1)
 	(functor 3)
 	(define-interface 1)
-	(module 2) ) )
+	(module 2)) )
 
 (setq chicken-indent-list
       '((printf 1)
 	(fprintf 2)
-	(sprintf 1)))
+	(sprintf 1)
+	(set-record-printer! 1)))
 
 ;(put 'module 'scheme-indent-function 'chicken-module-indent)
 ;(defun chicken-module-indent (state indent-point normal-indent) 0)
diff --git a/support.scm b/support.scm
index 0027344f..5eff6e23 100644
--- a/support.scm
+++ b/support.scm
@@ -472,8 +472,9 @@
   (parameters node-parameters node-parameters-set!) ; (value...)
   (subexpressions node-subexpressions node-subexpressions-set!)) ; (node...)
 
-(define-record-printer (node n out)
-  (fprintf out "#<node ~a ~a>" (node-class n) (node-parameters n)))
+(set-record-printer! node
+  (lambda (n out)
+    (fprintf out "#<node ~a ~a>" (node-class n) (node-parameters n))))
 
 (define (make-node c p s)
   (##sys#make-structure 'chicken.compiler.support#node c p s))
Trap