;;; File:
;;;   analyst.scm
;;; Authors:
;;;   Janet Davis
;;;   Samuel A. Rebelsky
;;; Version:
;;;   0.2 of 12 November 2006
;;; Summary:
;;;   A collection of procedures that help us analyze the cost of running code.
;;; Procedures:
;;;   (analyst 'count! sym)
;;;     Add a count for the specified symbol (usually the name of a proc.)
;;;   (analyst 'report!)
;;;     Print a short report on the steps executed.
;;;   (analyst 'reset!)
;;;     Reset the counts of the various steps.
;;; Syntax:
;;;   ($ proc)
;;;     A version of proc that counts the call.
;;;   (analyze exp)
;;;     Evaluate expression and then print out a summarize of the counts
;;;     generated during that evaluation.
;;;   (define$ proc body)
;;;     Define proc as a procedure that counts calls for each subexpression.
;;;
;;; Use:
;;;   1. Augment the procedure to count steps in one of three ways (examples in
;;;      analysis-examples.scm).
;;;     (0) Insert (analyst 'count! sym) each time you want to count a step.
;;;     (1) Apply $ to the procedure to call.
;;;     (2) Replace the define with define$. 
;;;   2. To analyze an algorithm,
;;;     Reset the counts.
;;;     Call your algorithm.
;;;     Report on the counts
;;; Practica:
;;;   (define lst ...)
;;;   (define$ myproc ...)
;;;   (analyst 'reset!)
;;;   (myproc lst)
;;;   (analyst 'report!)
;;; History:
;;;   At end.

; +-----+------------------------------------------------------------------
; | HOP |
; +-----+

(define left-section (lambda (proc left) (lambda (right) (proc left right))))
(define l-s left-section)


; +--------------------+---------------------------------------------------
; | Primary Procedures |
; +--------------------+

;;; Procedure
;;;   (analyst 'count! name)
;;; Parameters:
;;;   name, a symbol
;;; Purpose:
;;;   Increments the counter associated with name.
;;; Produces:
;;;   Nothing; called for its side effect.
;;; Preconditions:
;;;   (none)
;;; Postconditions:
;;;   The count associated with name has been incremented by 1.

;;; Procedure:
;;;   (analyst 'report!)
;;; Parameters:
;;;   (none)
;;; Purpose:
;;;   Report on all the counts done by count! (or related procedures).
;;; Produces:
;;;   Nothing; called for its side effect.
;;; Preconditions:
;;;   (none)
;;; Postconditions:
;;;   The counts have been displayed.

;;; Procedure:
;;;   (analyst 'reset!)
;;; Parameters:
;;;   (none)
;;; Purpose:
;;;   Reset all the counts.
;;; Produces:
;;;   Nothing; called ofr its side effect.
(define analyst
  (let ((counts null))
    (lambda (message . params)
      (cond
        ((eq? message 'count!)
         (letrec ((kernel (lambda (name lst)
                            (cond
                              ((null? lst) (list (cons name 1)))
                              ((eq? name (caar lst)) (set-cdr! (car lst) (+ 1 (cdar lst))) lst)
                              (else (cons (car lst) (kernel name (cdr lst))))))))
              (set! counts (kernel (car params) counts))))
        ((eq? message 'report!)
         (letrec ((kernel (lambda (lst)
                            (if (null? lst) 0
                                (begin
                                  (display (caar lst))
                                  (display ": ")
                                  (display (cdar lst))
                                  (newline)
                                  (+ (cdar lst) (kernel (cdr lst))))))))
;          (set! counts
;                (sort counts 
;                      (lambda (p1 p2) 
;                        (string-ci<? (symbol->string (car p1)) (symbol->string (car p2))))))
           (let ((total (kernel counts)))
             (display "Total: ")
             (display total)
             (newline))))
        ((eq? message 'reset!)
           (set! counts null))
        (else (error "analyst: unknown message"))))))


; +--------+---------------------------------------------------------------
; | Syntax |
; +--------+

;;; Keyword:
;;;   $
;;; Parameters:
;;;   proc, a procedure
;;; Purpose:
;;;   Record the call to proc.
;;; Produces:
;;;   proc, its parameter
;;; Preconditions:
;;;   proc names a procedure
;;; Postconditions:
;;;   The call has been recorded.
(define-syntax $
  (syntax-rules ()
    (($ proc)
     (begin (analyst 'count! 'proc) proc))))

;;; Procedure:
;;;   _insert-$
;;; Parameters:
;;;   struct, a Scheme structure
;;; Purpose:
;;;   Insert $ at all of the procedure calls (or so I hope)
;;; Produces:
;;;   $struct, a Scheme structure.
;;; Problems:
;;;   Only works with standard Scheme syntax.
(define _insert-$
  ; process-second recurses only on the second element of a length-two list.  It
  ; is used for the definitions part of let, let*, letrec, and named let.
  (let ((process-second (lambda (def) (list (car def) (_insert-$ (cadr def))))))
    (lambda (struct)
      (if (or (null? struct) (not (list? struct)) )
          struct
          (let ((first (car struct)))
            (cond
              ; lambda expression: Only process the body
              ((eq? first 'lambda)
               (cons first (cons (cadr struct) (map _insert-$ (cddr struct)))))
              ; cond expression: Process each clause
              ((eq? first 'cond)
               (cons first (map (l-s map _insert-$) (cdr struct))))
              ; let*, lectrec, and plain let:
              ((or (eq? first 'let*)
                   (eq? first 'letrec)
                   (and (eq? first 'let) (not (symbol? (cadr struct)))))
               (cons first (cons (map process-second (cadr struct)) (map _insert-$ (cddr struct)))))
              ; Named let
              ((eq? first 'let)
               (cons first 
                     (cons second
                           (cons (map-process-second (caddr struct))
                                 (map _insert-$ (cdddr struct))))))
              ; A simple application
              ((symbol? first)
               (cons (list '$ first) (map _insert-$ (cdr struct))))
              ; Everything else: Funky application
              (else (map _insert-$ struct))))))))

;;; Syntax:
;;;   analyze
;;; Parameters:
;;;   exp, an annotated expression
;;; Purpose:
;;;   Analyze the given expression.
;;; Produces:
;;;   val, a Scheme value.
;;; Preconditions:
;;;   exp is a valid expression.
;;; Postconditions:
;;;   val is the value of exp.
;;;   A report on exp has been printed.
(define-syntax analyze
  (syntax-rules ()
    ((analyze exp)
     (begin
       (analyst 'reset!)
       (let ((result exp))
         (analyst 'report!)
         result)))))

;;; Syntax:
;;;   define$
;;; Parameters:
;;;   name, a symbol (unquoted)
;;;   definiens, an expression
;;; Purpose:
;;;   Associates name with definiens, counting steps as appropriate
;;;   (and preparing to count more).
;;; Produces:
;;;   (nothing)
;;; Preconditions:
;;;   definiens is a valid expression.
;;; Postconditions:
;;;   Any procedure calls that appear in definiens are recorded.
;;;   If definiens returns a procedure, name refers to a version of
;;;     that procedure that records its steps.
(define-syntax define$
  (syntax-rules ()
    ((define$ name definiens)
     (define name (eval (_insert-$ 'definiens))))))

;;; Syntax:
;;;   define$$
;;; Parameters:
;;;   name, a symbol (unquoted)
;;;   definiens, an expression
;;; Purpose:
;;;   See what define$ does to the expression.
;;; Preconditions:
;;;   (none)
;;; Postconditions:
;;;   name now refers to the symbolic version of the annotated
;;;   definiens.
(define-syntax define$$
  (syntax-rules()
    ((define$$ name definiens)
     (define name (_insert-$ 'definiens)))))

; +---------+--------------------------------------------------------------
; | History |
; +---------+

; Saturday, 11 November 2006 (v 0.1) [Samuel A. Rebelsky]
; * Created.

; Sunday, 12 November 2006 (v 0.2) [Samuel A. Rebelsky]
; * Excised examples (now in analyst-examples.scm).
; * Changed call format.  (The procedures reset! analyze! and count! have been
;   replaced by (analyst 'reset!), (analyst 'report!) and (analyst 'count! name).
; * Added the analyze syntax.
; * Other, minor, updates.

; +-------+----------------------------------------------------------------
; | To Do |
; +-------+

; [] Think about names of procedures.  (For example is inserting the $ the best
;    way to indicate that we should count something?). 
; [] Make define$ work more generally.
; [] Test define$ on a wide variety of procedures.
; [] Find a way to count kernels and the parameters to hops better.
; [] Make insert-$ local.
; [] Think about a variant to analyze! that accepts a list of symbols to analyzze.
; [] Write a corresponding reading.