From 5b273e7c777cc975d398df9f9a6847b935cb5e86 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 1 Aug 2022 22:35:10 +0200 Subject: [PATCH] read-print: Introduce parent class of . * guix/read-print.scm (, blank?): New record type. (): Redefine using the record interface. (read-with-comments, pretty-print-with-comments): Change some uses of 'comment?' to 'blank?'. * guix/scripts/style.scm (simplify-inputs)[simplify-expressions]: Use 'blank?' instead of 'comment?'. --- guix/read-print.scm | 37 ++++++++++++++++++++++++++----------- guix/scripts/style.scm | 2 +- 2 files changed, 27 insertions(+), 12 deletions(-) diff --git a/guix/read-print.scm b/guix/read-print.scm index 5281878504..732d0dc1f8 100644 --- a/guix/read-print.scm +++ b/guix/read-print.scm @@ -22,13 +22,14 @@ #:use-module (ice-9 rdelim) #:use-module (ice-9 vlist) #:use-module (srfi srfi-1) - #:use-module (srfi srfi-9) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) #:export (pretty-print-with-comments read-with-comments object->string* + blank? + comment comment? comment->string @@ -47,12 +48,26 @@ ;;; Comment-preserving reader. ;;; -;; A comment. -(define-record-type - (string->comment str margin?) - comment? - (str comment->string) - (margin? comment-margin?)) +(define + ;; The parent class for "blanks". + (make-record-type ' '() + (lambda (obj port) + (format port "#" + (number->string (object-address obj) 16))) + #:extensible? #t)) + +(define blank? (record-predicate )) + +(define + ;; Comments. + (make-record-type ' '(str margin?) + #:parent + #:extensible? #f)) + +(define comment? (record-predicate )) +(define string->comment (record-type-constructor )) +(define comment->string (record-accessor 'str)) +(define comment-margin? (record-accessor 'margin?)) (define* (comment str #:optional margin?) "Return a new comment made from STR. When MARGIN? is true, return a margin @@ -66,7 +81,7 @@ end with newline, otherwise an error is raised." (string->comment str margin?)) (define (read-with-comments port) - "Like 'read', but include objects when they're encountered." + "Like 'read', but include objects when they're encountered." ;; Note: Instead of implementing this functionality in 'read' proper, which ;; is the best approach long-term, this code is a layer on top of 'read', ;; such that we don't have to rely on a specific Guile version. @@ -99,7 +114,7 @@ end with newline, otherwise an error is raised." (let/ec return (let liip ((lst '())) (liip (cons (loop (match lst - (((? comment?) . _) #t) + (((? blank?) . _) #t) (_ #f)) (lambda () (return (reverse/dot lst)))) @@ -327,7 +342,7 @@ FORMAT-COMMENT is 'canonicalize-comment'." (and (keyword? item) (not (eq? item #:allow-other-keys)))) (not first?) (not delimited?) - (not (comment? item)))) + (not (blank? item)))) (when newline? (newline port) @@ -335,7 +350,7 @@ FORMAT-COMMENT is 'canonicalize-comment'." (let ((column (if newline? indent column))) (print tail (keyword? item) ;keep #:key value next to one another - (comment? item) + (blank? item) (loop indent column (or newline? delimited?) context diff --git a/guix/scripts/style.scm b/guix/scripts/style.scm index e2530e80c0..5c0ecc0896 100644 --- a/guix/scripts/style.scm +++ b/guix/scripts/style.scm @@ -108,7 +108,7 @@ bailing out~%") (exp exp) (inputs inputs)) (match exp - (((? comment? head) . rest) + (((? blank? head) . rest) (loop (cons head result) rest inputs)) ((head . rest) (match inputs