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

47
src/main.c
View file

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

6
tests/syntax.scm
View file

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