blob: 9b53c841044f4641002d1690b937463675fb6339 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
|
;*=====================================================================*/
;* serrano/prgm/project/skribe/src/bigloo/debug.sch */
;* ------------------------------------------------------------- */
;* Author : Manuel Serrano */
;* Creation : Thu May 29 06:46:33 2003 */
;* Last change : Tue Nov 2 14:31:45 2004 (serrano) */
;* Copyright : 2003-04 Manuel Serrano */
;* ------------------------------------------------------------- */
;* Simple debug facilities */
;*=====================================================================*/
;*---------------------------------------------------------------------*/
;* directives */
;*---------------------------------------------------------------------*/
(directives
(import skribe_debug))
;*---------------------------------------------------------------------*/
;* when-debug ... */
;*---------------------------------------------------------------------*/
(define-macro (when-debug level . exp)
(if (and (number? *compiler-debug*) (> *compiler-debug* 0))
`(if (>= *skribe-debug* ,level) (begin ,@exp))
#unspecified))
;*---------------------------------------------------------------------*/
;* with-debug ... */
;*---------------------------------------------------------------------*/
(define-macro (with-debug level lbl . arg*)
(if (and (number? *compiler-debug*) (> *compiler-debug* 0))
`(%with-debug ,level ,lbl (lambda () (begin ,@arg*)))
`(begin ,@arg*)))
;*---------------------------------------------------------------------*/
;* with-push-trace ... */
;*---------------------------------------------------------------------*/
(define-macro (with-push-trace lbl . arg*)
(if (and (number? *compiler-debug*) (> *compiler-debug* 0))
(let ((r (gensym)))
`(let ()
(c-push-trace ,lbl)
(let ((,r ,@arg*))
(c-pop-trace)
,r)))
`(begin ,@arg*)))
;*---------------------------------------------------------------------*/
;* debug-item ... */
;*---------------------------------------------------------------------*/
(define-expander debug-item
(lambda (x e)
(if (and (number? *compiler-debug*) (> *compiler-debug* 0))
`(debug-item ,@(map (lambda (x) (e x e)) (cdr x)))
#unspecified)))
|
