This commit is contained in:
Justin Ethier 2017-08-29 13:52:20 +00:00
parent f96da8b9b6
commit 945c171892

View file

@ -903,30 +903,17 @@
(define (prim:inline-convert-prim-call prim-call) (define (prim:inline-convert-prim-call prim-call)
(cond (cond
((equal? (car prim-call) '+) ((equal? (car prim-call) '+) (->dyadic (cons 'Cyc-fast-plus (cdr prim-call))))
(->dyadic (cons 'Cyc-fast-plus (cdr prim-call)))) ((equal? (car prim-call) '*) (->dyadic (cons 'Cyc-fast-mul (cdr prim-call))))
((equal? (car prim-call) '*) ((and (equal? (car prim-call) '-) (= (length prim-call) 2)) `(Cyc-fast-sub 0 ,@(cdr prim-call))) ;; Special case, fast negation
(->dyadic (cons 'Cyc-fast-mul (cdr prim-call)))) ((equal? (car prim-call) '-) (->dyadic (cons 'Cyc-fast-sub (cdr prim-call))))
;((and (equal? (car prim-call) '-) (= (length prim-call) 3)) ((and (equal? (car prim-call) '/) (= (length prim-call) 2)) `(Cyc-fast-div 1 ,@(cdr prim-call))) ;; Special case, fast inversion
; (cons 'Cyc-fast-sub (cdr prim-call))) ((equal? (car prim-call) '/) (->dyadic (cons 'Cyc-fast-div (cdr prim-call))))
((and (equal? (car prim-call) '-) (= (length prim-call) 2)) ((and (equal? (car prim-call) '=) (= (length prim-call) 3)) (cons 'Cyc-fast-eq (cdr prim-call)))
`(Cyc-fast-sub 0 ,@(cdr prim-call))) ((and (equal? (car prim-call) '>) (= (length prim-call) 3)) (cons 'Cyc-fast-gt (cdr prim-call)))
((equal? (car prim-call) '-) ((and (equal? (car prim-call) '<) (= (length prim-call) 3)) (cons 'Cyc-fast-lt (cdr prim-call)))
(->dyadic (cons 'Cyc-fast-sub (cdr prim-call)))) ((and (equal? (car prim-call) '>=) (= (length prim-call) 3)) (cons 'Cyc-fast-gte (cdr prim-call)))
((equal? (car prim-call) '/) ((and (equal? (car prim-call) '<=) (= (length prim-call) 3)) (cons 'Cyc-fast-lte (cdr prim-call)))
(->dyadic (cons 'Cyc-fast-div (cdr prim-call))))
;((and (equal? (car prim-call) '/) (= (length prim-call) 3))
; (cons 'Cyc-fast-div (cdr prim-call)))
((and (equal? (car prim-call) '=) (= (length prim-call) 3))
(cons 'Cyc-fast-eq (cdr prim-call)))
((and (equal? (car prim-call) '>) (= (length prim-call) 3))
(cons 'Cyc-fast-gt (cdr prim-call)))
((and (equal? (car prim-call) '<) (= (length prim-call) 3))
(cons 'Cyc-fast-lt (cdr prim-call)))
((and (equal? (car prim-call) '>=) (= (length prim-call) 3))
(cons 'Cyc-fast-gte (cdr prim-call)))
((and (equal? (car prim-call) '<=) (= (length prim-call) 3))
(cons 'Cyc-fast-lte (cdr prim-call)))
(else (else
prim-call))) prim-call)))