;; BF IR Optimization - Collapse Multipliers
;; Jon Simons (simonsj at ccs dot neu dot edu)
;; August, 2007
;; -------------------------------------------------------------------------
;; This module provides an optimization which collapses multiplier loops.
;;
;; Optimization:
;;
;;   Take any (LOOP P <EXPRS> ...).
;;
;;   Assume that <EXPRS> ... contains no INs, OUTs, LTs, RTs and no inner
;;   LOOPs.
;;
;;     If the sum total of all value changes to pointer location P is -1,
;;     then we can conclude that this LOOP would be executed P times.  The
;;     only operations which would invalidate this conclusion would be I/O
;;     operations, pointer movement, and inner loops which contain either
;;     I/O or pointer movement.
;;
;;     It may be possible to lift the restriction of inner loops, but this
;;     would require analysis of the inner loop.
;;
;;   Then (LOOP P <EXPRS> ...) can be translated into (MUL P <EXPRS> ...).
;;   This is all that this IR optimization does.
;;
;;   Code-emitting modules use MULs as follows:
;;
;;     The <EXPRS> ... in the MUL will consist of only INCs and DECs.
;;
;;     Let M be the value of pointer location P for (MUL P <EXPRS> ...).
;;
;;     It holds that any (INC/DEC N ptr) in the MUL's <EXPRS> ... can be
;;     translated into (INC/DEC (N * M) ptr).
;;
;; -------------------------------------------------------------------------
(module collapse-mults mzscheme
  
  (require "../bf-ast-to-ir.scm")
  (provide collapse-multiplier-loops)
  
  ;; Yields an IR tree whose collapsable loops are MULs.
  ;;
  ;; collapse-multiplier-loops : (list of EXPRs) -> (list of EXPRs)
  (define (collapse-multiplier-loops AST)
    (map (lambda (expr)
           (let ((type  (EXPR-type  expr))
                 (n     (EXPR-N     expr))
                 (ptr   (EXPR-ptr   expr))
                 (exprs (EXPR-exprs expr)))
             (if (and (eq? type 'loop)
                      (can-collapse? expr))
                 (MUL (collapse-multiplier-loops exprs) ptr)
                 (if exprs
                     (make-EXPR type n ptr (collapse-multiplier-loops exprs))
                     expr))))
         AST))
  
  
  ;; Is the given EXPR elligible for multiplication-collapsing?
  ;;
  ;; It needs to be a LOOP, containing no INs or OUTs, no
  ;; LTs or RTs, and no inner LOOPs (for now, at least).
  ;;
  ;; can-collapse? : EXPR -> boolean
  (define (can-collapse? exp)
    (and (eq? 'loop (EXPR-type exp))
         (andmap (lambda (e)
                   (let ((type (EXPR-type e)))
                     (not (ormap (lambda (t) (eq? type t))
                                 '(in out lt rt loop)))))
                 (EXPR-exprs exp))
         (= (val-diff (EXPR-ptr exp) (EXPR-exprs exp)) -1)))
  
  
  ;; Returns the value difference at the given pointer location
  ;; for the end of the given list of EXPRs.
  ;;
  ;; val-diff : number (list of EXPRs) -> number
  (define (val-diff ptr-loc exprs)
    (letrec ((vd (lambda (ptr-loc exprs acc)
                   (if (null? exprs)
                       acc
                       (let ((e (car exprs)))
                         (if (= (EXPR-ptr e) ptr-loc)
                             (case (EXPR-type e)
                               ((inc) (vd ptr-loc
                                          (cdr exprs)
                                          (+ acc (EXPR-N e))))
                               ((dec) (vd ptr-loc
                                          (cdr exprs)
                                          (- acc (EXPR-N e))))
                               (else  (vd ptr-loc (cdr exprs) acc)))
                             (vd ptr-loc (cdr exprs) acc)))))))
      (vd ptr-loc exprs 0)))
  
  )