summaryrefslogtreecommitdiff
path: root/src/guile
diff options
context:
space:
mode:
authorLudovic Courtès2009-03-18 01:15:56 +0100
committerLudovic Courtès2009-03-18 01:15:56 +0100
commit7c98071e5bd7ff0451ad5650b0d728763ddd8924 (patch)
treecb2f083a5467ec315f81c04168e21b9c6556727f /src/guile
parent88e6df788fde76e5217a563b10a76ab34dd0a153 (diff)
downloadskribilo-7c98071e5bd7ff0451ad5650b0d728763ddd8924.tar.gz
skribilo-7c98071e5bd7ff0451ad5650b0d728763ddd8924.tar.lz
skribilo-7c98071e5bd7ff0451ad5650b0d728763ddd8924.zip
writer: Adapt `%procedure-arity' to Guile-VM.
* src/guile/skribilo/writer.scm (%using-vm?): Remove. It would always be true since `resolve-module' creates non-existent modules. (%procedure-arity): Use `eval-case', assuming the `else' clause matches Guile-VM, which is the case with Guile `master' commit 7eba9c99c262acb872a52d95c45a216232d2b8dc (dated Wed Mar 18 00:46:16 2009 +0100).
Diffstat (limited to 'src/guile')
-rw-r--r--src/guile/skribilo/writer.scm34
1 files changed, 25 insertions, 9 deletions
diff --git a/src/guile/skribilo/writer.scm b/src/guile/skribilo/writer.scm
index 9acc195..a57acc5 100644
--- a/src/guile/skribilo/writer.scm
+++ b/src/guile/skribilo/writer.scm
@@ -87,15 +87,31 @@
(proc node e)))))
-(define %using-vm?
- ;; #t if using Guile's VM.
- (false-if-exception (resolve-module '(system vm program))))
-
-(define (%procedure-arity proc)
- (if (and %using-vm?
- ((@ (system vm program) program?) proc))
- (car ((@ (system vm program) program-arity) proc))
- (car (procedure-property proc 'arity))))
+(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 (make-writer-predicate markup predicate class)
(let* ((t2 (if class