summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorLudovic Courtes2006-03-07 22:58:58 +0000
committerLudovic Courtes2006-03-07 22:58:58 +0000
commit86c7ef726434b31b78570bf80db3cdecf8b84ca3 (patch)
tree73b6ee4f648316b93cba740d4fc5b51474104f8f /src
parentfaf5a61d584ccad016d5bb3d50ce515931e17897 (diff)
downloadskribilo-86c7ef726434b31b78570bf80db3cdecf8b84ca3.tar.gz
skribilo-86c7ef726434b31b78570bf80db3cdecf8b84ca3.tar.lz
skribilo-86c7ef726434b31b78570bf80db3cdecf8b84ca3.zip
Partial rewrite of the debugging facilities (slightly slower).
* src/guile/skribilo.scm (skribilo): Use the new debugging API. * src/guile/skribilo/debug.scm: Use SRFI-39 parameter objects. Moved legacy procedures to `compat.scm'. * src/guile/skribilo/utils/compat.scm (set-skribe-debug!): New. (no-debug-color): New. (skribe-debug): New. (add-skribe-debug-symbol): New. git-archimport-id: lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-44
Diffstat (limited to 'src')
-rw-r--r--src/guile/skribilo.scm5
-rw-r--r--src/guile/skribilo/debug.scm126
-rw-r--r--src/guile/skribilo/utils/compat.scm17
3 files changed, 83 insertions, 65 deletions
diff --git a/src/guile/skribilo.scm b/src/guile/skribilo.scm
index f683080..dbaa368 100644
--- a/src/guile/skribilo.scm
+++ b/src/guile/skribilo.scm
@@ -413,9 +413,7 @@ Processes a Skribilo/Skribe source file and produces its output.
;; Parse the most important options.
- (set-skribe-debug! (string->number debugging-level))
-
- (if (> (skribe-debug) 4)
+ (if (> (*debug*) 4)
(set! %load-hook
(lambda (file)
(format #t "~~ loading `~a'...~%" file))))
@@ -428,6 +426,7 @@ Processes a Skribilo/Skribe source file and produces its output.
(append %load-path
(*source-path*))))
(*image-path* (cons image-path (*image-path*)))
+ (*debug* (string->number debugging-level))
(*warning* (string->number warning-level))
(*verbose* (let ((v (option-ref options
'verbose 0)))
diff --git a/src/guile/skribilo/debug.scm b/src/guile/skribilo/debug.scm
index 1cac749..1481a56 100644
--- a/src/guile/skribilo/debug.scm
+++ b/src/guile/skribilo/debug.scm
@@ -1,7 +1,7 @@
-;;; debug.scm -- Debug facilities.
+;;; debug.scm -- Debugging facilities.
;;;
-;;; Copyright 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
-;;; Copyright 2005 Ludovic Courtès <ludovic.courtes@laas.fr>
+;;; Copyright 2003, 2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;; Copyright 2005, 2006 Ludovic Courtès <ludovic.courtes@laas.fr>
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
@@ -20,41 +20,50 @@
(define-module (skribilo debug)
- :export (with-debug %with-debug
- debug-item skribe-debug set-skribe-debug! add-skribe-debug-symbol
- no-debug-color)
:use-module (skribilo utils syntax)
- :use-module (srfi srfi-17))
+ :use-module (srfi srfi-17)
+ :use-module (srfi srfi-39))
(fluid-set! current-reader %skribilo-module-reader)
+
+;;;
+;;; Parameters.
+;;;
-;;; FIXME: Use SRFI-39 fluids.
-;;; FIXME: Move this to `parameters.scm'?
+;; Current debugging level.
+(define-public *debug*
+ (make-parameter 0 (lambda (val)
+ (cond ((number? val) val)
+ ((string? val)
+ (string->number val))
+ (else
+ (error "*debug*: wrong argument type"
+ val))))))
-(define *skribe-debug* 0)
-(define *skribe-debug-symbols* '())
-(define *skribe-debug-color* #t)
-(define *skribe-debug-item* #f)
-(define *debug-port* (current-error-port))
-(define *debug-depth* 0)
-(define *debug-margin* "")
-(define *skribe-margin-debug-level* 0)
+;; Whether to use colors.
+(define-public *debug-use-colors?* (make-parameter #t))
+;; Where to spit debugging output.
+(define-public *debug-port* (make-parameter (current-output-port)))
-(define (set-skribe-debug! val)
- (set! *skribe-debug* val))
+;; Whether to debug individual items.
+(define-public *debug-item?* (make-parameter #f))
-(define (add-skribe-debug-symbol s)
- (set! *skribe-debug-symbols* (cons s *skribe-debug-symbols*)))
+;; Watched (debugged) symbols (procedure names).
+(define-public *watched-symbols* (make-parameter '()))
-(define (no-debug-color)
- (set! *skribe-debug-color* #f))
+
+;;;
+;;; Implementation.
+;;;
+
+(define *debug-depth* (make-parameter 0))
+(define *debug-margin* (make-parameter ""))
+(define *margin-level* (make-parameter 0))
+
-(define-public skribe-debug
- (getter-with-setter (lambda () *skribe-debug*)
- (lambda (val) (set! *skribe-debug* val))))
;;
;; debug-port
@@ -75,7 +84,7 @@
;;;
(define (debug-color col . o)
(with-output-to-string
- (if (and *skribe-debug-color*
+ (if (and (*debug-use-colors?*)
(equal? (getenv "TERM") "xterm"))
(lambda ()
(format #t "[1;~Am" (+ 31 col))
@@ -93,54 +102,45 @@
;;;
;;; debug-item
;;;
-(define (debug-item . args)
- (if (or (>= *skribe-debug* *skribe-margin-debug-level*)
- *skribe-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*))))
+ (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)
;; `())
+
;;;
;;; %with-debug-margin
;;;
(define (%with-debug-margin margin thunk)
- (let ((om *debug-margin*))
- (set! *debug-depth* (+ *debug-depth* 1))
- (set! *debug-margin* (string-append om margin))
- (let ((res (thunk)))
- (set! *debug-depth* (- *debug-depth* 1))
- (set! *debug-margin* om)
- res)))
+ (parameterize ((*debug-depth* (+ (*debug-depth*) 1))
+ (*debug-margin* (string-append (*debug-margin*) margin)))
+ (thunk)))
;;;
;;; %with-debug
;;
-(define (%with-debug lvl lbl thunk)
- (let ((ol *skribe-margin-debug-level*)
- (oi *skribe-debug-item*))
- (set! *skribe-margin-debug-level* lvl)
- (let ((r (if (or (and (number? lvl) (>= *skribe-debug* lvl))
- (and (symbol? lbl)
- (memq lbl *skribe-debug-symbols*)
- (set! *skribe-debug-item* #t)))
- (begin
- (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))))
- (set! *skribe-debug-item* oi)
- (set! *skribe-margin-debug-level* ol)
- r)))
+(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)))
@@ -148,6 +148,8 @@
;;(define-macro (with-debug level label . body)
;; `(begin ,@body))
+(export with-debug)
+
; Example:
diff --git a/src/guile/skribilo/utils/compat.scm b/src/guile/skribilo/utils/compat.scm
index 9ed9f3e..d4a4367 100644
--- a/src/guile/skribilo/utils/compat.scm
+++ b/src/guile/skribilo/utils/compat.scm
@@ -31,6 +31,7 @@
:use-module (ice-9 optargs)
:autoload (skribilo ast) (ast?)
:autoload (skribilo condition) (file-search-error? &file-search-error)
+ :use-module (skribilo debug)
:re-export (file-size)
:replace (gensym))
@@ -166,6 +167,22 @@
(define-public skribe-eval evaluate-document)
(define-public skribe-eval-port evaluate-document-from-port)
+
+;;;
+;;; Debugging facilities.
+;;;
+
+(define-public (set-skribe-debug! val)
+ (*debug* val))
+
+(define-public (no-debug-color)
+ (*debug-use-colors?* #f))
+
+(define-public skribe-debug *debug*)
+
+(define-public (add-skribe-debug-symbol s)
+ (*watched-symbols* (cons s *watched-symbols*)))
+
;;;