From c4a27fe3b32ac00da6378477b62cbf82b4ff18d4 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès
Date: Wed, 25 Apr 2012 15:45:17 +0200
Subject: Use hygienic macros for (skribilo debug) on Guile 2.x.

* src/guile/skribilo/debug.scm (%do-debug-item, %do-with-debug): Export
  only on Guile 1.8.
  (debug-item, with-debug): Add a hygienic implementation for Guile 2.x.
---
 src/guile/skribilo/debug.scm | 55 ++++++++++++++++++++++++++++++--------------
 1 file changed, 38 insertions(+), 17 deletions(-)

diff --git a/src/guile/skribilo/debug.scm b/src/guile/skribilo/debug.scm
index d9d54bd..c54a0d9 100644
--- a/src/guile/skribilo/debug.scm
+++ b/src/guile/skribilo/debug.scm
@@ -1,6 +1,6 @@
 ;;; debug.scm  --  Debugging facilities.  -*- coding: iso-8859-1 -*-
 ;;;
-;;; Copyright 2005, 2006, 2009  Ludovic Courtès <ludo@gnu.org>
+;;; Copyright 2005, 2006, 2009, 2012  Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright 2003, 2004  Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
 ;;;
 ;;; This program is free software; you can redistribute it and/or modify
@@ -102,18 +102,25 @@
 ;;;
 ;;; debug-item
 ;;;
-(define-macro (debug-item . args)
-  `(if (*debug-item?*) (%do-debug-item ,@args)))
 
-(define-public (%do-debug-item . args)
+(define (%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)
-;;  `())
+(cond-expand
+ (guile-2
+  (define-syntax-rule (debug-item args ...)
+    (if (*debug-item?*)
+        (%do-debug-item args ...))))
+ (else
+  (begin
+    ;; Work around Guile 1.8's broken macro support.
+    (export %do-debug-item)
+    (define-macro (debug-item . args)
+      `(if (*debug-item?*) (%do-debug-item ,@args))))))
 
 
 ;;;
@@ -127,7 +134,7 @@
 ;;;
 ;;; %with-debug
 ;;;
-(define-public (%do-with-debug lvl lbl thunk)
+(define (%do-with-debug lvl lbl thunk)
   (parameterize ((*margin-level* lvl)
                  (*debug-item?* #t))
     (display (*debug-margin*) (*debug-port*))
@@ -139,16 +146,30 @@
     (%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")))
+;; 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).
+(cond-expand
+ (guile-2
+  (define-syntax with-debug
+    (lambda (s)
+      (syntax-case s ()
+        ((_ level label body ...)
+         (integer? (syntax->datum #'level))
+         #'(if (or (>= (*debug*) level)
+                   (memq label (*watched-symbols*)))
+               (%do-with-debug level label (lambda () body ...))
+               (begin body ...)))))))
+ (else
+  (begin
+    (export %do-with-debug)
+    (define-macro (with-debug level label . body)
+      (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:
-- 
cgit v1.2.3