Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-12 15:27:36 +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
;; Baseline - 2.511
;; Dyadic - 1.409
;;
(import (scheme base)
(scheme write)
(scheme read))
#;(let ((x (read))
(let ((x (read))
(y (read))
(z (read))
(iterations 10000000)
@ -18,27 +19,27 @@
(set! sum (- sum sum (* x y z))))
(write sum))
;; 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))))))
(write (->dyadic '(+ 1)))
(write (->dyadic '(+ 1 2)))
(write (->dyadic '(+ 1 2 3)))
(write (->dyadic '(+ 1 2 3 4)))
;(write
; (foldl
; (lambda (x acc)
; (list 'Cyc-fast-plus acc x))
; '(Cyc-fast-plus 1 2)
; '(3 4 5)))
;;; 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))))))
;
;(write (->dyadic '(+ 1)))
;(write (->dyadic '(+ 1 2)))
;(write (->dyadic '(+ 1 2 3)))
;(write (->dyadic '(+ 1 2 3 4)))
;;(write
;; (foldl
;; (lambda (x acc)
;; (list 'Cyc-fast-plus acc x))
;; '(Cyc-fast-plus 1 2)
;; '(3 4 5)))

34
scheme/cyclone/primitives.sld
View file

@ -903,16 +903,20 @@
(define (prim:inline-convert-prim-call prim-call)
(cond
((and (equal? (car prim-call) '+) (= (length prim-call) 3))
(cons 'Cyc-fast-plus (cdr prim-call)))
((and (equal? (car prim-call) '-) (= (length prim-call) 3))
(cons 'Cyc-fast-sub (cdr prim-call)))
((equal? (car prim-call) '+)
(->dyadic (cons 'Cyc-fast-plus (cdr prim-call))))
((equal? (car 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))
`(Cyc-fast-sub 0 ,@(cdr prim-call)))
((and (equal? (car prim-call) '*) (= (length prim-call) 3))
(cons 'Cyc-fast-mul (cdr prim-call)))
((and (equal? (car prim-call) '/) (= (length prim-call) 3))
(cons 'Cyc-fast-div (cdr prim-call)))
((equal? (car prim-call) '-)
(->dyadic (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) 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))
@ -926,6 +930,20 @@
(else
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.
;;
;; Inputs: