Package: guile;
Reported by: Jean Abou Samra <jean <at> abou-samra.fr>
Date: Sun, 15 Aug 2021 10:14:02 UTC
Severity: normal
Done: lloda <lloda <at> sarc.name>
Bug is archived. No further changes may be made.
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
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.