[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] branch main updated: In curried definitions, move docstr
From: |
Daniel Llorens |
Subject: |
[Guile-commits] branch main updated: In curried definitions, move docstrings to outermost lambda |
Date: |
Mon, 29 Aug 2022 06:08:38 -0400 |
This is an automated email from the git hooks/post-receive script.
lloda pushed a commit to branch main
in repository guile.
The following commit(s) were added to refs/heads/main by this push:
new 61d8dab8e In curried definitions, move docstrings to outermost lambda
61d8dab8e is described below
commit 61d8dab8eafd498306ce618582aab37497df77b4
Author: Jean Abou Samra <jean@abou-samra.fr>
AuthorDate: Tue Mar 29 00:14:45 2022 +0200
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 | 68 ++++++++++++++++---------------
test-suite/tests/curried-definitions.test | 52 ++++++++++++++++++++++-
2 files changed, 86 insertions(+), 34 deletions(-)
diff --git a/module/ice-9/curried-definitions.scm
b/module/ice-9/curried-definitions.scm
index 7545338e3..3d76a25cd 100644
--- a/module/ice-9/curried-definitions.scm
+++ b/module/ice-9/curried-definitions.scm
@@ -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..c6e8dd3f5 100644
--- a/test-suite/tests/curried-definitions.test
+++ b/test-suite/tests/curried-definitions.test
@@ -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))))))
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] branch main updated: In curried definitions, move docstrings to outermost lambda,
Daniel Llorens <=