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
|
#t))
(define (debug:debug-mode n)
(or (and (number? *verbosity*)
(<= n *verbosity*))
(and (list? *verbosity*)
(member n *verbosity*))))
(define (debug:print n . params)
(if (debug:debug-mode n)
(begin
(apply print params)
(if *logging* (apply db:log-event params)))))
(define (debug:print-info n . params)
(if (debug:debug-mode n)
(let ((res (format#format #f "INFO:~2d ~a" n (apply conc params))))
(print res)
(if *logging* (db:log-event res)))))
;; if a value is printable (i.e. string or number) return the value
;; else return an empty string
(define-inline (printable val)
(if (or (number? val)(string? val)) val ""))
|
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
|
>
>
|
|
|
|
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
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
|
#t))
(define (debug:debug-mode n)
(or (and (number? *verbosity*)
(<= n *verbosity*))
(and (list? *verbosity*)
(member n *verbosity*))))
(define (debug:setup)
(let ((debugstr (or (args:get-arg "-debug")
(getenv "MT_DEBUG_MODE"))))
(set! *verbosity* (debug:calc-verbosity debugstr))
(debug:check-verbosity *verbosity* debugstr)
(if (or (args:get-arg "-debug")
(not (getenv "MT_DEBUG_MODE")))
(setenv "MT_DEBUG_MODE" (if (list? *verbosity*)
(string-intersperse (map conc *verbosity*) ",")
(conc *verbosity*))))))
(define (debug:print n . params)
(if (debug:debug-mode n)
(with-output-to-port (current-error-port)
(lambda ()
(apply print params)
(if *logging* (apply db:log-event params))))))
(define (debug:print-info n . params)
(if (debug:debug-mode n)
(with-output-to-port (current-error-port)
(lambda ()
(let ((res (format#format #f "INFO:~2d ~a" n (apply conc params))))
(print res)
(if *logging* (db:log-event res)))))))
;; if a value is printable (i.e. string or number) return the value
;; else return an empty string
(define-inline (printable val)
(if (or (number? val)(string? val)) val ""))
|