From 829e894af23bc2ae40304d6ab80adb81dd2cfc58 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Fri, 2 Dec 2011 20:46:00 -0700
Subject: [PATCH] flatten (begin ... (begin ...)) in last pass of compiler

Flattening just makes bytecode slightly smaller.
---
 src/racket/src/sfs.c | 50 +++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 47 insertions(+), 3 deletions(-)

diff --git a/src/racket/src/sfs.c b/src/racket/src/sfs.c
index ffd97a39c9..75d926c21c 100644
--- a/src/racket/src/sfs.c
+++ b/src/racket/src/sfs.c
@@ -314,7 +314,45 @@ static Scheme_Object *sfs_application3(Scheme_Object *o, SFS_Info *info)
   return o;
 }
 
-static Scheme_Object *sfs_sequence(Scheme_Object *o, SFS_Info *info)
+static Scheme_Object *flatten_sequence(Scheme_Object *o)
+{
+  /* At this point, we sometimes have (begin ... (begin ... (begin ...))).
+     Flatten those out. */
+  Scheme_Sequence *s = (Scheme_Sequence *)o, *s2;
+  int i, extra = 0;
+
+  o = s->array[s->count - 1];
+
+  while (SAME_TYPE(SCHEME_TYPE(o), scheme_sequence_type)) {
+    s2 = (Scheme_Sequence *)o;
+    extra += s2->count - 1;
+    o = s2->array[s2->count - 1];
+  }
+
+  if (extra) {
+    s2 = scheme_malloc_sequence(s->count + extra);
+    s2->so.type = scheme_sequence_type;
+    s2->count = s->count + extra;
+
+    extra = 0;
+    o = (Scheme_Object *)s;
+    while (SAME_TYPE(SCHEME_TYPE(o), scheme_sequence_type)) {
+      s = (Scheme_Sequence *)o;
+      for (i = 0; i < s->count - 1; i++) {
+        s2->array[extra++] = s->array[i];
+      }
+      o = s->array[i];
+    }
+    s2->array[extra++] = o;
+
+    if (extra != s2->count) scheme_signal_error("internal error: flatten failed");
+
+    return (Scheme_Object *)s2;
+  } else
+    return (Scheme_Object *)s;
+}
+
+static Scheme_Object *sfs_sequence(Scheme_Object *o, SFS_Info *info, int can_flatten)
 {
   Scheme_Object *orig, *naya;
   Scheme_Sequence *seq;
@@ -327,10 +365,13 @@ static Scheme_Object *sfs_sequence(Scheme_Object *o, SFS_Info *info)
 
   for (i = 0; i < n; i++) {
     orig = seq->array[i];
-    naya = scheme_sfs_expr(orig, info, -1);
+    naya = scheme_sfs_expr(orig, info, -2);
     seq->array[i] = naya;
   }
 
+  if (can_flatten && info->pass)
+    o = flatten_sequence(o);
+
   return o;
 }
 
@@ -1128,6 +1169,7 @@ top_level_require_sfs(Scheme_Object *data, SFS_Info *rslv)
 /*========================================================================*/
 
 Scheme_Object *scheme_sfs_expr(Scheme_Object *expr, SFS_Info *info, int closure_self_pos)
+/* closure_self_pos == -2 => immediately in sequence */
 {
   Scheme_Type type = SCHEME_TYPE(expr);
   int seqn, stackpos, tp;
@@ -1175,8 +1217,10 @@ Scheme_Object *scheme_sfs_expr(Scheme_Object *expr, SFS_Info *info, int closure_
     expr = sfs_application3(expr, info);
     break;
   case scheme_sequence_type:
+    expr = sfs_sequence(expr, info, closure_self_pos != -2);
+    break;
   case scheme_splice_sequence_type:
-    expr = sfs_sequence(expr, info);
+    expr = sfs_sequence(expr, info, 0);
     break;
   case scheme_branch_type:
     expr = sfs_branch(expr, info);