#!hacchpsimguile -b
!#
;; "select-nested-loop-a-03.hacchpsimscm"
;; copy-modified from "select-nested-loop-a-02.hacchpsimscm"
;; vi: ft=scheme
;;	$Id: select-nested-loop-a-03.hacchpsimscm,v 1.3 2007/05/04 03:38:29 fang Exp $
;; @haco@ select-nested-loop-a.haco-a
;; @chpsimtrace@ select-nested-loop-a-03.chpsimtrace

;; Testing histogram construction, using defined functions

; (use-modules (hackt chpsim-primitives))
(use-modules (hackt chpsim-trace))
(use-modules (hackt chpsim-primitives))
(use-modules (hackt chpsim))
; (use-modules (hackt algorithm)) ; for find-assoc-ref
(use-modules (hackt rb-tree))
(use-modules (hackt streams))
(use-modules (ice-9 streams))
; (use-modules (srfi srfi-1))	; for alist (associative lists)

(define trace-name "select-nested-loop-a-03.chpsimtrace")
; (define rand-trace (hac:open-chpsim-trace-accessor trace-name))

"trace:"
(define whole-trace (open-chpsim-trace-stream trace-name))
(stream-for-each-display-newline whole-trace)

; "all static events:"
; (define all-static-events-stream (static-event-stream))
; (stream-for-each-display-newline all-static-events-stream)

(define select-events
  (chpsim-filter-static-events-select all-static-events-stream))
; "all select-events:"
; (stream-for-each-display-newline select-events)

; "successors (cdr) of select events (car):"
(define select-successor-lists (chpsim-assoc-event-successors select-events))
; (stream-for-each-display-newline select-successor-lists)

; "list of successor lists, associated by common predecessor:"
(define ll (stream->list select-successor-lists))
ll

; "re-structure into branch-predecessor pairs association:"
(define ll-reverse-assoc-succ
  (chpsim-assoc-event-pred-from-succ select-successor-lists))
; (stream-for-each-display-newline ll-reverse-assoc-succ)


"flatten into single associative list:"
(define assoc-pred (stream-of-lists->stream ll-reverse-assoc-succ))
(stream-for-each-display-newline assoc-pred)
; unordered

"and sort (predecessor cdr is branch):"
; (set! assoc-pred (sort! assoc-pred (lambda (s t) (< (car s) (car t)))))
(define sorted-assoc-pred
  (let ((pred-map (make-rb-tree = <)))
; stuff the pairs into a sorted map
    (stream-for-each
      (lambda (s) (rb-tree/insert! pred-map (car s) (cdr s)))
      assoc-pred)
    pred-map
  )
)
sorted-assoc-pred

"make a zero-initialized histogram from successor-lists:"
(define ll-histo (chpsim-successor-lists->histogram ll))
ll-histo

"after counting..."
(define (count-selects x)
  (let ((f (rb-tree/lookup sorted-assoc-pred x #f)))
;    (if f (display f) (display "f: #f")) (newline)
    (if f (let ((y (rb-tree/lookup ll-histo f #f)))
;      (display (car f)) (display ": ") (display (cdr y))
      (rb-tree/lookup-mutate! y x
        (lambda (z)
;         (display "++") (display z) (newline)
#!
; this hack is no longer needed since we started executing selections, nice!
          (let ((p (stream-ref f all-static-events-stream)))
;            (display "p: ") (display p) (newline)
            (if (hac:chpsim-event-select? (cdr p))
              ; recurse to predecessor because selections are not 'executed'
              (count-selects (car p))
            ) ; end if
          ) ; end let
!#
          (1+ z)
        ) ; end lambda
        #f
      ) ; end lookup-mutate
    )) ; end if
  ) ; end let
) ; end lambda

(stream-for-each (lambda (e)
  (let ((x (chpsim-trace-entry-event e)))
    (count-selects x)
  ) ; end let
) ; end lambda
whole-trace
)

ll-histo

