bug#69998: [PATCH guile-web] libraries: Use guile-gnunet’s real name.

[Maxim Cournoyer]

Hi Florian,

"pelzflorian (Florian Pelz)"  writes:

> Hello Maxim, this patch is confusingly about the Guile website, not
> Guix. ;)  That is https://git.savannah.gnu.org/git/guile/guile-web.git
>
> It uses Guix to generate the Guile package list, where guile-gnunet has
> homepage https://gnu.org/software/guix and is thus called Guix in the
> Guile website library page.  This patch special-cases guile-gnunet like
> other special-case libraries.
>
> Thank you for looking at the patch, though I do not know if you can push
> to guile-web.git.

Nope; you'll want to ping one of the Guile committers, sorry about that!

-- 
Thanks,
Maxim

bug#69998: [PATCH guile-web] libraries: Use guile-gnunet’s real name.

[Maxim Cournoyer]

Hi Florian,

Florian Pelz  writes:

> * website/apps/base/libraries-page.scm (guix->package)[real-name]:
> Add special case.
> ---
>  website/apps/base/libraries-page.scm | 2 +-
>  1 file changed, 1 insertion(+), 1 deletion(-)
>
> diff --git a/website/apps/base/libraries-page.scm 
> b/website/apps/base/libraries-page.scm
> index 6dae8cc..371060e 100644
> --- a/website/apps/base/libraries-page.scm
> +++ b/website/apps/base/libraries-page.scm
> @@ -71,7 +71,7 @@
>"Return the  record corresponding to PKG, a Guix package."
>(define real-name
>  (let ((name (guix:package-name pkg)))
> -  (cond ((member name '("guile-bash" "guile-wm"))
> +  (cond ((member name '("guile-bash" "guile-gnunet" "guile-wm"))
>   name)
>  ((or (string-prefix? "guile-" name)
>   (string-prefix? "guile2.0-" name)
>
> base-commit: 3df4c6d456c92befe672c815a40c645fec496b1f

To which repo is this to be applied?  I expected 'guix-artwork', which
holds the website, but it has no such commit nor libraries-page.scm
file.

-- 
Thanks,
Maxim

bug#69395: GUILE_SYSTEM_PATH and GUILE_SYSTEM_COMPILED_PATH are not documented

[Maxim Cournoyer]

Hi,

libguile's load.c honors the GUILE_SYSTEM_PATH and
GUILE_SYSTEM_COMPILED_PATH environment variables, but these two are not
documented.

-- 
Thanks,
Maxim

bug#67959: Smobs chapter in doc says '“applicable SMOBs” discussed below', which aren't

[Maxim Cournoyer]

Hi,

Reading the chapter on Smobs (info '(guile) Smobs'), it mentions:

> With the exception of the so-called “applicable SMOBs” discussed below,
> smobs are now a legacy interface and are headed for eventual
> deprecation.

But I don't see "applicable" SMOBS being discussed anyhere in the
remaining of the chapter.  Is this category of SMOB still relevant?  Did
I miss anything?

-- 
Thanks,
Maxim

bug#67797: non-free license listed in module/ice-9/psyntax.scm

[Maxim Cournoyer]

Hi,

Mike Gran  writes:

>> Hi Mike,
>
>> Do I understand correctly that any copyright license comes with an
>> implicit "lawful" condition so as to be considered valid, per the law of
>> USA at least?  And that making this explicit is thus not considered a
>> restriction on the use?
>
> That is how I understand it. I am not a lawyer, but, I have had to read a 
> fair number
> of government contracts.

Thank you.  To get confirmation from a more authoritative source, I've
asked the question to same to FSF Licensing & Compliance Team; I'll
report their response if any!

-- 
Thanks,
Maxim

bug#67797: non-free license listed in module/ice-9/psyntax.scm

[Maxim Cournoyer]

Hi Mike,

Mike Gran  writes:

> On Tuesday, December 12, 2023 at 12:51:11 PM PST, Maxim Cournoyer 
>  wrote: 
>>> This confirms my hunch that there is no issue with the license.
>
>>That's great, but... why is it not a problem?  :-)
>
>>When we find out, we should add an explanation next to the license text,
>>why it's deemed alright.
>
> Maxim,
> This is not meant to be plain English, but rather, it is American Legal 
> Nonsense English.
>
> If you changed the text to "may be used for any purpose: lawful or unlawful", 
> then, in USA
> contract/copyright law, the contract is unenforceable because it is illegal.  
> It is not possible
> to be party to an unenforceable contract. If the receiver of the software 
> can't be a party
> to the contract because it is unenforceable, then effectively
> the software can't be open sourced by that copyright statement.

Do I understand correctly that any copyright license comes with an
implicit "lawful" condition so as to be considered valid, per the law of
USA at least?  And that making this explicit is thus not considered a
restriction on the use?

-- 
Thanks,
Maxim

bug#67797: non-free license listed in module/ice-9/psyntax.scm

[Maxim Cournoyer]

Hi David,

"Thompson, David"  writes:

> Hey Maxim,
>
> On Tue, Dec 12, 2023 at 10:53 AM Maxim Cournoyer
>  wrote:
>>
>> Hello,
>>
>> In our syntax-case implementation, module/ice-9/psyntax.scm, the
>> following license text can be found:
>>
>> --8<---cut here---start->8---
>> ;;; Portable implementation of syntax-case
>> ;;; Originally extracted from Chez Scheme Version 5.9f
>> ;;; Authors: R. Kent Dybvig, Oscar Waddell, Bob Hieb, Carl Bruggeman
>>
>> ;;; Copyright (c) 1992-1997 Cadence Research Systems
>> ;;; Permission to copy this software, in whole or in part, to use this
>> ;;; software for any lawful purpose, and to redistribute this software
>> ;;; is granted subject to the restriction that all copies made of this
>> ;;; software must include this copyright notice in full.  This software
>> ;;; is provided AS IS, with NO WARRANTY, EITHER EXPRESS OR IMPLIED,
>> ;;; INCLUDING BUT NOT LIMITED TO IMPLIED WARRANTIES OF MERCHANTABILITY
>> ;;; OR FITNESS FOR ANY PARTICULAR PURPOSE.  IN NO EVENT SHALL THE
>> ;;; AUTHORS BE LIABLE FOR CONSEQUENTIAL OR INCIDENTAL DAMAGES OF ANY
>> ;;; NATURE WHATSOEVER.
>> --8<---cut here---end--->8---
>>
>> Due to restricting the use to "lawful purpose", it conflicts with the
>> (L)GPL, as it places restrictions on running the program.
>
> I don't think this is true. Surely if it was it never would have made
> it into Guile, right? I mean... this is GNU we're talking about here
> and psyntax has been around awhile! Having been immediately nerdsniped
> by this email, I had to quickly do some research.
>
> A 'git blame' dates the quoted license text back to 1998, commit
> a63812a2fef2f81b8c4eca04c858e42b62e455f9, by Jim Blandy.
>
> Commit message:
>
> Talked to Stallman.  Actually, the syntax-case copyright is no problem.  Duh.
> * Makefile.am (ice9_sources): Revert last change.
> * syncase.scm, psyntax.pp, psyntax.ss: Added again.
> * Makefile.in: Regeneretade.
>
> This confirms my hunch that there is no issue with the license.

That's great, but... why is it not a problem?  :-)

When we find out, we should add an explanation next to the license text,
why it's deemed alright.

-- 
Thanks,
Maxim

bug#67797: non-free license listed in module/ice-9/psyntax.scm

[Maxim Cournoyer]

Hello,

In our syntax-case implementation, module/ice-9/psyntax.scm, the
following license text can be found:

--8<---cut here---start->8---
;;; Portable implementation of syntax-case
;;; Originally extracted from Chez Scheme Version 5.9f
;;; Authors: R. Kent Dybvig, Oscar Waddell, Bob Hieb, Carl Bruggeman

;;; Copyright (c) 1992-1997 Cadence Research Systems
;;; Permission to copy this software, in whole or in part, to use this
;;; software for any lawful purpose, and to redistribute this software
;;; is granted subject to the restriction that all copies made of this
;;; software must include this copyright notice in full.  This software
;;; is provided AS IS, with NO WARRANTY, EITHER EXPRESS OR IMPLIED,
;;; INCLUDING BUT NOT LIMITED TO IMPLIED WARRANTIES OF MERCHANTABILITY
;;; OR FITNESS FOR ANY PARTICULAR PURPOSE.  IN NO EVENT SHALL THE
;;; AUTHORS BE LIABLE FOR CONSEQUENTIAL OR INCIDENTAL DAMAGES OF ANY
;;; NATURE WHATSOEVER.
--8<---cut here---end--->8---

Due to restricting the use to "lawful purpose", it conflicts with the
(L)GPL, as it places restrictions on running the program.

Perhaps there are alternative, clean implementations out there under a
suitable license we could use?

-- 
Thanks,
Maxim

bug#66776: SRFI-64 test-error doesn't match error types

[Maxim Cournoyer]

Hi Taylan,

Taylan Kammer  writes:

> On 27.10.2023 20:40, Maxim Cournoyer wrote:
>> 
>> There is a more modern implementation of SRFI-64 out there for Guile
>> which may provide clues or be used wholesale, though I haven't tried it:
>> <https://codeberg.org/taylan/scheme-srfis/src/branch/master/srfi/64>.
>> 
>
> FYI, this is how I check whether a caught error matches the 'type':
>
> (define (error-matches? error type)
>   (cond
>((eq? type #t)
> #t)
>((condition-type? type)
> (and (condition? error) (condition-has-type? error type)))
>((procedure? type)
> (type error))
>(else
> (let ((runner (test-runner-get)))
>   ((%test-runner-on-bad-error-type runner) runner type error))
> #f)))
>
> Defined on Line 336 in execution.body.scm:
>
> https://codeberg.org/taylan/scheme-srfis/src/branch/master/srfi/64/execution.body.scm#L336
>
> In summary, other than #t to match anything, 'type' can be:
>
> - A SRFI 35 condition-type object
>
> - A procedure, which will be called as a predicate on the error
>
> The predicate case should cover the Guile and R6RS exception systems,
> which both simply use predicates to detect condition/exception type
> from what I can tell:
>
> https://www.gnu.org/software/guile/manual/html_node/Exception-Objects.html
>
> https://www.gnu.org/software/guile/manual/html_node/rnrs-conditions.html

I've tried your SRFI 64 R7RS implementation, and it passes my earlier
tests:

--8<---cut here---start->8---
scheme@(guile-user)> (use-modules (srfi srfi-64))
scheme@(guile-user)> (test-begin "test")
(test-error "testing" 'bad (throw 'oops))
(test-end "test")
Writing log file: test.srfi64.log
Test suite begin: test
$1 = ("test")
WARNING: unknown error type predicate: bad
 error was: #< components: (#<> #< 
irritants: ()> #< kind: oops args: ()>)>
[FAIL] test: testing
#f:2: (throw (quote oops))
Expected error: bad
Raised error: #< components: (#<> #< 
irritants: ()> #< kind: oops args: ()>)>

Test suite end: test
Passes:0
Expected failures: 0
Failures:  1
Unexpected passes: 0
Skipped tests: 0
Wrote log file: test.srfi64.log
scheme@(guile-user)> (use-modules (ice-9 exceptions) (srfi srfi-64))

(define-exception-type 
  ;parent
  make-my-exception ;constructor
  my-exception?);predicate

(test-begin "test-error exception types")

;; Passes, but should fail.
(test-error " raised"
  
  (raise-exception (make-error)))

;; OR

;; Unimplemented, but passes also.
(test-error " raised"
  my-exception?
  (raise-exception (make-error)))

(test-begin "test-error exception types")
Writing log file: test.srfi64.log
Test suite begin: test-error exception types
$2 = ("test-error exception types")
[FAIL] test-error exception types:  raised
#f:14: (raise-exception (make-error))
Expected error: #
Raised error: #<>

[FAIL] test-error exception types:  raised
#f:21: (raise-exception (make-error))
Expected error: #
Raised error: #<>

$3 = ("test-error exception types" "test-error exception types")
--8<---cut here---end--->8---

I'll send the patch upgrading our SRFI 64 implementation to it soon.

-- 
Thanks,
Maxim

bug#65363: Missing support for (library ...) match condition in 'cond-expand'

[Maxim Cournoyer]

Hi,

Zhu Zihao  writes:

> In R7RS, page 14, section 4.2.1 Conditionals. The form 'cond-expand' can
> accept following conditions
>
> ```
> A  takes one of the following forms:
>
> - 
> - (library )
> - (and  ...)
> - (or  ...)
> - (not )
> ```
>
> The form (library ) is used to test whether a R7RS library
> named  exists or not. For example:
>
> ```
> (cond-expand
>  ((library (srfi srfi-1))
>   (display "Yes, we have SRFI-1.\n")))
> ```
>
> However, this form is currently not supported by Guile. Supporting this
> form can help Guile use portable R7RS library more smoothly.

I'm not sure what doesn't work with the above example; it should work
when used within a define-library, per this 2020 commit:

--8<---cut here---start->8---
commit fd2ffc649c2d08639c2ac41c25e4ebdbeb4b151d
Date:   Sun Jan 12 20:14:30 2020 +0100

Support R7RS define-library
--8<---cut here---end--->8---

I've found it had a few omissions, which I've corrected locally, such as
not handling 'else' clauses or (srfi N) names, but your example should
have worked, AFAIK.

If trying 'cond-expand' from the REPL, you'll want to ,use (scheme base)
to get the newer cond-expand definition shadow the SRFI 0 one that is
defined in (guile).

-- 
Thanks,
Maxim

bug#67412: [PATCH v2 2/2] r7rs-libraries: Better support R7RS SRFI library names.

[Maxim Cournoyer]

* module/ice-9/r6rs-libraries.scm
(resolve-r6rs-interface : Relax symbol requirements.
Return a symbol.
: Add a new syntax matching clause to avoid stripping the
3rd identifier in a R7RS SRFI module name.
(library): Move R7RS specifics to...
* module/ice-9/r7rs-libraries.scm (define-library): ... here.
r6rs-name, r7rs-import->r6rs-import>: New nested procedures,
used to translate the library name and import sets.
* test-suite/tests/rnrs-libraries.test ("import features")
<"renaming works">: Extend test.
<"import works">: New test.

Fixes: https://bugs.gnu.org/67412
---

Changes in v2:
 - Leave/improve some R7RS SRFI handling in r6rs-libraries, for 'import'
 - New 'import' test

 module/ice-9/r6rs-libraries.scm  | 86 
 module/ice-9/r7rs-libraries.scm  | 48 +++-
 test-suite/tests/rnrs-libraries.test | 12 +++-
 3 files changed, 81 insertions(+), 65 deletions(-)

diff --git a/module/ice-9/r6rs-libraries.scm b/module/ice-9/r6rs-libraries.scm
index f27b07841..f02b13516 100644
--- a/module/ice-9/r6rs-libraries.scm
+++ b/module/ice-9/r6rs-libraries.scm
@@ -44,9 +44,9 @@
   (define (srfi-name? stx)
 (syntax-case stx (srfi)
   ((srfi n rest ...)
-   (and (and-map sym? #'(rest ...))
-(or (n? #'n)
-(colon-n? #'n
+   (cond ((n? #'n) 'r7rs)
+ ((colon-n? #'n) 'r6rs)
+ (else #f)))
   (_ #f)))
 
   (define (module-name? stx)
@@ -85,10 +85,19 @@
   (module-and-uses mod)))
 
   (syntax-case import-spec (library only except prefix rename srfi)
-;; (srfi :n ...) -> (srfi srfi-n ...)
+;; XXX: This is R7RS-specific, but it's here since we want the
+;; `import' procedure below to accept (srfi 64) as well as
+;; (srfi :64).
+;;
 ;; (srfi n ...) -> (srfi srfi-n ...)
 ((library (srfi n rest ... (version ...)))
- (srfi-name? #'(srfi n rest ...))
+ (eq? 'r7rs (srfi-name? #'(srfi n rest ...)))
+ (let ((srfi-n (make-srfi-n #'srfi #'n)))
+   (resolve-r6rs-interface
+#`(library (srfi #,srfi-n rest ... (version ...))
+;; (srfi :n ...) -> (srfi srfi-n ...)
+((library (srfi n rest ... (version ...)))
+ (eq? 'r6rs (srfi-name? #'(srfi n rest ...)))
  (let ((srfi-n (make-srfi-n #'srfi #'n)))
(resolve-r6rs-interface
 (syntax-case #'(rest ...) ()
@@ -98,7 +107,7 @@
;; SRFI 97 says that the first identifier after the `n'
;; is used for the libraries name, so it must be ignored.
#`(library (srfi #,srfi-n rest ... (version ...
-
+
 ((library (name name* ... (version ...)))
  (and-map sym? #'(name name* ...))
  (resolve-interface (syntax->datum #'(name name* ...))
@@ -107,7 +116,7 @@
 ((library (name name* ...))
  (and-map sym? #'(name name* ...))
  (resolve-r6rs-interface #'(library (name name* ... ()
-
+
 ((only import-set identifier ...)
  (and-map sym? #'(identifier ...))
  (let* ((mod (resolve-r6rs-interface #'import-set))
@@ -121,7 +130,7 @@
  (hashq-set! (module-replacements iface) sym #t)))
  (syntax->datum #'(identifier ...)))
iface))
-
+
 ((except import-set identifier ...)
  (and-map sym? #'(identifier ...))
  (let* ((mod (resolve-r6rs-interface #'import-set))
@@ -182,7 +191,7 @@
  (module-remove! iface from)
  (hashq-remove! replacements from)
  (lp (cdr in) (cons (vector to replace? var) out
-
+
 ((name name* ... (version ...))
  (module-name? #'(name name* ...))
  (resolve-r6rs-interface #'(library (name name* ... (version ...)
@@ -196,45 +205,11 @@
 (define (sym? stx)
   (symbol? (syntax->datum stx)))
 
-(define (n? stx)
-  (let ((n (syntax->datum stx)))
-(and (exact-integer? n)
- (not (negative? n)
-
-(define (colon-n? x)
-  (let ((sym (syntax->datum x)))
-(and (symbol? sym)
- (let ((str (symbol->string sym)))
-   (and (string-prefix? ":" str)
-(let ((num (string->number (substring str 1
-  (and (exact-integer? num)
-   (not (negative? num)
-
-(define (srfi-name? stx)
-  (syntax-case stx (srfi)
-((srfi n rest ...)
- (and (and-map sym? #'(rest ...))
-  (or (n? #'n)
-  (colon-n? #'n
-(_ #f)))
-
 (define (module-name? stx)
-  (or (srfi-name? stx)
-  (syntax-case stx ()
-((name name* ...)
- (and-map sym? #'(name name* ...)))
-(_ #f
-
-(define (make-srfi-n context n)
-  (datum->syntax
-   context
-   (string->symbol
-(string-append
- "srfi-"
- (let ((n (syntax->datum n)))
-   (if (symbol? n)
-   (substring (symbol->string n) 1)
-   (number->string n)))
+  

bug#67412: [PATCH v2 1/2] Use R7RS 'rename' syntax for exports.

[Maxim Cournoyer]

From: Timothy Sample 

* module/ice-9/r7rs-libraries.scm (define-library): Convert R7RS
exports to R6RS exports before passing them on to 'library'.

Fixes: https://bugs.gnu.org/67255
Reported-by: Maxim Cournoyer .
Modified-by: Maxim Cournoyer 
---

(no changes since v1)

 module/ice-9/r7rs-libraries.scm | 10 --
 1 file changed, 8 insertions(+), 2 deletions(-)

diff --git a/module/ice-9/r7rs-libraries.scm b/module/ice-9/r7rs-libraries.scm
index 63a300a26..429d82ad9 100644
--- a/module/ice-9/r7rs-libraries.scm
+++ b/module/ice-9/r7rs-libraries.scm
@@ -1,5 +1,5 @@
 ;; R7RS library support
-;;  Copyright (C) 2020, 2021 Free Software Foundation, Inc.
+;;  Copyright (C) 2020, 2021, 2023 Free Software Foundation, Inc.
 ;;
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
@@ -97,12 +97,18 @@
((decl ...)
 (partition-decls #'(decl ... . decls) exports imports code))
 
+(define (r7rs-export->r6rs-export export-spec)
+  (syntax-case export-spec (rename)
+((rename from-identifier to-identifier)
+ #'(rename (from-identifier to-identifier)))
+(identifier #'identifier)))
+
 (syntax-case stx ()
   ((_ name decl ...)
(call-with-values (lambda ()
(partition-decls #'(decl ...) '() '() '()))
  (lambda (exports imports code)
#`(library name
-   (export . #,exports)
+   (export . #,(map r7rs-export->r6rs-export exports))
(import . #,imports)
. #,code)))

base-commit: d579848cb5d65440af5afd9c8968628665554c22
-- 
2.41.0

bug#67255: [PATCH v2] Use R7RS 'rename' syntax for exports.

[Maxim Cournoyer]

From: Timothy Sample 

* module/ice-9/r7rs-libraries.scm (define-library): Convert R7RS
exports to R6RS exports before passing them on to 'library'.

Fixes: https://bugs.gnu.org/67255
Reported-by: Maxim Cournoyer .
Modified-by: Maxim Cournoyer 
---

Changes in v2:
 - Improve pattern variable names

 module/ice-9/r7rs-libraries.scm | 10 --
 1 file changed, 8 insertions(+), 2 deletions(-)

diff --git a/module/ice-9/r7rs-libraries.scm b/module/ice-9/r7rs-libraries.scm
index 63a300a26..429d82ad9 100644
--- a/module/ice-9/r7rs-libraries.scm
+++ b/module/ice-9/r7rs-libraries.scm
@@ -1,5 +1,5 @@
 ;; R7RS library support
-;;  Copyright (C) 2020, 2021 Free Software Foundation, Inc.
+;;  Copyright (C) 2020, 2021, 2023 Free Software Foundation, Inc.
 ;;
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
@@ -97,12 +97,18 @@
((decl ...)
 (partition-decls #'(decl ... . decls) exports imports code))
 
+(define (r7rs-export->r6rs-export export-spec)
+  (syntax-case export-spec (rename)
+((rename from-identifier to-identifier)
+ #'(rename (from-identifier to-identifier)))
+(identifier #'identifier)))
+
 (syntax-case stx ()
   ((_ name decl ...)
(call-with-values (lambda ()
(partition-decls #'(decl ...) '() '() '()))
  (lambda (exports imports code)
#`(library name
-   (export . #,exports)
+   (export . #,(map r7rs-export->r6rs-export exports))
(import . #,imports)
. #,code)))

base-commit: d579848cb5d65440af5afd9c8968628665554c22
-- 
2.41.0

bug#67412: [PATCH 1/2] Use R7RS 'rename' syntax for exports.

[Maxim Cournoyer]

From: Timothy Sample 

* module/ice-9/r7rs-libraries.scm (define-library): Convert R7RS
exports to R6RS exports before passing them on to 'library'.

Fixes: https://bugs.gnu.org/67255
Reported-by: Maxim Cournoyer .
---

 module/ice-9/r7rs-libraries.scm | 9 +++--
 1 file changed, 7 insertions(+), 2 deletions(-)

diff --git a/module/ice-9/r7rs-libraries.scm b/module/ice-9/r7rs-libraries.scm
index 63a300a26..f8b6b4c59 100644
--- a/module/ice-9/r7rs-libraries.scm
+++ b/module/ice-9/r7rs-libraries.scm
@@ -1,5 +1,5 @@
 ;; R7RS library support
-;;  Copyright (C) 2020, 2021 Free Software Foundation, Inc.
+;;  Copyright (C) 2020, 2021, 2023 Free Software Foundation, Inc.
 ;;
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
@@ -97,12 +97,17 @@
((decl ...)
 (partition-decls #'(decl ... . decls) exports imports code))
 
+(define (r7rs-export->r6rs-export export)
+  (syntax-case export (rename)
+((rename internal external) #'(rename (internal external)))
+(_ export)))
+
 (syntax-case stx ()
   ((_ name decl ...)
(call-with-values (lambda ()
(partition-decls #'(decl ...) '() '() '()))
  (lambda (exports imports code)
#`(library name
-   (export . #,exports)
+   (export . #,(map r7rs-export->r6rs-export exports))
(import . #,imports)
. #,code)))

base-commit: d579848cb5d65440af5afd9c8968628665554c22
-- 
2.41.0

bug#67412: [PATCH 2/2] r7rs-libraries: Better support R7RS SRFI library names.

[Maxim Cournoyer]

* module/ice-9/r6rs-libraries.scm (resolve-r6rs-interface)
(library): Move R7RS specifics to...
* module/ice-9/r7rs-libraries.scm (define-library): ... here.
r6rs-name, r7rs-import->r6rs-import>: New nested procedures,
used to translate the library name and import sets.
* test-suite/tests/rnrs-libraries.test ("import features"): Add a test.

Fixes: https://bugs.gnu.org/67412
---

 module/ice-9/r6rs-libraries.scm | 25 +++--
 module/ice-9/r7rs-libraries.scm | 48 +++--
 2 files changed, 50 insertions(+), 23 deletions(-)

diff --git a/module/ice-9/r6rs-libraries.scm b/module/ice-9/r6rs-libraries.scm
index f27b07841..78b3dfcfb 100644
--- a/module/ice-9/r6rs-libraries.scm
+++ b/module/ice-9/r6rs-libraries.scm
@@ -27,11 +27,6 @@
   (define (sym? stx)
 (symbol? (syntax->datum stx)))
 
-  (define (n? stx)
-(let ((n (syntax->datum stx)))
-  (and (exact-integer? n)
-   (not (negative? n)
-
   (define (colon-n? x)
 (let ((sym (syntax->datum x)))
   (and (symbol? sym)
@@ -45,8 +40,7 @@
 (syntax-case stx (srfi)
   ((srfi n rest ...)
(and (and-map sym? #'(rest ...))
-(or (n? #'n)
-(colon-n? #'n
+(colon-n? #'n)))
   (_ #f)))
 
   (define (module-name? stx)
@@ -63,9 +57,7 @@
   (string-append
"srfi-"
(let ((n (syntax->datum n)))
- (if (symbol? n)
- (substring (symbol->string n) 1)
- (number->string n)))
+ (substring (symbol->string n) 1))
 
   (define (make-custom-interface mod)
 (let ((iface (make-module)))
@@ -86,7 +78,6 @@
 
   (syntax-case import-spec (library only except prefix rename srfi)
 ;; (srfi :n ...) -> (srfi srfi-n ...)
-;; (srfi n ...) -> (srfi srfi-n ...)
 ((library (srfi n rest ... (version ...)))
  (srfi-name? #'(srfi n rest ...))
  (let ((srfi-n (make-srfi-n #'srfi #'n)))
@@ -196,11 +187,6 @@
 (define (sym? stx)
   (symbol? (syntax->datum stx)))
 
-(define (n? stx)
-  (let ((n (syntax->datum stx)))
-(and (exact-integer? n)
- (not (negative? n)
-
 (define (colon-n? x)
   (let ((sym (syntax->datum x)))
 (and (symbol? sym)
@@ -214,8 +200,7 @@
   (syntax-case stx (srfi)
 ((srfi n rest ...)
  (and (and-map sym? #'(rest ...))
-  (or (n? #'n)
-  (colon-n? #'n
+  (colon-n? #'n)))
 (_ #f)))
 
 (define (module-name? stx)
@@ -232,9 +217,7 @@
 (string-append
  "srfi-"
  (let ((n (syntax->datum n)))
-   (if (symbol? n)
-   (substring (symbol->string n) 1)
-   (number->string n)))
+   (substring (symbol->string n) 1))
 
 (define (compute-exports ifaces specs)
   (define (re-export? sym)
diff --git a/module/ice-9/r7rs-libraries.scm b/module/ice-9/r7rs-libraries.scm
index f8b6b4c59..f2692b833 100644
--- a/module/ice-9/r7rs-libraries.scm
+++ b/module/ice-9/r7rs-libraries.scm
@@ -102,12 +102,56 @@
 ((rename internal external) #'(rename (internal external)))
 (_ export)))
 
+(define (r7rs-name->r6rs-name name)
+  ;; This is a hack to support (srfi N x ...) modules in R7RS.  The
+  ;; longer term solution would be to add support at the level of
+  ;; resolve-interface (bug #40371).
+  (define (n? stx)
+(let ((n (syntax->datum stx)))
+  (and (exact-integer? n)
+   (not (negative? n)
+
+  (define (srfi-name? stx)
+(syntax-case stx (srfi)
+  ((srfi n rest ...)
+   (n? #'n))
+  (_ #f)))
+
+  (define (make-srfi-n context n)
+(datum->syntax
+ context
+ (string->symbol
+  (string-append
+   "srfi-"
+   (let ((n (syntax->datum n)))
+ (number->string n))
+
+  (syntax-case name (srfi)
+;; (srfi n ...) -> (srfi srfi-n ...)
+((srfi n rest ...) (srfi-name? #'(srfi n rest ...))
+ #`(srfi #,(make-srfi-n #'srfi #'n) rest ...))
+(_ name)))
+
+(define (r7rs-import->r6rs-import import-set)
+  ;; Normalize SRFI names.
+  (syntax-case import-set (only except prefix rename)
+((only import-set identifier ...)
+ #`(only #,(r7rs-import->r6rs-import #'import-set) identifier ...))
+((except import-set identifier ...)
+ #`(except #,(r7rs-import->r6rs-import #'import-set) identifier ...))
+((prefix import-set identifier ...)
+ #`(prefix #,(r7rs-import->r6rs-import #'import-set) identifier ...))
+((rename import-set (from-identifier to-identifier) ...)
+ #`(rename #,(r7rs-import->r6rs-import #'import-set)
+   (from-identifier to-identifier) ...))
+(_ (r7rs-name->r6rs-name import-set
+
 (syntax-case stx ()
   ((_ name decl ...)
(call-with-values (lambda ()
(partition-decls 

bug#40371: [R7RS] Guile does not accept library name parts that are non-negative exact integers

[Maxim Cournoyer]

Hi,

Maxim Cournoyer  writes:

> Hello,
>
> Martin Becze  writes:
>
>> Here is a patch that makes things usable for srfi's. (import (srfi
>> )) will work. It just remove the guard condition that was catching
>> the Integers. Does anyone know why the guard was there and if it is
>> really needed?
>
> Is still still an issue when working with R7RS .sld libraries?  It's
> been possible to use e.g. (import (srfi 64)) since commit 2cca09126,
> dated September 2019.  This is handled in (ice-9 r6rs-libraries), so not
> generally available, but it is in the context of a define-library
> definition.
>
> Let us know if the problem is solved on your side, and if so, let's
> close this issue!

I now understand it works in a very limited way.  For example, (srfi 64)
works, but (srfi 160 u8) doesn't, and if someone came up with any other
valid R7RS module name such as (anything 9) it would not work.  The
current support is done at r6rs-libraries.scm (which is kind of the
wrong place to do it as well).

I think there is value addressing it in the core resolve-interface to
better support R7RS libraries.

-- 
Thanks,
Maxim

bug#67412: (resolve-r6rs-interface '(srfi 160 u8) tries to load (srfi srfi-160)

[Maxim Cournoyer]

Hi,

Investigating, I've found this:

--8<---cut here---start->8---
trace: |  (_ # (160 (u8) ()))
trace: |  (_ 160 (u8) ())
trace: |  |  (syntax->datum 160)
trace: |  |  (strip 160)
trace: |  |  |  (syntax? 160)
trace: |  |  |  #f
trace: |  |  160
trace: |  |  (number->string 160)
trace: |  |  "160"
trace: |  |  (string-append "srfi-" "160")
trace: |  |  "srfi-160"
trace: |  |  (datum->syntax # srfi-160)
trace: |  |  |  (syntax-wrap #)
trace: |  |  |  ((top) #(ribcage #(n rest version) #((top) (top) (top)) 
#("l-680b775fb37a463-160b" "l-680b775fb37a463-160c" "l-680b775fb37a463-160d")) 
#(ribcage (module-for-each/nonlocal # make-srfi-n # …) …) …)
trace: |  |  |  (syntax-module #)
trace: |  |  |  (hygiene guile)
trace: |  |  |  (source-properties srfi-160)
trace: |  |  |  ()
trace: |  |  (make-syntax srfi-160 ((top) #(ribcage #(n rest version) #((top) 
(top) (top)) #("l-680b775fb37a463-160b" "l-680b775fb37a463-160c" 
"l-680b775fb37a463-160d")) #(ribcage (# # make-srfi-n # # …) …) …) …)
trace: |  |  #
trace: |  |  ($sc-dispatch (u8) ())
trace: |  |  |  (syntax? (u8))
trace: |  |  |  #f
trace: |  |  (match* (u8) () (()) () #f)
trace: |  |  #f
trace: |  |  ($sc-dispatch (u8) (any . each-any))
trace: |  |  |  (syntax? (u8))
trace: |  |  |  #f
trace: |  |  (match* (u8) (any . each-any) (()) () #f)
trace: |  |  |  (match () each-any (()) () #f)
trace: |  |  |  |  (syntax? ())
trace: |  |  |  |  #f
trace: |  |  |  (match* () each-any (()) () #f)
trace: |  |  |  |  (match-each-any () (()) #f)
trace: |  |  |  |  ()
trace: |  |  |  (())
trace: |  |  (match u8 any (()) (()) #f)
trace: |  |  |  (source-wrap u8 (()) #f #f)
trace: |  |  |  u8
trace: |  |  (u8 ())
trace: |  |  (_ # (u8 ()))
trace: |  |  (_ u8 ())
trace: |  |  |  (append () (()))
trace: |  |  |  (())
--8<---cut here---end--->8---

This corresponds to this source:

--8<---cut here---start->8---
 (syntax-case import-spec (library only except prefix rename srfi)
;; (srfi :n ...) -> (srfi srfi-n ...)
;; (srfi n ...) -> (srfi srfi-n ...)
((library (srfi n rest ... (version ...)))
 (srfi-name? #'(srfi n rest ...))
 (let ((srfi-n (make-srfi-n #'srfi #'n)))
   (resolve-r6rs-interface
(syntax-case #'(rest ...) ()
  (()
   #`(library (srfi #,srfi-n (version ...
  ((name rest ...)
   ;; SRFI 97 says that the first identifier after the `n'
   ;; is used for the libraries name, so it must be ignored.
   #`(library (srfi #,srfi-n rest ... (version ...
...
--8<---cut here---end--->8---

Notice the comment mentioning that the first identifier following 'n' is
ignored.  That seems wrong, at least in the context of R7RS libraries.

-- 
Thanks,
Maxim

bug#67412: (resolve-r6rs-interface '(srfi 160 u8) tries to load (srfi srfi-160)

[Maxim Cournoyer]

Hello,

While working on integrating SRFI 178, I've encountered the following
problem:

--8<---cut here---start->8---
Backtrace:
In system/base/compile.scm:
 53:4 19 (call-once #)
In ice-9/boot-9.scm:
  1755:12 18 (with-exception-handler # ?)
In system/base/compile.scm:
69:11 17 (_)
   190:11 16 (_ #)
309:6 15 (read-and-compile # #:from ?)
   331:39 14 (with-compiler #< name: scheme title: "Schem?> ?)
   261:27 13 (_ # ?)
In ice-9/boot-9.scm:
   2919:4 12 (save-module-excursion #)
In language/scheme/compile-tree-il.scm:
31:15 11 (_)
In ice-9/psyntax.scm:
  1229:36 10 (expand-top-sequence (#) ?)
  1121:20  9 (lp (#) ?)
  1342:32  8 (syntax-type (# ?) ?)
  1562:32  7 (expand-macro # ?)
In ice-9/r6rs-libraries.scm:
   304:14  6 (_ # (#) ?)
In ice-9/boot-9.scm:
   222:29  5 (map1 (# ?))
   222:29  4 (map1 (# ?))
   222:29  3 (map1 (# ?))
   222:17  2 (map1 (#))
   3413:6  1 (resolve-interface (srfi srfi-160) #:select _ #:hide _ # ?)
  1676:22  0 (lp 0)

ice-9/boot-9.scm:1676:22: In procedure lp:
no code for module (srfi srfi-160)
--8<---cut here---end--->8---

Indeed, there's no such (srfi 160) module in SRFI 160, but why is it
loaded in the first place?  My srfi-178.sld R7RS library imports:

--8<---cut here---start->8---
(define-library (srfi 178)
  (import (scheme base))
  (import (scheme case-lambda))
  (import (srfi 151))
  (import (srfi 160 u8))
  ...
--8<---cut here---end--->8---

There seems to be something that doesn't work as expected in the (ice-9
r6rs-libraries) module:

--8<---cut here---start->8---
(resolve-r6rs-interface '(srfi 160 u8))
ERROR: no code for module (srfi srfi-160)
--8<---cut here---end--->8---

(srfi 160) should not be loaded; it's (srfi 160 u8) that is requested.

-- 
Thanks,
Maxim

bug#40371: [R7RS] Guile does not accept library name parts that are non-negative exact integers

[Maxim Cournoyer]

Hello,

Martin Becze  writes:

> Here is a patch that makes things usable for srfi's. (import (srfi
> )) will work. It just remove the guard condition that was catching
> the Integers. Does anyone know why the guard was there and if it is
> really needed?

Is still still an issue when working with R7RS .sld libraries?  It's
been possible to use e.g. (import (srfi 64)) since commit 2cca09126,
dated September 2019.  This is handled in (ice-9 r6rs-libraries), so not
generally available, but it is in the context of a define-library
definition.

Let us know if the problem is solved on your side, and if so, let's
close this issue!

-- 
Thanks,
Maxim

bug#67255: define-library does not support 'rename' directives

[Maxim Cournoyer]

Hello!

Timothy Sample  writes:

> Timothy Sample  writes:
>
>> Maxim Cournoyer  writes:
>>
>>> Our R7RS define-library syntax, from (ice-9 r7rs-library) does not
>>> support renaming bindings to export, via 'rename' directives.
>>
>> I appreciate your R7RS debugging effort.  Thanks!
>
> Actions speak louder than words, so here’s a patch!
>
> The ‘define-library’ syntax uses the R6RS ‘library’ syntax under the
> hood.  TIL that R6RS and R7RS have different syntax for 'rename'.  In
> R6RS, you write:
>
> (export (rename (internal external)))
>
> while in R7RS, it’s:
>
> (export (rename internal external))
>
> My patch adds a conversion step to deal with this difference.

Oh, excellent, thank you!

>>From b87bf8910ac8e75dc0ec63cb7385ddf199fd400c Mon Sep 17 00:00:00 2001
> From: Timothy Sample 
> Date: Mon, 20 Nov 2023 11:01:08 -0600
> Subject: [PATCH] Use R7RS 'rename' syntax for exports.
>
> Fixes <https://bugs.gnu.org/67255>.
> Reported by Maxim Cournoyer .

Nitpick: at least 'Reported-by' is a common git trailer, and these
must appear at the bottom of the git commit.

> * module/ice-9/r7rs-libraries.scm (define-library): Convert R7RS
> exports to R6RS exports before passing them on to 'library'.
> ---
>  module/ice-9/r7rs-libraries.scm | 9 +++--
>  1 file changed, 7 insertions(+), 2 deletions(-)
>
> diff --git a/module/ice-9/r7rs-libraries.scm b/module/ice-9/r7rs-libraries.scm
> index 63a300a26..f8b6b4c59 100644
> --- a/module/ice-9/r7rs-libraries.scm
> +++ b/module/ice-9/r7rs-libraries.scm
> @@ -1,5 +1,5 @@
>  ;; R7RS library support
> -;;  Copyright (C) 2020, 2021 Free Software Foundation, Inc.
> +;;  Copyright (C) 2020, 2021, 2023 Free Software Foundation, Inc.
>  ;;
>  ;; This library is free software; you can redistribute it and/or
>  ;; modify it under the terms of the GNU Lesser General Public
> @@ -97,12 +97,17 @@
> ((decl ...)
>  (partition-decls #'(decl ... . decls) exports imports code))
>  
> +(define (r7rs-export->r6rs-export export)
> +  (syntax-case export (rename)
> +((rename internal external) #'(rename (internal external)))
> +(_ export)))
> +
>  (syntax-case stx ()
>((_ name decl ...)
> (call-with-values (lambda ()
> (partition-decls #'(decl ...) '() '() '()))
>   (lambda (exports imports code)
> #`(library name
> -   (export . #,exports)
> +   (export . #,(map r7rs-export->r6rs-export exports))
> (import . #,imports)
> . #,code)))

It at least works for my use case (SRFI 128), so it's for sure an
improvement :-).  You can see it in action in the series I've sent today.

-- 
Thanks,
Maxim

bug#66046: [PATCH v3 1/3] libguile/fports.c: Remove extraneous include.

[Maxim Cournoyer]

* libguile/fports.c: Delete "hashtab.h" include, which is unused.
---

(no changes since v1)

 libguile/fports.c | 1 -
 1 file changed, 1 deletion(-)

diff --git a/libguile/fports.c b/libguile/fports.c
index 9d4ca6ace..8f19216b7 100644
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -52,7 +52,6 @@
 #include "fluids.h"
 #include "gc.h"
 #include "gsubr.h"
-#include "hashtab.h"
 #include "keywords.h"
 #include "modules.h"
 #include "numbers.h"

base-commit: d579848cb5d65440af5afd9c8968628665554c22
-- 
2.41.0

bug#66046: [PATCH v3 3/3] ice-9: Fix 'include' when used in compilation contexts.

[Maxim Cournoyer]

Fixes bug #66046.

Introduce a '%file-port-stripped-prefixes' fluid that captures the
pre-canonicalized file name used when compiling a file, before it gets
modified in fport_canonicalize_filename.  That reference that can then
used by 'include' when searching for included files.

* libguile/fports.c (sys_file_port_stripped_prefixes): New C fluid.
(fport_canonicalize_filename): Register dirnames / stripped prefixes
pairs in.
(%file-port-stripped-prefixes): New corresponding Scheme fluid.
* module/ice-9/boot-9.scm (call-with-include-port): New procedure,
shadowing that from psyntax, that extends it to use the above fluid to
compute a fallback include file directory name to try.
* module/ice-9/psyntax.scm (call-with-include-port): Add comment.  Strip
documentation, as it's now an internal.

---

Changes in v3:
 - Move tests hunks to test commit

Changes in v2:
 - Move fluid to where the file name stripping happens, in libguile
 - Make the fluid value an alist of the last 100 stripped prefixes
 - Expound test to catch edge case (include in an include)

 libguile/fports.c| 41 +--
 module/ice-9/boot-9.scm  | 61 
 module/ice-9/psyntax.scm |  8 ++
 3 files changed, 102 insertions(+), 8 deletions(-)

diff --git a/libguile/fports.c b/libguile/fports.c
index 8f19216b7..12048828a 100644
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -1,4 +1,4 @@
-/* Copyright 1995-2004,2006-2015,2017-2020,2022
+/* Copyright 1995-2004,2006-2015,2017-2020,2022-2023
  Free Software Foundation, Inc.
 
This file is part of Guile.
@@ -43,6 +43,7 @@
 #include 
 #include 
 
+#include "alist.h"
 #include "async.h"
 #include "boolean.h"
 #include "dynwind.h"
@@ -59,6 +60,7 @@
 #include "ports-internal.h"
 #include "posix.h"
 #include "read.h"
+#include "srfi-13.h"
 #include "strings.h"
 #include "symbols.h"
 #include "syscalls.h"
@@ -123,6 +125,7 @@ SCM_DEFINE (scm_file_port_p, "file-port?", 1, 0, 0,
 
 
 static SCM sys_file_port_name_canonicalization;
+static SCM sys_file_port_stripped_prefixes;
 static SCM sym_relative;
 static SCM sym_absolute;
 
@@ -143,7 +146,34 @@ fport_canonicalize_filename (SCM filename)
 "%load-path"));
   rel = scm_i_relativize_path (filename, path);
 
-  return scm_is_true (rel) ? rel : filename;
+  if (scm_is_true (rel))
+{
+  SCM relative_dir = scm_dirname (rel);
+  SCM stripped_prefixes = scm_fluid_ref
+(sys_file_port_stripped_prefixes);
+
+  /* Extend the association list if needed, but keep its size
+ capped to limit memory usage. */
+  if (scm_is_false (scm_assoc_ref(stripped_prefixes, relative_dir)))
+{
+  SCM stripped_prefix = scm_string_drop_right
+(filename, scm_string_length (rel));
+
+  stripped_prefixes = scm_cons (scm_cons (relative_dir,
+  stripped_prefix),
+stripped_prefixes);
+
+  if (scm_to_int (scm_length (stripped_prefixes)) > 100)
+stripped_prefixes = scm_list_head (stripped_prefixes,
+   scm_from_int(100));
+
+  scm_fluid_set_x (sys_file_port_stripped_prefixes,
+   stripped_prefixes);
+}
+
+  return rel;
+}
+  return filename;
 }
   else if (scm_is_eq (mode, sym_absolute))
 {
@@ -766,4 +796,11 @@ scm_init_fports ()
   sys_file_port_name_canonicalization = scm_make_fluid ();
   scm_c_define ("%file-port-name-canonicalization",
 sys_file_port_name_canonicalization);
+
+  /* Used by `include' to locate the true source when relative
+ canonicalization strips a leading part of the source file. */
+  sys_file_port_stripped_prefixes = scm_make_fluid_with_default (SCM_EOL);
+
+  scm_c_define ("%file-port-stripped-prefixes",
+sys_file_port_stripped_prefixes);
 }
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index a5f2eea9b..a79d49ae1 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -2030,6 +2030,67 @@ non-locally, that exit determines the continuation."
 
 
 
+;;; {Include}
+;;;
+
+;;; This redefined version of call-with-include-port (first defined in
+;;; psyntax.scm) also try to locate an included file using the
+;;; %file-port-stripped-prefixes fluid.
+(define call-with-include-port
+  (let ((syntax-dirname (lambda (stx)
+  (define src (syntax-source stx))
+  (define filename (and src (assq-ref src 'filename)))
+  (and (string? filename)
+   (dirname filename)
+(lambda* (filename proc #:key (dirname (syntax-dirname filename)))
+  "Like @code{call-with-input-file}, except relative paths are
+searched 

bug#66046: [PATCH v3 2/3] tests: Add new compile-file tests.

[Maxim Cournoyer]

Add a test for bug #66046.

To run just the compiler tests:

  ./meta/guile -L test-suite -L . test-suite/tests/compiler.test

* test-suite/tests/compiler.test (with-temporary-directory): New syntax.
(delete-file-recursively): New procedure.
("compile-file: relative include works")
("compile-file: relative include works with load path
canonicalization"): New tests.
---

(no changes since v1)

 test-suite/tests/compiler.test | 82 +-
 1 file changed, 80 insertions(+), 2 deletions(-)

diff --git a/test-suite/tests/compiler.test b/test-suite/tests/compiler.test
index a018e0c41..79aee1a0e 100644
--- a/test-suite/tests/compiler.test
+++ b/test-suite/tests/compiler.test
@@ -1,5 +1,5 @@
  compiler.test --- tests for the compiler  -*- scheme -*-
- Copyright (C) 2008-2014, 2018, 2021-2022 Free Software Foundation, Inc.
+ Copyright (C) 2008-2014, 2018, 2021-2023 Free Software Foundation, Inc.
  
  This library is free software; you can redistribute it and/or
  modify it under the terms of the GNU Lesser General Public
@@ -18,15 +18,50 @@
 (define-module (tests compiler)
   #:use-module (test-suite lib)
   #:use-module (test-suite guile-test)
+  #:use-module (ice-9 ftw)
   #:use-module (system base compile)
   #:use-module ((language tree-il)
 #:select (tree-il-src call-args))
   #:use-module ((system vm loader) #:select (load-thunk-from-memory))
-  #:use-module ((system vm program) #:select (program-sources source:addr)))
+  #:use-module ((system vm program) #:select (program-sources source:addr))
+  #:use-module (srfi srfi-26))
 
 (define read-and-compile
   (@@ (system base compile) read-and-compile))
 
+;;; Based on 'with-directory-excursion', from (guix build utils).
+(define-syntax-rule (with-temporary-directory body ...)
+  "Run BODY with DIR as the process's current directory."
+  (let ((init (getcwd))
+(dir (mkdtemp "tempdir.XX")))
+   (dynamic-wind
+ (lambda ()
+   (chdir dir))
+ (lambda ()
+   body ...)
+ (lambda ()
+   (chdir init)
+   (delete-file-recursively dir)
+
+;;; XXX: Adapted from (guix build utils).
+(define* (delete-file-recursively dir)
+  "Delete DIR recursively, like `rm -rf', without following symlinks."
+  (file-system-fold (const #t)  ;enter
+(lambda (file stat result)   ; leaf
+  (delete-file file))
+(const #t)   ; down
+(lambda (dir stat result); up
+  (rmdir dir))
+(const #t)   ; skip
+(lambda (file stat errno result)
+  (format (current-error-port)
+  "warning: failed to delete ~a: ~a~%"
+  file (strerror errno)))
+#t
+dir
+
+;; Don't follow symlinks.
+lstat))
 
 
 (with-test-prefix "basic"
@@ -434,3 +469,46 @@
 (set! proc ((load-thunk-from-memory bytecode)))
 (procedure? proc)))
 (pass-if-equal "proc executes" 42 (proc
+
+(with-test-prefix "compile-file"
+  ;; Setup test library sources in a temporary directory.
+  (let ((hello-sexp '(define-library (hello)
+   (import (scheme base)
+   (scheme write))
+   (export hello)
+   (include "hello/hello-impl.scm")))
+(hello-impl-sexp '(begin
+(include "../external/nothing.scm")
+(include "body.scm")))
+(hello-body-sexp '(define (hello)
+(display "hello!\n"
+(with-temporary-directory
+ (mkdir "module")
+ (call-with-output-file "module/hello.scm"
+   (cut write hello-sexp <>))
+ (mkdir "module/hello")
+ (call-with-output-file "module/hello/hello-impl.scm"
+   (cut write hello-impl-sexp <>))
+ (call-with-output-file "module/hello/body.scm"
+   (cut write hello-body-sexp <>))
+ (mkdir "module/external")
+ (call-with-output-file "module/external/nothing.scm" (const #t))
+ (mkdir "build")
+ (chdir "build")
+
+ (pass-if "relative include works"
+   (compile-file "../module/hello.scm" #:output-file "hello.go")
+   #t)
+
+ ;; This used to fail, because compile-file's #:canonicalization
+ ;; defaults to 'relative, which causes 'scm_relativize_path' to
+ ;; strip the prefix not in the load path, to avoid baking an
+ ;; invalid source file reference in the byte compiled output file
+ ;; (see: https://bugs.gnu.org/66046).  This was fixed by having a
+ ;; '%file-port-stripped-prefixes' fluid to preserve the stripped
+ ;; prefix, to be used by 'include' to reconstruct the original
+ ;; complete relative file name.
+ (pass-if "relative include works with load path canonicalization"
+   

bug#66046: [PATCH v2 2/3] tests: Add new compile-file tests.

[Maxim Cournoyer]

Add a test for bug #66046.

To run just the compiler tests:

  ./meta/guile -L test-suite -L . test-suite/tests/compiler.test

* test-suite/tests/compiler.test (with-temporary-directory): New syntax.
(delete-file-recursively): New procedure.
("compile-file: relative include works")
("compile-file: relative include works with load path
canonicalization"): New tests.
---

(no changes since v1)

 test-suite/tests/compiler.test | 82 +-
 1 file changed, 80 insertions(+), 2 deletions(-)

diff --git a/test-suite/tests/compiler.test b/test-suite/tests/compiler.test
index a018e0c41..ff923095a 100644
--- a/test-suite/tests/compiler.test
+++ b/test-suite/tests/compiler.test
@@ -1,5 +1,5 @@
  compiler.test --- tests for the compiler  -*- scheme -*-
- Copyright (C) 2008-2014, 2018, 2021-2022 Free Software Foundation, Inc.
+ Copyright (C) 2008-2014, 2018, 2021-2023 Free Software Foundation, Inc.
  
  This library is free software; you can redistribute it and/or
  modify it under the terms of the GNU Lesser General Public
@@ -18,15 +18,50 @@
 (define-module (tests compiler)
   #:use-module (test-suite lib)
   #:use-module (test-suite guile-test)
+  #:use-module (ice-9 ftw)
   #:use-module (system base compile)
   #:use-module ((language tree-il)
 #:select (tree-il-src call-args))
   #:use-module ((system vm loader) #:select (load-thunk-from-memory))
-  #:use-module ((system vm program) #:select (program-sources source:addr)))
+  #:use-module ((system vm program) #:select (program-sources source:addr))
+  #:use-module (srfi srfi-26))
 
 (define read-and-compile
   (@@ (system base compile) read-and-compile))
 
+;;; Based on 'with-directory-excursion', from (guix build utils).
+(define-syntax-rule (with-temporary-directory body ...)
+  "Run BODY with DIR as the process's current directory."
+  (let ((init (getcwd))
+(dir (mkdtemp "tempdir.XX")))
+   (dynamic-wind
+ (lambda ()
+   (chdir dir))
+ (lambda ()
+   body ...)
+ (lambda ()
+   (chdir init)
+   (delete-file-recursively dir)
+
+;;; XXX: Adapted from (guix build utils).
+(define* (delete-file-recursively dir)
+  "Delete DIR recursively, like `rm -rf', without following symlinks."
+  (file-system-fold (const #t)  ;enter
+(lambda (file stat result)   ; leaf
+  (delete-file file))
+(const #t)   ; down
+(lambda (dir stat result); up
+  (rmdir dir))
+(const #t)   ; skip
+(lambda (file stat errno result)
+  (format (current-error-port)
+  "warning: failed to delete ~a: ~a~%"
+  file (strerror errno)))
+#t
+dir
+
+;; Don't follow symlinks.
+lstat))
 
 
 (with-test-prefix "basic"
@@ -434,3 +469,46 @@
 (set! proc ((load-thunk-from-memory bytecode)))
 (procedure? proc)))
 (pass-if-equal "proc executes" 42 (proc
+
+(with-test-prefix "compile-file"
+  ;; Setup test library sources in a temporary directory.
+  (let ((hello-sexp '(define-library (hello)
+   (import (scheme base)
+   (scheme write))
+   (export hello)
+   (include "hello/hello-impl.scm")))
+(hello-impl-sexp '(begin
+(include "../external/nothing.scm")
+(include "body.scm")))
+(hello-body-sexp '(define (hello)
+(display "hello!\n"
+(with-temporary-directory
+ (mkdir "module")
+ (call-with-output-file "module/hello.scm"
+   (cut write hello-sexp <>))
+ (mkdir "module/hello")
+ (call-with-output-file "module/hello/hello-impl.scm"
+   (cut write hello-impl-sexp <>))
+ (call-with-output-file "module/hello/body.scm"
+   (cut write hello-body-sexp <>))
+ (mkdir "module/external")
+ (call-with-output-file "module/external/nothing.scm" (const #t))
+ (mkdir "build")
+ (chdir "build")
+
+ (pass-if "relative include works"
+   (compile-file "../module/hello.scm" #:output-file "hello.go")
+   #t)
+
+ ;; This used to fail, because compile-file's #:canonicalization
+ ;; defaults to 'relative, which caused 'scm_relativize_path' to
+ ;; strip the prefix not in the load path, to avoid baking an
+ ;; invalid source file reference in the byte compiled output file
+ ;; (see: https://bugs.gnu.org/66046).  This was fixed by having a
+ ;; 'compilation-source-file' fluid that preserves the file name
+ ;; passed to 'compile-file', used by 'include' instead of the file
+ ;; name of the port.
+ (pass-if "relative include works with load path canonicalization"
+   

bug#66046: [PATCH v2 3/3] ice-9: Fix 'include' when used in compilation contexts.

[Maxim Cournoyer]

Fixes bug #66046.

Introduce a '%file-port-stripped-prefixes' fluid that captures the
pre-canonicalized file name used when compiling a file, before it gets
modified in fport_canonicalize_filename.  That reference that can then
used by 'include' when searching for included files.

* libguile/fports.c (sys_file_port_stripped_prefixes): New C fluid.
(fport_canonicalize_filename): Register dirnames / stripped prefixes
pairs in.
(%file-port-stripped-prefixes): New corresponding Scheme fluid.
* module/ice-9/boot-9.scm (call-with-include-port): New procedure,
shadowing that from psyntax, that extends it to use the above fluid to
compute a fallback include file directory name to try.
* module/ice-9/psyntax.scm (call-with-include-port): Add comment.  Strip
documentation, as it's now an internal.

---

Changes in v2:
 - Move fluid to where the file name stripping happens, in libguile
 - Make the fluid value an alist of the last 100 stripped prefixes
 - Expound test to catch edge case (include in an include)

 libguile/fports.c  | 41 +--
 module/ice-9/boot-9.scm| 61 ++
 module/ice-9/psyntax.scm   |  8 ++---
 test-suite/tests/compiler.test |  8 ++---
 4 files changed, 106 insertions(+), 12 deletions(-)

diff --git a/libguile/fports.c b/libguile/fports.c
index 8f19216b7..12048828a 100644
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -1,4 +1,4 @@
-/* Copyright 1995-2004,2006-2015,2017-2020,2022
+/* Copyright 1995-2004,2006-2015,2017-2020,2022-2023
  Free Software Foundation, Inc.
 
This file is part of Guile.
@@ -43,6 +43,7 @@
 #include 
 #include 
 
+#include "alist.h"
 #include "async.h"
 #include "boolean.h"
 #include "dynwind.h"
@@ -59,6 +60,7 @@
 #include "ports-internal.h"
 #include "posix.h"
 #include "read.h"
+#include "srfi-13.h"
 #include "strings.h"
 #include "symbols.h"
 #include "syscalls.h"
@@ -123,6 +125,7 @@ SCM_DEFINE (scm_file_port_p, "file-port?", 1, 0, 0,
 
 
 static SCM sys_file_port_name_canonicalization;
+static SCM sys_file_port_stripped_prefixes;
 static SCM sym_relative;
 static SCM sym_absolute;
 
@@ -143,7 +146,34 @@ fport_canonicalize_filename (SCM filename)
 "%load-path"));
   rel = scm_i_relativize_path (filename, path);
 
-  return scm_is_true (rel) ? rel : filename;
+  if (scm_is_true (rel))
+{
+  SCM relative_dir = scm_dirname (rel);
+  SCM stripped_prefixes = scm_fluid_ref
+(sys_file_port_stripped_prefixes);
+
+  /* Extend the association list if needed, but keep its size
+ capped to limit memory usage. */
+  if (scm_is_false (scm_assoc_ref(stripped_prefixes, relative_dir)))
+{
+  SCM stripped_prefix = scm_string_drop_right
+(filename, scm_string_length (rel));
+
+  stripped_prefixes = scm_cons (scm_cons (relative_dir,
+  stripped_prefix),
+stripped_prefixes);
+
+  if (scm_to_int (scm_length (stripped_prefixes)) > 100)
+stripped_prefixes = scm_list_head (stripped_prefixes,
+   scm_from_int(100));
+
+  scm_fluid_set_x (sys_file_port_stripped_prefixes,
+   stripped_prefixes);
+}
+
+  return rel;
+}
+  return filename;
 }
   else if (scm_is_eq (mode, sym_absolute))
 {
@@ -766,4 +796,11 @@ scm_init_fports ()
   sys_file_port_name_canonicalization = scm_make_fluid ();
   scm_c_define ("%file-port-name-canonicalization",
 sys_file_port_name_canonicalization);
+
+  /* Used by `include' to locate the true source when relative
+ canonicalization strips a leading part of the source file. */
+  sys_file_port_stripped_prefixes = scm_make_fluid_with_default (SCM_EOL);
+
+  scm_c_define ("%file-port-stripped-prefixes",
+sys_file_port_stripped_prefixes);
 }
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index a5f2eea9b..a79d49ae1 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -2030,6 +2030,67 @@ non-locally, that exit determines the continuation."
 
 
 
+;;; {Include}
+;;;
+
+;;; This redefined version of call-with-include-port (first defined in
+;;; psyntax.scm) also try to locate an included file using the
+;;; %file-port-stripped-prefixes fluid.
+(define call-with-include-port
+  (let ((syntax-dirname (lambda (stx)
+  (define src (syntax-source stx))
+  (define filename (and src (assq-ref src 'filename)))
+  (and (string? filename)
+   (dirname filename)
+(lambda* (filename proc #:key (dirname (syntax-dirname filename)))
+  "Like @code{call-with-input-file}, except relative paths are
+searched 

bug#66046: [PATCH v2 1/3] libguile/fports.c: Remove extraneous include.

[Maxim Cournoyer]

* libguile/fports.c: Delete "hashtab.h" include, which is unused.
---

(no changes since v1)

 libguile/fports.c | 1 -
 1 file changed, 1 deletion(-)

diff --git a/libguile/fports.c b/libguile/fports.c
index 9d4ca6ace..8f19216b7 100644
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -52,7 +52,6 @@
 #include "fluids.h"
 #include "gc.h"
 #include "gsubr.h"
-#include "hashtab.h"
 #include "keywords.h"
 #include "modules.h"
 #include "numbers.h"

base-commit: d579848cb5d65440af5afd9c8968628665554c22
-- 
2.41.0

bug#67370: FAIL: asyncs.test: preemption via sigprof (nondeterministic test failure)

[Maxim Cournoyer]

Hi,

I'm sometimes getting this test failure when running on the tip of the
main branch, commit: d579848cb.

The test does not seem to fail when run individually (via './meta/guile
-L test-suite -L . test-suite/tests/asyncs.test').

Guile was configured using './configure --enable-mini-gmp'.

It seems relatively rare on my 4 cores system, using something like
'make check -j5'.  I've just re-run the test suite 4 times without the
problem.  I've seen it at least twice in the last 3 weeks though, so I'm
reporting it.

-- 
Thanks,
Maxim

bug#66046: Relative includes in R7RS define-library seem broken

[Maxim Cournoyer]

Hello,

I've just found a cross-compilation buggy interaction with my fix:

--8<---cut here---start->8---
$ touch ./module/srfi/srfi-151.scm 
maxim@hurd ~/src/guile [env]$ touch ./module/srfi/srfi-160/base.sld 
maxim@hurd ~/src/guile [env]$ m
make  all-recursive
make[1]: Entering directory '/home/maxim/src/guile'
Making all in lib
make[2]: Entering directory '/home/maxim/src/guile/lib'
make  all-recursive
make[3]: Entering directory '/home/maxim/src/guile/lib'
make[4]: Entering directory '/home/maxim/src/guile/lib'
make[4]: Nothing to be done for 'all-am'.
make[4]: Leaving directory '/home/maxim/src/guile/lib'
make[3]: Leaving directory '/home/maxim/src/guile/lib'
make[2]: Leaving directory '/home/maxim/src/guile/lib'
Making all in meta
make[2]: Entering directory '/home/maxim/src/guile/meta'
make[2]: Nothing to be done for 'all'.
make[2]: Leaving directory '/home/maxim/src/guile/meta'
Making all in libguile
make[2]: Entering directory '/home/maxim/src/guile/libguile'
make  all-am
make[3]: Entering directory '/home/maxim/src/guile/libguile'
make[3]: Nothing to be done for 'all-am'.
make[3]: Leaving directory '/home/maxim/src/guile/libguile'
make[2]: Leaving directory '/home/maxim/src/guile/libguile'
Making all in module
make[2]: Entering directory '/home/maxim/src/guile/module'
make[2]: Nothing to be done for 'all'.
make[2]: Leaving directory '/home/maxim/src/guile/module'
Making all in stage0
make[2]: Entering directory '/home/maxim/src/guile/stage0'
  BOOTSTRAP(stage0) GUILEC srfi/srfi-151.go
  BOOTSTRAP(stage0) GUILEC srfi/srfi-160/base.go
;;; note: source file /home/maxim/src/guile/module/srfi/srfi-151.scm
;;;   newer than compiled /home/maxim/src/guile/stage0/srfi/srfi-151.go
;;; note: source file /home/maxim/src/guile/module/srfi/srfi-151.scm
;;;   newer than compiled 
/home/maxim/src/guile/cache/guile/ccache/3.0-LE-8-4.6/home/maxim/src/guile/module/srfi/srfi-151.scm.go
Backtrace:
In ice-9/r6rs-libraries.scm:
   113:17 19 (_ # ?)
In ice-9/boot-9.scm:
  3355:17 18 (resolve-interface (srfi srfi-151) #:select _ #:hide _ # ?)
In ice-9/threads.scm:
397:8 17 (_ #)
In ice-9/boot-9.scm:
  3281:13 16 (_)
In ice-9/threads.scm:
397:8 15 (_ #)
In ice-9/boot-9.scm:
  3572:20 14 (_)
   2864:4 13 (save-module-excursion #)
  3592:26 12 (_)
In unknown file:
  11 (primitive-load-path "srfi/srfi-151" #)
In ice-9/eval.scm:
   721:20 10 (primitive-eval (define-library (srfi srfi-151) (# #) ?))
wrote `srfi/srfi-151.go'
In ice-9/psyntax.scm:
  1229:36  9 (expand-top-sequence (#) ?)
  1123:16  8 (lp (#) ?)
  1123:16  7 (lp (# ?) ?)
  1123:16  6 (lp (#) ?)
  1121:20  5 (lp (#) ?)
  1342:32  4 (syntax-type (# #) ?)
  1562:32  3 (expand-macro # ?)
  3278:16  2 (_ # ?)
In unknown file:
   1 (open-file "../module/srfi/srfi-160/srfi-151/bitwise-3?" ?)
In ice-9/boot-9.scm:
  1682:22  0 (lp 0)

ice-9/boot-9.scm:1682:22: In procedure lp:
In procedure open-file: No such file or directory: 
"../module/srfi/srfi-160/srfi-151/bitwise-33.scm"
make[2]: *** [Makefile:2562: srfi/srfi-160/base.go] Error 1
make[2]: Leaving directory '/home/maxim/src/guile/stage0'
make[1]: *** [Makefile:2203: all-recursive] Error 1
make[1]: Leaving directory '/home/maxim/src/guile'
make: *** [Makefile:2088 : all] Erreur 2
--8<---cut here---end--->8---

I'll try to come up with a test case, then a fix.

-- 
Thanks,
Maxim

bug#67255: define-library does not support 'rename' directives

[Maxim Cournoyer]

Hi,

Our R7RS define-library syntax, from (ice-9 r7rs-library) does not
support renaming bindings to export, via 'rename' directives.  For
example, attempting to build srfi/125.sld, which reads:

--8<---cut here---start->8---
(define-library (srfi srfi-125)

  (export

   make-hash-table
   hash-table
   hash-table-unfold
   alist->hash-table

   hash-table?
   hash-table-contains?
   hash-table-empty?
   hash-table=?
   hash-table-mutable?

   hash-table-ref
   hash-table-ref/default

   hash-table-set!
   hash-table-delete!
   hash-table-intern!
   hash-table-update!
   hash-table-update!/default
   hash-table-pop!
   hash-table-clear!

   hash-table-size
   hash-table-keys
   hash-table-values
   hash-table-entries
   hash-table-find
   hash-table-count

   hash-table-map
   hash-table-for-each
   hash-table-map!
   hash-table-map->list
   hash-table-fold
   hash-table-prune!

   hash-table-copy
   hash-table-empty-copy
   hash-table->alist

   hash-table-union!
   hash-table-intersection!
   hash-table-difference!
   hash-table-xor!

   ;; The following procedures are deprecated by SRFI 125:

   (rename deprecated:hash hash)
   (rename deprecated:string-hash  string-hash)
   (rename deprecated:string-ci-hash   string-ci-hash)
   (rename deprecated:hash-by-identity hash-by-identity)

   (rename deprecated:hash-table-equivalence-function
   hash-table-equivalence-function)
   (rename deprecated:hash-table-hash-function hash-table-hash-function)
   (rename deprecated:hash-table-exists?   hash-table-exists?)
   (rename deprecated:hash-table-walk  hash-table-walk)
   (rename deprecated:hash-table-merge!hash-table-merge!)

   )

  (import (scheme base)
  (scheme write) ; for warnings about deprecated features
  (srfi 126)
  (except (srfi 128)
  hash-salt  ; exported by (srfi 126)
  string-hash; exported by (srfi 126)
  string-ci-hash ; exported by (srfi 126)
  symbol-hash; exported by (srfi 126)
  ))

  (cond-expand
   ((library (scheme char))
(import (scheme char)))
   (else
(begin (define string-ci=? string=?

  (include "srfi-125/125.body.scm")

  )
--8<---cut here---end--->8---

Fails with:

--8<---cut here---start->8---
$ ./meta/guild compile -W3 ./module/srfi/srfi-125.scm
/module/srfi/srfi-128.scm.go
ice-9/boot-9.scm:1682:22: In procedure raise-exception:
Syntax error:
unknown location: source expression failed to match any pattern in form 
((rename deprecated:hash hash) (rename deprecated:string-hash string-hash) 
(rename deprecated:string-ci-hash string-ci-hash) (rename 
deprecated:hash-by-identity hash-by-identity) (rename 
deprecated:hash-table-equivalence-function hash-table-equivalence-function) 
(rename deprecated:hash-table-hash-function hash-table-hash-function) (rename 
deprecated:hash-table-exists? hash-table-exists?) (rename 
deprecated:hash-table-walk hash-table-walk) (rename 
deprecated:hash-table-merge! hash-table-merge!))
--8<---cut here---end--->8---

Our define-module syntax does not have such a feature (of renaming
*exported* bindings), so this would seem to require new development on
that side first.

-- 
Thanks,
Maxim

bug#66046: Relative includes in R7RS define-library seem broken

[Maxim Cournoyer]

Hello,

Amirouche  writes:

> If I am not mistaken, the patch is not backward compatible.
>
> The problem with the current patch is that it force the included file 
> to be next to the including file, there is no fallback  mechanism. 
> The algorithm should be dynamic using an ordered list a priority to
> the favorite behavior. 
>
> The most relevant hunk is:
>
> --- a/module/ice-9/psyntax.scm
> +++ b/module/ice-9/psyntax.scm
> @@ -3260,15 +3260,20 @@
>(let ((syntax-dirname (lambda (stx)
>(define src (syntax-source stx))
>(define filename (and src (assq-ref src 
> 'filename)))
> -  (and (string? filename)
> -   (dirname filename)
> +  (define source-file-name
> +(fluid-ref compilation-source-file-name))
> +  (or (and source-file-name
> +   (dirname source-file-name))
> +  (and (string? filename)
> +   (dirname filename))
>
> Here the code says: the included file must be in (syntax-dirname). 
> It is preferable to have fallbacks, to be backward compatible.

It also falls back to the existing behavior, which is of picking up the
parent directory of the port's file name (that is, the parent directory
of the source file using the 'include' syntax), per the 'or' above.
Isn't that sufficient?

> `syntax-dirname' must be `syntax-dirnames' to return candidate directories 
> sorted list with biggest priority coming first where to find included 
> files.

I'm not sure what algorithm you are suggesting here; but it seems it'd
be something new in Guile.  Since the behavior of 'include' is not
standardized, I'd prefer we change it only if there are interesting use
cases not yet covered (can you think of a scenario?  we could add a test
for it).

> Also, mind the use of the fluid and how it interact with parallel compilation.

Fluids are thread safe, as far as I know, and files are compiled one at
a time anyway, so I don't foresee any problem here, as you also noted in
#scheme on Libera.

-- 
Thanks,
Maxim

bug#52239: R7RS define-library does not support cond-expand

[Maxim Cournoyer]

Hi,

Amirouche  writes:

> fixed in https://debbugs.gnu.org/cgi/bugreport.cgi?bug=40252

Great!  Closing, by replying to '52239-d...@debbugs.gnu.org'.

-- 
Thanks,
Maxim

bug#41956: is this still current ?

[Maxim Cournoyer]

Hi,

Adriano Peluso  writes:

> I understand that a overhaul of the exceptions stack intervened while
> this bug was open
>
> Is this still current ?

Yes.  The affected code hasn't been touched since 2019.  To recall, the
reproducer is this:

--8<---cut here---start->8---
(use-modules (srfi srfi-34)
 (srfi srfi-35))
(guard (c ((message-condition? c)
   (format #t "error: ~a~%" (condition-message c
  (canonicalize-path "/no/such/path"))
--8<---cut here---end--->8---

or this:

--8<---cut here---start->8---
(use-modules (srfi srfi-34)
 (srfi srfi-35))
(guard (c ((message-condition? c)
   (format #t "error: ~a~%" (condition-message c
  ;; This is what (canonicalize-path "/do/not/exist) ends up doing:
  (throw 'system-error "canonicalize-path" "~A" '("No such file or directory")))

error: ~A
--8<---cut here---end--->8---

-- 
Thanks,
Maxim

bug#66046: [PATCH 1/2] tests: Add new compile-file tests.

[Maxim Cournoyer]

Add a test for bug #66046.

To run just the compiler tests:

  ./meta/guile -L test-suite -L . test-suite/tests/compiler.test

* test-suite/tests/compiler.test (with-temporary-directory): New syntax.
(delete-file-recursively): New procedure.
("compile-file: relative include works")
("compile-file: relative include works with load path
canonicalization"): New tests.
---

 test-suite/tests/compiler.test | 75 +-
 1 file changed, 74 insertions(+), 1 deletion(-)

diff --git a/test-suite/tests/compiler.test b/test-suite/tests/compiler.test
index a018e0c41..2026d5ff3 100644
--- a/test-suite/tests/compiler.test
+++ b/test-suite/tests/compiler.test
@@ -1,5 +1,5 @@
  compiler.test --- tests for the compiler  -*- scheme -*-
- Copyright (C) 2008-2014, 2018, 2021-2022 Free Software Foundation, Inc.
+ Copyright (C) 2008-2014, 2018, 2021-2023 Free Software Foundation, Inc.
  
  This library is free software; you can redistribute it and/or
  modify it under the terms of the GNU Lesser General Public
@@ -18,6 +18,7 @@
 (define-module (tests compiler)
   #:use-module (test-suite lib)
   #:use-module (test-suite guile-test)
+  #:use-module (ice-9 ftw)
   #:use-module (system base compile)
   #:use-module ((language tree-il)
 #:select (tree-il-src call-args))
@@ -27,6 +28,39 @@
 (define read-and-compile
   (@@ (system base compile) read-and-compile))
 
+;;; Based on 'with-directory-excursion', from (guix build utils).
+(define-syntax-rule (with-temporary-directory body ...)
+  "Run BODY with DIR as the process's current directory."
+  (let ((init (getcwd))
+(dir (mkdtemp "tempdir.XX")))
+   (dynamic-wind
+ (lambda ()
+   (chdir dir))
+ (lambda ()
+   body ...)
+ (lambda ()
+   (chdir init)
+   (delete-file-recursively dir)
+
+;;; XXX: Adapted from (guix build utils).
+(define* (delete-file-recursively dir)
+  "Delete DIR recursively, like `rm -rf', without following symlinks."
+  (file-system-fold (const #t)  ;enter
+(lambda (file stat result)   ; leaf
+  (delete-file file))
+(const #t)   ; down
+(lambda (dir stat result); up
+  (rmdir dir))
+(const #t)   ; skip
+(lambda (file stat errno result)
+  (format (current-error-port)
+  "warning: failed to delete ~a: ~a~%"
+  file (strerror errno)))
+#t
+dir
+
+;; Don't follow symlinks.
+lstat))
 
 
 (with-test-prefix "basic"
@@ -434,3 +468,42 @@
 (set! proc ((load-thunk-from-memory bytecode)))
 (procedure? proc)))
 (pass-if-equal "proc executes" 42 (proc
+
+(with-test-prefix "compile-file"
+  ;; Setup test library sources in a temporary directory.
+  (let ((top-sexp '(define-library (hello)
+ (import (scheme base)
+ (scheme write))
+ (export hello)
+ (include "hello/hello-impl.scm")))
+(included-sexp '(define (hello)
+  (display "hello!\n"
+(with-temporary-directory
+ (mkdir "module")
+ (call-with-output-file "module/hello.scm"
+   (lambda (port)
+ (write top-sexp port)))
+ (mkdir "module/hello")
+ (call-with-output-file "module/hello/hello-impl.scm"
+   (lambda (port)
+ (write included-sexp port)))
+ (mkdir "build")
+ (chdir "build")
+
+ (pass-if "relative include works"
+   (compile-file "../module/hello.scm" #:output-file "hello.go")
+   #t)
+
+ ;; This used to fail, because compile-file's #:canonicalization
+ ;; defaults to 'relative, which caused 'scm_relativize_path' to
+ ;; strip the prefix not in the load path, to avoid baking an
+ ;; invalid source file reference in the byte compiled output file
+ ;; (see: https://bugs.gnu.org/66046).  This was fixed by having a
+ ;; 'compilation-source-file' fluid that preserves the file name
+ ;; passed to 'compile-file', used by 'include' instead of the file
+ ;; name of the port.
+ (pass-if "relative include works with load path canonicalization"
+   (begin
+ (add-to-load-path (string-append (getcwd) "/../module"))
+ (compile-file "../module/hello.scm" #:output-file "hello.go")
+ #t)

base-commit: 75cd95060fb1ea7586f0e4b9081694c6d61f1d3b
-- 
2.41.0

bug#66046: [PATCH 2/2] ice-9: Fix 'include' when used in compilation contexts.

[Maxim Cournoyer]

Fix bug #66046.

Introduce a 'compilation-source-file-name' fluid that captures the
pre-canonicalized file name used when compiling a file, before it gets
modified in fport_canonicalize_filename.  That reference that can then
used directly by 'include', avoiding problems.

* module/ice-9/boot-9.scm (compilation-source-file-name): New fluid.
(compile-file): Set it to the value of FILE.
(compile-and-load): Likewise.
* module/ice-9/psyntax.scm (call-with-include-port): Use it.

---

 module/ice-9/boot-9.scm|  6 ++
 module/ice-9/psyntax.scm   | 13 +
 module/system/base/compile.scm |  6 --
 3 files changed, 19 insertions(+), 6 deletions(-)

diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index a5f2eea9b..7f2a02007 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -395,6 +395,12 @@ If returning early, return the return value of F."
 ;; expanded macros, to dispatch an input against a set of patterns.
 (define $sc-dispatch #f)
 
+;;; This fluid captures the original compiled source file name, before
+;;; it gets potentially stripped by the file ports canonicalization.  It
+;;; is used with 'include' to locate the true source, which is necessary
+;;; when using relative paths during compilation, for example.
+(define compilation-source-file-name (make-fluid #f))
+
 ;; Load it up!
 (primitive-load-path "ice-9/psyntax-pp")
 ;; The binding for `macroexpand' has now been overridden, making psyntax the
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index 7811f7118..ccdd15fca 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -3260,15 +3260,20 @@
   (let ((syntax-dirname (lambda (stx)
   (define src (syntax-source stx))
   (define filename (and src (assq-ref src 'filename)))
-  (and (string? filename)
-   (dirname filename)
+  (define source-file-name
+(fluid-ref compilation-source-file-name))
+  (or (and source-file-name
+   (dirname source-file-name))
+  (and (string? filename)
+   (dirname filename))
 (lambda* (filename proc #:key (dirname (syntax-dirname filename)))
   "Like @code{call-with-input-file}, except relative paths are
-searched relative to the @var{dirname} instead of the current working
+searched relative to @var{dirname} instead of the current working
 directory.  Also, @var{filename} can be a syntax object; in that case,
 and if @var{dirname} is not specified, the @code{syntax-source} of
 @var{filename} is used to obtain a base directory for relative file
-names."
+names.  As a special case, when the @var{compilation-source-file-name}
+fluid is set, its value overrides the @var{dirname} argument provided."
   (let* ((filename (syntax->datum filename))
  (p (open-input-file
  (cond ((absolute-file-name? filename)
diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
index a33d012bd..7b2670c21 100644
--- a/module/system/base/compile.scm
+++ b/module/system/base/compile.scm
@@ -174,7 +174,8 @@
(opts '())
(canonicalization 'relative))
   (validate-options opts)
-  (with-fluids ((%file-port-name-canonicalization canonicalization))
+  (with-fluids ((%file-port-name-canonicalization canonicalization)
+(compilation-source-file-name file))
 (let* ((comp (or output-file (compiled-file-name file)
  (error "failed to create path for auto-compiled file"
 file)))
@@ -202,7 +203,8 @@
(opts '())
(canonicalization 'relative))
   (validate-options opts)
-  (with-fluids ((%file-port-name-canonicalization canonicalization))
+  (with-fluids ((%file-port-name-canonicalization canonicalization)
+(compilation-source-file-name file))
 (read-and-compile (open-input-file file)
   #:from from #:to to #:opts opts
   #:optimization-level optimization-level
-- 
2.41.0

bug#66046: Relative includes in R7RS define-library seem broken

[Maxim Cournoyer]

Hello,

Here's a new test that reproduces the issue:

1 file changed, 65 insertions(+)
test-suite/tests/compiler.test | 65 +

modified   test-suite/tests/compiler.test
@@ -18,6 +18,7 @@
 (define-module (tests compiler)
   #:use-module (test-suite lib)
   #:use-module (test-suite guile-test)
+  #:use-module (ice-9 ftw)
   #:use-module (system base compile)
   #:use-module ((language tree-il)
 #:select (tree-il-src call-args))
@@ -27,6 +28,39 @@
 (define read-and-compile
   (@@ (system base compile) read-and-compile))
 
+;;; Based on 'with-directory-excursion', from (guix build utils).
+(define-syntax-rule (with-temporary-directory body ...)
+  "Run BODY with DIR as the process's current directory."
+  (let ((init (getcwd))
+(dir (mkdtemp "tempdir.XX")))
+   (dynamic-wind
+ (lambda ()
+   (chdir dir))
+ (lambda ()
+   body ...)
+ (lambda ()
+   (chdir init)
+   (delete-file-recursively dir)
+
+;;; XXX: Adapted from (guix build utils).
+(define* (delete-file-recursively dir)
+  "Delete DIR recursively, like `rm -rf', without following symlinks."
+  (file-system-fold (const #t)  ;enter
+(lambda (file stat result)   ; leaf
+  (delete-file file))
+(const #t)   ; down
+(lambda (dir stat result); up
+  (rmdir dir))
+(const #t)   ; skip
+(lambda (file stat errno result)
+  (format (current-error-port)
+  "warning: failed to delete ~a: ~a~%"
+  file (strerror errno)))
+#t
+dir
+
+;; Don't follow symlinks.
+lstat))
 
 
 (with-test-prefix "basic"
@@ -434,3 +468,34 @@
 (set! proc ((load-thunk-from-memory bytecode)))
 (procedure? proc)))
 (pass-if-equal "proc executes" 42 (proc
+
+(with-test-prefix "compile-file"
+  ;; Setup test library sources in a temporary directory.
+  (let ((top-sexp '(define-library (hello)
+ (import (scheme base)
+ (scheme write))
+ (export hello)
+ (include "hello/hello-impl.scm")))
+(included-sexp '(define (hello)
+  (display "hello!\n"
+(with-temporary-directory
+ (mkdir "module")
+ (call-with-output-file "module/hello.scm"
+   (lambda (port)
+ (write top-sexp port)))
+ (mkdir "module/hello")
+ (call-with-output-file "module/hello/hello-impl.scm"
+   (lambda (port)
+ (write included-sexp port)))
+ (mkdir "build")
+ (chdir "build")
+
+ (pass-if "relative include works"
+   (compile-file "../module/hello.scm" #:output-file "hello.go")
+   #t)
+
+ (pass-if "relative include works with load path canonicalization"
+   (begin
+ (add-to-load-path (string-append (getcwd) "/../module"))
+ (compile-file "../module/hello.scm" #:output-file "hello.go")
+ #t)

I run it like:

--8<---cut here---start->8---
./meta/guile -L test-suite -L . test-suite/tests/compiler.test
--8<---cut here---end--->8---

And I see:

--8<---cut here---start->8---
ERROR: compile-file: relative include works with load path canonicalization - 
arguments: ((system-error "open-file" "~A: ~S" ("Aucun fichier ou dossier de ce 
type" "./hello/hello-impl.scm") (2)))
--8<---cut here---end--->8---

That's the include directive failing because scm_i_relativize_path
caused the path to be stripped from "../module/hello.scm" to
"hello.scm"; then include, through its call-with-include-port helper,
calls (dirname "hello.scm"), which produces ".".

Finally, the same helper calls (in-vicinity "." "hello/hello-impl.scm"),
which produces the unresolvable "./hello/hello-impl.scm" file name seen
in the error above.

-- 
Thanks,
Maxim

bug#66046: Relative includes in R7RS define-library seem broken

[Maxim Cournoyer]

Hi,

[...]

> That's what Guile does (it attempts to locate the directory of the
> including source file), but helas, it happens after the file port
> corresponding to the including file has been relativized, which appears
> ot strip the prefix of its file name that is in the load path.
>
> e.g.: ../module/srfi/srfi-151.scm --> srfi/srfi-151.scm

To illustrate this is indeed the problem, this diff allow include to
find the source file:

--8<---cut here---start->8---
modified   module/system/base/compile.scm
@@ -172,7 +172,7 @@
(optimization-level (default-optimization-level))
(warning-level (default-warning-level))
(opts '())
-   (canonicalization 'relative))
+   (canonicalization 'none))
   (validate-options opts)
   (with-fluids ((%file-port-name-canonicalization canonicalization))
 (let* ((comp (or output-file (compiled-file-name file)
@@ -200,7 +200,7 @@
(optimization-level (default-optimization-level))
(warning-level (default-warning-level))
(opts '())
-   (canonicalization 'relative))
+   (canonicalization 'none))
   (validate-options opts)
   (with-fluids ((%file-port-name-canonicalization canonicalization))
 (read-and-compile (open-input-file file)
--8<---cut here---end--->8---

This appears to be a 13 year old regression introduced with commit
0157a341577223a981d912c93b568792e9dc67e3 ("add
%file-port-name-canonicalization option"):

--8<---cut here---start->8---
Date:   Mon Apr 19 13:14:43 2010 +0200

add %file-port-name-canonicalization option

* libguile/fports.c (%file-port-name-canonicalization): New global var.
  (fport_canonicalize_filename): New helper. If
  %file-port-name-canonicalization is 'absolute, then run file port
  names through canonicalize_path; if it's 'relative, then canonicalize
  the name, but strip off load paths; otherwise leave the port name
  alone.
  (scm_open_file): Use fport_canonicalize_filename.
  (scm_init_fports): Define %file-port-name-canonicalization.
--8<---cut here---end--->8---

I'm now curious to know what was the rationale behind this change; I
gather it may have only been to avoid registering bogus source paths in
the generated .go file, as hinted by the NEWS file.  If that's
confirmed, then the solution could be to find another way to accomplish
the same without touching a file port's associated file name metadata.

-- 
Thanks,
Maxim

bug#66046: Relative includes in R7RS define-library seem broken

[Maxim Cournoyer]

Hi,

I also encountered that problem while working on adding new SRFIs to
Guile.

Timothy Sample  writes:

> Hi Daphne,
>
> Daphne Preston-Kendal  writes:
>
>> A standard layout for R7RS libraries is to have an .sld file
>> containing the library import and export declarations with a parallel
>> .scm file with the same name in the same directory, which the .sld
>> file (include ...)s.
>>
>> [...]
>>
>> Guile supports looking for .sld files before .scm files if started in
>> --r7rs mode. However, in this case, it will not find the .scm file if
>> it’s included from the .sld file.
>
> This is currently causing me problems, too, so I will look into writing
> and submitting a patch.
>
> We are technically following R7RS, which says the lookup strategy is
> “implementation-specific”.  However, it goes on to say: “implementations
> are encouraged to search for files in the directory which contains the
> including file [...].”  This is perfectly reasonable, and like you say,
> part of an established pattern for portable code.

That's what Guile does (it attempts to locate the directory of the
including source file), but helas, it happens after the file port
corresponding to the including file has been relativized, which appears
ot strip the prefix of its file name that is in the load path.

e.g.: ../module/srfi/srfi-151.scm --> srfi/srfi-151.scm

This NEWS entry describes the '%file-port-name-canonicalization' which
is used in 'compile-file' and friends:

--8<---cut here---start->8---
** New fluid: `%file-port-name-canonicalization'

This fluid parameterizes the file names that are associated with file
ports.  If %file-port-name-canonicalization is 'absolute, then file names
are canonicalized to be absolute paths. If it is 'relative, then the
name is canonicalized, but any prefix corresponding to a member of
`%load-path' is stripped off.  Otherwise the names are passed through
unchanged.

In addition, the `compile-file' and `compile-and-load' procedures bind
%file-port-name-canonicalization to their `#:canonicalization' keyword
argument, which defaults to 'relative. In this way, one might compile
"../module/ice-9/boot-9.scm", but the path that gets residualized into
the .go is "ice-9/boot-9.scm".
--8<---cut here---end--->8---

Perhaps there's a better way to avoid baking a bad reference in the .go
file without changing fundamental truths about file names, as this is
what breaks 'include'.

I tried setting the original file name to a parameter in compile-file
and compile-file-load, but given 'include' is a syntax, this cannot
work.  I'll try studying if an alternative to stripping can be used to
avoid baking bad file names in .go files.

-- 
Thanks,
Maxim

bug#66898: imported module (rnrs hashtables) overrides core binding `symbol-hash'

[Maxim Cournoyer]

Hello,

While working on integrating SRFI 126, I've noticed the following:

--8<---cut here---start->8---
WARNING: (srfi srfi-126): imported module (rnrs hashtables) overrides
core binding `symbol-hash'
--8<---cut here---end--->8---

The fix is to not export symbol-hash from (rnrs hashtables), since it
doesn't override it.  I'll link to a patch shortly.

-- 
Thanks,
Maxim

bug#66776: SRFI-64 test-error doesn't match error types

[Maxim Cournoyer]

Hello,

I've mean meaning to use 'test-error' in test suites, but as a comment
in its source says, it's currently incomplete:

--8<---cut here---start->8---
;; TODO: decide how to specify expected error types for Guile.
--8<---cut here---end--->8---

So, for example, this should fail but passes:

--8<---cut here---start->8---
(use-modules (srfi srfi-64))
(test-begin "test")
(test-error "testing" 'bad (throw 'oops))
(test-end "test")
--8<---cut here---end--->8---

'test-error' report success for any type of exception, which means its 2nd
argument is currently unused.

It'd also be nice if as its second argument it could accept non only a
error symbol key, but an exception type *or* an exception predicate,
e.g.:

--8<---cut here---start->8---
(use-modules (ice-9 exceptions) (srfi srfi-64))

(define-exception-type 
  ;parent
  make-my-exception ;constructor
  my-exception?);predicate

(test-begin "test-error exception types")

;; Passes, but should fail.
(test-error " raised"
  
  (raise-exception (make-error)))

;; OR

;; Unimplemented, but passes also.
(test-error " raised"
  my-exception?
  (raise-exception (make-error)))

(test-begin "test-error exception types")
--8<---cut here---end--->8---

There is a more modern implementation of SRFI-64 out there for Guile
which may provide clues or be used wholesale, though I haven't tried it:
.

-- 
Thanks,
Maxim

bug#66057: (ice-9 match) allows invalid usages of ... or ..1

[Maxim Cournoyer]

Hello,

Jean Abou Samra  writes:

> Le dimanche 17 septembre 2023 à 14:17 -0400, Maxim Cournoyer a écrit :
>> Hi,
>> 
>> After attempting the following:
>> 
>> --8<---cut here---start->8---
>> (match (string-split "./Bootloaders/Printer/Documentation/html" #\/)
>>  (("." path ..1 "Documentation" "html")
>
>
> For a start, where does that "..1" syntax come from? To my knowledge, no such
> syntax is supported by Guile's pattern matcher, which AFAIK is the one 
> described
> in SRFI-204.
>
> https://srfi.schemers.org/srfi-204/srfi-204.html

It's mentioned in the Guile Reference manual; see info "(guile) Pattern
Matching":

--8<---cut here---start->8---
 -- Scheme Syntax: match exp clause1 clause2 ...
 Match object EXP against the patterns in CLAUSE1 CLAUSE2 ... in the
 order in which they appear.  Return the value produced by the first
 matching clause.  If no clause matches, throw an exception with key
 ‘match-error’.

 Each clause has the form ‘(pattern body1 body2 ...)’.  Each PATTERN
 must follow the syntax described below.  Each body is an arbitrary
 Scheme expression, possibly referring to pattern variables of
 PATTERN.

   The syntax and interpretation of patterns is as follows:

patterns:   matches:

pat ::= identifier  anything, and binds identifier
  | _   anything
  | ()  the empty list
  | #t  #t
  | #f  #f
  | string  a string
  | number  a number
  | character   a character
  | 'sexp   an s-expression
  | 'symbol a symbol (special case of s-expr)
  | (pat_1 ... pat_n)   list of n elements
  | (pat_1 ... pat_n . pat_{n+1})   list of n or more
  | (pat_1 ... pat_n pat_n+1 ooo)   list of n or more, each element
  of remainder must match pat_n+1
  | #(pat_1 ... pat_n)  vector of n elements
  | #(pat_1 ... pat_n pat_n+1 ooo)  vector of n or more, each element
  of remainder must match pat_n+1
  | #   box
  | ($ record-name pat_1 ... pat_n) a record
  | (= field pat)   a ``field'' of an object
  | (and pat_1 ... pat_n)   if all of pat_1 thru pat_n match
  | (or pat_1 ... pat_n)if any of pat_1 thru pat_n match
  | (not pat_1 ... pat_n)   if all pat_1 thru pat_n don't match
  | (? predicate pat_1 ... pat_n)   if predicate true and all of
  pat_1 thru pat_n match
  | (set! identifier)   anything, and binds setter
  | (get! identifier)   anything, and binds getter
  | `qp a quasi-pattern
  | (identifier *** pat)matches pat in a tree and binds
identifier to the path leading
to the object that matches pat

ooo ::= ... zero or more
  | ___ zero or more
  | ..1 1 or more

quasi-patterns: matches:

qp  ::= ()  the empty list
  | #t  #t
  | #f  #f
  | string  a string
  | number  a number
  | character   a character
  | identifier  a symbol
  | (qp_1 ... qp_n) list of n elements
  | (qp_1 ... qp_n . qp_{n+1})  list of n or more
  | (qp_1 ... qp_n qp_n+1 ooo)  list of n or more, each element
  of remainder must match qp_n+1
  | #(qp_1 ... qp_n)vector of n elements
  | #(qp_1 ... qp_n qp_n+1 ooo) vector of n or more, each element
  of remainder must match qp_n+1
  | #box
  | ,pata pattern
  | ,@pat   a pattern

   The names ‘quote’, ‘quasiquote’, ‘unquote’, ‘unquote-splicing’, ‘?’,
‘_’, ‘$’, ‘and’, ‘or’, ‘not’, ‘set!’, ‘get!’, ‘...’, and ‘___’ cannot be
used as pattern variables.
--8<---cut here---end--->8---

>
> So your example is just binding the string "Printer" to the variable "..1":
> since "..1&qu

bug#66057: (ice-9 match) allows invalid usages of ... or ..1

[Maxim Cournoyer]

Hi,

After attempting the following:

--8<---cut here---start->8---
(match (string-split "./Bootloaders/Printer/Documentation/html" #\/)
 (("." path ..1 "Documentation" "html")
  (pk 'path path)))

=> ;;; (path "Bootloaders")

Expected (and works with '...'): 
;;; (path "Bootloaders" "Printer")
--8<---cut here---end--->8---

and asking about it in #scheme or #guile, it seems the '..1' and '...'
patterns *must* be used strictly to match at the end of lists, but this
isn't explicitly mentioned in the manual, and even works for ... but not
for ..1, which is inconsistent/econfusing.

It was suggested by Zipheir in #scheme that Guile should return a syntax
error when ..1 or ... are used somewhere else than at the end of a list.
It seems a good suggestion.

-- 
Thanks,
Maxim

bug#60799: Bogus 'Error while printing exception' message when raising srfi-35 exception

[Maxim Cournoyer]

Hello Ricardo,

Ricardo Wurmus  writes:

> Hi Maxim,
>
>> When raising a srfi-35 defined exception type like in the following, a
>> generic (and unhelpful) "Error while printing exception" message is
>> shown, with not even the exception type mentioned:
>>
>> (use-modules (srfi srfi-35))
>>
>> (define-condition-type  
>>   platform-not-found-error?)
>>
>> (raise-exception )
>>
>>
>> Produces:
>>
>> Backtrace:
>> In ice-9/boot-9.scm:
>>   1752:10  5 (with-exception-handler _ _ #:unwind? _ # _)
>> In unknown file:
>>4 (apply-smob/0 #)
>> In ice-9/boot-9.scm:
>> 724:2  3 (call-with-prompt _ _ #)
>> In ice-9/eval.scm:
>> 619:8  2 (_ #(#(#)))
>> In ice-9/boot-9.scm:
>>2836:4  1 (save-module-excursion _)
>>   4388:12  0 (_)
>>
>> ice-9/boot-9.scm:4388:12: Error while printing exception.
>>
>> This is probably not by design, right?
>
> Perhaps not, but conditions are expected to be raised with “raise”:
>
> (use-modules (srfi srfi-34) (srfi srfi-35))
>
> (define-condition-type  
>   platform-not-found-error?)
>
> (raise (condition ()))
> ice-9/boot-9.scm:1685:16: In procedure raise-exception:
> ERROR:
>   1. 

Thanks for pointing that.  The above with 'raise' doesn't produce the
same output for my Guile 3.0.8:

--8<---cut here---start->8---
(use-modules (srfi srfi-35))

(define-condition-type  
  platform-not-found-error?)

(raise (condition ()))
ice-9/boot-9.scm:1685:16: In procedure raise-exception:
Wrong type (expecting exact integer): #<>
--8<---cut here---end--->8---

Using 'raise-exception' instead of 'raise' fixes it for me:

--8<---cut here---start->8---
(raise-exception (condition ()))
ice-9/boot-9.scm:1685:16: In procedure raise-exception:
ERROR:
  1. 

Entering a new prompt.  Type `,bt' for a backtrace or `,q' to continue.
--8<---cut here---end--->8---

So my initial issue was attempting to raise on a type rather than an
object (which works both ways in other languages such as Python).

If I also import srfi-34, then it works as expected:

--8<---cut here---start->8---
(use-modules (srfi srfi-34) (srfi srfi-35))

(define-condition-type  
  platform-not-found-error?)

(raise (condition ()))
--8<---cut here---end--->8---

So my original confusing was that there exists a 'raise' procedure in
Guile, which has nothing to do with exceptions (it's used to send a
signal to the current process).

What I'll take from this is to use exclusively 'raise-exception', which
is not subject to the above srfi-34 vs builtin raise confusion.

Closing, thanks for helping me untangle things!

-- 
Thanks,
Maxim

bug#60799: Bogus 'Error while printing exception' message when raising srfi-35 exception

[Maxim Cournoyer]

Hello Guile,

When raising a srfi-35 defined exception type like in the following, a
generic (and unhelpful) "Error while printing exception" message is
shown, with not even the exception type mentioned:

--8<---cut here---start->8---
(use-modules (srfi srfi-35))

(define-condition-type  
  platform-not-found-error?)

(raise-exception )
--8<---cut here---end--->8---

Produces:

--8<---cut here---start->8---
Backtrace:
In ice-9/boot-9.scm:
  1752:10  5 (with-exception-handler _ _ #:unwind? _ # _)
In unknown file:
   4 (apply-smob/0 #)
In ice-9/boot-9.scm:
724:2  3 (call-with-prompt _ _ #)
In ice-9/eval.scm:
619:8  2 (_ #(#(#)))
In ice-9/boot-9.scm:
   2836:4  1 (save-module-excursion _)
  4388:12  0 (_)

ice-9/boot-9.scm:4388:12: Error while printing exception.
--8<---cut here---end--->8---

This is probably not by design, right?

-- 
Thanks,
Maxim

bug#36682: Error in Guile scripting examples

[Maxim Cournoyer]

Hi,

Maxim Cournoyer  writes:

[...]

> I have the following two files:
>
> fact:
>
> #!/run/current-system/profile/bin/guile \
> -e main -s
> !#
> (define-module (fact)
>  #:export (fact))
>
> (define (fact n)
>   (if (zero? n) 1
> (* n (fact (- n 1)
>
> (define (main args)
>   (display (fact (string->number (cadr args
>   (newline))
>
>
> fac:
>
> #!/run/current-system/profile/bin/guile \
> -e (@@ (fac) main) -s
> !#
> (define-module (fac)
>   #:export (main))
>
> (use-modules (fact))
>
> (define (choose n m)
>   (/ (fact m) (* (fact (- m n)) (fact n
>
> (define (main args)
>   (let ((n (string->number (cadr args)))
> (m (string->number (caddr args
> (display (choose n m))
> (newline)))
>
>
> But with Guile 3.0.8, this gives me:
>
> ./fac 5 20
> ice-9/read.scm:126:4: In procedure lp:
> #:1:4: unexpected end of input while searching for: )
>
> Which I don't understand.

OK, so what is apparently problematic with modules is the use of '-e (@@
(module-name) proc-name)' with Guil modules.  For the 'fac' file above,
modifying it like this:

--8<---cut here---start->8---
 #!/run/current-system/profile/bin/guile \
 -e (fac) -s
 !#
 (define-module (fac)
   #:export (main))

 (use-modules (fact))

 (define (choose n m)
   (/ (fact m) (* (fact (- m n)) (fact n

 (define (main args)
   (let ((n (string->number (cadr args)))
 (m (string->number (caddr args
 (display (choose n m))
 (newline)))
--8<---cut here---end--->8---

works.  This relies on 'main' being defined and public.  I hope that
helps!

-- 
Thanks,
Maxim

bug#36682: Error in Guile scripting examples

[Maxim Cournoyer]

Hello,

Arne Babenhauserheide  writes:

> Hello Hans-Werner Roitzsch,
>
> It looks like you’re mixing up two concepts: the fac creates a module
> and loads the fact which is not a module, so basically main and choose
> live in another namespace than fact (define-module starts a new
> namespace).
>
> And it seems that this is indeed a bug in the documentation, because
> https://www.gnu.org/software/guile/manual/html_node/Scripting-Examples.html#Scripting-Examples
> jumps to defining fac as a module but does not at the same time define
> and import fact as a module, too.
>
> Hans-Werner Roitzsch  writes:
>> I have the file `modules.scm` with the following code:
>>
>> 88
>> #!/usr/bin/env sh
>> exec guile -l fact.scm -e '(@ (my-module) main)' -s "$0" "$@"
>> !#
>>
>> ;; Explanation:
>> ;; -e (my-module)
>> ;; If run as a script run the `my-module` module's `main`.
>> ;; (Use `@@` to reference not exported procedures.)
>> ;; -s
>> ;; Run the script.
>>
>> (define-module (my-module)
>>   #:export (main))
>
> At this point you need
>
> (use-modules (fact))
>
>> ;; Create a module named `fac`.
>> ;; Export the `main` procedure as part of `fac`.
>>
>> (define (n-choose-k n k)
>>   (/ (fact n)
>>  (* (fact k)
>> (fact (- n k)
>>
>> (define (main args)
>>   (let ((n (string->number (cadr args)))
>> (k (string->number (caddr args
>> (display (n-choose-k n k))
>> (newline)))
>> 88
>>
>> And I have the following `fact.scm`:
>>
>> 88
>> #!/usr/local/bin/guile \
>> -e main -s
>> !#
>>
>> ;; How to run this program?
>> ;; Example:
>> ;; guile -e main -s factorial-script.scm 50
>> ;; Explanation:
>> ;; -e specifies the procedure to run
>> ;; -s specifies to run this as a script
>> ;; 50 is the number we take as input to the script
>
> To be usable as module, this needs to be defined as module:
>
> (define-module (fact)
>   #:export (fact))
>
>> (define (fact n)
>>   (if (zero? n) 1
>>   (* n (fact (- n 1)
>>
>> (define (main args)
>>   (display (fact (string->number (cadr args
>>   (newline))
>> 88
> …
>> chmod +x modules.scm
>> ./modules.scm 10 3
>
> Does it work with the added module definition and import?

Thank you for the above explanations.  I got confused by the this in the
documentation as well.  Trying the above suggestions, I still have a
problem.

I have the following two files:

fact:
--8<---cut here---start->8---
#!/run/current-system/profile/bin/guile \
-e main -s
!#
(define-module (fact)
 #:export (fact))

(define (fact n)
  (if (zero? n) 1
(* n (fact (- n 1)

(define (main args)
  (display (fact (string->number (cadr args
  (newline))
--8<---cut here---end--->8---

fac:
--8<---cut here---start->8---
#!/run/current-system/profile/bin/guile \
-e (@@ (fac) main) -s
!#
(define-module (fac)
  #:export (main))

(use-modules (fact))

(define (choose n m)
  (/ (fact m) (* (fact (- m n)) (fact n

(define (main args)
  (let ((n (string->number (cadr args)))
(m (string->number (caddr args
(display (choose n m))
(newline)))
--8<---cut here---end--->8---

But with Guile 3.0.8, this gives me:
--8<---cut here---start->8---
./fac 5 20
ice-9/read.scm:126:4: In procedure lp:
#:1:4: unexpected end of input while searching for: )
--8<---cut here---end--->8---

Which I don't understand.

-- 
Thanks,
Maxim

bug#59021: Unbounded heap growth when combining dynamic states & delimited continuation

[Maxim Cournoyer]

Hi,

Maxim Cournoyer  writes:

[...]

> I've tested both 3.0.8 from Guix on multiple machines (including Berlin)
> and 2.2 from Debian 10, and ran the above snippet; it grows initially
> but stabilize quickly and then doesn't budge.  I've let it run for more
> than an hour.

Actually, it does grow, it just takes a lot of time.  It's now at
150751472 from the original "stable" value of 87846912, so it seems like
an unbound leak after all.

-- 
Thanks,
Maxim

bug#59021: Unbounded heap growth when combining dynamic states & delimited continuation

[Maxim Cournoyer]

Hi Ludovic,

Ludovic Courtès  writes:

> (This is a followup to ,
> itself a followup to .)
>
> Consider this code:
>
> ;; https://issues.guix.gnu.org/58631
> ;; https://github.com/wingo/fibers/issues/65
>
> (define loss
>   (make-vector 100))
>
> (let ((tag (make-prompt-tag "my prompt")))
>   (define handler
> (lambda (k i)
>   (when (zero? (modulo i 200))
> (pk 'heap-size (assoc-ref (gc-stats) 'heap-size)))
>
>   (call-with-prompt tag
> (lambda ()
>   (k (modulo (+ 1 i) 1000)))
> handler)))
>
>   (call-with-prompt tag
> (let ((state (current-dynamic-state)))
>   (lambda ()
> ;; (define (with-dynamic-state state thunk)
> ;;   (let ((previous #f))
> ;; (dynamic-wind
> ;;   (lambda () (set! previous (set-current-dynamic-state state)))
> ;;   thunk
> ;;   (lambda () (set-current-dynamic-state previous)
> (with-dynamic-state state
> (lambda ()
>   (let loop ((i 0))
> (loop (abort-to-prompt tag i)))
> handler))
>
> On Guile 3.0.8, this program exhibits seemingly unbounded heap growth.
> Uncommenting the local ‘with-dynamic-state’ definition fixes the
> problem.

I've tested both 3.0.8 from Guix on multiple machines (including Berlin)
and 2.2 from Debian 10, and ran the above snippet; it grows initially
but stabilize quickly and then doesn't budge.  I've let it run for more
than an hour.

So there's a problem there (?), but it doesn't seem like an unbound leak
from my experiments.  Perhaps the reproducer needs to be tweaked to
mimic better what is happening in Shepherd?

-- 
Thanks,
Maxim

bug#41956: [PATCH] ice-9: exceptions: Properly format the error message.

[Maxim Cournoyer]

Hello Bengt,

Bengt Richter  writes:


[...]

> What do you think of using (ice-9 match) to make a universal 
> throwage-formatter,
> with the idea of making readable top level code for how exceptions become 
> messages on screen?
>
> I started a hack to explore the (throw 'whatever any ...) space, beginning 
> like
>
> (use-modules (ice-9 match))
> (define (make-exception-message key rest)
>   (begin
> (let*((l (cons key rest)))
>   (match l
>(('system-error subr message args data ...)
> ;; e.g. thrown with key 'system-error: ("open-fdes" "~A" ("No 
> such file or directory") (2))
> (format #f (string-append "match-1: subr ~s threw '~s " message " 
> sterror: ~s") subr key args (strerror (car (car data)
>
>(('signal   any ...)
>   ;; not yet implemented
> (format #f "match-2:  any: ~s" any))

Are you proposing to refactor (ice-9 exceptions) so that it's simpler to
follow a condition message is formed for a given exception type?

Maxim

bug#41956: [PATCH] ice-9: exceptions: Properly format the error message.

[Maxim Cournoyer]

Hello Ricardo!

Ricardo Wurmus  writes:

> Hi Maxim,
>
> here’s what I did in the REPL:
>
> scheme@(guile-user)> ,m (ice-9 exceptions)
> scheme@(ice-9 exceptions)> (define (my/guile-system-error-converter key args)
>   (apply (case-lambda
>   ((subr msg-args msg errno . rest)
>;; XXX TODO we should return a more specific error
>;; (usually an I/O error) as expected by R6RS programs.
>;; Unfortunately this often requires the 'filename' (or
>;; other?) which is not currently provided by the native
>;; Guile exceptions.
>  (make-exception
>   (make-external-error)
> (make-exception-with-origin subr)
> (apply make-exception-with-message msg)
> (make-exception-with-irritants msg-args)))
>   (_ (guile-external-error-converter key args)))
>  args))
> scheme@(ice-9 exceptions)> (set! guile-exception-converters (acons 
> 'system-error my/guile-system-error-converter guile-exception-converters))
> scheme@(ice-9 exceptions)> ,m (guile-user)
> scheme@(guile-user)> (guard (c ((message-condition? c)
> (format #t "message: ~a~%" (condition-message c
> (canonicalize-path "/doesntexist"))
> message: No such file or directory
> $11 = #t
> scheme@(guile-user)> 

I've tested that this indeed works, although I don't quite understand
how?

This brings embeds the definition of `guile-common-exceptions' into
`guile-system-error-converter', with a single change:

(make-exception-with-message msg) --> (apply make-exception-with-message
msg msg-args)

What is the magic I fail to see?

Is this fix proper to be merged into the original
guile-common-exceptions procedure?

Thank you!

Maxim

bug#41956: [PATCH] ice-9: exceptions: Properly format the error message.

[Maxim Cournoyer]

Hello Bengt!

Bengt Richter  writes:

> Hi Maxim,
>
> tl;dr:
> Does module/ice-9/exceptions.scm use the default format?
> Maybe (use-modules (ice-9) format) will help get to the next bug ?? :)

Thanks for suggesting!  I tried but got the same result.

I'm now testing a slightly different version:

@@ -189,7 +189,10 @@
   ((subr msg margs . _)
(make-exception
 (make-exception-with-origin subr)
-(make-exception-with-message msg)
+(let ((msg (if (list? margs)
+   (apply simple-format #f msg margs)
+   msg)))
+(make-exception-with-message msg))
 (make-exception-with-irritants margs)))
   (_ (make-exception-with-irritants args)))
  args))

Maxim

bug#41956: [PATCH] ice-9: exceptions: Properly format the error message.

[maxim . cournoyer]

Maxim Cournoyer  writes:

> Hello,
>
> I had this problem in Guix where 'guix deploy my-config.scm' would
> unhelpfully report an error like:
>
> guix deploy: error: failed to deploy my-host: ~A: ~S
>
> Digging a bit, I could reproduce at the REPL with:
>
> (guard (c ((message-condition? c)
>(format #t "error: ~a~%" (condition-message c
>   ;; This is what (canonicalize-path "/do/not/exist) ends up doing:
>   (throw 'system-error "canonicalize-path" "~A" '("No such file or 
> directory")))
>
> --> error: ~A

[...]

Unfortunately the previous patch breaks the tests, with errors like:

ERROR: bytevectors.test: Datum Syntax: incorrect prefix - arguments: 
((wrong-type-arg "apply" "Apply to non-list: ~S" (#\i) (#\i)))

I'm out of ideas for now, I last tried:

--8<---cut here---start->8---
modified   module/ice-9/exceptions.scm
@@ -189,7 +189,10 @@
   ((subr msg margs . _)
(make-exception
 (make-exception-with-origin subr)
-(make-exception-with-message msg)
+(let ((msg (if (null? margs)
+   msg
+   (apply simple-format #f msg margs
+(make-exception-with-message msg))
 (make-exception-with-irritants margs)))
   (_ (make-exception-with-irritants args)))
  args))
--8<---cut here---end--->8---

To the same effect.

Maxim

bug#41956: [PATCH] ice-9: exceptions: Properly format the error message.

[Maxim Cournoyer]

Hello,

I had this problem in Guix where 'guix deploy my-config.scm' would
unhelpfully report an error like:

guix deploy: error: failed to deploy my-host: ~A: ~S

Digging a bit, I could reproduce at the REPL with:

--8<---cut here---start->8---
(guard (c ((message-condition? c)
   (format #t "error: ~a~%" (condition-message c
  ;; This is what (canonicalize-path "/do/not/exist) ends up doing:
  (throw 'system-error "canonicalize-path" "~A" '("No such file or directory")))

--> error: ~A
--8<---cut here---end--->8---

It seems our native -> srfi-34 style exception converter should populate
the message field with a formatted message, given that's what happens to
present errors as explained in libguile/error.c:

When an error is reported,\n
"these are replaced by formatting the corresponding members of\n"
"@var{args}: @code{~A} (was @code{%s} in older versions of\n"
"Guile) formats using @code{display} and @code{~S}

I'm not sure about the second ~S that appeared in the Guix output;
possibly the exception got re-thrown and suffered from a slightly
different conversion problem?

Anyway, the simple patch attached should fix the "~A" exception message.

Thank you,

Maxim

>From adaa2f66fec7684e9e65491158afc5923613e3da Mon Sep 17 00:00:00 2001
From: Maxim Cournoyer 
Date: Fri, 19 Jun 2020 14:30:05 -0400
Subject: [PATCH] ice-9: exceptions: Properly format the error message.

Before this change, native exceptions such as system errors caught with
srfi-34's `guard' would be converted to an exception with its message
unhelpfully set to "~A".

Thus, apply the message arguments to the message format to derive a human
readable exception message.

* module/ice-9/exceptions.scm (guile-common-exceptions): Format the
message string using its arguments.
---
 module/ice-9/exceptions.scm | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/module/ice-9/exceptions.scm b/module/ice-9/exceptions.scm
index 143e7aa3e..c990790e9 100644
--- a/module/ice-9/exceptions.scm
+++ b/module/ice-9/exceptions.scm
@@ -189,7 +189,7 @@
   ((subr msg margs . _)
(make-exception
 (make-exception-with-origin subr)
-(make-exception-with-message msg)
+(make-exception-with-message (apply format #f msg margs))
 (make-exception-with-irritants margs)))
   (_ (make-exception-with-irritants args)))
  args))
-- 
2.26.2

bug#32580: Setting variables %load-should-autocompile and GUILE_AUTO_COMPILE in ~/.guile doesn't prevent compiling

[Maxim Cournoyer]

Hello Seamus,

seamus phenetols  writes:

> Setting GUILE_AUTO_COMPILE in ~/.profile and in ~/.bash_profile
> doesn't seem to have any effect.  I'm giving up on guile for now.
> Thank you very much for helping.

I'm sorry it hasn't worked for you! Let's see if we can find out why.

What exactly did you put in your ~/.profile or ~/.bash_profile? What
version of Guile are you using? When launching a new pseudo terminal
(i.e. xterm, gnome-terminal, etc.) and typing 'echo
$GUILE_AUTO_COMPILE', does it return the expected value defined in your
~/.profile or ~/.bash_profile?

Note that you would need to logout then login of your session for new
variable definition to take effect; otherwise you can test it in your
current shell by sourcing it:

--8<---cut here---start->8---
source ~/.bash_profile # or source ~/.profile
--8<---cut here---start->8---

I've put the following Scheme code in a file named
'test-auto-compile.scm' (attached for your convenience):

--8<---cut here---start->8---
#!/usr/bin/env guile
!#

(define (main)
  "Print whether auto-compilation is enabled or not and exit with an
exit status of 1 if it is enabled, 0 otherwise."
  (let ((guile-auto-compile-value (getenv "GUILE_AUTO_COMPILE")))
(display (format #f "The value of GUILE_AUTO_COMPILE is ~s\n"
 guile-auto-compile-value))
(when (and guile-auto-compile-value
   (string=? guile-auto-compile-value "0"))
(display "Auto-compilation is disabled.\n")
(exit 0))
(display "Auto-compilation is enabled.\n")
(exit 1)))

(main)
--8<---cut here---start->8---

Here's a small demonstration of what the above script gives on my system
(guile --version is 2.2.4, but this should work for any Guile version >=
2.0):

--8<---cut here---start->8---
echo $GUILE_AUTO_COMPILE

maxim@apteryx ~/Documents$ guile test-auto-compile.scm
;;; note: auto-compilation is enabled, set GUILE_AUTO_COMPILE=0
;;;   or pass the --no-auto-compile argument to disable.
;;; compiling /home/maxim/Documents/test-auto-compile.scm
;;; compiled 
/home/maxim/.cache/guile/ccache/2.2-LE-8-3.A/home/maxim/Documents/test-auto-compile.scm.go
The value of GUILE_AUTO_COMPILE is #f
Auto-compilation is enabled.
maxim@apteryx ~/Documents$ 
maxim@apteryx ~/Documents$ rm 
/home/maxim/.cache/guile/ccache/2.2-LE-8-3.A/home/maxim/Documents/test-auto-compile.scm.go
maxim@apteryx ~/Documents$ export GUILE_AUTO_COMPILE=0
maxim@apteryx ~/Documents$ guile test-auto-compile.scm
The value of GUILE_AUTO_COMPILE is "0"
Auto-compilation is disabled.
--8<---cut here---end--->8---

I hope this helps,

Maxim

#!/usr/bin/env guile
!#

(define (main)
  "Print whether auto-compilation is enabled or not and exit with an
exit status of 1 if it is enabled, 0 otherwise."
  (let ((guile-auto-compile-value (getenv "GUILE_AUTO_COMPILE")))
(display (format #f "The value of GUILE_AUTO_COMPILE is ~s\n"
 guile-auto-compile-value))
(when (and guile-auto-compile-value
   (string=? guile-auto-compile-value "0"))
(display "Auto-compilation is disabled.\n")
(exit 0))
(display "Auto-compilation is enabled.\n")
(exit 1)))

(main)

bug#32580: Setting variables %load-should-autocompile and GUILE_AUTO_COMPILE in ~/.guile doesn't prevent compiling

[Maxim Cournoyer]

Hello Seamus,

seamus phenetols  writes:

> Hello MC,
>
>> My guess is that setting GUILE_AUTO_COMPILE dynamically in your ~/.guile
>> is too late; the Guile process would have already been fire-up without
>> it set early enough to take effect (just a guess).
>
> I assumed ~/.guile would be evaluated before any script.  Perhaps I am 
> mistaken.
>
>> Try exporting the GUILE_AUTO_COMPILE variable before running your
>> program, or setting it inline in front of your guile command:
>
> Yes, that does work.  Now every time I want to disable autocompile I must:
>
> GUILE_AUTO_COMPILE=0 guile ~/scheme/hello.scm

As I wrote, you can also export the variable:
--8<---cut here---start->8---
export GUILE_AUTO_COMPILE=0
--8<---cut here---end--->8---

To make it permanent you can define such a line in your ~/.profile or
~/.bash_profile, and logout/login into your session to have it effective.

The Guile reference manual only defines two means to control
auto-compilation:

1. Setting the GUILE_AUTO_COMPILE environment variables (which, being an
environment variable, should be defined as such, as explained above)

2. Using the --no-auto-compile option passed directly to the guile
interpreter.

Let me know if this addresses your issue.

Thank you,

Maxim

bug#32580: Setting variables %load-should-autocompile and GUILE_AUTO_COMPILE in ~/.guile doesn't prevent compiling

[Maxim Cournoyer]

Hello,

seamus phenetols  writes:

> I'm new to guile and scheme.  I compiled 2.2.4 from source yesterday.
> I wish to silence the auto-compile chatter, other than real warnings and 
> errors
> while testing my programs.  There seems to be no way to do it, so I looked
> for a way to disable auto-compile in ~/.guile configuration file.  No luck so 
> far,
> but the variables %load-should-autocompile and GUILE_AUTO_COMPILE
> seem promising.  Sadly, they don't seem to prevent auto-compile when
> set within ~/.guile.
>
> Below is an excerpt of my shell session to demonstrate.  In case it may be
> poorly formatted, I could make  a web paste for easy viewing.

My guess is that setting GUILE_AUTO_COMPILE dynamically in your ~/.guile
is too late; the Guile process would have already been fire-up without
it set early enough to take effect (just a guess).

Try exporting the GUILE_AUTO_COMPILE variable before running your
program, or setting it inline in front of your guile command:

--8<---cut here---start->8---
guile hello.scm 
;;; note: source file /home/maxim/hello.scm
;;;   newer than compiled 
/home/maxim/.cache/guile/ccache/2.2-LE-8-3.A/home/maxim/hello.scm.go
;;; note: auto-compilation is enabled, set GUILE_AUTO_COMPILE=0
;;;   or pass the --no-auto-compile argument to disable.
;;; compiling /home/maxim/hello.scm
;;; compiled 
/home/maxim/.cache/guile/ccache/2.2-LE-8-3.A/home/maxim/hello.scm.go
Hello World
maxim@apteryx ~$ rm .cache/guile/ccache/2.2-LE-8-3.A/home/maxim/hello.scm.go
maxim@apteryx ~$ GUILE_AUTO_COMPILE=0 guile hello.scm
Hello World
--8<---cut here---end--->8---

Where have you seen that %load-should-autocompile variable documented?
It doesn't appear in the Guile Reference info manual.

This doesn't seem to be a bug :)

Thank you,

Maxim

bug#29553: Patches for guile on MSYS2

[Maxim Cournoyer]

Hannes Müller  writes:

> Dear Maintainer,
>
> Hereby I ask to apply the following patches for inclusion. They are
> already used downstream in guile on MSYS2.
>

[...]

FWIW, I've read those patches and they look fine to me.

Maxim

bug#28835: [PATCH] Re: bug#28835: guild help refers to non-existing info node

[Maxim Cournoyer]

Maxim Cournoyer <maxim.courno...@gmail.com> writes:

> While attempting to learn what I could do with guild, I stumbled on the 
> following:
>
> guild help
> Usage: guild COMMAND [ARGS]
> Run command-line scripts provided by GNU Guile and related programs.
>
> [...]
>
> Report guild bugs to bug-guile@gnu.org
> GNU Guile home page: <http://www.gnu.org/software/guile/>
> General help using GNU software: <http://www.gnu.org/gethelp/>
> For complete documentation, run: info guile 'Using Guile Tools'
>
> Running 'info guile 'Using Guile Tools' brings us to the top of the
> Guile Reference Manual with the following warning in the mini-buffer:
>
> No menu item 'Using Guile Tools' in node '(guile.info.gz)Top'.
>

Apparently, there *is* a node 'Using Guile Tools', but its reference
in the help should read as

info '(guile)Using Guile Tools'

instead of

info guile 'Using Guile Tools'

Patch attached.

Maxim
>From b5613324a15a3f9b64d32d30cd58ba5bea688016 Mon Sep 17 00:00:00 2001
From: Maxim Cournoyer <maxim.courno...@gmail.com>
Date: Sat, 14 Oct 2017 12:16:54 -0400
Subject: [PATCH] scripts: help: Fix reference to the "Using Guile Tools" node.

Fixes bug#28835.

* module/scripts/help.scm (list-commands): Fix reference to the "Using
Guile Tools" node.
---
 module/scripts/help.scm | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/module/scripts/help.scm b/module/scripts/help.scm
index 4e0f47c32..34400db3a 100644
--- a/module/scripts/help.scm
+++ b/module/scripts/help.scm
@@ -115,7 +115,7 @@ For help on a specific command, try \"guild help COMMAND\".
 Report guild bugs to ~a
 GNU Guile home page: <http://www.gnu.org/software/guile/>
 General help using GNU software: <http://www.gnu.org/gethelp/>
-For complete documentation, run: info guile 'Using Guile Tools'
+For complete documentation, run: info '(guile)Using Guile Tools'
 " %guile-bug-report-address))
 
 (define (module-commentary mod)
-- 
2.14.1

bug#28835: guild help refers to non-existing info node

[Maxim Cournoyer]

While attempting to learn what I could do with guild, I stumbled on the 
following:

guild help
Usage: guild COMMAND [ARGS]
Run command-line scripts provided by GNU Guile and related programs.

[...]

Report guild bugs to bug-guile@gnu.org
GNU Guile home page: 
General help using GNU software: 
For complete documentation, run: info guile 'Using Guile Tools'

Running 'info guile 'Using Guile Tools' brings us to the top of the
Guile Reference Manual with the following warning in the mini-buffer:

--8<---cut here---start->8---
No menu item 'Using Guile Tools' in node '(guile.info.gz)Top'.
--8<---cut here---end--->8---

Maxim

bug#27215: break-at-source doesn't seem to work

[Maxim Cournoyer]

Hello Guile!

I'm trying to get proficient at debugging Guile programs, and while
trying things I noticed that the ,break-at-source interactive command
doesn't seem to work. See the following Geiser session:

--8<---cut here---start->8---
GNU Guile 2.2.2
Copyright (C) 1995-2017 Free Software Foundation, Inc.

Guile comes with ABSOLUTELY NO WARRANTY; for details type `,show w'.
This program is free software, and you are welcome to redistribute it
under certain conditions; type `,show c' for details.

Enter `,help' for help.
scheme@(guile-user)> ,m (guix scripts environment)
scheme@(guix scripts environment)> ,bs 
"/home/maxim/src/guix/scripts/environment.scm" 543
While executing meta-command:
ERROR: No procedures found at ~a:~a. 
"/home/maxim/src/guix/scripts/environment.scm" 543
scheme@(guix scripts environment)> ,break guix-environment
Trap 1: Breakpoint at #.
--8<---cut here---end--->8---

There are two things to notice here:

1. The ,bs (break-at-source) command couldn't find the
(guix-environment) proceduce located exactly on line 543 of the
environment.scm file, although ,break guix-environment could.

2. The error message is not formatted right.

It might or might not be related to
https://debbugs.gnu.org/cgi/bugreport.cgi?bug=26027 as suggested by
spk121 on #guile.

Maxim