function compile_fn($expr, &$oob)
{
global $ENVIRONMENT;
global $RECUR_KEY;
$name = $oob["name"] == null ? $name = gensym() : $oob["name"];
$name_args = $oob["name_args"];
$oob["name"] = null;
$oob["name_args"] = null;
$args = $expr[1];
array_push($oob["locals"], $args);
array_shift($expr);
array_shift($expr);
$syms = extract_symbols($expr);
$tail = array_pop($expr);
array_unshift($expr, symbol("do"));
$body = compile($expr, $oob);
$tail_name = $ENVIRONMENT;
$tail = "" . $tail_name . "=" . compile($tail, $oob) . ";\n";
$body .= "\n" . $tail;
$body = "" . $body . "\n }while(is_array(" . $tail_name . ") && " . $tail_name . "[\"" . $RECUR_KEY . "\"] == true);\n";
$body .= "return " . $tail_name . ";\n";
$buf = "";
$buf3 = "";
foreach ($args as $arg) {
$buf .= "\"" . $arg . "\",";
$buf3 .= "\$" . $arg . ",";
}
$buf = substr($buf, 0, -1);
$buf3 = substr($buf3, 0, -1);
$f = "";
if ($name_args == null) {
$f .= "function " . $name . " (" . $ENVIRONMENT . ")\n{\n do{";
foreach (array_unique(array_merge($syms, $args)) as $s) {
if (!in_array($s . "", array("+"))) {
$f .= "\$" . mangle($s) . "=" . $ENVIRONMENT . "[\"" . $s . "\"];";
}
}
} else {
$f .= "function " . $name . " (" . mangle($buf3) . ")\n{\n do{";
}
$f .= $body;
$f .= "\n}";
//file_put_contents("php://stderr",$f."\n");
eval($f);
array_push($oob, $f);
$buf2 = "";
foreach ($syms as $s) {
if (!in_array($s, $args)) {
$buf2 .= "\"" . $s . "\"=>" . $ENVIRONMENT . "[\"" . $s . "\"],";
}
}
$buf2 = substr($buf2, 0, -1);
array_pop($oob["locals"]);
return "array(array(" . $buf2 . "),array(" . $buf . "),\"" . $name . "\")";
}
function lambda($args, $expr)
{
$name = gensym();
def_fun($name, $args, "return {$expr};");
return $name;
}
