diff options
author | Ludovic Court`es | 2006-07-12 12:03:49 +0000 |
---|---|---|
committer | Ludovic Court`es | 2006-07-12 12:03:49 +0000 |
commit | 65f3317c408ef8ea7c0441423e0317e9b370b2b3 (patch) | |
tree | 72768eaefe0b38d681c682214f7e75cce45e87cb | |
parent | f373fe42794b5b3ab4537b3cef73640c2fb583ef (diff) | |
download | skribilo-65f3317c408ef8ea7c0441423e0317e9b370b2b3.tar.gz skribilo-65f3317c408ef8ea7c0441423e0317e9b370b2b3.tar.lz skribilo-65f3317c408ef8ea7c0441423e0317e9b370b2b3.zip |
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
-rw-r--r-- | src/guile/skribilo/biblio.scm | 1 | ||||
-rw-r--r-- | 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: |