From ea81a8087bcd7953b083a2be9db447f75e7ebf56 Mon Sep 17 00:00:00 2001
From: Joel Martin <github@martintribe.org>
Date: Wed, 2 Apr 2014 22:23:37 -0500
Subject: All: split types into types, env, printer, core.

- types: low-level mapping to the implementation language.
- core: functions on types that are exposed directly to mal.
- printer: implementation called by pr-str, str, prn, println.
- env: the environment implementation

- Also, unindent all TCO while loops so that the diff of step4 and
  step5 are minimized.
---
 php/core.php | 221 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 221 insertions(+)
 create mode 100644 php/core.php

(limited to 'php/core.php')

diff --git a/php/core.php b/php/core.php
new file mode 100644
index 0000000..16d34f8
--- /dev/null
+++ b/php/core.php
@@ -0,0 +1,221 @@
+<?php
+
+require_once 'types.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;
+}
+
+
+// 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) {
+    return $seq[$idx];
+}
+
+function first($seq) {
+    if (count($seq) === 0) {
+        return NULL;
+    } else {
+        return $seq[0];
+    }
+}
+
+function rest($seq) {
+    $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 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 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();
+    $l->exchangeArray(array_map($f, $seq->getArrayCopy()));
+    return $l;
+}
+
+
+// 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); },
+    '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()); },
+    '<'=>      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); },
+
+    '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); },
+    'conj'=>   function () { return call_user_func_array('conj', func_get_args()); },
+    'apply'=>  function () { return call_user_func_array('apply', func_get_args()); },
+    'map'=>    function ($a, $b) { return map($a, $b); },
+
+    '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()); },
+);
+
+
+?>
-- 
cgit v1.2.3