Changeset 14874 in project for chicken/trunk/optimizer.scm


Ignore:
Timestamp:
06/03/09 13:25:11 (11 years ago)
Author:
felix winkelmann
Message:

global inlining fixes; other small things

File:
1 edited

Legend:

Unmodified
Added
Removed
  • chicken/trunk/optimizer.scm

    r14828 r14874  
    6262  parameter-limit eq-inline-operator optimizable-rest-argument-operators
    6363  membership-test-operators membership-unfold-limit valid-compiler-options valid-compiler-options-with-argument
    64   make-random-name final-foreign-type inline-max-size simplified-ops
     64  make-random-name final-foreign-type inline-max-size simplified-ops apply-pre-cps-rewrite-rules!
    6565  generate-code make-variable-list make-argument-list generate-foreign-stubs foreign-type-declaration
    6666  foreign-argument-conversion foreign-result-conversion foreign-type-convert-argument foreign-type-convert-result)
     
    349349                                                   [(test (car vars) 'unused)
    350350                                                    (touch)
    351                                                     (debugging 'o "removed unused parameter to known procedure" (car vars) var)
     351                                                    (debugging
     352                                                     'o "removed unused parameter to known procedure"
     353                                                     (car vars) var)
    352354                                                    (if (expression-has-side-effects? (car args) db)
    353355                                                        (make-node
     
    17901792            (when (debugging 'l "accessibles:") (pretty-print al))
    17911793            (debugging 'p "eliminating liftables by access-lists and non-liftable callees...")
    1792             (let ([ls (eliminate3 (eliminate4 g2))]) ;(eliminate2 g2 al)))])
     1794            (let ([ls (eliminate3 (eliminate4 g2))]) ;(eliminate2 g2 al)))]) - why isn't this used?
    17931795              (debugging 'o "liftable local procedures" (delay (unzip1 ls)))
    17941796              (debugging 'p "gathering extra parameters...")
     
    18011803                (debugging 'p "moving liftables to toplevel...")
    18021804                (reconstruct! ls extra) ) ) ) ) ) ) ) )
     1805
     1806
     1807;;; Apply rewrite-rules to procedure calls
     1808
     1809(define (apply-pre-cps-rewrite-rules! node db)
     1810  (define (walk n)
     1811    (let ((class (node-class n))
     1812          (params (node-parameters n))
     1813          (subs (node-subexpressions n)))
     1814      (case class
     1815        ((##core#call)
     1816         (let* ((opnode (walk (first subs)))
     1817                (proc (and (eq? '##core#variable (node-class opnode))
     1818                           (first (node-parameters opnode))) )
     1819                (handler (and proc
     1820                              (intrinsic? proc)
     1821                              (##sys#get proc '##compiler#rewrite) ) ) )
     1822           (for-each walk (cdr subs))
     1823           (cond (handler
     1824                  (let ((info (and (pair? (cdr params))
     1825                                   (source-info->line (second params)))))
     1826                    (debugging 'o "applying rule" proc info)
     1827                    (copy-node! (handler proc (cdr subs) db walk) n)))
     1828                 (else n))))
     1829        (else
     1830         (for-each walk subs)))))
     1831  (walk node))
Note: See TracChangeset for help on using the changeset viewer.