aboutsummaryrefslogtreecommitdiff
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: