defuns(['keys' => nary('array_keys', 1), 'values' => nary('array_values', 1), 'merge' => nary('array_merge', 2), 'foldr' => function ($f, $zero, $arr) {
// Take args in a sane order
return array_reduce($arr, $f, $zero);
}, 'key_foldr' => function ($f, $zero) {
return compose(foldr($f, $zero), key_map(array_(2)));
}, 'subscript' => function ($x, $y) {
return $x[$y];
}, 'take' => function ($n, $a) {
return array_slice($a, 0, $n);
}, 'cons' => function ($x, $y) {
return merge([$x], $y);
}, 'snoc' => function ($x, $y) {
return merge($y, [$x]);
}, 'echo_' => function ($x) {
echo $x;
return $x;
}, 'id' => function ($x) {
return $x;
}, 'chain' => function ($x, $y, $z) {
return $x($z, $y($z));
}, 'zip' => function ($arr1, $arr2) {
return foldr(function ($acc, $val) use($arr1, $arr2) {
$lookup = subscript($val);
$el1 = $lookup($arr1);
$el2 = $lookup($arr2);
return merge($acc, [[$el1, $el2]]);
}, [], keys($arr1));
}, 'dup' => function ($x) {
return [$x, $x];
}, 'swap' => function ($arr) {
return merge([$arr[1], $arr[0]], array_slice($arr, 2));
}, 'first' => function ($f, $arr) {
return cons($f(subscript(0, $arr)), array_slice($arr, 1));
}, 'second' => function ($f) {
return compose('swap', first($f), 'swap');
}, 'head' => function ($arr) {
return $arr[0];
}, 'delay' => function ($f, $args, $_) {
return call_user_func_array($f, $args);
}]);
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);
}
<?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'));
}));
