mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-29 19:30:36 +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-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*)

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

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