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 (count($seq) === 0) {
 109         return NULL;
 110     } else {
 111         return $seq[0];
 112     }
 113 }
 114
 115 function rest($seq) {
 116     $l = new ListClass();
 117     $l->exchangeArray(array_slice($seq->getArrayCopy(), 1));
 118     return $l;
 119 }
 120
 121 function empty_Q($seq) { return $seq->count() === 0; }
 122
 123 function scount($seq) { return ($seq === NULL ? 0 : $seq->count()); }
 124
 125 function conj($src) {
 126     $args = array_slice(func_get_args(), 1);
 127     $tmp = $src->getArrayCopy();
 128     if (_list_Q($src)) {
 129         foreach ($args as $arg) { array_unshift($tmp, $arg); }
 130         $s = new ListClass();
 131     } else {
 132         foreach ($args as $arg) { $tmp[] = $arg; }
 133         $s = new VectorClass();
 134     }
 135     $s->exchangeArray($tmp);
 136     return $s;
 137 }
 138
 139 function apply($f) {
 140     $args = array_slice(func_get_args(), 1);
 141     $last_arg = array_pop($args)->getArrayCopy();
 142     return $f->apply(array_merge($args, $last_arg));
 143 }
 144
 145 function map($f, $seq) {
 146     $l = new ListClass();
 147     # @ to surpress warning if $f throws an exception
 148     @$l->exchangeArray(array_map($f, $seq->getArrayCopy()));
 149     return $l;
 150 }
 151
 152
 153 // Metadata functions
 154 function with_meta($obj, $m) {
 155     $new_obj = clone $obj;
 156     $new_obj->meta = $m;
 157     return $new_obj;
 158 }
 159
 160 function meta($obj) {
 161     return $obj->meta;
 162 }
 163
 164
 165 // Atom functions
 166 function deref($atm) { return $atm->value; }
 167 function reset_BANG($atm, $val) { return $atm->value = $val; }
 168 function swap_BANG($atm, $f) {
 169     $args = array_slice(func_get_args(),2);
 170     array_unshift($args, $atm->value);
 171     $atm->value = call_user_func_array($f, $args);
 172     return $atm->value;
 173 }
 174
 175
 176 // core_ns is namespace of type functions
 177 $core_ns = array(
 178     '='=>      function ($a, $b) { return _equal_Q($a, $b); },
 179     'throw'=>  function ($a) { return mal_throw($a); },
 180     'nil?'=>   function ($a) { return _nil_Q($a); },
 181     'true?'=>  function ($a) { return _true_Q($a); },
 182     'false?'=> function ($a) { return _false_Q($a); },
 183     'symbol'=> function () { return call_user_func_array('_symbol', func_get_args()); },
 184     'symbol?'=> function ($a) { return _symbol_Q($a); },
 185     'keyword'=> function () { return call_user_func_array('_keyword', func_get_args()); },
 186     'keyword?'=> function ($a) { return _keyword_Q($a); },
 187
 188     'string?'=> function ($a) { return _string_Q($a); },
 189     'pr-str'=> function () { return call_user_func_array('pr_str', func_get_args()); },
 190     'str'=>    function () { return call_user_func_array('str', func_get_args()); },
 191     'prn'=>    function () { return call_user_func_array('prn', func_get_args()); },
 192     'println'=>function () { return call_user_func_array('println', func_get_args()); },
 193     'readline'=>function ($a) { return mal_readline($a); },
 194     'read-string'=>function ($a) { return read_str($a); },
 195     'slurp'=>  function ($a) { return file_get_contents($a); },
 196     '<'=>      function ($a, $b) { return $a < $b; },
 197     '<='=>     function ($a, $b) { return $a <= $b; },
 198     '>'=>      function ($a, $b) { return $a > $b; },
 199     '>='=>     function ($a, $b) { return $a >= $b; },
 200     '+'=>      function ($a, $b) { return intval($a + $b,10); },
 201     '-'=>      function ($a, $b) { return intval($a - $b,10); },
 202     '*'=>      function ($a, $b) { return intval($a * $b,10); },
 203     '/'=>      function ($a, $b) { return intval($a / $b,10); },
 204     'time-ms'=>function () { return time_ms(); },
 205
 206     'list'=>   function () { return call_user_func_array('_list', func_get_args()); },
 207     'list?'=>  function ($a) { return _list_Q($a); },
 208     'vector'=> function () { return call_user_func_array('_vector', func_get_args()); },
 209     'vector?'=> function ($a) { return _vector_Q($a); },
 210     'hash-map' => function () { return call_user_func_array('_hash_map', func_get_args()); },
 211     'map?'=>   function ($a) { return _hash_map_Q($a); },
 212     'assoc' => function () { return call_user_func_array('assoc', func_get_args()); },
 213     'dissoc' => function () { return call_user_func_array('dissoc', func_get_args()); },
 214     'get' =>   function ($a, $b) { return get($a, $b); },
 215     'contains?' => function ($a, $b) { return contains_Q($a, $b); },
 216     'keys' =>  function ($a) { return keys($a); },
 217     'vals' =>  function ($a) { return vals($a); },
 218
 219     'sequential?'=> function ($a) { return _sequential_Q($a); },
 220     'cons'=>   function ($a, $b) { return cons($a, $b); },
 221     'concat'=> function () { return call_user_func_array('concat', func_get_args()); },
 222     'nth'=>    function ($a, $b) { return nth($a, $b); },
 223     'first'=>  function ($a) { return first($a); },
 224     'rest'=>   function ($a) { return rest($a); },
 225     'empty?'=> function ($a) { return empty_Q($a); },
 226     'count'=>  function ($a) { return scount($a); },
 227     'conj'=>   function () { return call_user_func_array('conj', func_get_args()); },
 228     'apply'=>  function () { return call_user_func_array('apply', func_get_args()); },
 229     'map'=>    function ($a, $b) { return map($a, $b); },
 230
 231     'with-meta'=> function ($a, $b) { return with_meta($a, $b); },
 232     'meta'=>   function ($a) { return meta($a); },
 233     'atom'=>   function ($a) { return _atom($a); },
 234     'atom?'=>  function ($a) { return _atom_Q($a); },
 235     'deref'=>  function ($a) { return deref($a); },
 236     'reset!'=> function ($a, $b) { return reset_BANG($a, $b); },
 237     'swap!'=>  function () { return call_user_func_array('swap_BANG', func_get_args()); },
 238 );
 239
 240
 241 ?>