Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-09 22:17:34 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

fixing let optimization

Browse source
This commit is contained in:
Alex Shinn 2009-03-15 13:19:51 +09:00
parent 4ec2c98a58
commit f42a866d94
3 changed files with 42 additions and 37 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
config.h
View file

@ -18,3 +18,6 @@
#define USE_STRING_STREAMS 1 #define USE_STRING_STREAMS 1
#endif #endif
#ifndef USE_FAST_LET
#define USE_FAST_LET 1
#endif

56
eval.c
View file

@ -275,31 +275,33 @@ void analyze(sexp obj, bytecode *bc, unsigned int *i, env e,
analyze_app(obj, bc, i, e, params, fv, sv, d, tailp); analyze_app(obj, bc, i, e, params, fv, sv, d, tailp);
} }
} else if (SEXP_PAIRP(SEXP_CAR(obj))) { } else if (SEXP_PAIRP(SEXP_CAR(obj))) {
/* o2 = env_cell(e, SEXP_CAAR(obj)); */ #if USE_FAST_LET
/* if (o2 */ o2 = env_cell(e, SEXP_CAAR(obj));
/* && SEXP_COREP(SEXP_CDR(o2)) */ if (o2
/* && (((core_form)SEXP_CDR(o2))->code == CORE_LAMBDA) */ && SEXP_COREP(SEXP_CDR(o2))
/* && sexp_listp(SEXP_CADR(SEXP_CAR(obj)))) { */ && (((core_form)SEXP_CDR(o2))->code == CORE_LAMBDA)
/* /\* let *\/ */ && sexp_listp(SEXP_CADR(SEXP_CAR(obj)))) {
/* tmp1 = sexp_length(SEXP_CADR(SEXP_CAR(obj))); */ /* let */
/* e2 = extend_env_closure(e, SEXP_CADR(SEXP_CAR(obj)), (*d)); */ tmp1 = sexp_length(SEXP_CADR(SEXP_CAR(obj)));
/* for (o2=sexp_reverse(SEXP_CDR(obj)); SEXP_PAIRP(o2); o2=SEXP_CDR(o2)) */ e2 = extend_env_closure(e, SEXP_CADR(SEXP_CAR(obj)), (*d)+(tmp1-1));
/* analyze(SEXP_CAR(o2), bc, i, e, params, fv, sv, d, 0); */ for (o2=sexp_reverse(SEXP_CDR(obj)); SEXP_PAIRP(o2); o2=SEXP_CDR(o2))
/* params = sexp_append(SEXP_CADR(SEXP_CAR(obj)), params); */ analyze(SEXP_CAR(o2), bc, i, e, params, fv, sv, d, 0);
/* for (o2=SEXP_CDDR(SEXP_CAR(obj)); SEXP_PAIRP(o2); o2=SEXP_CDR(o2)) { */ params = sexp_append(SEXP_CADR(SEXP_CAR(obj)), params);
/* if (SEXP_PAIRP(SEXP_CDR(o2))) { */ for (o2=SEXP_CDDR(SEXP_CAR(obj)); SEXP_PAIRP(o2); o2=SEXP_CDR(o2)) {
/* analyze(SEXP_CAR(o2), bc, i, e2, params, fv, sv, d, 0); */ if (SEXP_PAIRP(SEXP_CDR(o2))) {
/* emit(bc, i, OP_DROP); */ analyze(SEXP_CAR(o2), bc, i, e2, params, fv, sv, d, 0);
/* } else { */ emit(bc, i, OP_DROP);
/* analyze(SEXP_CAR(o2), bc, i, e2, params, fv, sv, d, tailp); */ } else {
/* } */ analyze(SEXP_CAR(o2), bc, i, e2, params, fv, sv, d, tailp);
/* } */ }
/* emit(bc, i, OP_STACK_SET); */ }
/* emit_word(bc, i, tmp1+1); */ emit(bc, i, OP_STACK_SET);
/* (*d) -= tmp1; */ emit_word(bc, i, tmp1+1);
/* for (tmp1; tmp1>0; tmp1--) */ (*d) -= (tmp1-1);
/* emit(bc, i, OP_DROP); */ for (tmp1; tmp1>0; tmp1--)
/* } else */ emit(bc, i, OP_DROP);
} else
#endif
/* computed application */ /* computed application */
analyze_app(obj, bc, i, e, params, fv, sv, d, tailp); analyze_app(obj, bc, i, e, params, fv, sv, d, tailp);
} else { } else {
@ -663,8 +665,8 @@ sexp vm(bytecode bc, env e, sexp* stack, unsigned int top) {
int i, j, k; int i, j, k;
loop: loop:
/* print_stack(stack, top); */ print_stack(stack, top);
/* fprintf(stderr, "OP: %s (%d)\n", (*ip<=71) ? reverse_opcode_names[*ip] : "<unknown>", *ip); */ fprintf(stderr, "OP: %s (%d)\n", (*ip<=71) ? reverse_opcode_names[*ip] : "<unknown>", *ip);
switch (*ip++) { switch (*ip++) {
case OP_NOOP: case OP_NOOP:
fprintf(stderr, "noop\n"); fprintf(stderr, "noop\n");

20
init.scm
View file

@ -75,13 +75,13 @@
(cons (cons 'lambda (cons (map car (cadr expr)) (cddr expr))) (cons (cons 'lambda (cons (map car (cadr expr)) (cddr expr)))
(map cadr (cadr expr))))) (map cadr (cadr expr)))))
;; (define-syntax or (define-syntax or
;; (lambda (expr use-env mac-env) (lambda (expr use-env mac-env)
;; (if (null? (cdr expr)) (if (null? (cdr expr))
;; #f #f
;; (if (null? (cddr expr)) (if (null? (cddr expr))
;; (cadr expr) (cadr expr)
;; (list 'let (list (list 'tmp (cadr expr))) (list 'let (list (list 'tmp (cadr expr)))
;; (list 'if 'tmp (list 'if 'tmp
;; 'tmp 'tmp
;; (cons 'or (cddr expr)))))))) (cons 'or (cddr expr))))))))