php/core.php

   1 <?php
   2
   3 require_once 'types.php';
   4 require_once 'readline.php';
   5 require_once 'reader.php';
   6 require_once 'printer.php';
   7
   8 // Error/Exception functions
   9 function mal_throw($obj) { throw new Error($obj); }
  10
  11
  12 // String functions
  13 function pr_str() {
  14     $ps = array_map(function ($obj) { return _pr_str($obj, True); },
  15                     func_get_args());
  16     return implode(" ", $ps);
  17 }
  18
  19 function str() {
  20     $ps = array_map(function ($obj) { return _pr_str($obj, False); },
  21                     func_get_args());
  22     return implode("", $ps);
  23 }
  24
  25 function prn() {
  26     $ps = array_map(function ($obj) { return _pr_str($obj, True); },
  27                     func_get_args());
  28     print implode(" ", $ps) . "\n";
  29     return null;
  30 }
  31
  32 function println() {
  33     $ps = array_map(function ($obj) { return _pr_str($obj, False); },
  34                     func_get_args());
  35     print implode(" ", $ps) . "\n";
  36     return null;
  37 }
  38
  39
  40 // Number functions
  41 function time_ms() {
  42     return intval(microtime(1) * 1000);
  43 }
  44
  45
  46 // Hash Map functions
  47 function assoc($src_hm) {
  48     $args = func_get_args();
  49     $hm = clone $src_hm;
  50     $args[0] = $hm;
  51     return call_user_func_array('_assoc_BANG', $args);
  52 }
  53
  54 function dissoc($src_hm) {
  55     $args = func_get_args();
  56     $hm = clone $src_hm;
  57     $args[0] = $hm;
  58     return call_user_func_array('_dissoc_BANG', $args);
  59 }
  60
  61 function get($hm, $k) {
  62     if ($hm && $hm->offsetExists($k)) {
  63         return $hm[$k];
  64     } else {
  65         return NULL;
  66     }
  67 }
  68
  69 function contains_Q($hm, $k) { return array_key_exists($k, $hm); }
  70
  71 function keys($hm) {
  72     return call_user_func_array('_list', array_keys($hm->getArrayCopy()));
  73 }
  74 function vals($hm) {
  75     return call_user_func_array('_list', array_values($hm->getArrayCopy()));
  76 }
  77
  78
  79 // Sequence functions
  80 function cons($a, $b) {
  81     $tmp = $b->getArrayCopy();
  82     array_unshift($tmp, $a);
  83     $l = new ListClass();
  84     $l->exchangeArray($tmp);
  85     return $l;
  86 }
  87
  88 function concat() {
  89     $args = func_get_args();
  90     $tmp = array();
  91     foreach ($args as $arg) {
  92         $tmp = array_merge($tmp, $arg->getArrayCopy());
  93     }
  94     $l = new ListClass();
  95     $l->exchangeArray($tmp);
  96     return $l;
  97 }
  98
  99 function nth($seq, $idx) {
 100     if ($idx < $seq->count()) {
 101         return $seq[$idx];
 102     } else {
 103         throw new Exception("nth: index out of range");
 104     }
 105 }
 106
 107 function first($seq) {
 108     if ($seq === NULL || count($seq) === 0) {
 109         return NULL;
 110     } else {
 111         return $seq[0];
 112     }
 113 }
 114
 115 function rest($seq) {
 116     if ($seq === NULL) {
 117         return new ListClass();
 118     } else {
 119         $l = new ListClass();
 120         $l->exchangeArray(array_slice($seq->getArrayCopy(), 1));
 121         return $l;
 122     }
 123 }
 124
 125 function empty_Q($seq) { return $seq->count() === 0; }
 126
 127 function scount($seq) { return ($seq === NULL ? 0 : $seq->count()); }
 128
 129 function conj($src) {
 130     $args = array_slice(func_get_args(), 1);
 131     $tmp = $src->getArrayCopy();
 132     if (_list_Q($src)) {
 133         foreach ($args as $arg) { array_unshift($tmp, $arg); }
 134         $s = new ListClass();
 135     } else {
 136         foreach ($args as $arg) { $tmp[] = $arg; }
 137         $s = new VectorClass();
 138     }
 139     $s->exchangeArray($tmp);
 140     return $s;
 141 }
 142
 143 function apply($f) {
 144     $args = array_slice(func_get_args(), 1);
 145     $last_arg = array_pop($args)->getArrayCopy();
 146     return $f->apply(array_merge($args, $last_arg));
 147 }
 148
 149 function map($f, $seq) {
 150     $l = new ListClass();
 151     # @ to surpress warning if $f throws an exception
 152     @$l->exchangeArray(array_map($f, $seq->getArrayCopy()));
 153     return $l;
 154 }
 155
 156
 157 // Metadata functions
 158 function with_meta($obj, $m) {
 159     $new_obj = clone $obj;
 160     $new_obj->meta = $m;
 161     return $new_obj;
 162 }
 163
 164 function meta($obj) {
 165     return $obj->meta;
 166 }
 167
 168
 169 // Atom functions
 170 function deref($atm) { return $atm->value; }
 171 function reset_BANG($atm, $val) { return $atm->value = $val; }
 172 function swap_BANG($atm, $f) {
 173     $args = array_slice(func_get_args(),2);
 174     array_unshift($args, $atm->value);
 175     $atm->value = call_user_func_array($f, $args);
 176     return $atm->value;
 177 }
 178
 179
 180 // core_ns is namespace of type functions
 181 $core_ns = array(
 182     '='=>      function ($a, $b) { return _equal_Q($a, $b); },
 183     'throw'=>  function ($a) { return mal_throw($a); },
 184     'nil?'=>   function ($a) { return _nil_Q($a); },
 185     'true?'=>  function ($a) { return _true_Q($a); },
 186     'false?'=> function ($a) { return _false_Q($a); },
 187     'symbol'=> function () { return call_user_func_array('_symbol', func_get_args()); },
 188     'symbol?'=> function ($a) { return _symbol_Q($a); },
 189     'keyword'=> function () { return call_user_func_array('_keyword', func_get_args()); },
 190     'keyword?'=> function ($a) { return _keyword_Q($a); },
 191
 192     'string?'=> function ($a) { return _string_Q($a); },
 193     'pr-str'=> function () { return call_user_func_array('pr_str', func_get_args()); },
 194     'str'=>    function () { return call_user_func_array('str', func_get_args()); },
 195     'prn'=>    function () { return call_user_func_array('prn', func_get_args()); },
 196     'println'=>function () { return call_user_func_array('println', func_get_args()); },
 197     'readline'=>function ($a) { return mal_readline($a); },
 198     'read-string'=>function ($a) { return read_str($a); },
 199     'slurp'=>  function ($a) { return file_get_contents($a); },
 200     '<'=>      function ($a, $b) { return $a < $b; },
 201     '<='=>     function ($a, $b) { return $a <= $b; },
 202     '>'=>      function ($a, $b) { return $a > $b; },
 203     '>='=>     function ($a, $b) { return $a >= $b; },
 204     '+'=>      function ($a, $b) { return intval($a + $b,10); },
 205     '-'=>      function ($a, $b) { return intval($a - $b,10); },
 206     '*'=>      function ($a, $b) { return intval($a * $b,10); },
 207     '/'=>      function ($a, $b) { return intval($a / $b,10); },
 208     'time-ms'=>function () { return time_ms(); },
 209
 210     'list'=>   function () { return call_user_func_array('_list', func_get_args()); },
 211     'list?'=>  function ($a) { return _list_Q($a); },
 212     'vector'=> function () { return call_user_func_array('_vector', func_get_args()); },
 213     'vector?'=> function ($a) { return _vector_Q($a); },
 214     'hash-map' => function () { return call_user_func_array('_hash_map', func_get_args()); },
 215     'map?'=>   function ($a) { return _hash_map_Q($a); },
 216     'assoc' => function () { return call_user_func_array('assoc', func_get_args()); },
 217     'dissoc' => function () { return call_user_func_array('dissoc', func_get_args()); },
 218     'get' =>   function ($a, $b) { return get($a, $b); },
 219     'contains?' => function ($a, $b) { return contains_Q($a, $b); },
 220     'keys' =>  function ($a) { return keys($a); },
 221     'vals' =>  function ($a) { return vals($a); },
 222
 223     'sequential?'=> function ($a) { return _sequential_Q($a); },
 224     'cons'=>   function ($a, $b) { return cons($a, $b); },
 225     'concat'=> function () { return call_user_func_array('concat', func_get_args()); },
 226     'nth'=>    function ($a, $b) { return nth($a, $b); },
 227     'first'=>  function ($a) { return first($a); },
 228     'rest'=>   function ($a) { return rest($a); },
 229     'empty?'=> function ($a) { return empty_Q($a); },
 230     'count'=>  function ($a) { return scount($a); },
 231     'conj'=>   function () { return call_user_func_array('conj', func_get_args()); },
 232     'apply'=>  function () { return call_user_func_array('apply', func_get_args()); },
 233     'map'=>    function ($a, $b) { return map($a, $b); },
 234
 235     'with-meta'=> function ($a, $b) { return with_meta($a, $b); },
 236     'meta'=>   function ($a) { return meta($a); },
 237     'atom'=>   function ($a) { return _atom($a); },
 238     'atom?'=>  function ($a) { return _atom_Q($a); },
 239     'deref'=>  function ($a) { return deref($a); },
 240     'reset!'=> function ($a, $b) { return reset_BANG($a, $b); },
 241     'swap!'=>  function () { return call_user_func_array('swap_BANG', func_get_args()); },
 242 );
 243
 244
 245 ?>