diff options
| author | Ludovic Courtès | 2009-03-18 01:15:56 +0100 |
|---|---|---|
| committer | Ludovic Courtès | 2009-03-18 01:15:56 +0100 |
| commit | 7c98071e5bd7ff0451ad5650b0d728763ddd8924 (patch) | |
| tree | cb2f083a5467ec315f81c04168e21b9c6556727f /src | |
| parent | 88e6df788fde76e5217a563b10a76ab34dd0a153 (diff) | |
| download | skribilo-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')
| -rw-r--r-- | src/guile/skribilo/writer.scm | 34 |
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 |