diff options
author | Ludovic Courtès | 2009-11-20 11:52:06 +0100 |
---|---|---|
committer | Ludovic Courtès | 2009-11-20 11:52:06 +0100 |
commit | 1d1d62c420ae807f5e3d6b51e4b585a9dcd3bb1e (patch) | |
tree | 69fb541cd421e504300995968ba398ea94d1351a /src | |
parent | 5d263cf9a89b326876b2d669888296b2f929af9b (diff) | |
download | skribilo-1d1d62c420ae807f5e3d6b51e4b585a9dcd3bb1e.tar.gz skribilo-1d1d62c420ae807f5e3d6b51e4b585a9dcd3bb1e.tar.lz skribilo-1d1d62c420ae807f5e3d6b51e4b585a9dcd3bb1e.zip |
Fix `%procedure-arity'.
* src/guile/skribilo/writer.scm (%procedure-arity): Always use
`procedure-property'.
(make-writer-predicate): Fix `proc-name' argument of
`&invalid-argument-error' condition.
Diffstat (limited to 'src')
-rw-r--r-- | src/guile/skribilo/writer.scm | 31 |
1 files changed, 5 insertions, 26 deletions
diff --git a/src/guile/skribilo/writer.scm b/src/guile/skribilo/writer.scm index 08e72d5..42457c2 100644 --- a/src/guile/skribilo/writer.scm +++ b/src/guile/skribilo/writer.scm @@ -87,31 +87,10 @@ (proc node e))))) -(define %procedure-arity - (eval-case ((load-toplevel) - ;; Here we assume Guile's interpreter is used, either from - ;; Guile 1.8 or from Guile-VM (aka. Guile 2.x) but using both - ;; compiled procedures (aka. "programs") and good old - ;; interpreter procedures. - ;; - ;; This happens, e.g., while compiling Skribilo itself where - ;; some of the files loaded by the compiler are already - ;; compiled while others are interpreted. - (let* ((vm (resolve-module '(system vm program))) - (program? (false-if-exception - (module-ref vm 'program?)))) - (lambda (proc) - (if (and (procedure? program?) - (program? proc)) - (car ((module-ref vm 'program-arity) proc)) - (car (procedure-property proc 'arity)))))) - - (else - ;; Here we assume Guile-VM compiled code. - (lambda (proc) - (if ((@ (system vm program) program?) proc) - (car ((@ (system vm program) program-arity) proc)) - (car (procedure-property proc 'arity))))))) +(define (%procedure-arity proc) + ;; Return the number of required arguments for PROC. This technique is + ;; known to work with Guile 1.8 and Guile 1.9.5. + (car (procedure-property proc 'arity))) (define (make-writer-predicate markup predicate class) (let* ((t2 (if class @@ -123,7 +102,7 @@ ((or (not (procedure? predicate)) (not (eq? (%procedure-arity predicate) 2))) (raise (condition (&invalid-argument-error - (proc-name make-writer-predicate) + (proc-name 'make-writer-predicate) (argument predicate))))) (else (if (procedure? t2) |