about summary refs log tree commit diff
path: root/src/guile/skribilo/debug.scm
diff options
context:
space:
mode:
Diffstat (limited to 'src/guile/skribilo/debug.scm')
-rw-r--r--src/guile/skribilo/debug.scm69
1 files changed, 35 insertions, 34 deletions
diff --git a/src/guile/skribilo/debug.scm b/src/guile/skribilo/debug.scm
index 1481a56..f7709a0 100644
--- a/src/guile/skribilo/debug.scm
+++ b/src/guile/skribilo/debug.scm
@@ -15,14 +15,15 @@
 ;;;
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with this program; if not, write to the Free Software
-;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
 ;;; USA.
 
 
 (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)
-  `(%with-debug ,level ,label (lambda () ,@body)))
-
-;;(define-macro (with-debug  level label . body)
-;;  `(begin ,@body))
-
-(export with-debug)
+;;;
+(define-public (%do-with-debug lvl lbl thunk)
+  (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)))
+
+(define-macro (with-debug level label . body)
+  ;; We have this as a macro in order to avoid procedure calls in the
+  ;; non-debugging case.  Unfortunately, the macro below duplicates BODY,
+  ;; which has a negative impact on memory usage and startup time (XXX).
+  (if (number? level)
+      `(if (or (>= (*debug*) ,level)
+               (memq ,label (*watched-symbols*)))
+           (%do-with-debug ,level ,label (lambda () ,@body))
+           (begin ,@body))
+      (error "with-debug: syntax error")))
 
 
 ; Example: