From 1d1d62c420ae807f5e3d6b51e4b585a9dcd3bb1e Mon Sep 17 00:00:00 2001
From: Ludovic Courtès
Date: Fri, 20 Nov 2009 11:52:06 +0100
Subject: 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.
---
 src/guile/skribilo/writer.scm | 31 +++++--------------------------
 1 file changed, 5 insertions(+), 26 deletions(-)

(limited to 'src')

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)
-- 
cgit v1.2.3