diff options
author | Jean Abou Samra <jean@abou-samra.fr> | 2022-03-29 00:14:45 +0200 |
---|---|---|
committer | Daniel Llorens <lloda@sarc.name> | 2022-08-29 11:45:39 +0200 |
commit | 61d8dab8eafd498306ce618582aab37497df77b4 (patch) | |
tree | 6f1d95fc58b76b773bfd403d275a11349811923a /module | |
parent | eb5ecf4944cd646341f7e47dda5396cf96a4b8a3 (diff) | |
download | guile-61d8dab8eafd498306ce618582aab37497df77b4.tar.gz |
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
Diffstat (limited to 'module')
-rw-r--r-- | module/ice-9/curried-definitions.scm | 68 |
1 files changed, 36 insertions, 32 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*) |