Permalink
Browse files

optimize `begin`

  • Loading branch information...
1 parent 8a3f40b commit 060b2e7e8b5a89cc23717dfe9e892692ae0e36f1 @jlongster committed May 14, 2012
Showing with 4,348 additions and 433 deletions.
  1. +17 −0 NOTES
  2. +3,851 −0 a.js
  3. +151 −148 backends/js.js
  4. +10 −5 backends/js.ol
  5. +239 −230 compiler.js
  6. +69 −50 compiler.ol
  7. +10 −0 test.js
  8. +1 −0 test.ol
View
@@ -0,0 +1,17 @@
+
+I am currently working on optimizing the CPS transformation of Outlet
+(for debugging). I wrote a post about this and received good feedback.
+Here are things I need to think about or study:
+
+* "A First-Order One-Pass CPS algorithm" - Danvy, 2001 (clojure-tco)
+** http://www.brics.dk/RS/01/49/BRICS-RS-01-49.pdf
+* "The Essence of Compiling with Continuations" - Amr Sabry
+* "Compiling with Continuations, Continued" - Andrew Kennedy
+* Minimal thunkification
+** http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.158.7919
+* Oliver Danvy
+** http://t.co/VXIq3msE
+* "first cut would be to reduce thunks: if your only loop construct is
+ application, only thunk app-inner-k"
+* "second, the more efficient transformations you mention in your post
+ specifically reduce allocation by creating fewer closures"
View
3,851 a.js
Oops, something went wrong.
View
Oops, something went wrong.
View
@@ -6,7 +6,8 @@
(not (and (ast.list? form)
(or (== (ast.first* form) 'throw)
(== (ast.first* form) 'set!)
- (== (ast.first* form) 'define)))))
+ (== (ast.first* form) 'define)
+ (== (ast.first* form) 'begin)))))
(define (generator & optimizations)
(define code [])
@@ -241,8 +242,13 @@
((null? (ast.node-data args))
(write "(function() {")))
+ (write-statements body compile)
+ (write "})")
+ (terminate-expr expr?))
+
+ (define (write-statements expr* compile)
(let ((i 0)
- (len (length body)))
+ (len (length expr*)))
(for-each (lambda (form)
;; return the last form (if it's not a throw or a set)
(if (and (== i (- len 1))
@@ -251,9 +257,7 @@
(compile form)
(set! i (+ i 1)))
- body))
- (write "})")
- (terminate-expr expr?))
+ expr*)))
(define (write-func-call func args expr? compile)
;; write the calling function, which can be a symbol, a lambda, or a
@@ -319,6 +323,7 @@
:write-set! write-set!
:write-if write-if
:write-lambda write-lambda
+ :write-statements write-statements
:write-func-call write-func-call
:write-raw-code write-raw-code
View
Oops, something went wrong.
View
@@ -134,11 +134,6 @@
#f))))
(install-macro
- 'begin
- (lambda (form)
- `((lambda () ,@(cdr form)))))
-
-(install-macro
'cond
(lambda (form)
(if (null? (cdr form))
@@ -507,43 +502,62 @@
(caddr (ast.node-data node))
compile*))))
-(define (compile node generator . expr?)
- (define (compile* node . expr?)
- (compile node generator (opt expr? #f)))
-
- (let ((expr? (opt expr? #f)))
+(define (compile-begin node generator compile* expr? top?)
+ (let ((e* (cdr (ast.node-data node))))
(cond
- ((self-evaluating? (ast.node-data node))
- (compile-object node generator #f expr?))
- ((symbol? (ast.node-data node))
- (compile-reference node generator expr?))
- ((ast.vector? node)
- (compile-object node generator #f expr?))
- ((ast.dict? node)
- (compile-object node generator #f expr?))
- ((ast.list? node)
- (let ((sym (ast.first* node)))
- (cond
- ((== sym 'quote)
- (compile-object (cadr (ast.node-data node)) generator #t expr?))
- ((== sym 'quasiquote)
- (compile-quasi (cadr (ast.node-data node)) generator expr?))
- ((== sym 'if) (compile-if node generator expr? compile*))
- ((== sym 'lambda) (compile-lambda node generator expr? compile*))
- ((== sym 'set!) (compile-set! node generator compile*))
- ((== sym 'define) (compile-define node generator compile*))
- ((== sym '%raw)
- (generator.write-raw-code (cadr (ast.node-data node))))
- ((native? sym)
- ((native-function sym) node generator expr? compile*))
- (else
- (if (not (or (symbol? (ast.first* node))
- (list? (ast.first* node))))
- (throw (str "operator is not a procedure: " (ast.first* node))))
- (generator.write-func-call (ast.first node)
- (cdr (ast.node-data node))
- expr?
- compile*))))))))
+ (expr?
+ (compile*
+ (ast.make-list
+ (ast.make-list*
+ (cons
+ (ast.make-atom 'lambda node)
+ (cons
+ (ast.make-empty-list node)
+ e*))))
+ #t))
+ (top?
+ (for-each (lambda (e) (compile* e expr? top?))
+ e*))
+ (else
+ (generator.write-statements e* compile*)))))
+
+(define (compile node generator & expr? top?)
+ (define (compile* node & expr? top?)
+ (compile node generator expr? top?))
+
+ (cond
+ ((self-evaluating? (ast.node-data node))
+ (compile-object node generator #f expr?))
+ ((symbol? (ast.node-data node))
+ (compile-reference node generator expr?))
+ ((ast.vector? node)
+ (compile-object node generator #f expr?))
+ ((ast.dict? node)
+ (compile-object node generator #f expr?))
+ ((ast.list? node)
+ (let ((sym (ast.first* node)))
+ (cond
+ ((== sym 'quote)
+ (compile-object (cadr (ast.node-data node)) generator #t expr?))
+ ((== sym 'quasiquote)
+ (compile-quasi (cadr (ast.node-data node)) generator expr?))
+ ((== sym 'if) (compile-if node generator expr? compile*))
+ ((== sym 'lambda) (compile-lambda node generator expr? compile*))
+ ((== sym 'set!) (compile-set! node generator compile*))
+ ((== sym 'define) (compile-define node generator compile*))
+ ((== sym 'begin) (compile-begin node generator compile* expr? top?))
+ ((== sym '%raw)
+ (generator.write-raw-code (cadr (ast.node-data node))))
+ ((native? sym)
+ ((native-function sym) node generator expr? compile*))
+ (else
+ (if (not (or (symbol? (ast.first* node))
+ (list? (ast.first* node))))
+ (throw (str "operator is not a procedure: " (ast.first* node))))
+ (generator.write-func-call (ast.first node)
+ (cdr (ast.node-data node))
+ expr?
+ compile*)))))))
(define %optimize-mode 0)
@@ -554,19 +568,24 @@
(let ((exp (if (string? src)
(reader.read src)
(sourcify src 0 0))))
- (let ((src (desourcify (expand exp))))
- ;; We need to expand again after CPS because it generates a few
- ;; begin's
- (let ((src (expand (sourcify
- (list 'cps-trampoline
- ((cps.cps src) cps-halt))))))
- ;;(pp (desourcify src))
- (compile src generator)))
+
+ (compile (expand exp) generator #f #t)
+
+ ;; CPS version:
+ ;; (let ((src (desourcify (expand exp))))
+ ;; ;; We need to expand again after CPS because it generates a few
+ ;; ;; begin's
+ ;; (let ((src (expand (sourcify
+ ;; (list 'cps-trampoline
+ ;; ((cps.cps src) cps-halt))))))
+ ;; (pp (desourcify src))
+ ;; (compile src generator)))
+
(generator.get-code)))
(set! module.exports {:read (lambda (e) (desourcify (reader.read e)))
:expand expand
- :compile compile
+ :compile (lambda (e g) (compile e g #f #t))
:compile-program compile-program
:desourcify desourcify
:sourcify sourcify
View
@@ -746,6 +746,16 @@ var gensym_dash_fresh = (function() {_per_gensym_dash_base = 10000;
var gensym = (function() {_per_gensym_dash_base = (_per_gensym_dash_base + 1);
return string_dash__gt_symbol(("o" + _per_gensym_dash_base)); // Line 563 Column 3
});
+var cps_dash_trampoline = (function(func){
+var v = func();
+while(v) { v = v(); }return v; // Line <unknown undefined> Column <unknown undefined>
+});
+var cps_dash_jump = (function(to){
+return to; // Line <unknown undefined> Column <unknown undefined>
+});
+var cps_dash_halt = (function(v){
+return list(list("\uFDD1lambda",_emptylst,list("\uFDD1pp",list("\uFDD1str","halted with result: ",v)),false)); // Line 576 Column 4
+});
var __compiler = require('/Users/james/projects/outlet/compiler');
View
@@ -31,4 +31,5 @@
(let ((s (reader.read src))
(f (comp.expand s)))
(comp.compile f gen)
+ ;;(println (gen.get-code))
((%raw "eval") (gen.get-code)))))

0 comments on commit 060b2e7

Please sign in to comment.