@@ -264,7 +264,9 @@ obj execute (int pc) (list 'let (map (fn (p a) (list p!uid (source a))) (properify ((car ast!subx) 'params)) (cdr ast!subx)) (source (car ((car ast!subx) 'subx)))) (map source ast!subx)) (alam ast) - (list 'fn (map-improper [_ 'uid] ast!params) (source (car ast!subx))) + `(fn ,(map-improper [_ 'uid] ast!params) + ,@(if ast!continuation `((t arc2c continuation))) + ,(source (car ast!subx))) (aseq ast) (cons 'do (map source ast!subx)) (aquote ast) codegen.arc @@ -1,5 +1,10 @@ ; CPS conversion +(def make-cont (subx params) + (let ast (make-lam subx params) + (assert ast!continuation) + ast)) + (def cps (ast k-ast) (if (or (alit ast) (aref ast) (aquote ast)) @@ -18,6 +23,7 @@ (anapp ast) (let fun (car ast!subx) (if (alam fun) + ; let form (cps-list (cdr ast!subx) [make-app (cons (make-lam (list:cps-seq fun!subx k-ast) fun!params) _)]) (cps-list ast!subx [make-app (cons (car _) (cons k-ast (cdr _)))]))) (alam ast) @@ -35,7 +41,7 @@ (or (alit (car asts)) (aref (car asts))) (body (car asts)) (let r (new-var 'r) - (cps (car asts) (make-lam (list:body:make-ref '() r) (list r))))))) + (cps (car asts) (make-cont (list:body:make-ref '() r) (list r))))))) (def cps-seq (asts k-ast) (if @@ -44,7 +50,7 @@ (no (cdr asts)) (cps (car asts) k-ast) (let r (new-var 'r) - (cps (car asts) (make-lam (list:cps-seq (cdr asts) k-ast) (list r)))))) + (cps (car asts) (make-cont (list:cps-seq (cdr asts) k-ast) (list r)))))) (def cps-convert (ast) @@ -52,7 +58,7 @@ (cps ast (let r (new-var 'r) - (make-lam + (make-cont (list:make-prim (list:make-ref '() r) '%halt) (list r)))) primvar cps.arc b8108e707dd218ee2597d086172f51cf2a8fcbc5 Alan Manuel K. Gloria almkglor@gmail.com http://github.com/sacado/arc2c/commit/d6ab2bf140ce15151091a16c484b5789e2a983ac d6ab2bf140ce15151091a16c484b5789e2a983ac 2008-07-23T04:31:35-07:00 2008-07-23T04:31:35-07:00 cps, codegen: now adds a tag for continuation functions dfa7c29fd189dff09eaa421d2c80616b4417e300 Alan Manuel K. Gloria almkglor@gmail.com