mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

In curried definitions, move docstrings to outermost lambda

Browse source 
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
This commit is contained in:
Jean Abou Samra 2022-03-29 00:14:45 +02:00 • committed by Daniel Llorens
parent eb5ecf4944
commit 61d8dab8ea
2 changed files with 86 additions and 34 deletions
Download patch file Download diff file Expand all files Collapse all files

68
module/ice-9/curried-definitions.scm
View file

@ -20,38 +20,42 @@
define-public define-public
define*-public)) define*-public))
(define-syntax cdefine (define-syntax make-currying-define
(syntax-rules () (syntax-rules ::: ()
((_ (head . rest) body body* ...) ((_ currying-name lambda-name)
(cdefine head (define-syntax currying-name
(lambda rest body body* ...))) (lambda (St-Ax)
((_ name val) (syntax-case St-Ax ()
(define name val)))) ((_ ((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* (make-currying-define cdefine lambda)
(syntax-rules () (make-currying-define cdefine* lambda*)
((_ (head . rest) body body* ...)
(cdefine* head
(lambda* rest body body* ...)))
((_ name val)
(define* name val))))
(define-syntax define-public (define-syntax make-currying-define-public
(syntax-rules () (syntax-rules ::: ()
((_ (head . rest) body body* ...) ((_ public-name define-name)
(define-public head (define-syntax public-name
(lambda rest body body* ...))) (lambda (St-Ax)
((_ name val) (syntax-case St-Ax ()
(begin ((_ binding body body* ...)
(define name val) #`(begin
(export name))))) (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 (make-currying-define-public define-public cdefine)
(syntax-rules () (make-currying-define-public define*-public cdefine*)
((_ (head . rest) body body* ...)
(define*-public head
(lambda* rest body body* ...)))
((_ name val)
(begin
(define* name val)
(export name)))))

52
test-suite/tests/curried-definitions.test
View file

@ -49,7 +49,33 @@
(equal? 444 (equal? 444
(primitive-eval '(let () (primitive-eval '(let ()
(define foo 444) (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*" (with-test-prefix "define*"
(pass-if "define* works as usual" (pass-if "define* works as usual"
@ -81,4 +107,26 @@
(equal? 444 (equal? 444
(primitive-eval '(let () (primitive-eval '(let ()
(define* foo 444) (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))))))