From fc49dbb52a5f3ed7ea16a5735623f169af2644f6 Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Mon, 28 Aug 2017 19:02:11 -0400
Subject: [PATCH] Issue #215 - Added (->dyadic) and some conversions

---
 opt-test.scm                  | 51 ++++++++++++++++++-----------------
 scheme/cyclone/primitives.sld | 34 +++++++++++++++++------
 2 files changed, 52 insertions(+), 33 deletions(-)

diff --git a/opt-test.scm b/opt-test.scm
index ee3dbb4b..d98394a1 100644
--- a/opt-test.scm
+++ b/opt-test.scm
@@ -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)))
diff --git a/scheme/cyclone/primitives.sld b/scheme/cyclone/primitives.sld
index a17402c6..a694d958 100644
--- a/scheme/cyclone/primitives.sld
+++ b/scheme/cyclone/primitives.sld
@@ -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: