From 1f8c06114e81e521865b3836fce9d293f6f88417 Mon Sep 17 00:00:00 2001 From: Evan Hanson
Date: Tue, 13 Aug 2019 21:53:35 +1200 Subject: [PATCH] Add `record-printer' and `set-record-printer!' procedures These offer a procedural way to specify how records are printed. They deprecate the `define-record-printer' macro, which isn't a "real" definition (see #1294). Signed-off-by: Peter Bex --- DEPRECATED | 3 +++ NEWS | 3 +++ chicken-syntax.scm | 2 +- chicken.base.import.scm | 2 ++ distribution/manifest | 1 + library.scm | 30 ++++++++++++++++++++++++------ manual/Module (chicken base) | 19 +++++++++++++------ tests/record-printer-test.scm | 29 +++++++++++++++++++++++++++++ tests/runtests.bat | 6 ++++++ tests/runtests.sh | 3 +++ types.db | 3 +++ 11 files changed, 88 insertions(+), 13 deletions(-) create mode 100644 tests/record-printer-test.scm diff --git a/DEPRECATED b/DEPRECATED index d3d8d2b7..40756ce2 100644 --- a/DEPRECATED +++ b/DEPRECATED @@ -7,6 +7,9 @@ Deprecated functions and variables C_i_check_exact_2 have been deprecated (see also #1631). - "C_u_i_zerop" has been turned into an inline operation and is deprecated in favor of "C_u_i_zerop2". +- The define-record-printer macro has been deprecated in favour of + record-printer and set-record-printer! procedures, and a SRFI-17 + setter for the former. 5.0.0 diff --git a/NEWS b/NEWS index 7d216375..b2a11a8f 100644 --- a/NEWS +++ b/NEWS @@ -7,6 +7,9 @@ - for-each and map now behave consistently in compiled and interpreted mode, like in SRFI-1. They now stop when the shortest list is exhausted instead of raising an exception (fixes #1422). + - The procedures `record-printer` and `set-record-printer!` and a + corresponding SRFI-17 setter have been added. These deprecate + `define-record-printer` which isn't a "real" definition (see #1294). - Runtime system - Quoted empty keywords like ||: and :|| are now read like prescribed diff --git a/chicken-syntax.scm b/chicken-syntax.scm index 86aa74c7..e943222d 100644 --- a/chicken-syntax.scm +++ b/chicken-syntax.scm @@ -1040,7 +1040,7 @@ ;;; Record printing: (##sys#extend-macro-environment - 'define-record-printer '() + 'define-record-printer '() ;; DEPRECATED (##sys#er-transformer (lambda (form r c) (##sys#check-syntax 'define-record-printer form '(_ _ . _)) diff --git a/chicken.base.import.scm b/chicken.base.import.scm index 7c823271..79c8e19f 100644 --- a/chicken.base.import.scm +++ b/chicken.base.import.scm @@ -96,6 +96,8 @@ (quotient&remainder . chicken.base#quotient&remainder) (rassoc . chicken.base#rassoc) (ratnum? . chicken.base#ratnum?) + (record-printer . chicken.base#record-printer) + (set-record-printer! . chicken.base#set-record-printer!) (setter . chicken.base#setter) (signum . chicken.base#signum) (sleep . chicken.base#sleep) diff --git a/distribution/manifest b/distribution/manifest index 928d5ef1..316736e5 100644 --- a/distribution/manifest +++ b/distribution/manifest @@ -129,6 +129,7 @@ tests/compiler-tests.scm tests/inlining-tests.scm tests/locative-stress-test.scm tests/record-rename-test.scm +tests/record-printer-test.scm tests/r4rstest.scm tests/r4rstest.expected tests/null.scm diff --git a/library.scm b/library.scm index bc0ef42c..a6f35899 100644 --- a/library.scm +++ b/library.scm @@ -592,6 +592,7 @@ EOF notice procedure-information setter signum string->uninterned-symbol subvector symbol-append vector-copy! vector-resize warning quotient&remainder quotient&modulo + record-printer set-record-printer! alist-ref alist-update alist-update! rassoc atom? butlast chop compress flatten intersperse join list-of? tail? constantly complement compose conjoin disjoin each flip identity o @@ -660,6 +661,8 @@ EOF (define procedure-information) (define setter) (define string->uninterned-symbol) +(define record-printer) +(define set-record-printer!) (define gensym) @@ -4654,12 +4657,27 @@ EOF (define ##sys#record-printers '()) -(define (##sys#register-record-printer type proc) - (let ([a (assq type ##sys#record-printers)]) - (if a - (##sys#setslot a 1 proc) - (set! ##sys#record-printers (cons (cons type proc) ##sys#record-printers)) ) - (##core#undefined) ) ) +(set! chicken.base#record-printer + (lambda (type) + (##sys#check-symbol type 'record-printer) + (let ((a (assq type ##sys#record-printers))) + (and a (cdr a))))) + +(set! chicken.base#set-record-printer! + (lambda (type proc) + (##sys#check-symbol type 'set-record-printer!) + (##sys#check-closure proc 'set-record-printer!) + (let ((a (assq type ##sys#record-printers))) + (if a + (##sys#setslot a 1 proc) + (set! ##sys#record-printers (cons (cons type proc) ##sys#record-printers))) + (##core#undefined)))) + +;; OBSOLETE can be removed after bootstrapping +(set! ##sys#register-record-printer chicken.base#set-record-printer!) + +(set! chicken.base#record-printer + (getter-with-setter record-printer set-record-printer!)) (define (##sys#user-print-hook x readable port) (let* ((type (##sys#slot x 0)) diff --git a/manual/Module (chicken base) b/manual/Module (chicken base) index 3a8fab1e..49dad575 100644 --- a/manual/Module (chicken base) +++ b/manual/Module (chicken base) @@ -1187,11 +1187,17 @@ doesn't have to). This special form is also compatible with the definition from the R7RS {{(scheme base)}} library. +==== record-printer -==== define-record-printer +