load and eval in correct env

This commit is contained in:
Pekka Laiho 2020-06-06 15:31:09 +07:00
parent fae099d659
commit 7348ec3229
6 changed files with 61 additions and 21 deletions

View File

@ -5,13 +5,13 @@ function ml_get_lisp(): array
{ {
$tokenizer = new MadLisp\Tokenizer(); $tokenizer = new MadLisp\Tokenizer();
$reader = new MadLisp\Reader(); $reader = new MadLisp\Reader();
$eval = new MadLisp\Evaller(); $eval = new MadLisp\Evaller($tokenizer, $reader);
$printer = new MadLisp\Printer(); $printer = new MadLisp\Printer();
$lisp = new MadLisp\Lisp($tokenizer, $reader, $eval, $printer); $lisp = new MadLisp\Lisp($tokenizer, $reader, $eval, $printer);
// Environment // Environment
$env = new MadLisp\Env(); $env = new MadLisp\Env('root');
// Register core functions // Register core functions
$lisp->register($env); $lisp->register($env);
@ -25,8 +25,5 @@ function ml_get_lisp(): array
(new MadLisp\Lib\Time())->register($env); (new MadLisp\Lib\Time())->register($env);
(new MadLisp\Lib\Types())->register($env); (new MadLisp\Lib\Types())->register($env);
// Functions defined in lisp itself
$lisp->re('(def loadf (fn (f) (if (file? f) (eval (read (str "(do " (fread f) ")"))) (error (str "file " f " does not exist")))))', $env);
return [$lisp, $env]; return [$lisp, $env];
} }

View File

@ -4,7 +4,7 @@ require('bootstrap.php');
list($lisp, $rootEnv) = ml_get_lisp(); list($lisp, $rootEnv) = ml_get_lisp();
// Create new env for user definitions // Create new env for user definitions
$userEnv = new MadLisp\Env($rootEnv); $userEnv = new MadLisp\Env('repl', $rootEnv);
while (true) { while (true) {
$input = readline('> '); $input = readline('> ');

View File

@ -3,13 +3,24 @@ namespace MadLisp;
class Env extends Hash class Env extends Hash
{ {
protected string $name;
protected ?Env $parent; protected ?Env $parent;
public function __construct(?Env $parent = null) public function __construct(string $name, ?Env $parent = null)
{ {
$this->name = $name;
$this->parent = $parent; $this->parent = $parent;
} }
public function getFullName(): string
{
if ($this->parent) {
return $this->parent->getFullName() . '/' . $this->name;
}
return $this->name;
}
public function get(string $key) public function get(string $key)
{ {
if ($this->has($key)) { if ($this->has($key)) {

View File

@ -3,6 +3,15 @@ namespace MadLisp;
class Evaller class Evaller
{ {
protected Tokenizer $tokenizer;
protected Reader $reader;
public function __construct(Tokenizer $tokenizer, Reader $reader)
{
$this->tokenizer = $tokenizer;
$this->reader = $reader;
}
public function eval($ast, Env $env) public function eval($ast, Env $env)
{ {
while (true) { while (true) {
@ -82,6 +91,13 @@ class Evaller
} else { } else {
return $env; return $env;
} }
} elseif ($ast->get(0)->getName() == 'eval') {
if ($ast->count() == 1) {
return null;
}
$ast = $this->eval($ast->get(1), $env);
continue; // tco
} elseif ($ast->get(0)->getName() == 'fn') { } elseif ($ast->get(0)->getName() == 'fn') {
if ($ast->count() != 3) { if ($ast->count() != 3) {
throw new MadLispException("fn requires exactly 2 arguments"); throw new MadLispException("fn requires exactly 2 arguments");
@ -99,7 +115,7 @@ class Evaller
} }
$closure = function (...$args) use ($bindings, $ast, $env) { $closure = function (...$args) use ($bindings, $ast, $env) {
$newEnv = new Env($env); $newEnv = new Env('closure', $env);
for ($i = 0; $i < count($bindings); $i++) { for ($i = 0; $i < count($bindings); $i++) {
$newEnv->set($bindings[$i]->getName(), $args[$i] ?? null); $newEnv->set($bindings[$i]->getName(), $args[$i] ?? null);
@ -140,7 +156,7 @@ class Evaller
throw new MadLispException("uneven number of bindings for let"); throw new MadLispException("uneven number of bindings for let");
} }
$newEnv = new Env($env); $newEnv = new Env('let', $env);
for ($i = 0; $i < count($bindings) - 1; $i += 2) { for ($i = 0; $i < count($bindings) - 1; $i += 2) {
$key = $bindings[$i]; $key = $bindings[$i];
@ -156,6 +172,31 @@ class Evaller
$ast = $ast->get(2); $ast = $ast->get(2);
$env = $newEnv; $env = $newEnv;
continue; // tco continue; // tco
} elseif ($ast->get(0)->getName() == 'load') {
// Load is here because we want to load into
// current $env which is hard otherwise.
if ($ast->count() != 2) {
throw new MadLispException("load requires exactly 1 argument");
}
$filename = $ast->get(1);
if (!is_string($filename)) {
throw new MadLispException("first argument to load is not string");
} elseif (!is_readable($filename)) {
throw new MadLispException("unable to read file $filename");
}
$input = @file_get_contents($filename);
// Wrap input in a do to process multiple expressions
$input = "(do $input)";
$expr = $this->reader->read($this->tokenizer->tokenize($input));
$ast = $this->eval($expr, $env);
continue; // tco
} elseif ($ast->get(0)->getName() == 'or') { } elseif ($ast->get(0)->getName() == 'or') {
if ($ast->count() == 1) { if ($ast->count() == 1) {
return false; return false;

View File

@ -16,18 +16,13 @@ class Lisp
$this->printer = $printer; $this->printer = $printer;
} }
public function re(string $input, Env $env) public function rep(string $input, Env $env): void
{ {
$tokens = $this->tokenizer->tokenize($input); $tokens = $this->tokenizer->tokenize($input);
$expr = $this->reader->read($tokens); $expr = $this->reader->read($tokens);
return $this->eval->eval($expr, $env); $result = $this->eval->eval($expr, $env);
}
public function rep(string $input, Env $env): void
{
$result = $this->re($input, $env);
$this->printer->print($result); $this->printer->print($result);
} }
@ -48,10 +43,6 @@ class Lisp
fn (string $a) => $this->reader->read($this->tokenizer->tokenize($a)) fn (string $a) => $this->reader->read($this->tokenizer->tokenize($a))
)); ));
$env->set('eval', new CoreFunc('eval', 'Evaluate argument.', 1, 1,
fn ($a) => $this->eval->eval($a, $env)
));
$env->set('print', new CoreFunc('print', 'Print argument.', 1, 1, $env->set('print', new CoreFunc('print', 'Print argument.', 1, 1,
function ($a) { function ($a) {
$this->printer->print($a); $this->printer->print($a);

View File

@ -25,7 +25,7 @@ class UserFunc extends Func
public function getEnv(array $args) public function getEnv(array $args)
{ {
$newEnv = new Env($this->tempEnv); $newEnv = new Env('apply', $this->tempEnv);
for ($i = 0; $i < count($this->bindings); $i++) { for ($i = 0; $i < count($this->bindings); $i++) {
$newEnv->set($this->bindings[$i]->getName(), $args[$i] ?? null); $newEnv->set($this->bindings[$i]->getName(), $args[$i] ?? null);