(module no-brainer mzscheme
  (require (lib "unitsig.ss")
           "../no-brainer-sig.ss"
           (lib "match.ss")
           "build-arity-table.ss"
           "arity-table.ss"
           "check-program.ss"
	   (lib "my-macros.ss" "stepper" "private"))
  
  (provide no-brainer@)
  
  (define no-brainer@
    (unit/sig no-brainer^
      (import no-brainer-vc^ (program-expander))
      
      (define (my-error-display-handler msg exn)
        (receive-string
         (format "ERROR DURING EXPANSION:\n  ~a\n" msg)))
      
      (define (go)
        (parameterize ([error-display-handler my-error-display-handler])
        (program-expander expr-iterator)))
      
      (define table null)
      (define results null)
      
      
      ; header, predicate & printer sets:
      
      ; bad application
      
      (define bad-app-header "\nAPPLICATIONS WITH WRONG ARITY\n\n")
      
      (define (bad-app-predicate result)
        (eq? (car result) 'bad-application))
      
      (define (bad-app-printer result)
        (receive-string
         (format "mis-application at ~a with desired arities: ~a\n" 
                 (list-ref result 1)
                 (list-ref result 2))))
      
      ; unused let/rec bindings
      
      (define unused-bindings-header "\nUNUSED LET/REC BINDINGS\n\n")
      
      (define (unused-bindings-predicate result)
        (and (eq? (car result) 'unused-bindings)
             (eq? (list-ref result 2) 'let/rec)
             (ormap syntax-position (list-ref result 3))))
      
      (define (unused-bindings-printer result)
        (receive-string
         (format "bindings ~a (from ~a) unused in expression: ~a\n"
                 (map syntax-e (list-ref result 3))
                 (list-ref result 3)
                 (list-ref result 1))))

      ; unused module definitions
      
      (define unused-module-defs-header "\nUNUSED DEFINITIONS IN MODULE\n\n")
      
      (define (unused-module-defs-predicate result)
        (match result
          [`(unused-bindings ,stx module ,bindings)
           (ormap syntax-position bindings)]
          [else
           #f]))
      
      (define (unused-module-defs-printer result)
        (receive-string
         (apply string-append
                (map (lx (format "defined value ~a from ~a unused in module\n"
                                 (syntax-object->datum _)
                                 _))
                     (list-ref result 3)))))
      
      ; unused lambda bindings
      
      (define unused-lam-bindings-header "\nUNUSED LAMBDA BINDINGS\n\n")
      
      (define (unused-lam-bindings-predicate result)
        (and (eq? (car result) 'unused-bindings)
             (eq? (list-ref result 2) 'lambda)
             (ormap syntax-position (list-ref result 3))))
      
      (define (unused-lam-bindings-printer result)
        (receive-string
         (format "bindings ~a (from ~a) unused in expression: ~a\n"
                 (map syntax-e (list-ref result 3))
                 (list-ref result 3)
                 (list-ref result 1))))
      
      
      (define (loop-and-print header predicate printer results)
        (receive-string header)
        (let loop ([remaining results])
          (unless (null? remaining)
            (when (predicate (car remaining))
              (printer (car remaining)))
            (loop (cdr remaining)))))
      
      
      (define (expr-iterator expr recur)
        (if (eof-object? expr)
            (begin
              (loop-and-print bad-app-header bad-app-predicate bad-app-printer results)
              (loop-and-print unused-bindings-header unused-bindings-predicate unused-bindings-printer results)
              (loop-and-print unused-module-defs-header unused-module-defs-predicate unused-module-defs-printer results)
              (loop-and-print unused-lam-bindings-header unused-lam-bindings-predicate unused-lam-bindings-printer results))
            (begin
              (set! table (coalesce-table (append (build-arity-table expr) table)))
              (set! results (append (check-program expr table) results))
              (recur)))))))