[bug#49149] [PATCH 4/7] pack: Improve naming of the packs store file names.

[Maxim Cournoyer]

Hello Maxime & Ludovic,

Maxime Devos <maximedevos@telenet.be> writes:

>> I'm not sure how the expansion would be usable in the module it is
>> defined?  It seems I could manage to get 'manifest->friendly-name' to be
>> a procedure returning a gexp, but that gexp wouldn't be readily usable
>> in that module (it could only be used when gexp-unquote from inside
>> another G-Exp), and the expansion in the macro above doesn't bind any
>> identifier, unless I'm missing something?
>
> The macro does two things: define a procedure manifest->friendly-name
> that returns a string.
>
> (define (manifest->friendly-name manifest)
>   "Return a friendly name computed from the entries in MANIFEST, a
>   <manifest> object."
>   (let loop ((names (map manifest-entry-name
>                       (manifest-entries manifest))))
>     (define str (string-join names "-"))
>       (if (< (string-length str) 40)
>           str
>           (match names
>             ((_) str)
>             ((names ... _) (loop names))))))) ;drop one entry
>
> and also define a G-exp define-manifest->friendly-name
>
> (define define-manifest->friendly-nam
>   #~(define (manifest->friendly-name manifes)
>       "Return a friendly name [...]"
>       [...])

Thanks a lot for persevering in your explanations, that made it clear
and with some ideas from the fine folks in #guile was able to come up
with this:

--8<---------------cut here---------------start------------->8---
(define-syntax-rule (define-with-source (variable args ...) body body* ...)
  "Bind VARIABLE to a procedure accepting ARGS defined as BODY, also setting
its source property."
  (begin
    (define (variable args ...)
      body)
    (eval-when (load eval)
      (set-procedure-property! variable 'source
                               '(define (variable args ...) body body* ...)))))

(define-with-source (manifest->friendly-name manifest)
  "Return a friendly name computed from the entries in MANIFEST, a
<manifest> object."
  (let loop ((names (map manifest-entry-name
                         (manifest-entries manifest))))
    (define str (string-join names "-"))
    (if (< (string-length str) 40)
        str
        (match names
          ((_) str)
          ((names ... _) (loop names))))))
--8<---------------cut here---------------end--------------->8---

And then use it inside the build G-Exp via:

#$(procedure-source manifest->friendly-name)

The pack tests are still passing.

Maxim