public function Compile($sexp)
{
//$this->Emit(new StringExpression("// " . Expression::Render($sexp)));
if ($sexp instanceof Symbol) {
$this->Emit(new ReturnCE(new StringExpression("@\$env->environment['" . addslashes($sexp->name) . "'];")));
return;
} elseif (!is_array($sexp)) {
$this->Emit(new ReturnCE(new CompiledExpression($sexp)));
return;
}
$lambda = $sexp[0];
$args = array_slice($sexp, 1);
if (is_array($lambda)) {
$evald = $this->Compile($lambda);
//echo Expression::Render($lambda) . " ~~> " . Expression::Render($evald) . "\n";
$lambda = $evald;
}
if ($lambda instanceof Symbol && ($val = @$this->environment[$lambda->name]) !== NULL) {
$lambda = $val;
}
$phpName = NULL;
if ($lambda instanceof Symbol) {
$phpName = ($in = @self::$_internalNames[$lambda->name]) === NULL ? str_replace('-', '_', $lambda->name) : $in;
}
if ($lambda instanceof Macro) {
$list = NULL;
foreach ($lambda->expressions as $e) {
// macro-expansion-time
$applied = $lambda->arguments === NULL ? $e : $this->Apply($e, $lambda->arguments, $args);
//echo Expression::Render($e) . " =APPLY=> " . Expression::Render($applied) . "\n";
$expanded = $this->Evaluate($applied);
//echo Expression::Render($applied) . " =MACROEXPAND=> " . Expression::Render($expanded) . "\n";
}
return $this->Compile($expanded);
}
if ($lambda instanceof Symbol) {
// special forms (non-evaluated parameters)
$specialForm = "lizp_special_form_{$phpName}";
if (function_exists($specialForm)) {
$this->Emit(new ReturnCE(new FunctionCallCE($specialForm, array("env", new CompiledExpression($args)))));
return;
}
}
// We evaluate the parameters
$paramNames = array();
$params = array();
$expandNext = FALSE;
$rand = rand(1, 1000000);
foreach ($args as $i => $v) {
if ($v instanceof AtSign) {
$expandNext = TRUE;
continue;
}
$this->Compile($v);
$this->Emit(new LoadCE("param_{$rand}_{$i}"));
if ($expandNext && is_array($r)) {
$params = array_merge($params, $r);
} else {
$params[] = "\$param_{$rand}_{$i}";
//r;
$paramNames[] = "param_{$rand}_{$i}";
//r;
}
$expandNext = FALSE;
}
if ($lambda instanceof Lambda) {
$r = NULL;
foreach ($lambda->expressions as $e) {
$args = array();
foreach ($params as $i) {
if (is_array($i)) {
$i = array(Symbol::Make('quote'), $i);
}
$args[] = $i;
}
//$params = $args;
$applied = $lambda->arguments === NULL ? $e : $this->Apply($e, $lambda->arguments, $params);
//echo Expression::Render($e) . " -APPLY-> " . Expression::Render($applied) . "\n";
// $r =
$this->Compile($applied);
//echo Expression::Render($applied) . " -EVAL-> " . Expression::Render($r) . "\n";
}
return;
// $r
}
if ($lambda instanceof Symbol) {
// internal functions / php functions
$internalFn = "lizp_internal_fn_{$phpName}";
if (($isInternal = function_exists($internalFn)) || function_exists($phpName)) {
if ($isInternal) {
$this->Emit(new ReturnCE(new FunctionCallCE($internalFn, array("env", new StringExpression("array(" . implode(', ', $params) . ")")))));
return;
}
$this->Emit(new ReturnCE(new FunctionCallCE($phpName, $paramNames)));
$this->Emit(new StringExpression('if (is_array($r) && count($r) == 0) $r = NULL;'));
return;
}
}
$this->Emit("/* Unable to evaluate Expression: " . Expression::Render($sexp) . " because function name evaluates to " . Expression::Render($lambda) . " */");
}
public static function Parse(&$s, &$position = NULL)
{
if ($position === NULL) {
$pos = $position = 0;
} else {
$pos = $position;
}
$len = strlen($s);
$tokens = array();
$didClose = FALSE;
$qStack = array();
$qSymbol = Symbol::Make('quote');
$qqSymbol = Symbol::Make('quasiquote');
$append = FALSE;
for (;;) {
// append any expressions to our list
if ($append !== FALSE) {
while (count($qStack) > 0) {
$qChar = array_pop($qStack);
switch ($qChar) {
case "'":
$append = array($qSymbol, $append);
break;
case "`":
$append = is_array($append) ? array_merge(array($qqSymbol), $append) : array($qSymbol, $append);
break;
}
}
$tokens[] = $append;
$append = FALSE;
}
// end reached?
if ($pos >= $len) {
break;
}
// closing?
if ($s[$pos] == ')') {
if ($position === 0) {
throw new Exception("Missing (!");
}
$didClose = TRUE;
$pos++;
break;
}
// consume whitespace
if (preg_match('/\\s/', $s[$pos])) {
$pos++;
continue;
}
// consume comments
if ($s[$pos] == ';') {
if (($nl = strpos($s, "\n", $pos)) !== FALSE) {
$pos = $nl;
}
$pos++;
continue;
}
// open paren
if ($s[$pos] == '(') {
$p = $pos + 1;
$append = self::Parse($s, $p);
$pos = $p;
continue;
}
// quote and quasiquote
if ($s[$pos] == "`" || $s[$pos] == "'") {
array_push($qStack, $s[$pos]);
$pos++;
continue;
}
// tilde
if ($s[$pos] == "~") {
$append = new Tilde();
$pos++;
continue;
}
// at sign
if ($s[$pos] == "@") {
$append = new AtSign();
$pos++;
continue;
}
// from here on i'll need an actual substring,
// because the regexp functions do not allow matching
// at a specified offset only. :(
$sub = substr($s, $pos);
// consume strings
if (preg_match('/^"((?:\\\\"|[^"])*)"/s', $sub, $m)) {
$append = stripslashes($m[1]);
$pos += strlen($m[1]) + 2;
continue;
}
// consume integers
if (preg_match('/^([+-]?[0-9]+)/s', $sub, $m)) {
$append = (int) $m[1];
$pos += strlen($m[1]);
continue;
}
// consume symbols
if (preg_match('/^([^0-9][^\\s\\(\\)\\[\\]\\{\\}]*)/s', $sub, $m)) {
$sname = $m[1];
$supper = strtoupper($sname);
if ($supper == 'T') {
$append = TRUE;
} elseif ($supper == 'NIL') {
$append = NULL;
} else {
$symbol = new Symbol();
$symbol->name = $sname;
$append = $symbol;
}
$pos += strlen($sname);
continue;
}
throw new Exception("Unexpected character at pos {$pos}: {$s[$pos]}");
}
if ($position !== 0 && !$didClose) {
throw new Exception("Missing )!");
}
$position = $pos;
return empty($tokens) ? NULL : $tokens;
}
function lizp_special_form_defmacro($env, $args)
{
if (!@$args[0] instanceof Symbol || !(is_array(@$args[1]) || @$args[1] === NULL || @$args[1] === FALSE)) {
throw new Exception("Syntax Error: (DEFMACRO <id> (<params>*) <expr>*)");
}
$lambda = new Macro();
$lambda->arguments = empty($args[1]) ? NULL : $args[1];
$lambda->expressions = array_slice($args, 2);
$env->environment[$args[0]->name] = $lambda;
return Symbol::Make($args[0]->name);
}
function lizp_internal_fn_map($env, $args)
{
if (count($args) !== 2 || !($args[0] instanceof Lambda || $args[0] instanceof Symbol) || !is_array($args[1]) && $args[1] !== NULL) {
throw new Exception("syntax: (MAP <lambda> <list>)");
}
$r = array();
foreach ((array) $args[1] as $i => $v) {
$r[] = $env->Evaluate(array($args[0], array(Symbol::Make('quote'), $v), array(Symbol::Make('quote'), $i)));
}
return empty($r) ? NULL : $r;
}
