In my previous blog post titled "Literal string interpolation", I've shown how
one can add a simple syntax called fstring
to have variable interpolation in
Guile. Today, I want to go further and incorporate a reader so one don't have
to use the fstring
syntax. I also want to have some kind of heredoc à la bash
where users can specify if they want to trim or not whitespace.
NOTE: Rendering of code on the website is not okay. You can try the code in the REPL it's all valid.
Goals
Simple interpolation
Input
(let ((x 2))
(display #"x^2=@(* x x)")
(newline))
Output
(let ((x 2))
(display (format #f "x^2=~a" (* x x)))
(newline))
Interpolation with whitespaces trimming
Input
(let ((foo 'bar))
(display #@"\
This is a multi-line
heredoc
where whitespaces
are trimmed
and with interpolation
foo=@foo
"))
Output
(let ((foo 'bar))
(display (format #f "This is a multi-line\nheredoc\nwhere whitespaces\nare trimmed\nand with interpolation\nfoo=~a\n" foo)))
Whitespaces trimming without interpolation
Input
(let ((foo 'bar))
(display #@~"\
This is a multi-line
heredoc
where whitespaces are
trimmed
and without interpolation
foo=@foo
"))
Output
(let ((foo 'bar))
(display "This is a multi-line\nheredoc\nwhere whitespaces are\ntrimmed\nand without interpolation\nfoo=@foo\n"))
Tests
Since we've put our goals in term of Scheme code, why not use them as our base for testing?
;;; SPDX-License-Identifier: GPL-3.0-or-later
;;;
;;; Copyright (c) 2022 Olivier Dion <olivier-dion@proton.me>
;;;
;;; Commentary:
;;;
;;; Our code will be in the (fmt) module.
;;;
;;; Code:
(define-module (tests fmt)
#:use-module (fmt)
#:use-module (srfi srfi-64))
(test-begin "(fmt)")
(let ((x 10))
(test-equal "Simple interpolation"
(format #f "x^2=~a" (* x x))
#"x^2=@(* x x)"))
(let ((foo 'bar))
(test-equal "Interpolation with whitespaces trimming"
(format #f
"\
This is a multi-line
heredoc
where whitespaces are
trimmed
and with interpolation
foo=~a
" foo)
#@"\
This is a multi-line
heredoc
where whitespaces are
trimmed
and with interpolation
foo=@foo
"))
(let ((foo 'bar))
(test-equal "Whitespaces trimming without interpolation"
"\
This is a multi-line
heredoc
where whitespaces are
trimmed
and without interpolation
foo=@foo
"
#@~"\
This is a multi-line
heredoc
where whitespaces are
trimmed
and without interpolation
foo=@foo
"))
(test-end "(fmt)")
Extending the reader
Guile allows user to extend the reader using the read-hash-extend
procedure.
It takes two arguments. The first argument is a character that is going to be
used for dispatching to the second argument which is a procedure that takes two
arguments. That procedure receives the character that was used for dispatching
-- since different characters can dispatch to the same procedure -- as its first
argument and the port for reading as its second argument.
For us, we want to dispatch on tree different prefix.
"
@"
@~"
Implementation
Helpers
First, we want to trim whitespaces of each lines. This can easily be implemented like this:
(define (trim-lines-whitespaces text)
(string-join
(map (cut string-trim <> char-set:whitespace)
(string-split text #\newline))
"\n"
'infix))
Second, we want a procedure that will transform a text into an S-exp for formating that text with interpolated expressions.
(define (interpolate-this% text)
(call-with-input-string text
(lambda (port)
(let loop ((new-text '())
(exps '())
(escape? #f))
(let ((chr (get-char port)))
(cond
((eof-object? chr)
(values
(reverse-list->string new-text)
(reverse exps)))
(escape?
(if (char=? chr #\@)
(loop (cons chr new-text) exps #f)
(loop (cons chr (cons #\\ next-text)) exps #f)))
((char=? chr #\\)
(loop new-text exps #t))
((char=? chr #\@)
(loop (cons #\a (cons #\~ new-text))
(cons (read port) exps)
#f))
(else
(loop (cons chr new-text) exps #f))))))))
(define (interpolate-this text)
(receive (fmt args)
(interpolate-this% text)
`(format #f ,fmt ,@args)))
The transformer
We want to transform a string into a new string or a formating of a new string with its arguments. Our transformer will take three arguments. The text to transform and two switches for enabling/disabling interpolation and trimming.
(define (transform text interpolate? trim?)
(cond
((and interpolate? trim?)
(interpolate-this (trim-lines-whitespaces text)))
(interpolate?
(interpolate-this text))
(trim?
(trim-lines-whitespaces text))
(else
text)))
The readers
Finally, we want to simply the life of user by not having to call transform
.
To do this we're going to use the read-hash-extend
procedure to extend Guile's
reader.
(define (read-string/interpolation char port)
(unget-char port char)
(transform (read port) #t #f))
(define (read-heredoc _ port)
(let ((ahead (get-char port)))
(if (char=? ahead #\~)
(transform (read port) #f #t)
(begin
(unget-char port ahead)
(transform (read port) #t #t)))))
(read-hash-extend #\" read-string/interpolation)
(read-hash-extend #\@ read-heredoc)
Also readers are weird beasts, so we have to put all our code in a eval-when
form like this:
(eval-when (expand load eval) ...)
Conclusion
That is it! In this post we've seen that it is quite easy to extend the Guile's
reader so we can have expression interpolation and whitespaces trimming. Our
extensions use some characters that might not make sens for some. I've choose
these characters because paredit in Emacs seems to not get confused about them.
However, it would be nice if we could parameterize the (fmt)
module so users
can select the prefixes that they want to use in their project.
Happy hacking!
Full code
;;; SPDX-License-Identifier: GPL-3.0-or-later
;;;
;;; Copyright (c) 2022 Olivier Dion <olivier-dion@proton.me>
;;;
;;; Commentary:
;;;
;;; Expression interpolation and whitespaces trimming extensions to Guile's
;;; reader.
;;;
;;; The '@' character is used to interpolate an expression in string.
;;;
;;; Strings prefixed with '#' have expressions interpolation.
;;;
;;; Strings prefixed with '#@' have expressions interpolation and whitespaces
;;; are trimmed for each lines.
;;;
;;; Strings prefixed with '#@~' don't have expressions interpolation and
;;; whitespaces are trimmed for each lines.
;;;
;;; Code:
(define-module (fmt)
#:use-module (ice-9 receive)
#:use-module (ice-9 textual-ports)
#:use-module (srfi srfi-26))
(eval-when (expand load eval)
(define (trim-lines-whitespaces text)
(string-join
(map (cut string-trim <> char-set:whitespace)
(string-split text #\newline))
"\n"
'infix))
(define (interpolate-this% text)
(call-with-input-string text
(lambda (port)
(let loop ((new-text '())
(exps '())
(escape? #f))
(let ((chr (get-char port)))
(cond
((eof-object? chr)
(values
(reverse-list->string new-text)
(reverse exps)))
(escape?
(if (char=? chr #\@)
(loop (cons chr new-text) exps #f)
(loop (cons chr (cons #\\ next-text)) exps #f)))
((char=? chr #\\)
(loop new-text exps #t))
((char=? chr #\@)
(loop (cons #\a (cons #\~ new-text))
(cons (read port) exps)
#f))
(else
(loop (cons chr new-text) exps #f))))))))
(define (interpolate-this text)
(receive (fmt args)
(interpolate-this% text)
`(format #f ,fmt ,@args)))
(define (transform text interpolate? trim?)
(cond
((and interpolate? trim?)
(interpolate-this (trim-lines-whitespaces text)))
(interpolate?
(interpolate-this text))
(trim?
(trim-lines-whitespaces text))
(else
text)))
(define (read-string/interpolation char port)
(unget-char port char)
(transform (read port) #t #f))
(define (read-heredoc _ port)
(let ((ahead (get-char port)))
(if (char=? ahead #\~)
(transform (read port) #f #t)
(begin
(unget-char port ahead)
(transform (read port) #t #t)))))
(read-hash-extend #\" read-string/interpolation)
(read-hash-extend #\@ read-heredoc))