madlisp/src/Evaller.php

334 lines
12 KiB
PHP
Raw Normal View History

2020-05-28 10:10:00 +00:00
<?php
namespace MadLisp;
class Evaller
{
2020-06-06 08:31:09 +00:00
protected Tokenizer $tokenizer;
protected Reader $reader;
2020-06-06 14:02:02 +00:00
protected Printer $printer;
protected bool $safemode;
2020-06-06 08:31:09 +00:00
2020-06-10 13:40:15 +00:00
protected bool $debug = false;
2020-06-06 14:02:02 +00:00
public function __construct(Tokenizer $tokenizer, Reader $reader, Printer $printer, bool $safemode)
2020-06-06 08:31:09 +00:00
{
$this->tokenizer = $tokenizer;
$this->reader = $reader;
2020-06-06 14:02:02 +00:00
$this->printer = $printer;
$this->safemode = $safemode;
2020-06-06 08:31:09 +00:00
}
2020-06-04 02:10:48 +00:00
public function eval($ast, Env $env)
2020-05-28 12:41:41 +00:00
{
2020-06-10 13:40:15 +00:00
if ($this->debug) {
2020-06-06 14:02:02 +00:00
print("eval: ");
$this->printer->print($ast);
print("\n");
$loops = 0;
}
2020-06-04 14:26:00 +00:00
while (true) {
2020-06-04 11:00:30 +00:00
2020-06-10 13:40:15 +00:00
if ($this->debug) {
2020-06-06 14:02:02 +00:00
if ($loops++ > 0) {
print("eval loop: ");
$this->printer->print($ast);
print("\n");
}
}
// Not list
2020-06-04 14:26:00 +00:00
if (!($ast instanceof MList)) {
return $this->evalAst($ast, $env);
}
$astData = $ast->getData();
$astLength = count($astData);
// Empty list
if ($astLength == 0) {
2020-06-04 14:26:00 +00:00
return $ast;
}
2020-06-04 11:26:26 +00:00
2020-06-04 14:26:00 +00:00
// Handle special forms
if ($astData[0] instanceof Symbol) {
$symbolName = $astData[0]->getName();
if ($symbolName == 'and') {
if ($astLength == 1) {
2020-06-04 14:26:00 +00:00
return true;
2020-06-04 11:26:26 +00:00
}
for ($i = 1; $i < $astLength - 1; $i++) {
$value = $this->eval($astData[$i], $env);
2020-06-04 14:26:00 +00:00
if ($value == false) {
return $value;
}
}
2020-05-30 11:47:54 +00:00
$ast = $astData[$astLength - 1];
2020-06-04 14:26:00 +00:00
continue; // tco
} elseif ($symbolName == 'case') {
if ($astLength < 2) {
2020-06-04 14:26:00 +00:00
throw new MadLispException("case requires at least 1 argument");
}
2020-05-30 11:47:54 +00:00
for ($i = 1; $i < $astLength - 1; $i += 2) {
$test = $this->eval($astData[$i], $env);
2020-06-04 14:26:00 +00:00
if ($test == true) {
$ast = $astData[$i + 1];
2020-06-04 14:39:26 +00:00
continue 2; // tco
2020-06-04 14:26:00 +00:00
}
}
2020-05-30 12:19:37 +00:00
2020-06-04 14:26:00 +00:00
// Last value, no test
if ($astLength % 2 == 0) {
$ast = $astData[$astLength - 1];
2020-06-04 14:39:26 +00:00
continue; // tco
2020-06-04 14:26:00 +00:00
} else {
return null;
}
} elseif ($symbolName == 'def') {
if ($astLength != 3) {
2020-06-04 14:26:00 +00:00
throw new MadLispException("def requires exactly 2 arguments");
}
2020-05-30 12:19:37 +00:00
if (!($astData[1] instanceof Symbol)) {
2020-06-04 14:26:00 +00:00
throw new MadLispException("first argument to def is not symbol");
2020-06-04 10:36:01 +00:00
}
$name = $astData[1]->getName();
// Do not allow reserved symbols to be defined
$reservedSymbols = ['__FILE__', '__DIR__'];
if (in_array($name, $reservedSymbols)) {
throw new MadLispException("def reserved symbol $name");
}
$value = $this->eval($astData[2], $env);
return $env->set($name, $value);
} elseif ($symbolName == 'do') {
if ($astLength == 1) {
2020-06-06 02:39:12 +00:00
return null;
2020-06-04 14:26:00 +00:00
}
2020-05-31 09:35:03 +00:00
for ($i = 1; $i < $astLength - 1; $i++) {
$this->eval($astData[$i], $env);
2020-06-04 14:26:00 +00:00
}
2020-05-31 09:35:03 +00:00
$ast = $astData[$astLength - 1];
2020-06-04 14:26:00 +00:00
continue; // tco
} elseif (!$this->safemode && $symbolName == 'env') {
if ($astLength >= 2) {
if (!($astData[1] instanceof Symbol)) {
2020-06-04 14:26:00 +00:00
throw new MadLispException("first argument to env is not symbol");
}
return $env->get($astData[1]->getName());
2020-06-04 14:26:00 +00:00
} else {
return $env;
}
} elseif (!$this->safemode && $symbolName == 'eval') {
if ($astLength == 1) {
2020-06-06 08:31:09 +00:00
return null;
}
$ast = $this->eval($astData[1], $env);
2020-06-06 08:31:09 +00:00
continue; // tco
} elseif ($symbolName == 'fn') {
if ($astLength != 3) {
2020-06-04 14:26:00 +00:00
throw new MadLispException("fn requires exactly 2 arguments");
2020-05-31 09:35:03 +00:00
}
if (!($astData[1] instanceof Seq)) {
throw new MadLispException("first argument to fn is not seq");
2020-06-04 14:26:00 +00:00
}
2020-05-31 09:35:03 +00:00
$bindings = $astData[1]->getData();
2020-06-04 14:26:00 +00:00
foreach ($bindings as $bind) {
if (!($bind instanceof Symbol)) {
throw new MadLispException("binding key for fn is not symbol");
}
2020-05-31 09:35:03 +00:00
}
2020-12-05 02:48:17 +00:00
$closure = function (...$args) use ($bindings, $ast, $env, $astData) {
2020-06-06 08:31:09 +00:00
$newEnv = new Env('closure', $env);
2020-05-30 12:02:41 +00:00
2020-06-04 14:26:00 +00:00
for ($i = 0; $i < count($bindings); $i++) {
$newEnv->set($bindings[$i]->getName(), $args[$i] ?? null);
}
2020-05-30 12:02:41 +00:00
return $this->eval($astData[2], $newEnv);
};
2020-12-05 01:13:17 +00:00
return new UserFunc($closure, $astData[2], $env, $astData[1]);
} elseif ($symbolName == 'if') {
if ($astLength < 3 || $astLength > 4) {
2020-06-04 14:26:00 +00:00
throw new MadLispException("if requires 2 or 3 arguments");
}
2020-05-30 11:47:54 +00:00
$result = $this->eval($astData[1], $env);
2020-06-04 14:26:00 +00:00
if ($result == true) {
$ast = $astData[2];
2020-06-04 14:26:00 +00:00
continue;
} elseif ($astLength == 4) {
$ast = $astData[3];
2020-06-04 14:26:00 +00:00
continue;
} else {
return null;
}
} elseif ($symbolName == 'let') {
if ($astLength != 3) {
2020-06-04 14:26:00 +00:00
throw new MadLispException("let requires exactly 2 arguments");
}
2020-05-30 11:47:54 +00:00
if (!($astData[1] instanceof MList)) {
2020-06-04 14:26:00 +00:00
throw new MadLispException("first argument to let is not list");
}
2020-05-30 11:47:54 +00:00
$bindings = $astData[1]->getData();
2020-05-30 11:47:54 +00:00
2020-06-04 14:26:00 +00:00
if (count($bindings) % 2 == 1) {
throw new MadLispException("uneven number of bindings for let");
}
2020-05-30 11:47:54 +00:00
2020-06-06 08:31:09 +00:00
$newEnv = new Env('let', $env);
2020-05-30 11:47:54 +00:00
2020-06-04 14:26:00 +00:00
for ($i = 0; $i < count($bindings) - 1; $i += 2) {
$key = $bindings[$i];
if (!($key instanceof Symbol)) {
throw new MadLispException("binding key for let is not symbol");
}
$val = $this->eval($bindings[$i + 1], $newEnv);
$newEnv->set($key->getName(), $val);
2020-05-30 11:47:54 +00:00
}
$ast = $astData[2];
2020-06-04 14:26:00 +00:00
$env = $newEnv;
continue; // tco
} elseif (!$this->safemode && $symbolName == 'load') {
2020-06-06 08:31:09 +00:00
// Load is here because we want to load into
// current $env which is hard otherwise.
// This is disabled now for safe-mode, but some
// use (maybe restricted) might need to be allowed.
if ($astLength != 2) {
2020-06-06 08:31:09 +00:00
throw new MadLispException("load requires exactly 1 argument");
}
// We have to evaluate the argument, it could be a function
$filename = $this->eval($astData[1], $env);
2020-06-06 08:31:09 +00:00
if (!is_string($filename)) {
throw new MadLispException("first argument to load is not string");
}
// Replace ~ with user home directory
// Expand relative path names into absolute
$targetFile = realpath(str_replace('~', $_SERVER['HOME'], $filename));
if (!$targetFile || !is_readable($targetFile)) {
2020-06-06 08:31:09 +00:00
throw new MadLispException("unable to read file $filename");
}
$input = @file_get_contents($targetFile);
2020-06-06 08:31:09 +00:00
// Wrap input in a do to process multiple expressions
$input = "(do $input)";
$expr = $this->reader->read($this->tokenizer->tokenize($input));
// Handle special constants
$rootEnv = $env->getRoot();
$prevFile = $rootEnv->get('__FILE__');
$prevDir = $rootEnv->get('__DIR__');
$rootEnv->set('__FILE__', $targetFile);
$rootEnv->set('__DIR__', dirname($targetFile) . \DIRECTORY_SEPARATOR);
// Evaluate the contents
2020-06-06 08:31:09 +00:00
$ast = $this->eval($expr, $env);
// Restore the special constants to previous values
$rootEnv->set('__FILE__', $prevFile);
$rootEnv->set('__DIR__', $prevDir);
2020-06-06 08:31:09 +00:00
continue; // tco
} elseif ($symbolName == 'or') {
if ($astLength == 1) {
2020-06-04 14:26:00 +00:00
return false;
}
2020-05-30 11:47:54 +00:00
for ($i = 1; $i < $astLength - 1; $i++) {
$value = $this->eval($astData[$i], $env);
2020-06-04 14:26:00 +00:00
if ($value == true) {
return $value;
}
}
2020-06-04 11:00:30 +00:00
$ast = $astData[$astLength - 1];
2020-06-04 14:26:00 +00:00
continue; // tco
} elseif ($symbolName == 'quote') {
if ($astLength != 2) {
2020-06-04 14:26:00 +00:00
throw new MadLispException("quote requires exactly 1 argument");
2020-06-04 11:00:30 +00:00
}
return $astData[1];
2020-05-28 13:30:37 +00:00
}
}
2020-06-04 14:26:00 +00:00
// Get new evaluated list
$ast = $this->evalAst($ast, $env);
$astData = $ast->getData();
2020-05-28 10:10:00 +00:00
// First item is function, rest are arguments
$func = $astData[0];
$args = array_slice($astData, 1);
if ($func instanceof CoreFunc) {
return $func->call($args);
} elseif ($func instanceof UserFunc) {
$ast = $func->getAst();
$env = $func->getEnv($args);
} else {
2020-06-04 14:26:00 +00:00
throw new MadLispException("eval: first item of list is not function");
}
}
2020-05-28 10:10:00 +00:00
}
2020-06-04 02:10:48 +00:00
2020-12-05 01:42:56 +00:00
public function getDebug(): bool
{
return $this->debug;
}
2020-06-10 13:40:15 +00:00
public function setDebug(bool $val): void
{
$this->debug = $val;
}
2020-06-04 02:10:48 +00:00
private function evalAst($ast, Env $env)
{
if ($ast instanceof Symbol) {
// Lookup symbol from env
return $env->get($ast->getName());
2020-06-05 08:55:38 +00:00
} elseif ($ast instanceof Seq) {
$results = [];
foreach ($ast->getData() as $val) {
$results[] = $this->eval($val, $env);
}
return $ast::new($results);
2020-06-04 02:10:48 +00:00
} elseif ($ast instanceof Hash) {
$results = [];
foreach ($ast->getData() as $key => $val) {
$results[$key] = $this->eval($val, $env);
}
return new Hash($results);
}
return $ast;
}
2020-05-28 10:10:00 +00:00
}