From ec52558397ec16b3528b2408fc857e8ce3e003c2 Mon Sep 17 00:00:00 2001 From: Alex Kotov Date: Sun, 7 May 2023 20:23:35 +0400 Subject: [PATCH] Load modules; define lambdas --- Makefile | 26 ++++++++++++++------------ src/main.c | 47 ++++++++++++++++++++++++++++++++++------------- src/syntax.c | 33 +++++++++++++++++++++++++++------ tests/syntax.scm | 6 ++++++ 4 files changed, 81 insertions(+), 31 deletions(-) diff --git a/Makefile b/Makefile index 0c53fce..99f41d0 100644 --- a/Makefile +++ b/Makefile @@ -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) diff --git a/src/main.c b/src/main.c index e511f1f..423c955 100644 --- a/src/main.c +++ b/src/main.c @@ -12,28 +12,50 @@ #include #include -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); } diff --git a/src/syntax.c b/src/syntax.c index 3077abb..c458e39 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -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 ); diff --git a/tests/syntax.scm b/tests/syntax.scm index faf7434..973a40e 100644 --- a/tests/syntax.scm +++ b/tests/syntax.scm @@ -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))