GNU bug report logs - #50068
Curried definitions lose docstrings

Previous Next

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 50068 in the body.
You can then email your comments to 50068 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Jean Abou Samra <jean <at> abou-samra.fr>
To: bug-guile <at> gnu.org
Subject: Curried definitions lose docstrings
Date: Sun, 15 Aug 2021 12:13:28 +0200

When a docstring is used in the body of a curried definition,
it ends up on the result of the application of the resulting
curried function, not on the function itself. Example:

(use-modules (ice-9 curried-definitions))

(define ((curried a) b)
  "Docstring of curried"
  'whatever)

(procedure-documentation curried)
=> #f

(procedure-documentation (curried 'whatnot))
=> "Docstring of curried"


This is apparently because Guile translates

(define ((curried a) b)
  ...)

to

(define (curried a)
  (lambda (b)
    ...))

which puts the docstring in the body
of lambda.

Tested with Guile 2.2 and 3.0.5.

Message #8 received at 50068 <at> debbugs.gnu.org (full text, mbox):

From: Jean Abou Samra <jean <at> abou-samra.fr>
To: 50068 <at> debbugs.gnu.org
Cc: guile-devel <at> gnu.org
Subject: [PATCH] In curried definitions, move docstrings to outermost lambda
Date: Tue, 29 Mar 2022 01:25:21 +0200

Hi,

Please consider the following patch, fixing bug #50068.

Best regards,
Jean



From 79552d2974e9cbcfcf01960aab68cb6824c88972 Mon Sep 17 00:00:00 2001
From: Jean Abou Samra <jean <at> abou-samra.fr>
Date: Tue, 29 Mar 2022 00:14:45 +0200
Subject: [PATCH] In curried definitions, move docstrings to outermost lambda

This makes the docstring attached to the curried function being defined
rather than the result of its application until a function that runs the
body is obtained, fixing
https://debbugs.gnu.org/cgi/bugreport.cgi?bug=50068
---
 module/ice-9/curried-definitions.scm      | 72 ++++++++++++-----------
 test-suite/tests/curried-definitions.test | 56 ++++++++++++++++--
 2 files changed, 90 insertions(+), 38 deletions(-)

diff --git a/module/ice-9/curried-definitions.scm 
b/module/ice-9/curried-definitions.scm
index 7545338e3..7e758be5e 100644
--- a/module/ice-9/curried-definitions.scm
+++ b/module/ice-9/curried-definitions.scm
@@ -4,12 +4,12 @@
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
 ;;;; version 3 of the License, or (at your option) any later version.
-;;;;
+;;;;
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 ;;;; Lesser General Public License for more details.
-;;;;
+;;;;
 ;;;; You should have received a copy of the GNU Lesser General Public
 ;;;; License along with this library; if not, write to the Free Software
 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 
02110-1301 USA
@@ -20,38 +20,42 @@
              define-public
              define*-public))

-(define-syntax cdefine
-  (syntax-rules ()
-    ((_ (head . rest) body body* ...)
-     (cdefine head
-       (lambda rest body body* ...)))
-    ((_ name val)
-     (define name val))))
+(define-syntax make-currying-define
+  (syntax-rules ::: ()
+    ((_ currying-name lambda-name)
+     (define-syntax currying-name
+       (lambda (St-Ax)
+         (syntax-case St-Ax ()
+           ((_ ((head2 . rest2) . rest) docstring body body* ...)
+            (string? (syntax->datum #'docstring))
+            ;; Keep moving docstring to outermost lambda.
+            #'(currying-name (head2 . rest2)
+                docstring
+                (lambda-name rest body body* ...)))
+           ((_ (head . rest) body body* ...)
+            #'(currying-name head
+                (lambda-name rest body body* ...)))
+           ((_ name val)
+            #'(define name val))))))))

-(define-syntax cdefine*
-  (syntax-rules ()
-    ((_ (head . rest) body body* ...)
-     (cdefine* head
-       (lambda* rest body body* ...)))
-    ((_ name val)
-     (define* name val))))
+(make-currying-define cdefine lambda)
+(make-currying-define cdefine* lambda*)

-(define-syntax define-public
-  (syntax-rules ()
-    ((_ (head . rest) body body* ...)
-     (define-public head
-       (lambda rest body body* ...)))
-    ((_ name val)
-     (begin
-       (define name val)
-       (export name)))))
+(define-syntax make-currying-define-public
+  (syntax-rules ::: ()
+    ((_ public-name define-name)
+     (define-syntax public-name
+       (lambda (St-Ax)
+         (syntax-case St-Ax ()
+           ((_ binding body body* ...)
+            #`(begin
+                (define-name binding body body* ...)
+                (export #,(let find-name ((form #'binding))
+                            (syntax-case form ()
+                              ((head . tail)
+                               (find-name #'head))
+                              (name
+                               #'name))))))))))))

-(define-syntax define*-public
-  (syntax-rules ()
-    ((_ (head . rest) body body* ...)
-     (define*-public head
-       (lambda* rest body body* ...)))
-    ((_ name val)
-     (begin
-       (define* name val)
-       (export name)))))
+(make-currying-define-public define-public cdefine)
+(make-currying-define-public define*-public cdefine*)
diff --git a/test-suite/tests/curried-definitions.test 
b/test-suite/tests/curried-definitions.test
index b4a1f6509..cd535b162 100644
--- a/test-suite/tests/curried-definitions.test
+++ b/test-suite/tests/curried-definitions.test
@@ -5,12 +5,12 @@
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
 ;;;; version 3 of the License, or (at your option) any later version.
-;;;;
+;;;;
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 ;;;; Lesser General Public License for more details.
-;;;;
+;;;;
 ;;;; You should have received a copy of the GNU Lesser General Public
 ;;;; License along with this library; if not, write to the Free Software
 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 
02110-1301 USA
@@ -49,7 +49,33 @@
     (equal? 444
             (primitive-eval '(let ()
                                (define foo 444)
-                               foo)))))
+                               foo))))
+
+  (pass-if "docstring"
+    (equal? "Doc"
+            (primitive-eval '(let ()
+                               (define (((foo a) b c) d)
+                                 "Doc"
+                                 42)
+                               (procedure-documentation foo)))))
+
+  (pass-if "define-public"
+    (eqv? 6
+          (primitive-eval '(let ()
+                             (define-public (((f a) b) c)
+                               (+ a b c))
+                             (((f 1) 2) 3)))))
+
+  ;; FIXME: how to test for define-public actually making
+  ;; a public binding?
+
+  (pass-if "define-public and docstring"
+    (equal? "Addition curried."
+            (primitive-eval '(let ()
+                               (define-public (((f a) b) c)
+                                 "Addition curried."
+                                 (+ a b c))
+                               (procedure-documentation f))))))

 (with-test-prefix "define*"
   (pass-if "define* works as usual"
@@ -81,4 +107,26 @@
     (equal? 444
             (primitive-eval '(let ()
                                (define* foo 444)
-                               foo)))))
+                               foo))))
+  (pass-if "docstring"
+    (equal? "Doc"
+            (primitive-eval '(let ()
+                               (define* (((f a) b c) #:optional d)
+                                 "Doc"
+                                 42)
+                               (procedure-documentation f)))))
+
+  (pass-if "define*-public"
+    (eqv? 6
+          (primitive-eval '(let ()
+                             (define*-public (((f a) b) #:optional c)
+                               (+ a b c))
+                             (((f 1) 2) 3)))))
+
+  (pass-if "define*-public and docstring"
+    (equal? "Addition curried."
+            (primitive-eval '(let ()
+                               (define*-public (((f a) b) #:key (c 3))
+                                 "Addition curried."
+                                 (+ a b c))
+                               (procedure-documentation f))))))
-- 
2.32.0

Message #11 received at 50068 <at> debbugs.gnu.org (full text, mbox):

From: Jean Abou Samra <jean <at> abou-samra.fr>
To: 50068 <at> debbugs.gnu.org
Subject: Re: [PATCH] In curried definitions, move docstrings to outermost
 lambdas
Date: Fri, 26 Aug 2022 13:00:23 +0200

Ping? Could this patch be considered please?

Message #16 received at 50068-done <at> debbugs.gnu.org (full text, mbox):

From: lloda <lloda <at> sarc.name>
To: Jean Abou Samra <jean <at> abou-samra.fr>
Cc: 50068-done <at> debbugs.gnu.org
Subject: Re: bug#50068: [PATCH] In curried definitions, move docstrings to
 outermost lambdas
Date: Mon, 29 Aug 2022 18:10:30 +0200

Applied in 61d8dab8eafd498306ce618582aab37497df77b4. Thank you!

Message #19 received at 50068-done <at> debbugs.gnu.org (full text, mbox):

From: Jean Abou Samra <jean <at> abou-samra.fr>
To: lloda <lloda <at> sarc.name>
Cc: 50068-done <at> debbugs.gnu.org
Subject: Re: bug#50068: [PATCH] In curried definitions, move docstrings to
 outermost lambdas
Date: Mon, 29 Aug 2022 18:15:08 +0200

Le 29/08/2022 à 18:10, lloda a écrit :
> Applied in 61d8dab8eafd498306ce618582aab37497df77b4. Thank you!

Thanks, Iloda!

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.