Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-12 23:37:38 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Issue #215 - Added (->dyadic) and some conversions

Browse source
This commit is contained in:
Justin Ethier 2017-08-28 19:02:11 -04:00
parent 6e896fa2d8
commit fc49dbb52a
2 changed files with 52 additions and 33 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

51
opt-test.scm
View file

@ -3,11 +3,12 @@
;; ;;
;; Timings: T430 ;; Timings: T430
;; Baseline - 2.511 ;; Baseline - 2.511
;; Dyadic - 1.409
;; ;;
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
(scheme read)) (scheme read))
#;(let ((x (read)) (let ((x (read))
(y (read)) (y (read))
(z (read)) (z (read))
(iterations 10000000) (iterations 10000000)
@ -18,27 +19,27 @@
(set! sum (- sum sum (* x y z)))) (set! sum (- sum sum (* x y z))))
(write sum)) (write sum))
;; Take an expression containing a single function call and break it up ;;; Take an expression containing a single function call and break it up
;; into many calls of 2 arguments each. ;;; into many calls of 2 arguments each.
(define (->dyadic expr) ;(define (->dyadic expr)
(cond ; (cond
((< (length expr) 4) ; ((< (length expr) 4)
expr) ; expr)
(else ; (else
(let ((fnc (car expr))) ; (let ((fnc (car expr)))
(foldl ; (foldl
(lambda (x acc) ; (lambda (x acc)
(list fnc acc x)) ; (list fnc acc x))
`(,fnc ,(cadr expr) ,(caddr expr)) ; `(,fnc ,(cadr expr) ,(caddr expr))
(cdddr expr)))))) ; (cdddr expr))))))
;
(write (->dyadic '(+ 1))) ;(write (->dyadic '(+ 1)))
(write (->dyadic '(+ 1 2))) ;(write (->dyadic '(+ 1 2)))
(write (->dyadic '(+ 1 2 3))) ;(write (->dyadic '(+ 1 2 3)))
(write (->dyadic '(+ 1 2 3 4))) ;(write (->dyadic '(+ 1 2 3 4)))
;(write ;;(write
; (foldl ;; (foldl
; (lambda (x acc) ;; (lambda (x acc)
; (list 'Cyc-fast-plus acc x)) ;; (list 'Cyc-fast-plus acc x))
; '(Cyc-fast-plus 1 2) ;; '(Cyc-fast-plus 1 2)
; '(3 4 5))) ;; '(3 4 5)))

34
scheme/cyclone/primitives.sld
View file

@ -903,16 +903,20 @@
(define (prim:inline-convert-prim-call prim-call) (define (prim:inline-convert-prim-call prim-call)
(cond (cond
((and (equal? (car prim-call) '+) (= (length prim-call) 3)) ((equal? (car prim-call) '+)
(cons 'Cyc-fast-plus (cdr prim-call))) (->dyadic (cons 'Cyc-fast-plus (cdr prim-call))))
((and (equal? (car prim-call) '-) (= (length prim-call) 3)) ((equal? (car prim-call) '*)
(cons 'Cyc-fast-sub (cdr prim-call))) (->dyadic (cons 'Cyc-fast-mul (cdr prim-call))))
;((and (equal? (car prim-call) '-) (= (length prim-call) 3))
; (cons 'Cyc-fast-sub (cdr prim-call)))
((and (equal? (car prim-call) '-) (= (length prim-call) 2)) ((and (equal? (car prim-call) '-) (= (length prim-call) 2))
`(Cyc-fast-sub 0 ,@(cdr prim-call))) `(Cyc-fast-sub 0 ,@(cdr prim-call)))
((and (equal? (car prim-call) '*) (= (length prim-call) 3)) ((equal? (car prim-call) '-)
(cons 'Cyc-fast-mul (cdr prim-call))) (->dyadic (cons 'Cyc-fast-sub (cdr prim-call))))
((and (equal? (car prim-call) '/) (= (length prim-call) 3)) ((equal? (car prim-call) '/)
(cons 'Cyc-fast-div (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)) ((and (equal? (car prim-call) '=) (= (length prim-call) 3))
(cons 'Cyc-fast-eq (cdr prim-call))) (cons 'Cyc-fast-eq (cdr prim-call)))
((and (equal? (car prim-call) '>) (= (length prim-call) 3)) ((and (equal? (car prim-call) '>) (= (length prim-call) 3))
@ -926,6 +930,20 @@
(else (else
prim-call))) prim-call)))
;; Take an expression containing a single function call and break it up
;; into many calls of 2 arguments each.
(define (->dyadic expr)
(cond
((< (length expr) 4)
expr)
(else
(let ((fnc (car expr)))
(foldl
(lambda (x acc)
(list fnc acc x))
`(,fnc ,(cadr expr) ,(caddr expr))
(cdddr expr))))))
;; Map from a Scheme function to a primitive, if possible. ;; Map from a Scheme function to a primitive, if possible.
;; ;;
;; Inputs: ;; Inputs: