#lang racket

(require prospect/route)
(require logbook)

(define E (standard-logbook-entry (default-logbook #:verbose? #t) "minimart" "routes-size"))
(define Ttime (logbook-table E "timing"
			   #:column-spec '(initial-count
					   wallclock-secs/entry
					   entries/wallclock-sec
					   cpu+gc-sec
					   wallclock-sec
					   gc-sec
					   final-count)))
(define T (logbook-table E "measurements"
			   #:column-spec '(number-of-entries
					   bytes-per-entry
					   current-memory-use)))
(define Tprobe (logbook-table E "probe-rate"
			      #:column-spec '(number-of-entries
					      positive-probes-per-second
					      negative-probes-per-second
					      large-positive-per-second
                                              seconds-per-positive-probe
                                              seconds-per-negative-probe
                                              seconds-per-large-positive)))

(define *the-routes* #f)
(define *count* 0)
(define *zero-datapoint* #f)

(define (record-datapoint!)
  (collect-garbage)
  (collect-garbage)
  (collect-garbage)
  (define latest-datapoint (current-memory-use))
  (define n *count*)
  (when (not *zero-datapoint*) (set! *zero-datapoint* latest-datapoint))
  (define delta (- latest-datapoint *zero-datapoint*))
  (define perentry (/ delta (exact->inexact n)))
  (write-logbook-datum! T (list n perentry latest-datapoint)))

(define (run-probes!)
  (define n-probes 100000)
  (define-syntax-rule (probe message-expr)
    (let-values (((ignorable-results cpu+gc-time wallclock-time gc-time)
		  (time-apply
		   (lambda ()
		     (let loop ((i 0))
		       (when (< i n-probes)
			 (trie-lookup *the-routes* message-expr)
			 (loop (+ i 1)))))
		   '())))
      (/ n-probes (/ wallclock-time 1000.0))))
  (define positive-probes-per-second (probe (list (random *count*) "hello")))
  (define large-list (make-list 1000 'x))
  (define large-positive-per-second (probe (list (random *count*) large-list)))
  (define negative-probes-per-second (probe (list "hello" (random *count*))))
  (write-logbook-datum! Tprobe (list *count*
				     positive-probes-per-second
				     negative-probes-per-second
				     large-positive-per-second
                                     (/ positive-probes-per-second)
                                     (/ negative-probes-per-second)
                                     (/ large-positive-per-second))))

(record-datapoint!)
(let loop ((next-count 1000))
  (when (< next-count 500000)
    (define old-count *count*)
    (define-values (ignorable-results cpu+gc-time wallclock-time gc-time)
      (time-apply
       (lambda ()
	 (let inner-loop ()
	   (when (< *count* next-count)
	     (set! *the-routes* (trie-union *the-routes*
					    (pattern->trie *count* (list *count* ?))))
	     (set! *count* (+ *count* 1))
	     (inner-loop))))
       '()))
    (define cpu+gc-sec (/ cpu+gc-time 1000.0))
    (define wallclock-sec (/ wallclock-time 1000.0))
    (define gc-sec (/ gc-time 1000.0))
    (write-logbook-datum! Ttime (list old-count
				      (/ wallclock-sec (- next-count old-count))
				      (and (positive? wallclock-sec)
					   (/ (- next-count old-count) wallclock-sec))
				      cpu+gc-sec
				      wallclock-sec
				      gc-sec
				      next-count))

    (record-datapoint!)
    (run-probes!)
    (loop (inexact->exact (truncate (* next-count 1.2))))))