read-print: Introduce <blank> parent class of <comment>.
* guix/read-print.scm (<blank>, blank?): New record type. (<comment>): 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?'.
This commit is contained in:
parent
38f1fb843c
commit
5b273e7c77
@ -22,13 +22,14 @@
|
|||||||
#:use-module (ice-9 rdelim)
|
#:use-module (ice-9 rdelim)
|
||||||
#:use-module (ice-9 vlist)
|
#:use-module (ice-9 vlist)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (srfi srfi-9)
|
|
||||||
#:use-module (srfi srfi-34)
|
#:use-module (srfi srfi-34)
|
||||||
#:use-module (srfi srfi-35)
|
#:use-module (srfi srfi-35)
|
||||||
#:export (pretty-print-with-comments
|
#:export (pretty-print-with-comments
|
||||||
read-with-comments
|
read-with-comments
|
||||||
object->string*
|
object->string*
|
||||||
|
|
||||||
|
blank?
|
||||||
|
|
||||||
comment
|
comment
|
||||||
comment?
|
comment?
|
||||||
comment->string
|
comment->string
|
||||||
@ -47,12 +48,26 @@
|
|||||||
;;; Comment-preserving reader.
|
;;; Comment-preserving reader.
|
||||||
;;;
|
;;;
|
||||||
|
|
||||||
;; A comment.
|
(define <blank>
|
||||||
(define-record-type <comment>
|
;; The parent class for "blanks".
|
||||||
(string->comment str margin?)
|
(make-record-type '<blank> '()
|
||||||
comment?
|
(lambda (obj port)
|
||||||
(str comment->string)
|
(format port "#<blank ~a>"
|
||||||
(margin? comment-margin?))
|
(number->string (object-address obj) 16)))
|
||||||
|
#:extensible? #t))
|
||||||
|
|
||||||
|
(define blank? (record-predicate <blank>))
|
||||||
|
|
||||||
|
(define <comment>
|
||||||
|
;; Comments.
|
||||||
|
(make-record-type '<comment> '(str margin?)
|
||||||
|
#:parent <blank>
|
||||||
|
#:extensible? #f))
|
||||||
|
|
||||||
|
(define comment? (record-predicate <comment>))
|
||||||
|
(define string->comment (record-type-constructor <comment>))
|
||||||
|
(define comment->string (record-accessor <comment> 'str))
|
||||||
|
(define comment-margin? (record-accessor <comment> 'margin?))
|
||||||
|
|
||||||
(define* (comment str #:optional margin?)
|
(define* (comment str #:optional margin?)
|
||||||
"Return a new comment made from STR. When MARGIN? is true, return a 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?))
|
(string->comment str margin?))
|
||||||
|
|
||||||
(define (read-with-comments port)
|
(define (read-with-comments port)
|
||||||
"Like 'read', but include <comment> objects when they're encountered."
|
"Like 'read', but include <blank> objects when they're encountered."
|
||||||
;; Note: Instead of implementing this functionality in 'read' proper, which
|
;; 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',
|
;; 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.
|
;; 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/ec return
|
||||||
(let liip ((lst '()))
|
(let liip ((lst '()))
|
||||||
(liip (cons (loop (match lst
|
(liip (cons (loop (match lst
|
||||||
(((? comment?) . _) #t)
|
(((? blank?) . _) #t)
|
||||||
(_ #f))
|
(_ #f))
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(return (reverse/dot lst))))
|
(return (reverse/dot lst))))
|
||||||
@ -327,7 +342,7 @@ FORMAT-COMMENT is 'canonicalize-comment'."
|
|||||||
(and (keyword? item)
|
(and (keyword? item)
|
||||||
(not (eq? item #:allow-other-keys))))
|
(not (eq? item #:allow-other-keys))))
|
||||||
(not first?) (not delimited?)
|
(not first?) (not delimited?)
|
||||||
(not (comment? item))))
|
(not (blank? item))))
|
||||||
|
|
||||||
(when newline?
|
(when newline?
|
||||||
(newline port)
|
(newline port)
|
||||||
@ -335,7 +350,7 @@ FORMAT-COMMENT is 'canonicalize-comment'."
|
|||||||
(let ((column (if newline? indent column)))
|
(let ((column (if newline? indent column)))
|
||||||
(print tail
|
(print tail
|
||||||
(keyword? item) ;keep #:key value next to one another
|
(keyword? item) ;keep #:key value next to one another
|
||||||
(comment? item)
|
(blank? item)
|
||||||
(loop indent column
|
(loop indent column
|
||||||
(or newline? delimited?)
|
(or newline? delimited?)
|
||||||
context
|
context
|
||||||
|
@ -108,7 +108,7 @@ bailing out~%")
|
|||||||
(exp exp)
|
(exp exp)
|
||||||
(inputs inputs))
|
(inputs inputs))
|
||||||
(match exp
|
(match exp
|
||||||
(((? comment? head) . rest)
|
(((? blank? head) . rest)
|
||||||
(loop (cons head result) rest inputs))
|
(loop (cons head result) rest inputs))
|
||||||
((head . rest)
|
((head . rest)
|
||||||
(match inputs
|
(match inputs
|
||||||
|
Loading…
x
Reference in New Issue
Block a user