From d4c65f804a72192ab27d276f2ac52ee7ae7a7751 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès
Date: Thu, 5 Mar 2009 00:41:55 +0100
Subject: Move `%procedure-arity' out of `lib.scm'.

* src/guile/skribilo/lib.scm (%procedure-arity): Remove.

* src/guile/skribilo/writer.scm (%using-vm?, %procedure-arity): New.
  This new version can handle VM "programs".  This removes a dependency
  on `lib', which depends on almost all of Skribilo.
---
 src/guile/skribilo/lib.scm    |  9 +--------
 src/guile/skribilo/writer.scm | 12 ++++++++++--
 2 files changed, 11 insertions(+), 10 deletions(-)

diff --git a/src/guile/skribilo/lib.scm b/src/guile/skribilo/lib.scm
index b5e86f2..9c0158d 100644
--- a/src/guile/skribilo/lib.scm
+++ b/src/guile/skribilo/lib.scm
@@ -26,7 +26,7 @@
            skribe-warning skribe-warning/ast
            skribe-message
 
-	   type-name %procedure-arity)
+	   type-name)
 
   :export-syntax (new define-markup define-simple-markup
                   define-simple-container define-processor-markup)
@@ -226,11 +226,4 @@
   (when (> (*verbose*) 0)
     (apply format (current-error-port) fmt obj)))
 
-
-;;;
-;;; %PROCEDURE-ARITY
-;;;
-(define (%procedure-arity proc)
-  (car (procedure-property proc 'arity)))
-
 ;;; lib.scm ends here
diff --git a/src/guile/skribilo/writer.scm b/src/guile/skribilo/writer.scm
index b339284..c57f3a8 100644
--- a/src/guile/skribilo/writer.scm
+++ b/src/guile/skribilo/writer.scm
@@ -1,6 +1,6 @@
 ;;; writer.scm  --  Markup writers.
 ;;;
-;;; Copyright 2005, 2006, 2008  Ludovic Courtès <ludo@gnu.org>
+;;; Copyright 2005, 2006, 2008, 2009  Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright 2003, 2004  Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
 ;;;
 ;;;
@@ -36,7 +36,6 @@
   :use-module (skribilo debug)
   :use-module (skribilo output)
   :use-module (skribilo ast)
-  :use-module ((skribilo lib) :select (%procedure-arity))
 
   :use-module (oop goops)
   :use-module (ice-9 optargs))
@@ -89,6 +88,15 @@
 	     (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 (make-writer-predicate markup predicate class)
   (let* ((t2 (if class
-- 
cgit v1.2.3