haskal
/
crossfire
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

move needed log filters to make-log-receiver

This commit is contained in:
xenia 2020-11-23 03:40:43 -05:00
parent 77d012e69a
commit b399eb9078
1 changed files with 38 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
crossfire/logging.rkt
View File

@ -22,14 +22,6 @@
(define global-logger (make-logger)) (define global-logger (make-logger))
(define (default-log-filter level topic)
(match topic
['optimizer #f]
['collapsible-contract-bailout #f]
['collapsible-value-bailout #f]
['racket/contract #f]
[else #t]))
(define (recv-thd receiver stop-chan) (define (recv-thd receiver stop-chan)
;; iso8601 gang ;; iso8601 gang
(date-display-format 'iso-8601) (date-display-format 'iso-8601)
@ -37,7 +29,6 @@
;; formats one log entry to stdout ;; formats one log entry to stdout
(define (log-one entry) (define (log-one entry)
(match-define (vector level msg arg topic) entry) (match-define (vector level msg arg topic) entry)
(when (default-log-filter level topic)
(define level-str (define level-str
(match level (match level
['fatal "FATAL"] ['fatal "FATAL"]
@ -57,13 +48,12 @@
[_ "<7>"])) [_ "<7>"]))
;; in UTC ;; in UTC
(define time-str (define time-str (date->string (seconds->date (* 0.001 (current-inexact-milliseconds)) #f) #t))
(date->string (seconds->date (* 0.001 (current-inexact-milliseconds)) #f) #t))
;; prefix each line of the log entry with the metadata ;; prefix each line of the log entry with the metadata
(define msg-lines (string-split msg "\n")) (define msg-lines (string-split msg "\n"))
(for ([line (in-list msg-lines)]) (for ([line (in-list msg-lines)])
(printf "~a[~aZ] [~a] ~a\n" prefix-str time-str level-str line) (printf "~a[~aZ] [~a] ~a\n" prefix-str time-str level-str line)
(flush-output (current-output-port))))) (flush-output (current-output-port))))
;; process log entries until told to stop ;; process log entries until told to stop
;; this uses the same technique as with-intercepted-logging ;; this uses the same technique as with-intercepted-logging
@ -84,7 +74,20 @@
;; install the logging system ;; install the logging system
;; call as early as possible in the application ;; call as early as possible in the application
(define (install-logging! [level 'debug]) (define (install-logging! [level 'debug])
(define recv (make-log-receiver global-logger level)) (define recv
(make-log-receiver
global-logger
;; set of default filters
'info 'optimizer
'warning 'collapsible-contract-bailout
'warning 'collapsible-value-bailout
'warning 'racket/contract
'warning 'cm-accomplice
'info 'GC
'warning 'module-prefetch
'info 'sequence-specialization
;; default level
level #f))
(define stop-chan (make-channel)) (define stop-chan (make-channel))
(define logger-thd (thread (lambda () (recv-thd recv stop-chan)))) (define logger-thd (thread (lambda () (recv-thd recv stop-chan))))