add inline expansion optimization
This commit is contained in:
		
							parent
							
								
									5f9a6880e2
								
							
						
					
					
						commit
						ee9ee2f03e
					
				|  | @ -295,6 +295,68 @@ pic_expand(pic_state *pic, pic_value expr, struct pic_env *env) | |||
|   return v; | ||||
| } | ||||
| 
 | ||||
| static pic_value | ||||
| optimize_beta(pic_state *pic, pic_value expr) | ||||
| { | ||||
|   size_t ai = pic_gc_arena_preserve(pic); | ||||
|   pic_value functor, formals, args, tmp, val, it, defs; | ||||
| 
 | ||||
|   if (! pic_list_p(expr)) | ||||
|     return expr; | ||||
| 
 | ||||
|   if (pic_nil_p(expr)) | ||||
|     return expr; | ||||
| 
 | ||||
|   if (pic_sym_p(pic_list_ref(pic, expr, 0))) { | ||||
|     pic_sym *sym = pic_sym_ptr(pic_list_ref(pic, expr, 0)); | ||||
| 
 | ||||
|     if (sym == pic->uQUOTE) { | ||||
|       return expr; | ||||
|     } else if (sym == pic->uLAMBDA) { | ||||
|       return pic_list3(pic, pic_list_ref(pic, expr, 0), pic_list_ref(pic, expr, 1), optimize_beta(pic, pic_list_ref(pic, expr, 2))); | ||||
|     } | ||||
|   } | ||||
| 
 | ||||
|   tmp = pic_nil_value(); | ||||
|   pic_for_each (val, expr, it) { | ||||
|     pic_push(pic, optimize_beta(pic, val), tmp); | ||||
|   } | ||||
|   expr = pic_reverse(pic, tmp); | ||||
| 
 | ||||
|   pic_gc_arena_restore(pic, ai); | ||||
|   pic_gc_protect(pic, expr); | ||||
| 
 | ||||
|   functor = pic_list_ref(pic, expr, 0); | ||||
|   if (pic_pair_p(functor) && pic_eq_p(pic_car(pic, functor), pic_obj_value(pic->uLAMBDA))) { | ||||
|     formals = pic_list_ref(pic, functor, 1); | ||||
|     if (! pic_list_p(formals)) | ||||
|       goto exit;              /* TODO: support ((lambda args x) 1 2) */ | ||||
|     args = pic_cdr(pic, expr); | ||||
|     if (pic_length(pic, formals) != pic_length(pic, args)) | ||||
|       goto exit; | ||||
|     defs = pic_nil_value(); | ||||
|     pic_for_each (val, args, it) { | ||||
|       pic_push(pic, pic_list3(pic, pic_obj_value(pic->uDEFINE), pic_car(pic, formals), val), defs); | ||||
|       formals = pic_cdr(pic, formals); | ||||
|     } | ||||
|     expr = pic_list_ref(pic, functor, 2); | ||||
|     pic_for_each (val, defs, it) { | ||||
|       expr = pic_list3(pic, pic_obj_value(pic->uBEGIN), val, expr); | ||||
|     } | ||||
|   } | ||||
|  exit: | ||||
| 
 | ||||
|   pic_gc_arena_restore(pic, ai); | ||||
|   pic_gc_protect(pic, expr); | ||||
|   return expr; | ||||
| } | ||||
| 
 | ||||
| pic_value | ||||
| pic_optimize(pic_state *pic, pic_value expr) | ||||
| { | ||||
|   return optimize_beta(pic, expr); | ||||
| } | ||||
| 
 | ||||
| KHASH_DECLARE(a, pic_sym *, int) | ||||
| KHASH_DEFINE2(a, pic_sym *, int, 0, kh_ptr_hash_func, kh_ptr_hash_equal) | ||||
| 
 | ||||
|  | @ -1055,6 +1117,17 @@ pic_compile(pic_state *pic, pic_value obj, struct pic_env *env) | |||
| 
 | ||||
|   SAVE(pic, ai, obj); | ||||
| 
 | ||||
|   /* optimize */ | ||||
|   obj = pic_optimize(pic, obj); | ||||
| #if DEBUG | ||||
|   fprintf(stdout, "## optimize completed\n"); | ||||
|   pic_write(pic, obj); | ||||
|   fprintf(stdout, "\n"); | ||||
|   fprintf(stdout, "ai = %zu\n", pic_gc_arena_preserve(pic)); | ||||
| #endif | ||||
| 
 | ||||
|   SAVE(pic, ai, obj); | ||||
| 
 | ||||
|   /* analyze */ | ||||
|   obj = pic_analyze(pic, obj); | ||||
| #if DEBUG | ||||
|  |  | |||
		Loading…
	
		Reference in New Issue
	
	 Yuichi Nishiwaki
						Yuichi Nishiwaki