bug#60971: build failure of v3.0.9rc1 on mac os 12.6

bug#60971: build failure of v3.0.9rc1 on mac os 12.6

[lloda]

Hello,

v3.0.9rc1 fails on mac os 12.6.2 & gcc 12.2 or clang 14, same error in either case. gcc's error is:

------------------------------------
CC       libguile_3.0_la-posix.lo
In file included from ../../../src/guile4/libguile/posix.c:82:
../../../src/guile4/libguile/posix.c:109:9: error: lvalue required as unary '&' operand
  109 | verify (WEXITSTATUS (W_EXITCODE (127, 0)) == 127);
      |         ^~~~~~~~~~~
../../../src/guile4/lib/verify.h:213:57: note: in definition of macro '_GL_VERIFY'
  213 | # define _GL_VERIFY(R, DIAGNOSTIC, ...) _Static_assert (R, DIAGNOSTIC)
      |                                                         ^
../../../src/guile4/libguile/posix.c:109:1: note: in expansion of macro 'verify'
  109 | verify (WEXITSTATUS (W_EXITCODE (127, 0)) == 127);
      | ^~~~~~
../../../src/guile4/libguile/posix.c:109:9: error: expression in static assertion is not an integer
  109 | verify (WEXITSTATUS (W_EXITCODE (127, 0)) == 127);
      |         ^~~~~~~~~~~
../../../src/guile4/lib/verify.h:213:57: note: in definition of macro '_GL_VERIFY'
  213 | # define _GL_VERIFY(R, DIAGNOSTIC, ...) _Static_assert (R, DIAGNOSTIC)
      |                                                         ^
../../../src/guile4/libguile/posix.c:109:1: note: in expansion of macro 'verify'
  109 | verify (WEXITSTATUS (W_EXITCODE (127, 0)) == 127);
      | ^~~~~~
------------------------------------

The problematic section in libguile/posix.c

...

#if HAVE_SYS_WAIT_H
# include <sys/wait.h>
#endif
#ifndef WEXITSTATUS
# define WEXITSTATUS(stat_val) ((unsigned)(stat_val) >> 8)
#endif
#ifndef WIFEXITED
# define WIFEXITED(stat_val) (((stat_val) & 255) == 0)
#endif

#ifndef W_EXITCODE
/* Macro for constructing a status value.  Found in glibc.  */
# ifdef _WIN32                            /* see Gnulib's posix-w32.h */
#  define W_EXITCODE(ret, sig)   (ret)
# else
#  define W_EXITCODE(ret, sig)   ((ret) << 8 | (sig))
# endif
#endif
verify (WEXITSTATUS (W_EXITCODE (127, 0)) == 127);
...

adding -o .libs/libguile_3.0_la-posix.i -E to the build line shows line 109 as

_Static_assert ( (((*(int *)&((( 127 ) << 8 | ( 0 )))) >> 8) & 0x000000ff) == 127, "verify (" "WEXITSTATUS (W_EXITCODE (127, 0)) == 127" ")");
                            ^

forcing redefinition of WEXITSTATUS shows the previous definition at /Applications/Xcode.app/Contents/Developer/Platforms/MacOSX.platform/Developer/SDKs/MacOSX.sdk/usr/include/sys/wait.h

...

#if defined(_POSIX_C_SOURCE) && !defined(_DARWIN_C_SOURCE)
#define _W_INT(i)       (i)
#else
#define _W_INT(w)       (*(int *)&(w))  /* convert union wait to int */   <------------- problem
#define WCOREFLAG       0200
#endif /* (_POSIX_C_SOURCE && !_DARWIN_C_SOURCE) */

/* These macros are permited, as they are in the implementation namespace */
#define _WSTATUS(x)     (_W_INT(x) & 0177)
#define _WSTOPPED       0177            /* _WSTATUS if process is stopped */

/*
 * [XSI] The <sys/wait.h> header shall define the following macros for
 * analysis of process status values
 */
#if __DARWIN_UNIX03
#define WEXITSTATUS(x)  ((_W_INT(x) >> 8) & 0x000000ff)
#else /* !__DARWIN_UNIX03 */
#define WEXITSTATUS(x)  (_W_INT(x) >> 8)
#endif /* !__DARWIN_UNIX03 */
/* 0x13 == SIGCONT */
#define WSTOPSIG(x)     (_W_INT(x) >> 8)
#define WIFCONTINUED(x) (_WSTATUS(x) == _WSTOPPED && WSTOPSIG(x) == 0x13)
#define WIFSTOPPED(x)   (_WSTATUS(x) == _WSTOPPED && WSTOPSIG(x) != 0x13)
#define WIFEXITED(x)    (_WSTATUS(x) == 0)
#define WIFSIGNALED(x)  (_WSTATUS(x) != _WSTOPPED && _WSTATUS(x) != 0)
#define WTERMSIG(x)     (_WSTATUS(x))
#if (!defined(_POSIX_C_SOURCE) || defined(_DARWIN_C_SOURCE))
#define WCOREDUMP(x)    (_W_INT(x) & WCOREFLAG)

#define W_EXITCODE(ret, sig)    ((ret) << 8 | (sig))
#define W_STOPCODE(sig)         ((sig) << 8 | _WSTOPPED)
#endif /* (!defined(_POSIX_C_SOURCE) || defined(_DARWIN_C_SOURCE)) */

...

so that's the problem, but I'm not sure what the solution is. The way it's
written, W_EXITCODE() is always going to give up a number...

Thanks

  Daniel

bug#61660: [feature request] optimization of case-lambda

[lloda]

[-- Attachment #1: Type: text/plain, Size: 39 bytes --]


Patch attached, tests tbd. Thoughts?


[-- Attachment #2: 0001-peval-reduces-some-inlined-case-lambda-calls.patch --]
[-- Type: application/octet-stream, Size: 1952 bytes --]

From a1f605598a7a49b2971072c8db635b788e209e3a Mon Sep 17 00:00:00 2001
From: Daniel Llorens <lloda@sarc.name>
Date: Thu, 23 Feb 2023 17:38:10 +0100
Subject: [PATCH] peval reduces some inlined case-lambda calls

* module/language/tree-il/peval.scm (peval): Reduce multiple case lambda
  in <call> trees according to the number of arguments. Lambda cases
  with more than required args (either optional, keyword, or rest
  arguments) are ignored.
---
 module/language/tree-il/peval.scm | 15 +++++++++++++++
 1 file changed, 15 insertions(+)

diff --git a/module/language/tree-il/peval.scm b/module/language/tree-il/peval.scm
index 7945fd9b9..5c9799edb 100644
--- a/module/language/tree-il/peval.scm
+++ b/module/language/tree-il/peval.scm
@@ -1668,6 +1668,21 @@ top-level bindings from ENV and return the resulting expression."
 
                   (log 'inline-end result exp)
                   result)))))
+           (($ <lambda> src-proc meta body)
+            ;; If there are multiple cases and one matches nargs, omit all the others.
+            (or (and (lambda-case-alternate body)
+                 (let ((nargs (length orig-args)))
+                   (let loop ((body body))
+                     (match body
+                       (#f #f)
+                       (($ <lambda-case> src-body req opt rest kw inits gensyms body alt)
+                        (if (and (not opt) (not rest) (not kw) (= nargs (length req)))
+                          (revisit-proc
+                           (make-lambda
+                            src-proc meta
+                            (make-lambda-case src-body req opt rest kw inits gensyms body #f)))
+                          (loop alt)))))))
+                (make-call src (for-call orig-proc) (map for-value orig-args))))
            (($ <let> _ _ _ vals _)
             ;; Attempt to inline `let' in the operator position.
             ;;
-- 
2.30.2

bug#61660: [feature request] optimization of case-lambda

[lloda]

[-- Attachment #1: Type: text/plain, Size: 59 bytes --]


Fixed patch handling rest & #:optional, with test cases.


[-- Attachment #2: 0001-peval-reduces-some-inlined-case-lambda-calls.patch --]
[-- Type: application/octet-stream, Size: 4757 bytes --]

From 61ed612fb36108e395bdee4b1bbb46b49ef017b3 Mon Sep 17 00:00:00 2001
From: Daniel Llorens <lloda@sarc.name>
Date: Thu, 23 Feb 2023 17:38:10 +0100
Subject: [PATCH] peval reduces some inlined case-lambda calls

* module/language/tree-il/peval.scm (peval): Reduce multiple case lambda
  in <call> trees according to the number of arguments. Do not try to
  reduce case-lambda using keyword arguments.
* test-suite/tests/peval.test: Tests.
---
 module/language/tree-il/peval.scm | 23 ++++++++++
 test-suite/tests/peval.test       | 72 +++++++++++++++++++++++++++++++
 2 files changed, 95 insertions(+)

diff --git a/module/language/tree-il/peval.scm b/module/language/tree-il/peval.scm
index 7945fd9b9..7c05e9a2e 100644
--- a/module/language/tree-il/peval.scm
+++ b/module/language/tree-il/peval.scm
@@ -1668,6 +1668,29 @@ top-level bindings from ENV and return the resulting expression."
 
                   (log 'inline-end result exp)
                   result)))))
+           (($ <lambda> src-proc meta orig-body)
+            ;; If there are multiple cases and one matches nargs, omit all the others.
+            (or (and
+                 (lambda-case-alternate orig-body)
+                 (let ((nargs (length orig-args)))
+                   (let loop ((body orig-body))
+                     (match body
+                       (#f #f) ;; No matching case; an error.
+                       (($ <lambda-case> src-case req opt rest kw inits gensyms case-body alt)
+                        (cond (kw
+                               ;; FIXME: Not handling keyword cases.
+                               #f)
+                              ((let ((nreq (length req)))
+                                 (if rest
+                                   (<= nreq nargs)
+                                   (<= nreq nargs (+ nreq (if opt (length opt) 0)))))
+                               ;; Keep only this case.
+                               (revisit-proc
+                                (make-lambda
+                                 src-proc meta
+                                 (make-lambda-case src-case req opt rest kw inits gensyms case-body #f))))
+                              (else (loop alt))))))))
+                (make-call src (for-call orig-proc) (map for-value orig-args))))
            (($ <let> _ _ _ vals _)
             ;; Attempt to inline `let' in the operator position.
             ;;
diff --git a/test-suite/tests/peval.test b/test-suite/tests/peval.test
index a2e4975d9..8a8f0124a 100644
--- a/test-suite/tests/peval.test
+++ b/test-suite/tests/peval.test
@@ -1456,6 +1456,78 @@
     ;; <https://bugs.gnu.org/60522>.
     (primcall make-vector)))
 
+(with-test-prefix "case-lambda"
+  ;; one case
+  (pass-if-peval
+   ((case-lambda (() 0)))
+   (const 0))
+
+  ;; middle
+  (pass-if-peval
+   ((case-lambda (() 0) ((a b) 1) ((a) 2)) 1 2)
+   (const 1))
+
+  ;; last
+  (pass-if-peval
+   ((case-lambda ((a b) 0) ((a) 1) (() 2)))
+   (const 2))
+
+  ;; first
+  (pass-if-peval
+   ((case-lambda ((a) 0) (() 1) ((a b) 2)) 1)
+   (const 0))
+
+  ;; rest arg
+  (pass-if-peval
+   ((case-lambda (args 0) ((a b) 1) ((a) 2)) 1 2)
+   (const 0))
+
+  ;; req before rest I
+  (pass-if-peval
+   ((case-lambda ((a b) 0) (args 1) ((a) 1)) 1 2)
+   (const 0))
+
+  ;; req before rest II
+  (pass-if-peval
+   ((case-lambda ((a) 0) (args 1) ((a b) 2)) 1 2)
+   (const 1))
+
+  ;; optional
+  (pass-if-peval
+   ((case-lambda* ((a #:optional x) 0) (args 1) ((a) 2)) 1 2)
+   (const 0))
+
+  ;; optional and rest, no match I
+  (pass-if-peval
+   ((case-lambda* ((a #:optional x . rest) 0) (args 1) ((a) 2)))
+   (const 1))
+
+  ;; optional and rest, match I
+  (pass-if-peval
+   ((case-lambda* (() 0) ((a #:optional x . rest) 1) ((a) 2)) 1)
+   (const 1))
+
+  ;; optional and rest, match II
+  (pass-if-peval
+   ((case-lambda* ((a #:optional x . rest) 0) (args 1) ((a) 2)) 1)
+   (const 0))
+
+  ;; optional and rest, match III
+  (pass-if-peval
+   ((case-lambda* ((a #:optional x . rest) 0) (args 1) ((a) 2)) 1 2)
+   (const 0))
+
+  ;; optional and rest, match IV
+  (pass-if-peval
+   ((case-lambda* ((a #:optional x . rest) 0) (args 1) ((a) 2)) 1 2 3)
+   (const 0))
+
+  ;; keyword cases survive
+  (pass-if (= 1 ((case-lambda* ((a b) 0) ((a #:key x) 1)) 0 #:x 1)))
+  (pass-if (= 0 ((case-lambda* ((a b c) 0) ((a #:key x) 1)) 0 #:x 1)))
+  (pass-if (= 0 ((case-lambda* ((a #:key x) 0) ((a b) 0)) 0 #:x 1)))
+  (pass-if (= 1 ((case-lambda* ((a #:key x) 0) ((a b c) 1)) 0 1 2))))
+
 (with-test-prefix "eqv?"
   (pass-if-peval (eqv? x #f)
     (primcall eq? (toplevel x) (const #f)))
-- 
2.30.2

bug#61660: [feature request] optimization of case-lambda

[Ludovic Courtès]

Hi Daniel,

lloda <lloda@sarc.name> skribis:

> From 61ed612fb36108e395bdee4b1bbb46b49ef017b3 Mon Sep 17 00:00:00 2001
> From: Daniel Llorens <lloda@sarc.name>
> Date: Thu, 23 Feb 2023 17:38:10 +0100
> Subject: [PATCH] peval reduces some inlined case-lambda calls
>
> * module/language/tree-il/peval.scm (peval): Reduce multiple case lambda
>   in <call> trees according to the number of arguments. Do not try to
>   reduce case-lambda using keyword arguments.
> * test-suite/tests/peval.test: Tests.

[...]

> +++ b/module/language/tree-il/peval.scm
> @@ -1668,6 +1668,29 @@ top-level bindings from ENV and return the resulting expression."
>  
>                    (log 'inline-end result exp)
>                    result)))))
> +           (($ <lambda> src-proc meta orig-body)
> +            ;; If there are multiple cases and one matches nargs, omit all the others.
> +            (or (and
> +                 (lambda-case-alternate orig-body)
> +                 (let ((nargs (length orig-args)))
> +                   (let loop ((body orig-body))
> +                     (match body
> +                       (#f #f) ;; No matching case; an error.
> +                       (($ <lambda-case> src-case req opt rest kw inits gensyms case-body alt)
> +                        (cond (kw
> +                               ;; FIXME: Not handling keyword cases.
> +                               #f)

Maybe s/FIXME/XXX/ since it’s at most a limitation, certainly not a bug.

It LGTM and Andy already approved it on IRC, so go ahead!

Ludo’.

bug#61660: [feature request] optimization of case-lambda

[lloda]

> On 27 Feb 2023, at 11:11, Ludovic Courtès <ludo@gnu.org> wrote:
> 
> Hi Daniel,
> 
> lloda <lloda@sarc.name> skribis:
> 
>> From 61ed612fb36108e395bdee4b1bbb46b49ef017b3 Mon Sep 17 00:00:00 2001
>> From: Daniel Llorens <lloda@sarc.name>
>> Date: Thu, 23 Feb 2023 17:38:10 +0100
>> Subject: [PATCH] peval reduces some inlined case-lambda calls
>> 
>> * module/language/tree-il/peval.scm (peval): Reduce multiple case lambda
>>  in <call> trees according to the number of arguments. Do not try to
>>  reduce case-lambda using keyword arguments.
>> * test-suite/tests/peval.test: Tests.
> 
> [...]
> 
>> +++ b/module/language/tree-il/peval.scm
>> @@ -1668,6 +1668,29 @@ top-level bindings from ENV and return the resulting expression."
>> 
>>                   (log 'inline-end result exp)
>>                   result)))))
>> +           (($ <lambda> src-proc meta orig-body)
>> +            ;; If there are multiple cases and one matches nargs, omit all the others.
>> +            (or (and
>> +                 (lambda-case-alternate orig-body)
>> +                 (let ((nargs (length orig-args)))
>> +                   (let loop ((body orig-body))
>> +                     (match body
>> +                       (#f #f) ;; No matching case; an error.
>> +                       (($ <lambda-case> src-case req opt rest kw inits gensyms case-body alt)
>> +                        (cond (kw
>> +                               ;; FIXME: Not handling keyword cases.
>> +                               #f)
> 
> Maybe s/FIXME/XXX/ since it’s at most a limitation, certainly not a bug.
> 
> It LGTM and Andy already approved it on IRC, so go ahead!
> 
> Ludo’.

Apologies for not seeing this earlier. Pushed to 3b47f87618047ebb8812788c64a44877a4f2e0dd. Thanks!

  - Daniel

bug#61660: [feature request] optimization of case-lambda

[lloda]

On 3.0.9


> ,optimize ((case-lambda (() 0)))
= 0

but 

> ,optimize ((case-lambda (() 0) ((a) 1)))
= ((case-lambda (() 0) ((a) 1)))


The problem with this is that when the output of a macro contains case-lambda, recursive application results in geometrical increase of code size. It seems that it should be possible to resolve the application on the spot; at last to reduce the case-lambda to a simple lambda when the arity is available (which now only happens when the case-lambda contains a single clause).

Thanks

  Daniel