From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Jean Abou Samra Newsgroups: gmane.lisp.guile.bugs Subject: bug#50068: [PATCH] In curried definitions, move docstrings to outermost lambda Date: Tue, 29 Mar 2022 01:25:21 +0200 Message-ID: References: <531f2e17-3f13-4610-5238-17ff94a2b3fd@abou-samra.fr> Mime-Version: 1.0 Content-Type: text/plain; charset=UTF-8; format=flowed Content-Transfer-Encoding: 8bit Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="27818"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:91.0) Gecko/20100101 Thunderbird/91.7.0 Cc: guile-devel@gnu.org To: 50068@debbugs.gnu.org Original-X-From: bug-guile-bounces+guile-bugs=m.gmane-mx.org@gnu.org Tue Mar 29 01:26:35 2022 Return-path: Envelope-to: guile-bugs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1nYykt-00071v-P7 for guile-bugs@m.gmane-mx.org; Tue, 29 Mar 2022 01:26:35 +0200 Original-Received: from localhost ([::1]:40880 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1nYyks-0000SO-Cu for guile-bugs@m.gmane-mx.org; Mon, 28 Mar 2022 19:26:34 -0400 Original-Received: from eggs.gnu.org ([209.51.188.92]:44670) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nYykO-00005O-HR for bug-guile@gnu.org; Mon, 28 Mar 2022 19:26:05 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]:37236) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nYykM-0005aE-Jg for bug-guile@gnu.org; Mon, 28 Mar 2022 19:26:03 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1nYykM-00008I-Ba for bug-guile@gnu.org; Mon, 28 Mar 2022 19:26:02 -0400 X-Loop: help-debbugs@gnu.org In-Reply-To: <531f2e17-3f13-4610-5238-17ff94a2b3fd@abou-samra.fr> Resent-From: Jean Abou Samra Original-Sender: "Debbugs-submit" Resent-CC: bug-guile@gnu.org Resent-Date: Mon, 28 Mar 2022 23:26:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 50068 X-GNU-PR-Package: guile Original-Received: via spool by 50068-submit@debbugs.gnu.org id=B50068.1648509931466 (code B ref 50068); Mon, 28 Mar 2022 23:26:02 +0000 Original-Received: (at 50068) by debbugs.gnu.org; 28 Mar 2022 23:25:31 +0000 Original-Received: from localhost ([127.0.0.1]:59366 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nYyjr-00007R-2z for submit@debbugs.gnu.org; Mon, 28 Mar 2022 19:25:31 -0400 Original-Received: from mout.kundenserver.de ([217.72.192.73]:55193) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nYyjo-000079-J6 for 50068@debbugs.gnu.org; Mon, 28 Mar 2022 19:25:29 -0400 Original-Received: from [10.188.216.67] ([46.193.67.184]) by mrelayeu.kundenserver.de (mreue107 [212.227.15.184]) with ESMTPSA (Nemesis) id 1MEVqu-1nnsyG0gu2-00FxpD; Tue, 29 Mar 2022 01:25:22 +0200 Content-Language: en-US X-Provags-ID: V03:K1:O+fYQ5i/PuO92di3boOzLYIRvPvvvGgMCGar3qRf8AJr1/I+GPD jyDJiV3NIn3dlNggoIHWgt+sW3JCAE49IA317X7/KN2k7zuuRGAm2VsNUhqcNAIyiGAbkHl fsVZvnnqyxJ2QjN509gay9E2yRp1Re25av3SQP7hAL5Rj5BFqe5OJou91y48G9qYgEHIZ5l Plq6AEAH6alMLyL0BSSDQ== X-UI-Out-Filterresults: notjunk:1;V03:K0:RzZgqL2d7us=:O9yBgGS8e1cuGh0hdpjCnD JJ/1SPiwg7QHtkLQvoofLwOwK9kvjuRIYgG9H6xt1oZUVk5Uu2Sfnn0vawUzLGW4nhjV/5Nnk i4ZARWDSPwerlORaCquKibHMtbbQpfNFfZgGEstugZZ4F5WrRBVuKqmRe8DpDPAtB0rNk4oYs dOvBI8cvhWO1RJLVHFSicKbtc7/FYzZv9CgcS7Ll+a+RA3jTyzKbsNCP5tqonZceSI5zXKTke t31Y4z6KilQoj4NOiSGBDdicDHMZQX9YcrMlKh66gCA+CmCJbt+loPbBisbAkFC3xAPcCHhw4 fGODKjdSFQ8K7oGUs8t8B1MV4cwJXaKUUkopmVXV6wFtMYCAFJUF9Ra6vdsLwQ5HqsQu85qy2 OPc73o/3KQRV4MVixi6u/SvFbMwv8JBZ2nCF2jDnsjejQ/I14nrx7Up0oZbeqALGXzAXUA6eZ BPdpqEV8Et2WtSK0YAhybGTTfl9FKzKtRCW7usbYsdu7E0ezXOgF8jU/53DmNhrjHfh6Mj0uu ve1dVhqvXfP9WTJjd6xfjwQpWb5tv/bWINcX6r+ez0gqChhePTg1iEjgg/23BoJ9um+c1oD1U O2FqFFu8BVPfLB3PQNXS6ROa3s0TjVeK9OPASEV+szfss9LGrkv4nN+/71VDF6d5yrbcduZ4J VZbPPAC2mf90N3gpBpBOB9+OijUTccui3lmFeAu2L4ACjqKv90+cAKUahCI53NaG35DE= X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-guile@gnu.org List-Id: "Bug reports for GUILE, GNU's Ubiquitous Extension Language" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-guile-bounces+guile-bugs=m.gmane-mx.org@gnu.org Original-Sender: "bug-guile" Xref: news.gmane.io gmane.lisp.guile.bugs:10272 Archived-At: 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 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