mirror of
https://github.com/kanaka/mal.git
synced 2024-11-11 00:52:44 +03:00
273 lines
8.3 KiB
PHP
273 lines
8.3 KiB
PHP
<?php
|
|
|
|
require_once 'types.php';
|
|
require_once 'readline.php';
|
|
require_once 'reader.php';
|
|
require_once 'printer.php';
|
|
|
|
// Error/Exception functions
|
|
function mal_throw($obj) { throw new _Error($obj); }
|
|
|
|
|
|
// String functions
|
|
function pr_str() {
|
|
$ps = array_map(function ($obj) { return _pr_str($obj, True); },
|
|
func_get_args());
|
|
return implode(" ", $ps);
|
|
}
|
|
|
|
function str() {
|
|
$ps = array_map(function ($obj) { return _pr_str($obj, False); },
|
|
func_get_args());
|
|
return implode("", $ps);
|
|
}
|
|
|
|
function prn() {
|
|
$ps = array_map(function ($obj) { return _pr_str($obj, True); },
|
|
func_get_args());
|
|
print implode(" ", $ps) . "\n";
|
|
return null;
|
|
}
|
|
|
|
function println() {
|
|
$ps = array_map(function ($obj) { return _pr_str($obj, False); },
|
|
func_get_args());
|
|
print implode(" ", $ps) . "\n";
|
|
return null;
|
|
}
|
|
|
|
|
|
// Number functions
|
|
function time_ms() {
|
|
return intval(microtime(1) * 1000);
|
|
}
|
|
|
|
|
|
// Hash Map functions
|
|
function assoc($src_hm) {
|
|
$args = func_get_args();
|
|
$hm = clone $src_hm;
|
|
$args[0] = $hm;
|
|
return call_user_func_array('_assoc_BANG', $args);
|
|
}
|
|
|
|
function dissoc($src_hm) {
|
|
$args = func_get_args();
|
|
$hm = clone $src_hm;
|
|
$args[0] = $hm;
|
|
return call_user_func_array('_dissoc_BANG', $args);
|
|
}
|
|
|
|
function get($hm, $k) {
|
|
if ($hm && $hm->offsetExists($k)) {
|
|
return $hm[$k];
|
|
} else {
|
|
return NULL;
|
|
}
|
|
}
|
|
|
|
function contains_Q($hm, $k) { return array_key_exists($k, $hm); }
|
|
|
|
function keys($hm) {
|
|
return call_user_func_array('_list', array_keys($hm->getArrayCopy()));
|
|
}
|
|
function vals($hm) {
|
|
return call_user_func_array('_list', array_values($hm->getArrayCopy()));
|
|
}
|
|
|
|
|
|
// Sequence functions
|
|
function cons($a, $b) {
|
|
$tmp = $b->getArrayCopy();
|
|
array_unshift($tmp, $a);
|
|
$l = new ListClass();
|
|
$l->exchangeArray($tmp);
|
|
return $l;
|
|
}
|
|
|
|
function concat() {
|
|
$args = func_get_args();
|
|
$tmp = array();
|
|
foreach ($args as $arg) {
|
|
$tmp = array_merge($tmp, $arg->getArrayCopy());
|
|
}
|
|
$l = new ListClass();
|
|
$l->exchangeArray($tmp);
|
|
return $l;
|
|
}
|
|
|
|
function nth($seq, $idx) {
|
|
if ($idx < $seq->count()) {
|
|
return $seq[$idx];
|
|
} else {
|
|
throw new Exception("nth: index out of range");
|
|
}
|
|
}
|
|
|
|
function first($seq) {
|
|
if ($seq === NULL || count($seq) === 0) {
|
|
return NULL;
|
|
} else {
|
|
return $seq[0];
|
|
}
|
|
}
|
|
|
|
function rest($seq) {
|
|
if ($seq === NULL) {
|
|
return new ListClass();
|
|
} else {
|
|
$l = new ListClass();
|
|
$l->exchangeArray(array_slice($seq->getArrayCopy(), 1));
|
|
return $l;
|
|
}
|
|
}
|
|
|
|
function empty_Q($seq) { return $seq->count() === 0; }
|
|
|
|
function scount($seq) { return ($seq === NULL ? 0 : $seq->count()); }
|
|
|
|
function apply($f) {
|
|
$args = array_slice(func_get_args(), 1);
|
|
$last_arg = array_pop($args)->getArrayCopy();
|
|
return $f->apply(array_merge($args, $last_arg));
|
|
}
|
|
|
|
function map($f, $seq) {
|
|
$l = new ListClass();
|
|
# @ to surpress warning if $f throws an exception
|
|
@$l->exchangeArray(array_map($f, $seq->getArrayCopy()));
|
|
return $l;
|
|
}
|
|
|
|
function conj($src) {
|
|
$args = array_slice(func_get_args(), 1);
|
|
$tmp = $src->getArrayCopy();
|
|
if (_list_Q($src)) {
|
|
foreach ($args as $arg) { array_unshift($tmp, $arg); }
|
|
$s = new ListClass();
|
|
} else {
|
|
foreach ($args as $arg) { $tmp[] = $arg; }
|
|
$s = new VectorClass();
|
|
}
|
|
$s->exchangeArray($tmp);
|
|
return $s;
|
|
}
|
|
|
|
function seq($src) {
|
|
if (_list_Q($src)) {
|
|
if (count($src) == 0) { return NULL; }
|
|
return $src;
|
|
} elseif (_vector_Q($src)) {
|
|
if (count($src) == 0) { return NULL; }
|
|
$tmp = $src->getArrayCopy();
|
|
$s = new ListClass();
|
|
$s->exchangeArray($tmp);
|
|
return $s;
|
|
} elseif (_string_Q($src)) {
|
|
if (strlen($src) == 0) { return NULL; }
|
|
$tmp = str_split($src);
|
|
$s = new ListClass();
|
|
$s->exchangeArray($tmp);
|
|
return $s;
|
|
} elseif (_nil_Q($src)) {
|
|
return NULL;
|
|
} else {
|
|
throw new Exception("seq: called on non-sequence");
|
|
}
|
|
return $s;
|
|
}
|
|
|
|
|
|
|
|
// Metadata functions
|
|
function with_meta($obj, $m) {
|
|
$new_obj = clone $obj;
|
|
$new_obj->meta = $m;
|
|
return $new_obj;
|
|
}
|
|
|
|
function meta($obj) {
|
|
return $obj->meta;
|
|
}
|
|
|
|
|
|
// Atom functions
|
|
function deref($atm) { return $atm->value; }
|
|
function reset_BANG($atm, $val) { return $atm->value = $val; }
|
|
function swap_BANG($atm, $f) {
|
|
$args = array_slice(func_get_args(),2);
|
|
array_unshift($args, $atm->value);
|
|
$atm->value = call_user_func_array($f, $args);
|
|
return $atm->value;
|
|
}
|
|
|
|
|
|
// core_ns is namespace of type functions
|
|
$core_ns = array(
|
|
'='=> function ($a, $b) { return _equal_Q($a, $b); },
|
|
'throw'=> function ($a) { return mal_throw($a); },
|
|
'nil?'=> function ($a) { return _nil_Q($a); },
|
|
'true?'=> function ($a) { return _true_Q($a); },
|
|
'false?'=> function ($a) { return _false_Q($a); },
|
|
'symbol'=> function () { return call_user_func_array('_symbol', func_get_args()); },
|
|
'symbol?'=> function ($a) { return _symbol_Q($a); },
|
|
'keyword'=> function () { return call_user_func_array('_keyword', func_get_args()); },
|
|
'keyword?'=> function ($a) { return _keyword_Q($a); },
|
|
|
|
'string?'=> function ($a) { return _string_Q($a); },
|
|
'pr-str'=> function () { return call_user_func_array('pr_str', func_get_args()); },
|
|
'str'=> function () { return call_user_func_array('str', func_get_args()); },
|
|
'prn'=> function () { return call_user_func_array('prn', func_get_args()); },
|
|
'println'=>function () { return call_user_func_array('println', func_get_args()); },
|
|
'readline'=>function ($a) { return mal_readline($a); },
|
|
'read-string'=>function ($a) { return read_str($a); },
|
|
'slurp'=> function ($a) { return file_get_contents($a); },
|
|
'<'=> function ($a, $b) { return $a < $b; },
|
|
'<='=> function ($a, $b) { return $a <= $b; },
|
|
'>'=> function ($a, $b) { return $a > $b; },
|
|
'>='=> function ($a, $b) { return $a >= $b; },
|
|
'+'=> function ($a, $b) { return intval($a + $b,10); },
|
|
'-'=> function ($a, $b) { return intval($a - $b,10); },
|
|
'*'=> function ($a, $b) { return intval($a * $b,10); },
|
|
'/'=> function ($a, $b) { return intval($a / $b,10); },
|
|
'time-ms'=>function () { return time_ms(); },
|
|
|
|
'list'=> function () { return call_user_func_array('_list', func_get_args()); },
|
|
'list?'=> function ($a) { return _list_Q($a); },
|
|
'vector'=> function () { return call_user_func_array('_vector', func_get_args()); },
|
|
'vector?'=> function ($a) { return _vector_Q($a); },
|
|
'hash-map' => function () { return call_user_func_array('_hash_map', func_get_args()); },
|
|
'map?'=> function ($a) { return _hash_map_Q($a); },
|
|
'assoc' => function () { return call_user_func_array('assoc', func_get_args()); },
|
|
'dissoc' => function () { return call_user_func_array('dissoc', func_get_args()); },
|
|
'get' => function ($a, $b) { return get($a, $b); },
|
|
'contains?' => function ($a, $b) { return contains_Q($a, $b); },
|
|
'keys' => function ($a) { return keys($a); },
|
|
'vals' => function ($a) { return vals($a); },
|
|
|
|
'sequential?'=> function ($a) { return _sequential_Q($a); },
|
|
'cons'=> function ($a, $b) { return cons($a, $b); },
|
|
'concat'=> function () { return call_user_func_array('concat', func_get_args()); },
|
|
'nth'=> function ($a, $b) { return nth($a, $b); },
|
|
'first'=> function ($a) { return first($a); },
|
|
'rest'=> function ($a) { return rest($a); },
|
|
'empty?'=> function ($a) { return empty_Q($a); },
|
|
'count'=> function ($a) { return scount($a); },
|
|
'apply'=> function () { return call_user_func_array('apply', func_get_args()); },
|
|
'map'=> function ($a, $b) { return map($a, $b); },
|
|
|
|
'conj'=> function () { return call_user_func_array('conj', func_get_args()); },
|
|
'seq'=> function ($a) { return seq($a); },
|
|
|
|
'with-meta'=> function ($a, $b) { return with_meta($a, $b); },
|
|
'meta'=> function ($a) { return meta($a); },
|
|
'atom'=> function ($a) { return _atom($a); },
|
|
'atom?'=> function ($a) { return _atom_Q($a); },
|
|
'deref'=> function ($a) { return deref($a); },
|
|
'reset!'=> function ($a, $b) { return reset_BANG($a, $b); },
|
|
'swap!'=> function () { return call_user_func_array('swap_BANG', func_get_args()); },
|
|
);
|
|
|
|
|
|
?>
|