causa-arcana-misc/lesson-lisp
1
0
Fork 0
Code Activity

Load modules; define lambdas

Browse source
This commit is contained in:
Alex Kotov 2023-05-07 20:23:35 +04:00
parent 727a2ed6ea
commit ec52558397
Signed by: kotovalexarian
GPG key ID: 553C0EBBEB5D5F08
4 changed files with 81 additions and 31 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

26
Makefile
View file

@ -7,6 +7,8 @@ RM_F = rm -f
CFLAGS = -Wall -Wextra
LISP_REQ = -r lib/lists.scm
OBJS = \
src/builtins.c.o \
src/ctype.c.o \
@ -19,20 +21,20 @@ OBJS = \
src/tokens.c.o
repl: arcana-lisp
./arcana-lisp
./arcana-lisp $(LISP_REQ)
test: arcana-lisp
$(CAT) tests/arcana/builtin.scm | ./arcana-lisp
$(CAT) tests/arcana/tokenize.scm | ./arcana-lisp
$(CAT) tests/arcana/typeof.scm | ./arcana-lisp
$(CAT) tests/arcana/parse.scm | ./arcana-lisp
$(CAT) tests/arithm_ops.scm | ./arcana-lisp
$(CAT) tests/basic_data_structs.scm | ./arcana-lisp
$(CAT) tests/equiv.scm | ./arcana-lisp
$(CAT) tests/logic_ops.scm | ./arcana-lisp
$(CAT) tests/syntax.scm | ./arcana-lisp
$(CAT) tests/type_conv.scm | ./arcana-lisp
$(CAT) tests/type_preds.scm | ./arcana-lisp
$(CAT) tests/arcana/builtin.scm | ./arcana-lisp $(LISP_REQ)
$(CAT) tests/arcana/tokenize.scm | ./arcana-lisp $(LISP_REQ)
$(CAT) tests/arcana/typeof.scm | ./arcana-lisp $(LISP_REQ)
$(CAT) tests/arcana/parse.scm | ./arcana-lisp $(LISP_REQ)
$(CAT) tests/arithm_ops.scm | ./arcana-lisp $(LISP_REQ)
$(CAT) tests/basic_data_structs.scm | ./arcana-lisp $(LISP_REQ)
$(CAT) tests/equiv.scm | ./arcana-lisp $(LISP_REQ)
$(CAT) tests/logic_ops.scm | ./arcana-lisp $(LISP_REQ)
$(CAT) tests/syntax.scm | ./arcana-lisp $(LISP_REQ)
$(CAT) tests/type_conv.scm | ./arcana-lisp $(LISP_REQ)
$(CAT) tests/type_preds.scm | ./arcana-lisp $(LISP_REQ)
clean:
$(RM_F) arcana-lisp $(OBJS)

47
src/main.c
View file

@ -12,28 +12,50 @@
#include <string.h>
#include <unistd.h>
static void repl();
static void script();
static void repl(struct Object *environment);
static void script(FILE *file, struct Object *environment);
int main()
int main(int argc, char **argv)
{
const bool is_tty = isatty(fileno(stdin));
struct Object *const environment = Object_new_pair(NULL, NULL);
if (is_tty) {
repl();
int index = 1;
for (; index < argc; ++index) {
if (strcmp(argv[index], "-r") == 0) {
++index;
assert(index < argc);
FILE *const file = fopen(argv[index], "r");
assert(file);
script(file, environment);
fclose(file);
} else {
break;
}
}
if (index < argc) {
for (; index < argc; ++index) {
FILE *const file = fopen(argv[index], "r");
assert(file);
script(file, environment);
fclose(file);
}
} else {
script();
const bool is_tty = isatty(fileno(stdin));
if (is_tty) {
repl(environment);
} else {
script(stdin, environment);
}
}
exit(EXIT_SUCCESS);
}
void repl()
void repl(struct Object *const environment)
{
printf("Lisp by Causa Arcana\n\n");
struct Object *const environment = Object_new_pair(NULL, NULL);
while (true) {
Tokens tokens = Tokens_new();
assert(tokens);
@ -76,7 +98,7 @@ void repl()
}
}
void script()
void script(FILE *const file, struct Object *const environment)
{
Tokens tokens = Tokens_new();
assert(tokens);
@ -85,7 +107,7 @@ void script()
assert(lexer);
while (true) {
const char chr = getchar();
const char chr = getc(file);
if (chr == EOF) break;
Lexer_lex(lexer, chr);
}
@ -102,6 +124,5 @@ void script()
if (program == NULL) return;
struct Object *const environment = Object_new_pair(NULL, NULL);
syntax_script(program, environment);
}

33
src/syntax.c
View file

@ -45,18 +45,39 @@ struct Object *syntax_define(
struct Object *const args,
struct Object *const environment
) {
assert(Object_is_pair(environment));
assert(OBJECT_IS_NULL(environment->pair.cdr));
assert(OBJECT_IS_LIST_HEAD(environment->pair.car));
assert(Object_is_pair(args));
struct Object *const name = args->pair.car;
assert(Object_is_symbol(name));
struct Object *const name_and_args = args->pair.car;
assert(Object_is_pair(args->pair.cdr));
struct Object *const value_expr = args->pair.cdr->pair.car;
assert(OBJECT_IS_NULL(args->pair.cdr->pair.cdr));
assert(Object_is_pair(environment));
assert(OBJECT_IS_NULL(environment->pair.cdr));
assert(OBJECT_IS_LIST_HEAD(environment->pair.car));
struct Object *name = NULL;
struct Object *value = NULL;
// Variable
if (Object_is_symbol(name_and_args)) {
name = name_and_args;
value = eval(value_expr, environment);
}
// Lambda
else {
assert(Object_is_pair(name_and_args));
name = name_and_args->pair.car;
assert(Object_is_symbol(name));
struct Object *const arg_names = name_and_args->pair.cdr;
assert(OBJECT_IS_LIST_HEAD(arg_names));
value = Object_new_lambda(name->s, arg_names, value_expr, environment);
}
environment->pair.car = Object_new_pair(
Object_new_pair(name, eval(value_expr, environment)),
Object_new_pair(name, value),
environment->pair.car
);

6
tests/syntax.scm
View file

@ -18,6 +18,12 @@
(define old x)
(define x 456)
(list old x)))
(assert-equal
5
(begin
(define (sum a b) (+ a b))
(define (inc a) (+ a 1))
(sum (inc 1) (inc 2))))
;;; if ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(assert-equal 123 (if #true 123 456))