suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

flatten (begin ... (begin ...)) in last pass of compiler

Browse Source 
Flattening just makes bytecode slightly smaller.
This commit is contained in:
Matthew Flatt 2011-12-02 20:46:00 -07:00
parent 787437223c
commit 829e894af2
1 changed files with 47 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
src/racket/src/sfs.c
View File

@ -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);