Permalink
Browse files

optimize compose in a functional position

  • Loading branch information...
1 parent 260504d commit f998de0ba562103cee6a7dc1124b67bd3435cfa9 Rafael Sevilla committed Jan 7, 2012
Showing with 26 additions and 0 deletions.
  1. +26 −0 src/compiler.c
View
@@ -731,6 +731,26 @@ static value compile_apply(arc *c, value expr, value ctx, value env,
return(compile_continuation(c, ctx, cont));
}
+#if 1
+
+static value fold(arc *c, value expr, value final)
+{
+ if (cdr(expr) == CNIL)
+ return(cons(c, car(expr), final));
+ return(cons(c, car(expr), cons(c, fold(c, cdr(expr), final), CNIL)));
+}
+
+static value compile_compose(arc *c, value expr, value ctx, value env,
+ value cont)
+{
+ value composer = cdr(car(expr));
+ value cargs = cdr(expr);
+
+ return(arc_compile(c, fold(c, composer, cargs), ctx, env, cont));
+}
+
+#endif
+
static value compile_list(arc *c, value expr, value ctx, value env,
value cont)
{
@@ -742,5 +762,11 @@ static value compile_list(arc *c, value expr, value ctx, value env,
if ((fun = inline_func(c, car(expr))) != NULL)
return(fun(c, expr, ctx, env, cont));
+#if 1
+ /* compose in a functional position */
+ if (CONS_P(car(expr)) && car(car(expr)) == ARC_BUILTIN(c, S_COMPOSE))
+ return(compile_compose(c, expr, ctx, env, cont));
+#endif
+
return(compile_apply(c, expr, ctx, env, cont));
}

0 comments on commit f998de0

Please sign in to comment.