diff --git a/cyclone.scm b/cyclone.scm index fb24aaa0..6ee9e670 100644 --- a/cyclone.scm +++ b/cyclone.scm @@ -206,6 +206,15 @@ input-program)) (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) diff --git a/scheme/cyclone/transforms.sld b/scheme/cyclone/transforms.sld index 55e36909..aae1e5d9 100644 --- a/scheme/cyclone/transforms.sld +++ b/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 (conv ast) -; (cond -; ((define? ast) -; `(define ,@(map (lambda (a) (conv a)) (cdr ast)))) -; ((set!? ast) -; `(set! ,@(map (lambda (a) (conv a)) (cdr ast)))) -; ((if? ast) -; TODO -; ((lambda? ast) -; ((app? ast) -; (else -; ast))) -; (conv expr)) +(define (prim-convert expr) + (define (conv ast) + (cond + ((const? ast) ast) + ((quote? ast) ast) + ((ref? ast) ast) + ((set!? ast) + `(set! ,@(map (lambda (a) (conv a)) (cdr ast)))) + ((if? ast) + `(if ,(conv (if->condition ast)) + ,(conv (if->then ast)) + ,(conv (if->else ast)))) + ((lambda? ast) + (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