From f42a866d94bb2b287ceca5c2831936bc360ba406 Mon Sep 17 00:00:00 2001
From: Alex Shinn <ashinn@users.noreply.github.com>
Date: Sun, 15 Mar 2009 13:19:51 +0900
Subject: [PATCH] fixing let optimization

---
 config.h |  3 +++
 eval.c   | 56 +++++++++++++++++++++++++++++---------------------------
 init.scm | 20 ++++++++++----------
 3 files changed, 42 insertions(+), 37 deletions(-)

diff --git a/config.h b/config.h
index 625d3117..297ab9c4 100644
--- a/config.h
+++ b/config.h
@@ -18,3 +18,6 @@
 #define USE_STRING_STREAMS 1
 #endif
 
+#ifndef USE_FAST_LET
+#define USE_FAST_LET 1
+#endif
diff --git a/eval.c b/eval.c
index e1890ec5..d8e16c22 100644
--- a/eval.c
+++ b/eval.c
@@ -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);
       }
     } else if (SEXP_PAIRP(SEXP_CAR(obj))) {
-/*       o2 = env_cell(e, SEXP_CAAR(obj)); */
-/*       if (o2 */
-/*           && SEXP_COREP(SEXP_CDR(o2)) */
-/*           && (((core_form)SEXP_CDR(o2))->code == CORE_LAMBDA) */
-/*           && sexp_listp(SEXP_CADR(SEXP_CAR(obj)))) { */
-/*         /\* let *\/ */
-/*         tmp1 = sexp_length(SEXP_CADR(SEXP_CAR(obj))); */
-/*         e2 = extend_env_closure(e, SEXP_CADR(SEXP_CAR(obj)), (*d)); */
-/*         for (o2=sexp_reverse(SEXP_CDR(obj)); SEXP_PAIRP(o2); o2=SEXP_CDR(o2)) */
-/*           analyze(SEXP_CAR(o2), bc, i, e, params, fv, sv, d, 0); */
-/*         params = sexp_append(SEXP_CADR(SEXP_CAR(obj)), params); */
-/*         for (o2=SEXP_CDDR(SEXP_CAR(obj)); SEXP_PAIRP(o2); o2=SEXP_CDR(o2)) { */
-/*           if (SEXP_PAIRP(SEXP_CDR(o2))) { */
-/*             analyze(SEXP_CAR(o2), bc, i, e2, params, fv, sv, d, 0); */
-/*             emit(bc, i, OP_DROP); */
-/*           } 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); */
-/*         (*d) -= tmp1; */
-/*         for (tmp1; tmp1>0; tmp1--) */
-/*           emit(bc, i, OP_DROP); */
-/*       } else */
+#if USE_FAST_LET
+      o2 = env_cell(e, SEXP_CAAR(obj));
+      if (o2
+          && SEXP_COREP(SEXP_CDR(o2))
+          && (((core_form)SEXP_CDR(o2))->code == CORE_LAMBDA)
+          && sexp_listp(SEXP_CADR(SEXP_CAR(obj)))) {
+        /* let */
+        tmp1 = sexp_length(SEXP_CADR(SEXP_CAR(obj)));
+        e2 = extend_env_closure(e, SEXP_CADR(SEXP_CAR(obj)), (*d)+(tmp1-1));
+        for (o2=sexp_reverse(SEXP_CDR(obj)); SEXP_PAIRP(o2); o2=SEXP_CDR(o2))
+          analyze(SEXP_CAR(o2), bc, i, e, params, fv, sv, d, 0);
+        params = sexp_append(SEXP_CADR(SEXP_CAR(obj)), params);
+        for (o2=SEXP_CDDR(SEXP_CAR(obj)); SEXP_PAIRP(o2); o2=SEXP_CDR(o2)) {
+          if (SEXP_PAIRP(SEXP_CDR(o2))) {
+            analyze(SEXP_CAR(o2), bc, i, e2, params, fv, sv, d, 0);
+            emit(bc, i, OP_DROP);
+          } 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);
+        (*d) -= (tmp1-1);
+        for (tmp1; tmp1>0; tmp1--)
+          emit(bc, i, OP_DROP);
+      } else
+#endif
         /* computed application */
         analyze_app(obj, bc, i, e, params, fv, sv, d, tailp);
     } else {
@@ -663,8 +665,8 @@ sexp vm(bytecode bc, env e, sexp* stack, unsigned int top) {
   int i, j, k;
 
  loop:
-/*   print_stack(stack, top); */
-/*   fprintf(stderr, "OP: %s (%d)\n", (*ip<=71) ? reverse_opcode_names[*ip] : "<unknown>", *ip); */
+  print_stack(stack, top);
+  fprintf(stderr, "OP: %s (%d)\n", (*ip<=71) ? reverse_opcode_names[*ip] : "<unknown>", *ip);
   switch (*ip++) {
   case OP_NOOP:
     fprintf(stderr, "noop\n");
diff --git a/init.scm b/init.scm
index d68939ad..33fe780a 100644
--- a/init.scm
+++ b/init.scm
@@ -75,13 +75,13 @@
     (cons (cons 'lambda (cons (map car (cadr expr)) (cddr expr)))
           (map cadr (cadr expr)))))
 
-;; (define-syntax or
-;;   (lambda (expr use-env mac-env)
-;;     (if (null? (cdr expr))
-;;         #f
-;;         (if (null? (cddr expr))
-;;             (cadr expr)
-;;             (list 'let (list (list 'tmp (cadr expr)))
-;;                   (list 'if 'tmp
-;;                         'tmp
-;;                         (cons 'or (cddr expr))))))))
+(define-syntax or
+  (lambda (expr use-env mac-env)
+    (if (null? (cdr expr))
+        #f
+        (if (null? (cddr expr))
+            (cadr expr)
+            (list 'let (list (list 'tmp (cadr expr)))
+                  (list 'if 'tmp
+                        'tmp
+                        (cons 'or (cddr expr))))))))