eval("function {$name}() {\n static \$defined = true; // Used by arity\n static \$f = NULL;\n \$args = func_get_args();\n return (is_null(\$f))? \$f = \$args[0]\n : call_user_func_array(\$f, \$args);\n }");
// Initialise $f to $expr
return $name($curry($expr));
};
// Make these functions available in curried form
$defun('defun', $defun);
defun('op', function ($x) use($op) {
return in_array($x, array('array', 'new')) ? $op($x) : curry($op($x));
});
defun('curry', $curry);
defun('curry_', $curry_);
defun('arity', $arity);
});
defun('key_map', function ($f, $a) {
return array_combine(array_keys($a), array_map(op($f), array_keys($a), $a));
});
defun('defuns', key_map('defun'));
defuns(array('uncurry' => function ($f, $args) {
return call_user_func_array(op($f), $args);
}, 'up_to' => function ($n) {
return $n ? range(0, $n - 1) : array();
}, 'random' => function ($_) {
return abs(mt_rand());
}));
// Like call_user_func but uses curry & op. We don't curry call since it's nary.
function call()
{
$args = func_get_args();
$f = op(array_shift($args));
return call_user_func_array($f, $args);
}
// Grouping syntax
function __()
{
return array_merge(['grouped' => true], func_get_args());
}
call_user_func(function () {
$interpret = null;
$call = curry(function (array $env, $f, $arg) use(&$interpret) {
return op($f, $interpret($env, $arg));
});
$chain = curry(function (array $env, array $calls) use($call) {
return array_reduce(array_diff_key($calls, ['grouped' => '']), $call($env), function ($x) {
return $x;
});
});
$plumb = curry(function (array $env, array $expr, $arg) use($chain) {
return $expr ? $chain(array_merge([$arg], $env), $expr) : $arg;
});
$interpret = curry(function (array $e, $x) use($chain, $plumb) {
// Assume ints and arrays are Plumb; anything else is PHP
if (is_int($x)) {
return $e[$x];
}
if (is_array($x)) {
return isset($x['grouped']) ? $chain($e, $x) : $plumb($e, $x);
}
return $x;
});
// Interpret $f in an empty environment
defun('plumb', $plumb([]));
});
}, 'instanceof spots non-instances' => function () {
$o = new Exception();
$result = call('instanceof', $o, 'stdClass');
return $result ? get_defined_vars() : 0;
}, 'array is callable' => function ($x, $y, $z) {
$lhs = call('array', $x, $y, $z);
return $lhs === array($x, $y, $z) ? 0 : get_defined_vars();
}, 'not is callable' => function ($x, $y) {
$f = op('!');
$lhs = $f($x > $y);
$rhs = !($x > $y);
return $lhs === $rhs ? 0 : get_defined_vars();
}, 'not is curried' => function ($x, $y) {
$lhs = op('!', $x > $y);
$rhs = !($x > $y);
return $lhs === $rhs ? 0 : get_defined_vars();
}, 'can define functions' => function ($x, $y, $z) {
$name = "func{$x}";
$f = defun($name, function ($n) use($y) {
return $y + $n;
});
$result = $name($z);
return $result === $y + $z ? 0 : get_defined_vars();
}, 'uncurry uncurries' => function ($x, $y, $z) {
$f = uncurry(function ($a, $b, $c) {
return $a + $b + $c;
});
$result = $f(func_get_args());
return $result === $x + $y + $z ? 0 : get_defined_vars();
}));
$failures ? var_dump(array('Test failures' => $failures)) : (print "All tests passed\n");
defun('trampoline', function ($f) {
for ($stop = false; !$stop; list($stop, $f) = $f(null)) {
}
return $f;
});
defun('y', function ($f) {
$cf = curry($f);
return curry(function ($x) use($cf) {
return $cf(y($cf), $x);
});
});
defun('stream_take', function ($n, $s) {
return trampoline(y(function ($f, $x, $n, $s, $_) {
if (!$n) {
return [true, $x];
}
list($h, $t) = $s(null);
return [false, $f(snoc($h, $x), $n - 1, $t)];
}, [], $n, $s));
});
defun('stream_drop', function ($n, $s) {
return trampoline(y(function ($f, $n, $s, $_) {
if (!$n) {
return [true, $s];
}
list($h, $t) = $s(null);
return [false, $f($n - 1, $t)];
}));
});
defun('dump', nary('var_dump', 1));
<?php
set_error_handler(function () {
var_dump(array('args' => func_get_args(), 'trace' => debug_backtrace()));
die;
});
defun('sample', function ($f, $n) {
return array_map($f, up_to($n));
});
defuns(call_user_func(function () {
$tests = array();
$run = function ($t) {
return call_user_func_array($t[0], sample('random', $t[1]));
};
return array('deftest' => function ($name, $test) use(&$tests) {
$tests[$name] = array($test, arity($test));
}, 'runtests' => function ($t) use(&$tests, $run) {
return is_array($t) ? $run($t) : array_filter(array_map($run, $tests));
}, 'deftests' => key_map('deftest'));
}));
