unofficial mirror of bug-guile@gnu.org 
 help / color / mirror / Atom feed
From: Jean Abou Samra <jean@abou-samra.fr>
To: 50068@debbugs.gnu.org
Cc: guile-devel@gnu.org
Subject: bug#50068: [PATCH] In curried definitions, move docstrings to outermost lambda
Date: Tue, 29 Mar 2022 01:25:21 +0200	[thread overview]
Message-ID: <c7fd438c-60f8-417f-3a86-74437d051372__41823.3634832845$1648510003$gmane$org@abou-samra.fr> (raw)
In-Reply-To: <531f2e17-3f13-4610-5238-17ff94a2b3fd@abou-samra.fr>

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@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







      reply	other threads:[~2022-03-28 23:25 UTC|newest]

Thread overview: 2+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2021-08-15 10:13 bug#50068: Curried definitions lose docstrings Jean Abou Samra
2022-03-28 23:25 ` Jean Abou Samra [this message]

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/guile/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to='c7fd438c-60f8-417f-3a86-74437d051372__41823.3634832845$1648510003$gmane$org@abou-samra.fr' \
    --to=jean@abou-samra.fr \
    --cc=50068@debbugs.gnu.org \
    --cc=guile-devel@gnu.org \
    --subject='Re: bug#50068: [PATCH] In curried definitions, move docstrings to outermost lambda' \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).