Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-08 21:47:33 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Issue #215

Browse source
This commit is contained in:
Justin Ethier 2017-08-29 13:52:20 +00:00
parent f96da8b9b6
commit 945c171892
1 changed files with 11 additions and 24 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

35
scheme/cyclone/primitives.sld
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)))