Ignore:
Timestamp:
09/15/08 08:46:03 (13 years ago)
Author:
felix winkelmann
Message:

eqv?-optimization also for ##sys#eqv?

File:
1 edited

Legend:

Unmodified
Added
Removed
  • chicken/branches/hygienic/c-platform.scm

    r11919 r11948  
    364364             (cons* (make-node '##core#proc '("C_quotient" #t) '()) cont callargs) ) ) ) ) )
    365365
    366 (rewrite
    367  'eqv? 8
    368  (lambda (db classargs cont callargs)
    369    ;; (eqv? <var> <var>) -> (quote #t)
    370    ;; (eqv? ...) -> (##core#inline "C_eqp" ...) [one argument is a constant and not a flonum]
    371    (and (= (length callargs) 2)
    372         (let ([arg1 (first callargs)]
    373               [arg2 (second callargs)] )
    374           (or (and (eq? '##core#variable (node-class arg1))
    375                    (eq? '##core#variable (node-class arg2))
    376                    (equal? (node-parameters arg1) (node-parameters arg2))
    377                    (make-node '##core#call '(#t) (list cont (qnode #t))) )
    378               (and (or (and (eq? 'quote (node-class arg1))
    379                             (not (flonum? (first (node-parameters arg1)))) )
    380                        (and (eq? 'quote (node-class arg2))
    381                             (not (flonum? (first (node-parameters arg2)))) ) )
    382                    (make-node
    383                     '##core#call '(#t)
    384                     (list cont (make-node '##core#inline '("C_eqp") callargs)) ) ) ) ) ) ) )
     366(let ()
     367  (define (eqv?-id db classargs cont callargs)
     368    ;; (eqv? <var> <var>) -> (quote #t)
     369    ;; (eqv? ...) -> (##core#inline "C_eqp" ...) [one argument is a constant and not a flonum]
     370    (and (= (length callargs) 2)
     371         (let ([arg1 (first callargs)]
     372               [arg2 (second callargs)] )
     373           (or (and (eq? '##core#variable (node-class arg1))
     374                    (eq? '##core#variable (node-class arg2))
     375                    (equal? (node-parameters arg1) (node-parameters arg2))
     376                    (make-node '##core#call '(#t) (list cont (qnode #t))) )
     377               (and (or (and (eq? 'quote (node-class arg1))
     378                             (not (flonum? (first (node-parameters arg1)))) )
     379                        (and (eq? 'quote (node-class arg2))
     380                             (not (flonum? (first (node-parameters arg2)))) ) )
     381                    (make-node
     382                     '##core#call '(#t)
     383                     (list cont (make-node '##core#inline '("C_eqp") callargs)) ) ) ) ) ) )
     384  (rewrite 'eqv? 8 eqv?-id)
     385  (rewrite '##sys#eqv? 8 eqv?-id))
    385386
    386387(rewrite
Note: See TracChangeset for help on using the changeset viewer.