From acaea412ea839300707dced710cc591fda864ac8 Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Thu, 13 Oct 2016 18:32:15 -0400
Subject: [PATCH] WIP

---
 scheme/cyclone/primitives.sld | 21 ++++++++++++++++++++-
 scheme/cyclone/transforms.sld |  9 ++++-----
 2 files changed, 24 insertions(+), 6 deletions(-)

diff --git a/scheme/cyclone/primitives.sld b/scheme/cyclone/primitives.sld
index a6f89224..adfaa6c6 100644
--- a/scheme/cyclone/primitives.sld
+++ b/scheme/cyclone/primitives.sld
@@ -7,7 +7,9 @@
 ;;;; This module contains information about Cyclone's scheme primitives.
 ;;;;
 (define-library (scheme cyclone primitives)
-  (import (scheme base))
+  (import (scheme base)
+          ;(scheme write)
+  )
   (export
     prim?
     *primitives*
@@ -18,6 +20,7 @@
     prim/data-arg?
     prim/c-var-assign
     prim/cvar?
+    prim:inline-convert-prim-call
     prim:check-arg-count
     prim:mutates?
     prim:cont?
@@ -57,6 +60,7 @@
          Cyc-stdout
          Cyc-stdin
          Cyc-stderr
+         Cyc-fast-plus
          +
          -
          *
@@ -176,6 +180,7 @@
          (Cyc-stdout 0 0)
          (Cyc-stdin 0 0)
          (Cyc-stderr 0 0)
+         (Cyc-fast-plus 2 2)
          (- 1 #f)
          (/ 1 #f)
          (= 2 #f)
@@ -402,6 +407,7 @@
          ((eq? p 'Cyc-stdout)            "Cyc_stdout")
          ((eq? p 'Cyc-stdin)             "Cyc_stdin")
          ((eq? p 'Cyc-stderr)            "Cyc_stderr")
+         ((eq? p 'Cyc-fast-plus)         "Cyc_fast_sum")
          ((eq? p '+)                     "Cyc_sum")
          ((eq? p '-)                     "Cyc_sub")
          ((eq? p '*)                     "Cyc_mul")
@@ -523,6 +529,7 @@
     ;; Does the primitive require passing thread data as its first argument?
     (define (prim/data-arg? p)
       (member p '(
+        Cyc-fast-plus
         +
         -
         *
@@ -604,6 +611,7 @@
         ((eq? p 'Cyc-stderr) "port_type")
         ((eq? p 'open-input-file) "port_type")
         ((eq? p 'open-output-file) "port_type")
+        ((eq? p 'Cyc-fast-plus) "common_type")
         ((eq? p '+) "object")
         ((eq? p '-) "object")
         ((eq? p '*) "object")
@@ -658,6 +666,7 @@
                  make-vector list->vector
                  symbol->string number->string 
                  substring
+                 Cyc-fast-plus
                  + - * / apply 
                  = > < >= <=
                  command-line-arguments
@@ -710,4 +719,14 @@
     (define (prim:allocates-object? exp)
         (and  (prim? exp)
               (member exp '())))
+
+    (define (prim:inline-convert-prim-call prim-call)
+      ;(write `(prim:inline-convert-prim-call ,prim-call))
+      ;(newline)
+      (cond
+        ((and (equal? (car prim-call) '+)
+              (= (length prim-call) 3))
+          (cons 'Cyc-fast-plus (cdr prim-call)))
+        (else
+          prim-call)))
 ))
diff --git a/scheme/cyclone/transforms.sld b/scheme/cyclone/transforms.sld
index 080110b9..444d3bb8 100644
--- a/scheme/cyclone/transforms.sld
+++ b/scheme/cyclone/transforms.sld
@@ -1022,8 +1022,6 @@
 
   ;; Perform actual alpha conversion
   (define (convert ast renamed)
-;(write `(DEBUG convert ,ast))
-;(write (newline))
     (cond
       ((const? ast) ast)
       ((quote? ast) ast)
@@ -1059,14 +1057,15 @@
             new-ast))))
       ((and (prim-call? ast)
             ;; Not a primitive if the identifier has been redefined
-            (not assoc (car ast) renamed))
+            (not (assoc (car ast) renamed)))
        (let ((converted
                (cons (car ast) 
                      (map (lambda (a) (convert a renamed))
                           (cdr ast)))))
          (if (precompute-prim-app? converted)
-           (eval converted) ;; OK, evaluate at compile time
-           converted)))
+           converted ; TODO:(eval converted) ;; OK, evaluate at compile time
+           converted))) ;; No, see if we can fast-convert it
+           ;(prim:inline-convert-prim-call converted)))) ;; No, see if we can fast-convert it
       ((lambda? ast)
        (let* ((args (lambda-formals->list ast))
               (ltype (lambda-formals-type ast))