This commit is contained in:
Pekka Laiho 2020-05-28 11:55:58 +07:00
parent 56c80b9aaf
commit adc6ab99c3
16 changed files with 532 additions and 458 deletions

1
.gitignore vendored Normal file
View File

@ -0,0 +1 @@
vendor/

12
bootstrap.php Normal file
View File

@ -0,0 +1,12 @@
<?php
require('vendor/autoload.php');
function ml_get_env(): MadLisp\Env
{
$env = new MadLisp\Env();
$core = new MadLisp\Lib\Core();
$core->register($env);
return $env;
}

View File

@ -1,93 +0,0 @@
<?php
class MadLispException extends Exception {}
abstract class MLCollection
{
protected array $data = [];
public function __construct(array $data = [])
{
$this->data = $data;
}
public function count(): int
{
return count($this->data);
}
public function has(string $key): bool
{
return array_key_exists($key, $this->data);
}
public function getData(): array
{
return $this->data;
}
}
class MLList extends MLCollection
{
public function get(int $index)
{
if ($this->has($index)) {
return $this->data[$index];
}
throw new MadLispException("list does not contain index $index");
}
}
class MLHash extends MLCollection
{
public function get(string $key)
{
if ($this->has($key)) {
return $this->data[$key];
}
throw new MadLispException("hash does not contain key $key");
}
}
class MLEnv extends MLHash
{
protected ?MLEnv $parent;
public function __construct(?MLEnv $parent = null)
{
$this->parent = $parent;
}
public function get(string $key)
{
if ($this->has($key)) {
return $this->data[$key];
} elseif ($this->parent) {
return $this->parent->get($key);
}
throw new MadLispException("symbol $key not defined");
}
public function set(string $key, $value): void
{
$this->data[$key] = $value;
}
}
class MLSymbol
{
protected string $name;
public function __construct(string $name)
{
$this->name = $name;
}
public function name(): string
{
return $this->name;
}
}

22
composer.json Normal file
View File

@ -0,0 +1,22 @@
{
"name": "maddy83/madlisp",
"description": "Lisp interpreter for the MadLisp language.",
"license": "MIT",
"authors": [
{
"name": "Pekka Laiho",
"email": "pekka.i.laiho@gmail.com"
}
],
"require": {
},
"require-dev": {
},
"autoload": {
"psr-4": {
"MadLisp\\": "src/"
}
}
}

151
lib.php
View File

@ -1,151 +0,0 @@
<?php
require_once('classes.php');
function ml_get_env(): MLEnv
{
$env = new MLEnv();
// logic
$env->set('or', function (...$args) {
// return first true
for ($i = 0; $i < count($args) - 1; $i++) {
if ($args[$i] == true) {
return $args[$i];
}
}
// return last
return $args[count($args) - 1];
});
$env->set('and', function (...$args) {
// return first false
for ($i = 0; $i < count($args) - 1; $i++) {
if ($args[$i] == false) {
return $args[$i];
}
}
// return last
return $args[count($args) - 1];
});
$env->set('not', fn ($a) => !$a);
// arithmetic
$env->set('+', function (...$args) {
return array_sum($args);
});
$env->set('-', function (...$args) {
$result = $args[0] ?? null;
for ($i = 1; $i < count($args); $i++) {
$result -= $args[$i];
}
return $result;
});
$env->set('*', function (...$args) {
$result = $args[0] ?? null;
for ($i = 1; $i < count($args); $i++) {
$result *= $args[$i];
}
return $result;
});
$env->set('/', function (...$args) {
$result = $args[0] ?? null;
for ($i = 1; $i < count($args); $i++) {
$result /= $args[$i];
}
return $result;
});
$env->set('%', function (...$args) {
$result = $args[0] ?? null;
for ($i = 1; $i < count($args); $i++) {
$result %= $args[$i];
}
return $result;
});
// comparison
$env->set('=', fn ($a, $b) => $a == $b);
$env->set('<', fn ($a, $b) => $a < $b);
$env->set('>', fn ($a, $b) => $a > $b);
$env->set('<=', fn ($a, $b) => $a <= $b);
$env->set('>=', fn ($a, $b) => $a >= $b);
$env->set('!=', fn ($a, $b) => $a != $b);
// types
$env->set('type?', function ($a) {
if ($a instanceof Closure) {
return 'function';
} elseif ($a instanceof MLList) {
return 'list';
} elseif ($a instanceof MLHash) {
return 'hash';
} elseif ($a instanceof MLSymbol) {
return 'symbol';
} elseif ($a === true || $a === false) {
return 'bool';
} elseif ($a === null) {
return 'null';
} elseif (is_int($a)) {
return 'int';
} elseif (is_float($a)) {
return 'float';
} else {
return 'string';
}
});
$env->set('fn?', fn ($a) => $a instanceof Closure);
$env->set('list?', fn ($a) => $a instanceof MLList);
$env->set('hash?', fn ($a) => $a instanceof MLHash);
$env->set('sym?', fn ($a) => $a instanceof MLSymbol);
$env->set('bool?', fn ($a) => $a === true || $a === false);
$env->set('true?', fn ($a) => $a == true); // not strict
$env->set('false?', fn ($a) => $a == false); // not strict
$env->set('null?', fn ($a) => $a === null);
$env->set('int?', fn ($a) => is_int($a));
$env->set('float?', fn ($a) => is_float($a));
$env->set('str?', fn ($a) => is_string($a));
// collections
$env->set('list', function (...$args) {
return new MLList($args);
});
$env->set('hash', function (...$args) {
if (count($args) % 2 == 1) {
throw new MadLispException('uneven number of arguments for hash');
}
$data = [];
for ($i = 0; $i < count($args) - 1; $i += 2) {
$key = $args[$i];
$val = $args[$i + 1];
if (!is_string($key)) {
throw new MadLispException('invalid key for hash (not string)');
}
$data[$key] = $val;
}
return new MLHash($data);
});
// for debugging!
$env->set('eval', fn ($a) => ml_eval($a, $env));
return $env;
}

210
lisp.php
View File

@ -1,210 +0,0 @@
<?php
require_once('classes.php');
function ml_tokenize(string $a): array
{
$tokens = [];
$current = '';
$string = false;
$parens = 0;
$addCurrent = function () use (&$tokens, &$current) {
if ($current !== '') {
$tokens[] = $current;
$current = '';
}
};
for ($i = 0; $i < strlen($a); $i++) {
$c = substr($a, $i, 1);
if ($string) {
// Inside string, add all characters
$current .= $c;
// Stop at "
if ($c == '"') {
$addCurrent();
$string = false;
}
} else {
// Not inside string
if ($c == '"') {
// Start of string
$addCurrent();
$current .= $c;
$string = true;
} elseif ($c == ' ' || $c == "\t" || $c == "\n" || $c == "\r") {
// Whitespace is ignored
$addCurrent();
} elseif ($c == '(') {
// Start of list
$addCurrent();
$tokens[] = '(';
$parens++;
} elseif ($c == ')') {
// End of list
if ($parens == 0) {
throw new MadLispException("unexpected closing parenthesis");
}
$addCurrent();
$tokens[] = ')';
$parens--;
} else {
// All other characters
$current .= $c;
}
}
}
// Add last also
$addCurrent();
// Check for errors
if ($parens != 0) {
throw new MadLispException("missing closing parenthesis");
} elseif ($string) {
throw new MadLispException("unterminated string");
}
return $tokens;
}
function ml_read_form(array $tokens, int &$index)
{
if ($tokens[$index] == '(') {
return ml_read_list($tokens, $index);
} else {
return ml_read_atom($tokens, $index);
}
}
function ml_read_list(array $tokens, int &$index): MLList
{
$result = [];
// start tag
$index++;
while ($tokens[$index] != ')') {
$result[] = ml_read_form($tokens, $index);
}
// end tag
$index++;
return new MLList($result);
}
function ml_read_atom(array $tokens, int &$index)
{
$a = $tokens[$index++];
if ($a === 'true') {
return true;
} elseif ($a === 'false') {
return false;
} elseif ($a === 'null') {
return null;
} elseif (substr($a, 0, 1) === '"') {
// string
return substr($a, 1, strlen($a) - 2);
} elseif (is_numeric($a)) {
if (filter_var($a, FILTER_VALIDATE_INT) !== false) {
return intval($a);
} else {
return floatval($a);
}
} else {
return new MLSymbol($a);
}
}
function ml_parse(array $tokens): array
{
$result = [];
$index = 0;
while ($index < count($tokens)) {
$result[] = ml_read_form($tokens, $index);
}
return $result;
}
function ml_read(string $code): array
{
$tokens = ml_tokenize($code);
$expressions = ml_parse($tokens);
return $expressions;
}
function ml_eval($expr, MLEnv $env)
{
if ($expr instanceof MLList && $expr->count() > 0) {
// Evaluate list contents
$results = array_map(fn ($a) => ml_eval($a, $env), $expr->getData());
$fn = $results[0];
if ($fn instanceof Closure) {
// If the first item is a function, call it
$args = array_slice($results, 1);
return $fn(...$args);
} else {
// Otherwise return new list with evaluated contents
return new MLList($results);
}
} elseif ($expr instanceof MLHash) {
// Hash: return new hash with all items evaluated
$items = [];
foreach ($expr->getData() as $key => $val) {
$items[$key] = ml_eval($val, $env);
}
return new MLHash($items);
} elseif ($expr instanceof MLSymbol) {
return $env->get($expr->name());
}
return $expr;
}
function ml_print($a): string
{
if ($a instanceof Closure) {
return '<function>';
} elseif ($a instanceof MLList) {
return '(' . implode(' ', array_map('ml_print', $a->getData())) . ')';
} elseif ($a instanceof MLHash) {
$items = [];
foreach ($a->getData() as $key => $val) {
$items[] = ml_print($key) . ':' . ml_print($val);
}
return '{' . implode(' ', $items) . '}';
} elseif ($a instanceof MLSymbol) {
return $a->name();
} elseif ($a === true) {
return 'true';
} elseif ($a === false) {
return 'false';
} elseif ($a === null) {
return 'null';
} elseif (is_string($a)) {
return '"' . $a . '"';
} else {
return $a;
}
}
function ml_rep(string $input, MLEnv $env): string
{
$expressions = ml_read($input);
$results = array_map(fn ($expr) => ml_eval($expr, $env), $expressions);
return implode(" ", array_map('ml_print', $results));
}

View File

@ -1,15 +1,14 @@
<?php
require_once('lib.php');
require_once('lisp.php');
require('bootstrap.php');
$env = ml_get_env();
$lisp = new MadLisp\Lisp();
while (true) {
$input = readline('> ');
try {
print(ml_rep($input, $env));
$lisp->rep($input, $env);
} catch (MadLispException $ex) {
print('error: ' . $ex->getMessage());
}

27
src/Collection.php Normal file
View File

@ -0,0 +1,27 @@
<?php
namespace MadLisp;
abstract class Collection
{
protected array $data = [];
public function __construct(array $data = [])
{
$this->data = $data;
}
public function count(): int
{
return count($this->data);
}
public function has(string $key): bool
{
return array_key_exists($key, $this->data);
}
public function getData(): array
{
return $this->data;
}
}

28
src/Env.php Normal file
View File

@ -0,0 +1,28 @@
<?php
namespace MadLisp;
class Env extends Hash
{
protected ?Env $parent;
public function __construct(?Env $parent = null)
{
$this->parent = $parent;
}
public function get(string $key)
{
if ($this->has($key)) {
return $this->data[$key];
} elseif ($this->parent) {
return $this->parent->get($key);
}
throw new MadLispException("symbol $key not defined in env");
}
public function set(string $key, $value): void
{
$this->data[$key] = $value;
}
}

14
src/Hash.php Normal file
View File

@ -0,0 +1,14 @@
<?php
namespace MadLisp;
class Hash extends Collection
{
public function get(string $key)
{
if ($this->has($key)) {
return $this->data[$key];
}
throw new MadLispException("hash does not contain key $key");
}
}

156
src/Lib/Core.php Normal file
View File

@ -0,0 +1,156 @@
<?php
namespace MadLisp\Lib;
use Closure;
use MadLisp\Env;
use MadLisp\Hash;
use MadLisp\MList;
use MadLisp\Symbol;
use MadLisp\MadLispException;
class Core implements ILib
{
public function register(Env $env): void
{
// logic
$env->set('or', function (...$args) {
// return first true
for ($i = 0; $i < count($args) - 1; $i++) {
if ($args[$i] == true) {
return $args[$i];
}
}
// return last
return $args[count($args) - 1];
});
$env->set('and', function (...$args) {
// return first false
for ($i = 0; $i < count($args) - 1; $i++) {
if ($args[$i] == false) {
return $args[$i];
}
}
// return last
return $args[count($args) - 1];
});
$env->set('not', fn ($a) => !$a);
// arithmetic
$env->set('+', function (...$args) {
return array_sum($args);
});
$env->set('-', function (...$args) {
$result = $args[0] ?? null;
for ($i = 1; $i < count($args); $i++) {
$result -= $args[$i];
}
return $result;
});
$env->set('*', function (...$args) {
$result = $args[0] ?? null;
for ($i = 1; $i < count($args); $i++) {
$result *= $args[$i];
}
return $result;
});
$env->set('/', function (...$args) {
$result = $args[0] ?? null;
for ($i = 1; $i < count($args); $i++) {
$result /= $args[$i];
}
return $result;
});
$env->set('%', function (...$args) {
$result = $args[0] ?? null;
for ($i = 1; $i < count($args); $i++) {
$result %= $args[$i];
}
return $result;
});
// comparison
$env->set('=', fn ($a, $b) => $a == $b);
$env->set('<', fn ($a, $b) => $a < $b);
$env->set('>', fn ($a, $b) => $a > $b);
$env->set('<=', fn ($a, $b) => $a <= $b);
$env->set('>=', fn ($a, $b) => $a >= $b);
$env->set('!=', fn ($a, $b) => $a != $b);
// types
$env->set('type?', function ($a) {
if ($a instanceof Closure) {
return 'function';
} elseif ($a instanceof MList) {
return 'list';
} elseif ($a instanceof Hash) {
return 'hash';
} elseif ($a instanceof Symbol) {
return 'symbol';
} elseif ($a === true || $a === false) {
return 'bool';
} elseif ($a === null) {
return 'null';
} elseif (is_int($a)) {
return 'int';
} elseif (is_float($a)) {
return 'float';
} else {
return 'string';
}
});
$env->set('fn?', fn ($a) => $a instanceof Closure);
$env->set('list?', fn ($a) => $a instanceof MList);
$env->set('hash?', fn ($a) => $a instanceof Hash);
$env->set('sym?', fn ($a) => $a instanceof Symbol);
$env->set('bool?', fn ($a) => $a === true || $a === false);
$env->set('true?', fn ($a) => $a == true); // not strict
$env->set('false?', fn ($a) => $a == false); // not strict
$env->set('null?', fn ($a) => $a === null);
$env->set('int?', fn ($a) => is_int($a));
$env->set('float?', fn ($a) => is_float($a));
$env->set('str?', fn ($a) => is_string($a));
// collections
$env->set('list', function (...$args) {
return new MList($args);
});
$env->set('hash', function (...$args) {
if (count($args) % 2 == 1) {
throw new MadLispException('uneven number of arguments for hash');
}
$data = [];
for ($i = 0; $i < count($args) - 1; $i += 2) {
$key = $args[$i];
$val = $args[$i + 1];
if (!is_string($key)) {
throw new MadLispException('invalid key for hash (not string)');
}
$data[$key] = $val;
}
return new Hash($data);
});
// for debugging!
$env->set('eval', fn ($a) => ml_eval($a, $env));
}
}

9
src/Lib/ILib.php Normal file
View File

@ -0,0 +1,9 @@
<?php
namespace MadLisp\Lib;
use MadLisp\Env;
interface ILib
{
public function register(Env $env): void;
}

222
src/Lisp.php Normal file
View File

@ -0,0 +1,222 @@
<?php
namespace MadLisp;
use Closure;
class Lisp
{
public function tokenize(string $a): array
{
$tokens = [];
$current = '';
$string = false;
$parens = 0;
$addCurrent = function () use (&$tokens, &$current) {
if ($current !== '') {
$tokens[] = $current;
$current = '';
}
};
for ($i = 0; $i < strlen($a); $i++) {
$c = substr($a, $i, 1);
if ($string) {
// Inside string, add all characters
$current .= $c;
// Stop at "
if ($c == '"') {
$addCurrent();
$string = false;
}
} else {
// Not inside string
if ($c == '"') {
// Start of string
$addCurrent();
$current .= $c;
$string = true;
} elseif ($c == ' ' || $c == "\t" || $c == "\n" || $c == "\r") {
// Whitespace is ignored
$addCurrent();
} elseif ($c == '(') {
// Start of list
$addCurrent();
$tokens[] = '(';
$parens++;
} elseif ($c == ')') {
// End of list
if ($parens == 0) {
throw new MadLispException("unexpected closing parenthesis");
}
$addCurrent();
$tokens[] = ')';
$parens--;
} else {
// All other characters
$current .= $c;
}
}
}
// Add last also
$addCurrent();
// Check for errors
if ($parens != 0) {
throw new MadLispException("missing closing parenthesis");
} elseif ($string) {
throw new MadLispException("unterminated string");
}
return $tokens;
}
public function parse(array $tokens): array
{
$result = [];
$index = 0;
while ($index < count($tokens)) {
$result[] = $this->readForm($tokens, $index);
}
return $result;
}
public function read(string $code): array
{
$tokens = $this->tokenize($code);
$expressions = $this->parse($tokens);
return $expressions;
}
public function eval($expr, Env $env)
{
if ($expr instanceof MList && $expr->count() > 0) {
// Evaluate list contents
$results = array_map(fn ($a) => $this->eval($a, $env), $expr->getData());
$fn = $results[0];
if ($fn instanceof Closure) {
// If the first item is a function, call it
$args = array_slice($results, 1);
return $fn(...$args);
} else {
// Otherwise return new list with evaluated contents
return new MList($results);
}
} elseif ($expr instanceof Hash) {
// Hash: return new hash with all items evaluated
$items = [];
foreach ($expr->getData() as $key => $val) {
$items[$key] = $this->eval($val, $env);
}
return new Hash($items);
} elseif ($expr instanceof Symbol) {
return $env->get($expr->name());
}
return $expr;
}
public function print($a): string
{
$result = $a;
if ($a instanceof Closure) {
$result = '<function>';
} elseif ($a instanceof MList) {
$items = [];
foreach ($a->getData() as $val) {
$items[] = $this->print($val);
}
$result = '(' . implode(' ', $items) . ')';
} elseif ($a instanceof Hash) {
$items = [];
foreach ($a->getData() as $key => $val) {
$items[] = $this->print($key) . ':' . $this->print($val);
}
$result = '{' . implode(' ', $items) . '}';
} elseif ($a instanceof Symbol) {
$result = $a->name();
} elseif ($a === true) {
$result = 'true';
} elseif ($a === false) {
$result = 'false';
} elseif ($a === null) {
$result = 'null';
} elseif (is_string($a)) {
$result = '"' . $a . '"';
}
return $result;
}
public function rep(string $input, Env $env): void
{
$expressions = $this->read($input);
$results = array_map(fn ($expr) => $this->eval($expr, $env), $expressions);
$output = array_map(fn ($res) => $this->print($res), $results);
print(implode(' ', $output));
}
private function readForm(array $tokens, int &$index)
{
if ($tokens[$index] == '(') {
return $this->readList($tokens, $index);
} else {
return $this->readAtom($tokens, $index);
}
}
private function readList(array $tokens, int &$index): MList
{
$result = [];
// start tag
$index++;
while ($tokens[$index] != ')') {
$result[] = $this->readForm($tokens, $index);
}
// end tag
$index++;
return new MList($result);
}
private function readAtom(array $tokens, int &$index)
{
$a = $tokens[$index++];
if ($a === 'true') {
return true;
} elseif ($a === 'false') {
return false;
} elseif ($a === 'null') {
return null;
} elseif (substr($a, 0, 1) === '"') {
// string
return substr($a, 1, strlen($a) - 2);
} elseif (is_numeric($a)) {
if (filter_var($a, FILTER_VALIDATE_INT) !== false) {
return intval($a);
} else {
return floatval($a);
}
} else {
return new Symbol($a);
}
}
}

14
src/MList.php Normal file
View File

@ -0,0 +1,14 @@
<?php
namespace MadLisp;
class MList extends Collection
{
public function get(int $index)
{
if ($this->has($index)) {
return $this->data[$index];
}
throw new MadLispException("list does not contain index $index");
}
}

7
src/MadLispException.php Normal file
View File

@ -0,0 +1,7 @@
<?php
namespace MadLisp;
class MadLispException extends \Exception
{
}

17
src/Symbol.php Normal file
View File

@ -0,0 +1,17 @@
<?php
namespace MadLisp;
class Symbol
{
protected string $name;
public function __construct(string $name)
{
$this->name = $name;
}
public function name(): string
{
return $this->name;
}
}