1
0
Fork 0
lesson-lisp/main.c
2023-05-04 23:23:59 +04:00

857 lines
18 KiB
C

#include "builtins.h"
#include "enums.h"
#include "lexer.h"
#include "object.h"
#include "parser.h"
#include "tokens.h"
#include <assert.h>
#include <stdbool.h>
#include <stddef.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
static void run();
static void test();
int main(int argc, char **argv)
{
assert(argc == 1 || argc == 2);
if (argc == 1) {
run();
} else if (argc == 2 && strcmp(argv[1], "--test") == 0) {
test();
} else {
abort();
}
exit(EXIT_SUCCESS);
}
static struct Object *eval(struct Object *object);
static struct Object *eval_list(struct Object *object);
struct Object *eval(struct Object *const object)
{
// NULL is an empty list, can't eval
assert(object);
// SYMBOL performs lookup
if (object->type == TYPE_SYMBOL) {
struct Object *const procedure = builtins_get(object->s);
if (!procedure) {
printf("NOT FOUND: %s\n", object->s);
}
assert(procedure);
return procedure;
}
// Almost everything evaluates to itself
if (object->type != TYPE_PAIR) return object;
struct Object *const func_expr = object->pair.a;
struct Object *const args = object->pair.b;
if (func_expr && func_expr->type == TYPE_SYMBOL) {
if (strcmp(func_expr->s, "quote") == 0) {
assert(args);
assert(args->type == TYPE_PAIR);
assert(args->pair.b == NULL);
return args->pair.a;
}
if (strcmp(func_expr->s, "if") == 0) {
assert(args);
assert(args->type == TYPE_PAIR);
struct Object *const cond = args->pair.a;
struct Object *const then_else_list = args->pair.b;
assert(then_else_list);
assert(then_else_list->type == TYPE_PAIR);
struct Object *const then_branch = then_else_list->pair.a;
struct Object *const else_list = then_else_list->pair.b;
assert(else_list);
assert(else_list->type == TYPE_PAIR);
struct Object *const else_branch = else_list->pair.a;
assert(else_list->pair.b == NULL);
if (Object_is_false(cond)) {
return eval(else_branch);
} else {
return eval(then_branch);
}
}
}
struct Object *const func = eval(func_expr);
assert(func);
if (func->type == TYPE_PROCEDURE) {
return func->procedure.func(eval_list(args));
} else {
assert(0);
}
}
struct Object *eval_list(struct Object *const object)
{
if (!object) {
return NULL;
} else if (object->type != TYPE_PAIR) {
return eval(object);
} else if (!object->pair.a) {
return Object_new_pair(
NULL,
eval_list(object->pair.b)
);
} else {
return Object_new_pair(
eval(object->pair.a),
eval_list(object->pair.b)
);
}
}
void run()
{
char chr;
while ((chr = getchar()) != EOF) {
lex(chr);
}
printf("\n=== TOKENS =======\n");
for (
const struct Tokens *token = tokens_top();
token;
token = token->next
) {
printf("%s:%s;\n", TokenType_to_str(token->type), token->val);
}
struct Object *const program = parse();
printf("\n=== PROGRAM =======\n");
Object_print(program, 0);
printf("\n=== OUTPUT =======\n");
struct Object *const result = eval(program);
printf("\n\n=== RESULT =======\n");
Object_print(result, 0);
}
// Macros
static void test_if();
// Type predicates
static void test_booleanQN();
static void test_charQN();
static void test_nullQN();
static void test_numberQN();
static void test_pairQN();
static void test_stringQN();
static void test_symbolQN();
// Logical operators
static void test_not();
void test()
{
// Macros
test_if();
// Type predicates
test_booleanQN();
test_charQN();
test_nullQN();
test_numberQN();
test_pairQN();
test_stringQN();
test_symbolQN();
// Logical operators
test_not();
struct Object *const sym_foo = Object_new_symbol("foo");
struct Object *const sharp_true = Object_new_boolean(true);
struct Object *const num_123 = Object_new_number(123);
// #t
// #t
assert(eval(sharp_true) == sharp_true);
// 123
// 123
assert(eval(num_123) == num_123);
// (quote foo)
// 'foo
assert(
eval(
Object_build_list(2, Object_new_symbol("quote"), sym_foo)
) == sym_foo
);
// (quote #t)
// #t
assert(
eval(
Object_build_list(2, Object_new_symbol("quote"), sharp_true)
) == sharp_true
);
// (quote ())
// '()
assert(
eval(
Object_build_list(2, Object_new_symbol("quote"), NULL)
) == NULL
);
// (quote 123)
// 123
assert(
eval(
Object_build_list(2, Object_new_symbol("quote"), num_123)
) == num_123
);
}
void test_if()
{
struct Object *const num_123 = Object_new_number(123);
struct Object *const num_456 = Object_new_number(456);
// (if #t 123 456)
assert(eval(Object_build_list(
4,
Object_new_symbol("if"),
Object_new_boolean(true),
num_123,
num_456
)) == num_123);
// (if "foo" 123 456)
assert(eval(Object_build_list(
4,
Object_new_symbol("if"),
Object_new_string("foo"),
num_123,
num_456
)) == num_123);
// (if #f 123 456)
assert(eval(Object_build_list(
4,
Object_new_symbol("if"),
Object_new_boolean(false),
num_123,
num_456
)) == num_456);
}
void test_booleanQN()
{
// (boolean? '())
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("boolean?"),
NULL
))));
// (boolean? #t)
// #t
assert(Object_is_true(eval(Object_build_list(
2,
Object_new_symbol("boolean?"),
Object_new_boolean(true)
))));
// (boolean? #f)
// #t
assert(Object_is_true(eval(Object_build_list(
2,
Object_new_symbol("boolean?"),
Object_new_boolean(false)
))));
// (boolean? #\n)
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("boolean?"),
Object_new_char('\n')
))));
// (boolean? 'foo)
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("boolean?"),
Object_build_list(
2,
Object_new_symbol("quote"),
Object_new_symbol("foo")
)
))));
// (boolean? "foo")
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("boolean?"),
Object_new_string("foo")
))));
// (boolean? 123)
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("boolean?"),
Object_new_number(123)
))));
// (boolean? (cons 123 456))
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("boolean?"),
Object_build_list(
3,
Object_new_symbol("cons"),
Object_new_number(123),
Object_new_number(456)
)
))));
}
void test_charQN()
{
// (char? '())
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("char?"),
NULL
))));
// (char? #t)
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("char?"),
Object_new_boolean(true)
))));
// (char? #f)
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("char?"),
Object_new_boolean(false)
))));
// (char? #\n)
// #t
assert(Object_is_true(eval(Object_build_list(
2,
Object_new_symbol("char?"),
Object_new_char('\n')
))));
// (char? 'foo)
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("char?"),
Object_build_list(
2,
Object_new_symbol("quote"),
Object_new_symbol("foo")
)
))));
// (char? "foo")
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("char?"),
Object_new_string("foo")
))));
// (char? 123)
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("char?"),
Object_new_number(123)
))));
// (char? (cons 123 456))
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("char?"),
Object_build_list(
3,
Object_new_symbol("cons"),
Object_new_number(123),
Object_new_number(456)
)
))));
}
void test_nullQN()
{
// (null? '())
// #t
assert(Object_is_true(eval(Object_build_list(
2,
Object_new_symbol("null?"),
NULL
))));
// (null? #t)
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("null?"),
Object_new_boolean(true)
))));
// (null? #f)
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("null?"),
Object_new_boolean(false)
))));
// (null? #\n)
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("null?"),
Object_new_char('\n')
))));
// (null? 'foo)
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("null?"),
Object_build_list(
2,
Object_new_symbol("quote"),
Object_new_symbol("foo")
)
))));
// (null? "foo")
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("null?"),
Object_new_string("foo")
))));
// (null? 123)
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("null?"),
Object_new_number(123)
))));
// (null? (cons 123 456))
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("null?"),
Object_build_list(
3,
Object_new_symbol("cons"),
Object_new_number(123),
Object_new_number(456)
)
))));
}
void test_numberQN()
{
// (number? '())
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("number?"),
NULL
))));
// (number? #t)
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("number?"),
Object_new_boolean(true)
))));
// (number? #f)
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("number?"),
Object_new_boolean(false)
))));
// (number? #\n)
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("number?"),
Object_new_char('\n')
))));
// (number? 'foo)
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("number?"),
Object_build_list(
2,
Object_new_symbol("quote"),
Object_new_symbol("foo")
)
))));
// (number? "foo")
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("number?"),
Object_new_string("foo")
))));
// (number? 123)
// #t
assert(Object_is_true(eval(Object_build_list(
2,
Object_new_symbol("number?"),
Object_new_number(123)
))));
// (number? (cons 123 456))
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("number?"),
Object_build_list(
3,
Object_new_symbol("cons"),
Object_new_number(123),
Object_new_number(456)
)
))));
}
void test_pairQN()
{
// (pair? '())
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("pair?"),
NULL
))));
// (pair? #t)
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("pair?"),
Object_new_boolean(true)
))));
// (pair? #f)
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("pair?"),
Object_new_boolean(false)
))));
// (pair? #\n)
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("pair?"),
Object_new_char('\n')
))));
// (pair? 'foo)
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("pair?"),
Object_build_list(
2,
Object_new_symbol("quote"),
Object_new_symbol("foo")
)
))));
// (pair? "foo")
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("pair?"),
Object_new_string("foo")
))));
// (pair? 123)
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("pair?"),
Object_new_number(123)
))));
// (pair? (cons 123 456))
// #t
assert(Object_is_true(eval(Object_build_list(
2,
Object_new_symbol("pair?"),
Object_build_list(
3,
Object_new_symbol("cons"),
Object_new_number(123),
Object_new_number(456)
)
))));
}
void test_stringQN()
{
// (string? '())
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("string?"),
NULL
))));
// (string? #t)
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("string?"),
Object_new_boolean(true)
))));
// (string? #f)
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("string?"),
Object_new_boolean(false)
))));
// (string? #\n)
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("string?"),
Object_new_char('\n')
))));
// (string? 'foo)
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("string?"),
Object_build_list(
2,
Object_new_symbol("quote"),
Object_new_symbol("foo")
)
))));
// (string? "foo")
// #t
assert(Object_is_true(eval(Object_build_list(
2,
Object_new_symbol("string?"),
Object_new_string("foo")
))));
// (string? 123)
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("string?"),
Object_new_number(123)
))));
// (string? (cons 123 456))
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("string?"),
Object_build_list(
3,
Object_new_symbol("cons"),
Object_new_number(123),
Object_new_number(456)
)
))));
}
void test_symbolQN()
{
// (symbol? '())
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("symbol?"),
NULL
))));
// (symbol? #t)
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("symbol?"),
Object_new_boolean(true)
))));
// (symbol? #f)
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("symbol?"),
Object_new_boolean(false)
))));
// (symbol? #\n)
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("symbol?"),
Object_new_char('\n')
))));
// (symbol? 'foo)
// #t
assert(Object_is_true(eval(Object_build_list(
2,
Object_new_symbol("symbol?"),
Object_build_list(
2,
Object_new_symbol("quote"),
Object_new_symbol("foo")
)
))));
// (symbol? "foo")
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("symbol?"),
Object_new_string("foo")
))));
// (symbol? 123)
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("symbol?"),
Object_new_number(123)
))));
// (symbol? (cons 123 456))
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("symbol?"),
Object_build_list(
3,
Object_new_symbol("cons"),
Object_new_number(123),
Object_new_number(456)
)
))));
}
void test_not()
{
// (not '())
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("not"),
NULL
))));
// (not #t)
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("not"),
Object_new_boolean(true)
))));
// (not #f)
// #t
assert(Object_is_true(eval(Object_build_list(
2,
Object_new_symbol("not"),
Object_new_boolean(false)
))));
// (not #\n)
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("not"),
Object_new_char('\n')
))));
// (not 'foo)
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("not"),
Object_build_list(
2,
Object_new_symbol("quote"),
Object_new_symbol("foo")
)
))));
// (not "foo")
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("not"),
Object_new_string("foo")
))));
// (not 123)
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("not"),
Object_new_number(123)
))));
// (not (cons 123 456))
// #f
assert(Object_is_false(eval(Object_build_list(
2,
Object_new_symbol("not"),
Object_build_list(
3,
Object_new_symbol("cons"),
Object_new_number(123),
Object_new_number(456)
)
))));
}