PasteRack.org
Paste # 14948
2017-02-24 13:28:56

Fork as a new paste.

Paste viewed 214 times.


Embed:

with-intercepted-logging example

  1. #lang racket/base
  2. ;; github.com/bennn/rosette-contract
  3.  
  4. (define-logger rosette-contract)
  5.  
  6. (define (force/rc-log thunk #:level [level 'info])
  7.   (define inbox (make-hasheq '((debug . ()) (info . ()) (warning . ()) (error . ()) (fatal . ()))))
  8.   (with-intercepted-logging
  9.     (λ (l)
  10.       (define lvl (vector-ref l 0))
  11.       (define msg (vector-ref l 1))
  12.       (when (eq? 'rosette-contract (vector-ref l 3))
  13.         (hash-set! inbox lvl (cons msg (hash-ref inbox lvl))))
  14.       (void))
  15.     thunk
  16.     #:logger rosette-contract-logger
  17.     level)
  18.   ;; Return immutable hash with keys in [first recieved] -> [last received] order
  19.   (for/hasheq ([(k v) (in-hash inbox)])
  20.     (values k (reverse v))))
  21.  
  22. ;; --- formatting, pretty-logging
  23.  
  24. (define (format-rc-info kind ctc srcloc why)
  25.   (format
  26.     "[~a:~a] ~a ~a in ~a"
  27.     (source-location-line srcloc)
  28.     (source-location-column srcloc)
  29.     kind
  30.     why
  31.     ctc))
  32.  
  33. (define (log-rc kind ctc srcloc why)
  34.   (log-rosette-contract-info (format-rc-info kind ctc srcloc why)))
  35.  
  36. (define (log-success ctc srcloc [why ""])
  37.   (log-rc 'SUCCESS ctc srcloc why))
  38.  
  39. (define (log-failure ctc srcloc [why ""])
  40.   (log-rc 'FAILURE ctc srcloc why))

=>