Added prim-convert

cyclone.scm

@@ -207,6 +207,15 @@
       (trace:info "---------------- after alpha conversion:")
       (trace:info input-program) ;pretty-print
 
+      ;; Convert some function calls to primitives, if possible
+      (set! input-program 
+        (map
+          (lambda (expr)
+            (prim-convert expr))
+          input-program))
+      (trace:info "---------------- after func->primitive conversion:")
+      (trace:info input-program) ;pretty-print
+    
       (let ((cps (map 
                    (lambda (expr)
                      (cps-convert expr))

scheme/cyclone/transforms.sld

@@ -104,6 +104,7 @@
     cps-convert 
     pos-in-list 
     closure-convert 
+    prim-convert
   )
   (begin
 
@@ -1185,22 +1186,45 @@
                  (difference fv (built-in-syms)))
                (list))))))
 
-;TODO: upgrade applicable function calls to inlinable primitives
+;; Upgrade applicable function calls to inlinable primitives
+;;
+;; Assumptions:
+;; - This executes after alpha conversion, so there are no define
+;;   expressions or if's without an else clause
+;;
 ;first case is char=? => Cyc-fast-char-eq (and rest of the family)
-;(define (inline-applicable-funcs expr)
+(define (prim-convert expr)
-;  (define (conv ast)
+  (define (conv ast)
-;    (cond
+    (cond
-;      ((define? ast)
+      ((const? ast) ast)
-;       `(define ,@(map (lambda (a) (conv a)) (cdr ast))))
+      ((quote? ast) ast)
-;      ((set!? ast)
+      ((ref? ast)   ast)
-;       `(set! ,@(map (lambda (a) (conv a)) (cdr ast))))
+      ((set!? ast)
-;      ((if? ast)
+       `(set! ,@(map (lambda (a) (conv a)) (cdr ast))))
-;        TODO
+      ((if? ast)
-;      ((lambda? ast)
+       `(if ,(conv (if->condition ast))
-;      ((app? ast)
+            ,(conv (if->then ast))
-;      (else
+            ,(conv (if->else ast))))
-;        ast)))
+      ((lambda? ast)
-;  (conv expr))
+       (let* ((args (lambda-formals->list ast))
+              (ltype (lambda-formals-type ast))
+              (body (lambda->exp ast))
+            )
+         `(lambda
+            ,(list->lambda-formals args ltype) ;; Overkill??
+            ,@(map conv body))))
+      ((app? ast)
+       (cond
+        ((and 
+           (eq? (car ast) 'char=?)
+           (= (length ast) 3) 
+         )
+         `(Cyc-fast-char-eq ,@(cdr ast)))
+        (else
+         (map conv ast))))
+      (else
+        ast)))
+  (conv expr))
 
 ;;
 ;; Helpers to syntax check primitive calls