Hello!
Le samedi 09 novembre 2024 à 14:06 +0100, Maxime Devos a écrit :
> * Define a mapping of module->collected-strings somewhere.
> * Let G_ add things to this mapping, during _expansion_ (syntax-case
> instead of syntax-rules will be needed).
> * Define another macro ‘define-marked-strings’ that, during
> expansion, looks into this mapping, and from its contents constructs
> code that defines the variable.
>
> For hygiene, to avoid state and to make it independent of the module
> system, you could try to make it in the form:
>
> (collect-G-literals marked-strings
> [various definitions])
> -> (begin [various definitions] (defined marked-strings '("bla"
> ...)))
>
> There is something similar to ‘parameterize’ but for macros and
> syntax that may be useful for this, but I’m not sure if it has the
> required semantics.
With your precious help and some digging around, I produced the
attached code. Thank you!
Vivien
;; This solution uses syntax-parameters.
(define-syntax-parameter G_
;; G_ is replaced in the body by a call to a function named
;; “translate”, which is not defined here.
(lambda (sintax)
(syntax-violation 'G_
"G_ used outside of with-exported-string-literals"
sintax)))
(define-syntax-parameter all-string-literals
;; all-string-literals is replaced by the data in the form of a list
;; of calls to cons: (cons context-1 message-1) (cons context-2
;; message-2). So, the result evaluates to a list of pairs.
(lambda (sintax)
(syntax-violation 'all-string-literals
"all-string-literals used outside of with-exported-string-literals"
sintax)))
(define-syntax with-exported-string-literals
;; This big macro will evaluate its guts by replacing calls to G_
;; and all-string-literals.
(lambda (sintax)
;; Whenever G_ expands, its arguments are saved in
;; collected-strings.
(define collected-strings '())
;; This is a convenience function to push a new collected string
;; to the list.
(define (push-collected-string! context message)
(unless (string? message)
(error "only literal string messages are accepted"))
(unless (or (not context)
(string? context))
(error "only optional literal string contexts are accepted"))
(set! collected-strings (cons (cons context message)
collected-strings))
(datum->syntax #f #t))
;; The *push-collected-string!* transformer converts calls to a
;; G_-like macro by first recording the arguments, and then
;; replacing the call with a call to translate.
(define *push-collected-string!*
(lambda (sintax)
(syntax-case sintax ()
((_ context-argument message-argument)
#`(begin
#,(push-collected-string! (syntax->datum #'context-argument)
(syntax->datum #'message-argument))
(translate message-argument #:context context-argument)))
((_ message-argument)
#`(begin
#,(push-collected-string! #f (syntax->datum #'message-argument))
(translate message-argument))))))
;; The *all-collected-string* transformer converts the
;; all-string-literals placeholder with code evaluating to the
;; data: (list (cons "context-1" "message-1") (cons "context-2"
;; "message-2")), because I can’t get the transformer to do (quote
;; ("context-1" . "message-1") ...)
(define *all-collected-strings*
(lambda (sintax)
(syntax-case sintax ()
(_
#`(list
#,@(map
(lambda (item)
#`(cons #,(datum->syntax #f (car item))
#,(datum->syntax #f (cdr item))))
(reverse collected-strings)))))))
;; And now the transformation of the guts to
;; with-exported-string-literals.
(syntax-case sintax ()
((_ body ...)
(with-syntax ((push *push-collected-string!*)
(all *all-collected-strings*))
#'(begin
;; It uses syntax-parameterize.
(syntax-parameterize ((G_ push))
;; I can’t end the syntax-parameterize body with the
;; dots (wtf???) so I end it with a #t. The body does
;; not have access to the all-string-literals form.
body ... #t)
(syntax-parameterize ((all-string-literals all))
(define _i18n:strings
all-string-literals)
(export _i18n:strings))))))))
,expand (with-exported-string-literals
(define (generic-hello)
(display (G_ "greeting" "Hello, world!\\n"))
(newline))
(define (hello-guile-user)
(display (G_ "greeting" "Hello, Guile user!\\n"))
(newline)))
;; Expands to:
#;(begin
(let ()
(define (generic-hello)
(display
(begin
#t ;; This is unfortunate but not a problem
(translate
"Hello, world!\\n"
#:context
"greeting")))
(newline))
(define (hello-guile-user)
(display
(begin
#t
(translate
"Hello, Guile user!\\n"
#:context
"greeting")))
(newline))
#t)
(let ()
(define _i18n:strings ;; It is unfortunate that I can’t produce a quoted S-expr
(list (cons "greeting" "Hello, world!\\n")
(cons "greeting" "Hello, Guile user!\\n")))
;; The rest is to export _i18n:strings:
((@@ (guile) call-with-deferred-observers)
(lambda ()
((@@ (guile) module-export!)
((@@ (guile) current-module))
'(_i18n:strings))))))
