@@ -297,14 +297,14 @@ void PR(); //place arguments exceeding nbreq into a list at the top of //the stack -#define VARIADIC2LIST(nbreq) {\ +#define VARIADIC2LIST(nbreq, expected) {\ for(PUSH(NILOBJ); num_args > nbreq; --num_args) CONS();\ if(num_args != nbreq){\ ERROR("apply",\ - "Expected at least " #nbreq " arguments")\ + "Expected at least " #expected " arguments")\ }\ ++num_args;} -#define CHECK_PARAMS(n) {if(num_args != (n)) ERROR("apply","Expected " #n " arguments");} +#define CHECK_PARAMS(n, expected) {if(num_args != (n)) ERROR("apply","Expected " #expected " arguments");} #define BEGIN_CLOSURE(label,nbfree) closure = (obj *) gc_malloc(sizeof(obj) * (nbfree + 3)); #define INICLO(i) closure[i+2] = POP(); @@ -334,6 +334,15 @@ while(!(APTR(LOCAL(0)) && AFN(LOCAL(0)))){\ }\ }\ closure = (obj *) LOCAL(0); pc = closure[2]; goto jump;} +#define APPLY() { obj l = POP(); obj k = POP(); obj f = TOS();\ + sp = stack; PUSH(f); PUSH(k);\ + for(num_args = 2; l != NILOBJ; ++num_args){\ + PUSH(l); CAR();\ + l = (obj) ((pair*)l)->cdr;\ + }\ + END_JUMP(num_args);\ +} + #define LIST_REF() {\ long idx; obj i = POP();\ a2c.h @@ -73,6 +73,8 @@ (aprim ast) (let args ast!subx (if + (is ast!op '%apply) + (list (cg-args args stack-env) " APPLY();") (is ast!op '%string-ref) (list (cg-args args stack-env) " STRING_REF();") (is ast!op '%list-ref) @@ -155,8 +157,12 @@ (let num-reqs (len:properify ast!params) ; if variadic, use variadic handling code (if (dotted ast!params) - (list " VARIADIC2LIST(" (- num-reqs 1) ");\n") - (list " CHECK_PARAMS(" num-reqs ");\n"))) + ; the second argument is the arc-side expected number of + ; arguments (arguments include the function to execute as + ; well as the continuation, which the arc-side programmer + ; doesn't care about) + (list " VARIADIC2LIST(" (- num-reqs 1) "," (- num-reqs 3) ");\n") + (list " CHECK_PARAMS(" num-reqs "," (- num-reqs 2) ");\n"))) (code-gen (car ast!subx) (rev:properify ast!params)) "\n\n" (compile-all-lambdas)))))) codegen.arc @@ -48,17 +48,39 @@ (def cps-convert (ast) - (let ast-cps - (cps - ast - (let r (new-var 'r) - (make-lam - (list:make-prim (list:make-ref '() r) '%halt) - (list r)))) + (with (ast-cps + (cps + ast + (let r (new-var 'r) + (make-lam + (list:make-prim (list:make-ref '() r) '%halt) + (list r)))) + primvar + (fn (var) + (and (aglobal var) + (is #\% ((string var!id) 0)))) + primitivize nil) + (= primitivize + (fn (ast) + (if + (and (anapp ast) + (aref:car ast!subx) + (primvar ((car ast!subx) 'var))) + (make-prim (map primitivize (cdr ast!subx)) + (((car ast!subx) 'var) 'id)) + ; else + (do (zap [map primitivize _] ast!subx) + ast)))) (if (lookup 'ccc (fv ast)) - ; add this definition for call/cc if call/cc is needed - (make-app:list - (make-lam (list ast-cps) (list (new-var '_))) - (xe '(set ccc (fn (k f) (f k (fn (_ result) (k result))))) '())) - ast-cps))) + ; add this definition for call/cc if call/cc is needed + (= ast-cps + (make-app:list + (make-lam (list ast-cps) (list (new-var '_))) + (xe '(set ccc (fn (k f) (f k (fn (_ result) (k result))))) '())))) + (if (lookup '<arc2c>!apply (fv ast)) + (= ast-cps + (make-app:list + (make-lam (list ast-cps) (list (new-var '_))) + (primitivize:xe '(set <arc2c>!apply (fn (k f l) (%apply f k l))) '())))) + ast-cps)) cps.arc @@ -138,6 +138,16 @@ (f))))) (%curr-err)))) +(set $cons*-base + (fn (con) + (if (cdr con) + (cons (car con) ($cons*-base (cdr con))) + (car con)))) + +(set apply + (fn (f . rest) + (<arc2c>!apply f ($cons*-base rest)))) + (set call* (%table)) (%sref call* (fn (l i) (%list-ref l i)) 'cons) (%sref call* (fn (s i) (%string-ref s i)) 'string) lib-ac.scm.arc @@ -72,7 +72,7 @@ (diff readset writeset) ; allow some undefined globals: these are inserted later in ; the transformation - (if (all [in _!uid 'ccc] it) + (if (all [in _!uid 'ccc '<arc2c>!apply] it) ast (err:tostring:pr "Global variables read, but aren't assigned to: " (map [_ 'uid] it))) rm-global.arc 39e5431b1f8d568bdb2c50cb2b8bcdcdeac7a4b8 Alan Manuel K. Gloria almkglor@gmail.com http://github.com/sacado/arc2c/commit/1bccf00c9d1f3ac073d2813a72a3ae657003ce0d 1bccf00c9d1f3ac073d2813a72a3ae657003ce0d 2008-06-07T20:29:09-07:00 2008-06-07T20:29:09-07:00 Added support for 'apply 08e0a87a84456c3707c9b662c02407fb1bb6eb51 Alan Manuel K. Gloria almkglor@gmail.com