unofficial mirror of bug-guile@gnu.org 
 help / color / mirror / Atom feed
* bug#50068: Curried definitions lose docstrings
@ 2021-08-15 10:13 Jean Abou Samra
  2022-03-28 23:25 ` bug#50068: [PATCH] In curried definitions, move docstrings to outermost lambda Jean Abou Samra
  0 siblings, 1 reply; 2+ messages in thread
From: Jean Abou Samra @ 2021-08-15 10:13 UTC (permalink / raw)
  To: 50068

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.





^ permalink raw reply	[flat|nested] 2+ messages in thread

* bug#50068: [PATCH] In curried definitions, move docstrings to outermost lambda
  2021-08-15 10:13 bug#50068: Curried definitions lose docstrings Jean Abou Samra
@ 2022-03-28 23:25 ` Jean Abou Samra
  0 siblings, 0 replies; 2+ messages in thread
From: Jean Abou Samra @ 2022-03-28 23:25 UTC (permalink / raw)
  To: 50068; +Cc: guile-devel

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







^ permalink raw reply	[flat|nested] 2+ messages in thread

end of thread, other threads:[~2022-03-28 23:25 UTC | newest]

Thread overview: 2+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-08-15 10:13 bug#50068: Curried definitions lose docstrings Jean Abou Samra
2022-03-28 23:25 ` bug#50068: [PATCH] In curried definitions, move docstrings to outermost lambda Jean Abou Samra

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).