From 65f3317c408ef8ea7c0441423e0317e9b370b2b3 Mon Sep 17 00:00:00 2001
From: Ludovic Court`es
Date: Wed, 12 Jul 2006 12:03:49 +0000
Subject: Noticeable performance improvements (notably in `debug').

* src/guile/skribilo/biblio.scm: Don't use `(ice-9 format)': it is
  unneeded and very slow compared to `simple-format'.

* src/guile/skribilo/debug.scm: Export `debug-item' and `with-debug' as
  macros.
  (debug-item): Turned into a macro rather than a procedure.  Also, don't
  take `*margin-level*' into account when deciding whether to do
  something: only look at `*debug-item?*'.
  (%do-debug-item): New.
  (%with-debug): Invoke `parameterize' only in the debugging case.  This
  noticeably improves performance.

git-archimport-id: lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-6
---
 src/guile/skribilo/biblio.scm |  1 -
 src/guile/skribilo/debug.scm  | 55 ++++++++++++++++++++++---------------------
 2 files changed, 28 insertions(+), 28 deletions(-)

diff --git a/src/guile/skribilo/biblio.scm b/src/guile/skribilo/biblio.scm
index d9aa0ed..2d5f1ea 100644
--- a/src/guile/skribilo/biblio.scm
+++ b/src/guile/skribilo/biblio.scm
@@ -32,7 +32,6 @@
 
   :autoload   (skribilo reader)      (%default-reader)
   :autoload   (skribilo parameters)  (*bib-path*)
-  :autoload   (ice-9 format)         (format)
   :use-module (ice-9 optargs)
 
   :export (bib-table? make-bib-table default-bib-table
diff --git a/src/guile/skribilo/debug.scm b/src/guile/skribilo/debug.scm
index 1481a56..a06067c 100644
--- a/src/guile/skribilo/debug.scm
+++ b/src/guile/skribilo/debug.scm
@@ -22,7 +22,8 @@
 (define-module (skribilo debug)
   :use-module (skribilo utils syntax)
   :use-module (srfi srfi-17)
-  :use-module (srfi srfi-39))
+  :use-module (srfi srfi-39)
+  :export-syntax (debug-item with-debug))
 
 (fluid-set! current-reader %skribilo-module-reader)
 
@@ -102,14 +103,15 @@
 ;;;
 ;;; debug-item
 ;;;
-(define-public (debug-item . args)
-  (if (or (>= (*debug*) (*margin-level*))
-          (*debug-item?*))
-      (begin
-        (display (*debug-margin*) (*debug-port*))
-        (display (debug-color (- (*debug-depth*) 1) "- ") (*debug-port*))
-        (for-each (lambda (a) (display a (*debug-port*))) args)
-        (newline (*debug-port*)))))
+(define-macro (debug-item . args)
+  `(if (*debug-item?*) (%do-debug-item ,@args)))
+
+(define-public (%do-debug-item . args)
+  (begin
+    (display (*debug-margin*) (*debug-port*))
+    (display (debug-color (- (*debug-depth*) 1) "- ") (*debug-port*))
+    (for-each (lambda (a) (display a (*debug-port*))) args)
+    (newline (*debug-port*))))
 
 ;;(define-macro (debug-item  . args)
 ;;  `())
@@ -125,30 +127,29 @@
 
 ;;;
 ;;; %with-debug
-;;
+;;;
 (define-public (%with-debug lvl lbl thunk)
-  (parameterize ((*margin-level* lvl))
-    (if (or (and (number? lvl) (>= (*debug*) lvl))
-	    (and (symbol? lbl)
-		 (memq lbl (*watched-symbols*))))
-	(parameterize ((*debug-item?* #t))
-	  (display (*debug-margin*) (*debug-port*))
-	  (display (if (= (*debug-depth*) 0)
-		       (debug-color (*debug-depth*) "+ " lbl)
-		       (debug-color (*debug-depth*) "--+ " lbl))
-		   (*debug-port*))
-	  (newline (*debug-port*))
-	  (%with-debug-margin (debug-color (*debug-depth*) "  |")
-			      thunk))
-	(thunk))))
-
-(define-macro (with-debug  level label . body)
+  (if (or (and (number? lvl) (>= (*debug*) lvl))
+          (and (symbol? lbl)
+               (memq lbl (*watched-symbols*))))
+      (parameterize ((*margin-level* lvl)
+                     (*debug-item?* #t))
+        (display (*debug-margin*) (*debug-port*))
+        (display (if (= (*debug-depth*) 0)
+                     (debug-color (*debug-depth*) "+ " lbl)
+                     (debug-color (*debug-depth*) "--+ " lbl))
+                 (*debug-port*))
+        (newline (*debug-port*))
+        (%with-debug-margin (debug-color (*debug-depth*) "  |")
+                            thunk))
+      (thunk)))
+
+(define-macro (with-debug level label . body)
   `(%with-debug ,level ,label (lambda () ,@body)))
 
 ;;(define-macro (with-debug  level label . body)
 ;;  `(begin ,@body))
 
-(export with-debug)
 
 
 ; Example:
-- 
cgit v1.2.3