From 219c94c7eb7448bfc86602579de3765216888297 Mon Sep 17 00:00:00 2001 From: LLLL Colonq Date: Fri, 19 Dec 2025 16:24:15 -0500 Subject: Update --- Makefile | 37 ++--- flake.nix | 1 + include/lcq/pit/lexer.h | 34 +++++ include/lcq/pit/library.h | 10 ++ include/lcq/pit/parser.h | 21 +++ include/lcq/pit/runtime.h | 214 +++++++++++++++++++++++++++ include/lcq/pit/types.h | 17 +++ include/lcq/pit/utils.h | 12 ++ src/lexer.c | 15 +- src/lexer.h | 34 ----- src/library.c | 367 +++++++++++++++++++++++++++++++++++----------- src/library.h | 8 - src/main.c | 9 +- src/parser.c | 24 +-- src/parser.h | 21 --- src/runtime.c | 187 +++++++++++------------ src/runtime.h | 206 -------------------------- src/types.h | 17 --- src/utils.c | 2 +- src/utils.h | 13 -- test2.lisp | 1 + test3.lisp | 6 + 22 files changed, 723 insertions(+), 533 deletions(-) create mode 100644 include/lcq/pit/lexer.h create mode 100644 include/lcq/pit/library.h create mode 100644 include/lcq/pit/parser.h create mode 100644 include/lcq/pit/runtime.h create mode 100644 include/lcq/pit/types.h create mode 100644 include/lcq/pit/utils.h delete mode 100644 src/lexer.h delete mode 100644 src/library.h delete mode 100644 src/parser.h delete mode 100644 src/runtime.h delete mode 100644 src/types.h delete mode 100644 src/utils.h create mode 100644 test2.lisp create mode 100644 test3.lisp diff --git a/Makefile b/Makefile index 619da0f..0735e0a 100644 --- a/Makefile +++ b/Makefile @@ -1,15 +1,16 @@ -SRCS := src/utils.c src/lexer.c src/parser.c src/runtime.c src/library.c -HEADERS := $(wildcard src/*.h) -OBJECTS := $(SRCS:src/%.c=build/%.o) -EXE := pit -LIB := libcolonq-pit.a - CC ?= gcc AR ?= ar CHK_SOURCES ?= src/main.c $(SRCS) CPPFLAGS ?= -MMD -MP -CFLAGS ?= --std=c89 -g -Ideps/ -Isrc/ -Wall -Wextra -Wpedantic -Wconversion -Wformat-security -Wshadow -Wpointer-arith -Wstrict-prototypes -Wmissing-prototypes -Wnull-dereference -Wfloat-equal -Wundef -Wpointer-arith -Wbad-function-cast -Wlogical-op -Wmissing-braces -Wcast-align -Wstrict-overflow=5 -ftrapv -LDFLAGS ?= -g -static +CFLAGS ?= -flto -ffat-lto-objects -march=native --std=c99 -g -Ideps/ -Isrc/ -Iinclude/ -Wall -Wextra -Wpedantic -Wconversion -Wformat-security -Wshadow -Wpointer-arith -Wstrict-prototypes -Wmissing-prototypes -Wnull-dereference -Wfloat-equal -Wundef -Wpointer-arith -Wbad-function-cast -Wlogical-op -Wmissing-braces -Wcast-align -Wstrict-overflow=5 -ftrapv +LDFLAGS ?= -flto -g -static + +BUILD = build_$(CC) + +SRCS := src/utils.c src/lexer.c src/parser.c src/runtime.c src/library.c +OBJECTS := $(SRCS:src/%.c=$(BUILD)/%.o) +EXE := pit +LIB := libcolonq-pit.a prefix ?= /usr/local exec_prefix ?= $(prefix) @@ -21,32 +22,34 @@ libdir ?= $(exec_prefix)/lib all: $(EXE) $(LIB) -$(EXE): build/main.o $(LIB) +$(EXE): $(BUILD)/main.o $(LIB) $(CC) -o $@ $^ $(LDFLAGS) $(LIB): $(OBJECTS) ar rcs $@ $^ -build: - mkdir build/ +$(BUILD): + mkdir $(BUILD)/ -build/%.o: src/%.c | build +$(BUILD)/%.o: src/%.c | $(BUILD) $(CC) $(CPPFLAGS) $(CFLAGS) -o $@ -c $< clean: -rm $(EXE) - -rm -r build/ + -rm $(LIB) + -rm -r $(BUILD)/ TAGS: $(SRCS) - etags $^ + ctags --output-format=etags $^ install: $(EXE) $(LIB) mkdir -p $(DESTDIR)$(bindir) $(DESTDIR)$(libdir) $(DESTDIR)$(includedir) - install $(EXE) $(DESTDIR)$(bindir)/pit - install $(LIB) $(DESTDIR)$(libdir)/libpit.a - install $(HEADERS) $(DESTDIR)$(includedir) + install $(EXE) $(DESTDIR)$(bindir)/$(EXE) + install $(LIB) $(DESTDIR)$(libdir)/$(LIB) + cp -r include/* $(DESTDIR)$(includedir) check-syntax: TAGS gcc $(CFLAGS) -fsyntax-only $(CHK_SOURCES) +-include $(BUILD)/main.d -include $(OBJECTS:.o=.d) diff --git a/flake.nix b/flake.nix index a3a7f4f..60c1dde 100644 --- a/flake.nix +++ b/flake.nix @@ -28,6 +28,7 @@ buildInputs = [ pkgs.musl pkgs.valgrind + pkgs.universal-ctags ]; }; } diff --git a/include/lcq/pit/lexer.h b/include/lcq/pit/lexer.h new file mode 100644 index 0000000..d6e4611 --- /dev/null +++ b/include/lcq/pit/lexer.h @@ -0,0 +1,34 @@ +#ifndef LCOLONQ_PIT_LEXER_H +#define LCOLONQ_PIT_LEXER_H + +#include + +typedef enum { + PIT_LEX_TOKEN_ERROR=-1, + PIT_LEX_TOKEN_EOF=0, + PIT_LEX_TOKEN_LPAREN, + PIT_LEX_TOKEN_RPAREN, + PIT_LEX_TOKEN_DOT, + PIT_LEX_TOKEN_QUOTE, + PIT_LEX_TOKEN_INTEGER_LITERAL, + PIT_LEX_TOKEN_STRING_LITERAL, + PIT_LEX_TOKEN_SYMBOL, + PIT_LEX_TOKEN__SENTINEL +} pit_lex_token; + +typedef struct { + char *input; + i64 len; /* length of input */ + i64 start, end; /* bounds of the current token */ + i64 line, column; /* for error reporting only; current line and column */ + i64 start_line, start_column; /* for error reporting only; line and column of token start */ + char *error; +} pit_lexer; + +void pit_lex_cstr(pit_lexer *ret, char *buf); +void pit_lex_bytes(pit_lexer *ret, char *buf, i64 len); +void pit_lex_file(pit_lexer *ret, char *path); +pit_lex_token pit_lex_next(pit_lexer *st); +const char *pit_lex_token_name(pit_lex_token t); + +#endif diff --git a/include/lcq/pit/library.h b/include/lcq/pit/library.h new file mode 100644 index 0000000..ff325dc --- /dev/null +++ b/include/lcq/pit/library.h @@ -0,0 +1,10 @@ +#ifndef LCOLONQ_PIT_LIBRARY_H +#define LCOLONQ_PIT_LIBRARY_H + +#include + +void pit_install_library_essential(pit_runtime *rt); +void pit_install_library_io(pit_runtime *rt); +void pit_install_library_bytestring(pit_runtime *rt); + +#endif diff --git a/include/lcq/pit/parser.h b/include/lcq/pit/parser.h new file mode 100644 index 0000000..c2f1597 --- /dev/null +++ b/include/lcq/pit/parser.h @@ -0,0 +1,21 @@ +#ifndef LCOLONQ_PIT_PARSER_H +#define LCOLONQ_PIT_PARSER_H + +#include +#include + +typedef struct { + pit_lex_token token; + i64 start, end; + i64 line, column; /* for error reporting */ +} pit_parser_token_info; + +typedef struct { + pit_lexer *lexer; + pit_parser_token_info cur, next; +} pit_parser; + +void pit_parser_from_lexer(pit_parser *ret, pit_lexer *lex); +pit_value pit_parse(pit_runtime *rt, pit_parser *st, bool *eof); + +#endif diff --git a/include/lcq/pit/runtime.h b/include/lcq/pit/runtime.h new file mode 100644 index 0000000..a8b6593 --- /dev/null +++ b/include/lcq/pit/runtime.h @@ -0,0 +1,214 @@ +#ifndef LCOLONQ_PIT_RUNTIME_H +#define LCOLONQ_PIT_RUNTIME_H + +#include +#include +#include + +struct pit_runtime; + +/* arenas */ +typedef struct { + i64 elem_size, capacity, next; + u8 data[]; +} pit_arena; +pit_arena *pit_arena_new(i64 capacity, i64 elem_size); +i32 pit_arena_next_idx(pit_arena *a); +i32 pit_arena_alloc_idx(pit_arena *a); +i32 pit_arena_alloc_bulk_idx(pit_arena *a, i64 num); +void *pit_arena_idx(pit_arena *a, i32 idx); +void *pit_arena_alloc(pit_arena *a); +void *pit_arena_alloc_bulk(pit_arena *a, i64 num); + +/* nil is always the symbol with index 0 */ +#define PIT_NIL 0xfff4000000000000 /* 0b1111111111110100000000000000000000000000000000000000000000000000 */ +#define PIT_T 0xfff4000000000001 /* 0b1111111111110100000000000000000000000000000000000000000000000001 */ + +enum pit_value_sort { + PIT_VALUE_SORT_DOUBLE = 0, /* 0b00 - double */ + PIT_VALUE_SORT_INTEGER = 1, /* 0b01 - NaN-boxed 49-bit integer */ + PIT_VALUE_SORT_SYMBOL = 2, /* 0b10 - NaN-boxed index into symbol table */ + PIT_VALUE_SORT_REF = 3 /* 0b11 - NaN-boxed index into "heavy object" arena */ +}; +typedef i32 pit_symbol; /* a symbol at runtime is an index into the runtime's symbol table */ +typedef i32 pit_ref; /* a reference is an index into the runtime's arena */ +typedef u64 pit_value; +enum pit_value_sort pit_value_sort(pit_value v); +u64 pit_value_data(pit_value v); + +typedef struct { + i64 top, cap; + pit_value data[]; +} pit_values; +pit_values *pit_values_new(i64 capacity); +void pit_values_push(struct pit_runtime *rt, pit_values *s, pit_value x); +pit_value pit_values_pop(struct pit_runtime *rt, pit_values *s); + +typedef pit_value (*pit_nativefunc)(struct pit_runtime *rt, pit_value args); +typedef struct { /* "heavy" values, the targets of refs */ + enum pit_value_heavy_sort { + PIT_VALUE_HEAVY_SORT_CELL=0, /* value cell - basically, a "location" referred to by a variable binding */ + PIT_VALUE_HEAVY_SORT_CONS, /* cons cell - a pair of two values */ + PIT_VALUE_HEAVY_SORT_ARRAY, /* fixed-size array of values */ + PIT_VALUE_HEAVY_SORT_BYTES, /* bytestring */ + PIT_VALUE_HEAVY_SORT_FUNC, /* Lisp closure */ + PIT_VALUE_HEAVY_SORT_NATIVEFUNC, /* native function */ + PIT_VALUE_HEAVY_SORT_NATIVEDATA /* native data (C pointer) */ + } hsort; + union { + pit_value cell; + struct { pit_value car, cdr; } cons; + struct { pit_value *data; i64 len; } array; + struct { u8 *data; i64 len; } bytes; + struct { pit_value env; pit_value args; pit_value body; } func; + pit_nativefunc nativefunc; + struct { pit_value tag; void *data; } nativedata; + } in; +} pit_value_heavy; + +typedef struct { + pit_value name; /* ref to bytestring */ + pit_value value; /* ref to cell */ + pit_value function; /* ref to cell */ + bool is_macro, is_special_form; +} pit_symtab_entry; + +/* "programs"; vectors of "instructions" for a very simple VM used by the evaluator */ +typedef struct { + enum { + EVAL_PROGRAM_ENTRY_LITERAL, + EVAL_PROGRAM_ENTRY_APPLY + } sort; + union { + pit_value literal; + i64 apply; /* arity of application */ + } in; +} pit_runtime_eval_program_entry; +typedef struct { + i64 top, cap; + pit_runtime_eval_program_entry data[]; +} pit_runtime_eval_program; +pit_runtime_eval_program *pit_runtime_eval_program_new(i64 capacity); +void pit_runtime_eval_program_push_literal(struct pit_runtime *rt, pit_runtime_eval_program *s, pit_value x); +void pit_runtime_eval_program_push_apply(struct pit_runtime *rt, pit_runtime_eval_program *s, i64 arity); + +typedef struct pit_runtime { + /* interpreter state */ + pit_arena *values; /* all heavy values - effectively an array of pit_value_heavy - MUTABLE! */ + pit_arena *bytes; /* all bytestrings (including symbol names) - immutable */ + pit_arena *symtab; i64 symtab_len; /* all symbols - effectively an array of pit_symtab_entry - MUTABLE! */ + /* temporary/"scratch" memory */ + pit_arena *scratch; /* temporary arena used during parsing and evaluation */ + pit_values *saved_bindings; /* stack used to save old values of bindings to be restored ("shallow binding") */ + pit_values *expr_stack; /* stack of subexpressions to evaluate during evaluation */ + pit_values *result_stack; /* stack of intermediate values during evaluation */ + pit_runtime_eval_program *program; /* intermediate stack-based program constructed during evaluation */ + /* bookkeeping */ + /* "frozen" values offsets: values before these offsets are immutable, and we can reset here later */ + i64 frozen_values, frozen_bytes, frozen_symtab; + pit_value error; /* error value - if this is non-nil, an error has occured! only tracks the first error */ + i64 source_line, source_column; /* for error reporting only; line and column of token start */ + i64 error_line, error_column; /* line and column of token start at time of error */ +} pit_runtime; +pit_runtime *pit_runtime_new(void); + +void pit_runtime_freeze(pit_runtime *rt); /* freeze the runtime at the current point - everything currently defined becomes immutable */ +void pit_runtime_reset(pit_runtime *rt); /* restore the runtime to the frozen point, resetting everything that has happened since */ +bool pit_runtime_print_error(pit_runtime *rt); /* return true if an error has occured, and print to stderr */ + +i64 pit_dump(pit_runtime *rt, char *buf, i64 len, pit_value v, bool readable); /* if readable is true, try to produce output that can be machine-read (quotes on strings, etc) */ +#define pit_trace(rt, v) pit_trace_(rt, "Trace [" __FILE__ ":" PIT_STR(__LINE__) "] %s\n", v) +void pit_trace_(pit_runtime *rt, const char *format, pit_value v); +void pit_error(pit_runtime *rt, const char *format, ...); + +/* working with small values */ +pit_value pit_value_new(pit_runtime *rt, enum pit_value_sort s, u64 data); +double pit_as_double(pit_runtime *rt, pit_value v); +pit_value pit_double_new(pit_runtime *rt, double d); +i64 pit_as_integer(pit_runtime *rt, pit_value v); +pit_value pit_integer_new(pit_runtime *rt, i64 i); +pit_symbol pit_as_symbol(pit_runtime *rt, pit_value v); +pit_value pit_symbol_new(pit_runtime *rt, pit_symbol s); +pit_ref pit_as_ref(pit_runtime *rt, pit_value v); +pit_value pit_ref_new(pit_runtime *rt, pit_ref r); + +/* working with heavy values and refs */ +pit_value pit_heavy_new(pit_runtime *rt); +pit_value_heavy *pit_deref(pit_runtime *rt, pit_ref p); + +/* convenient predicates */ +bool pit_is_integer(pit_runtime *rt, pit_value a); +bool pit_is_double(pit_runtime *rt, pit_value a); +bool pit_is_symbol(pit_runtime *rt, pit_value a); +bool pit_is_value_heavy_sort(pit_runtime *rt, pit_value a, enum pit_value_heavy_sort e); +bool pit_is_cell(pit_runtime *rt, pit_value a); +bool pit_is_cons(pit_runtime *rt, pit_value a); +bool pit_is_array(pit_runtime *rt, pit_value a); +bool pit_is_bytes(pit_runtime *rt, pit_value a); +bool pit_is_func(pit_runtime *rt, pit_value a); +bool pit_is_nativefunc(pit_runtime *rt, pit_value a); +bool pit_is_nativedata(pit_runtime *rt, pit_value a); +bool pit_eq(pit_value a, pit_value b); +bool pit_equal(pit_runtime *rt, pit_value a, pit_value b); + +/* working with binary data */ +pit_value pit_bytes_new(pit_runtime *rt, u8 *buf, i64 len); +pit_value pit_bytes_new_cstr(pit_runtime *rt, char *s); +pit_value pit_bytes_new_file(pit_runtime *rt, char *path); +bool pit_bytes_match(pit_runtime *rt, pit_value v, u8 *buf, i64 len); +i64 pit_as_bytes(pit_runtime *rt, pit_value v, u8 *buf, i64 maxlen); +bool pit_lexer_from_bytes(pit_runtime *rt, pit_lexer *ret, pit_value v); +pit_value pit_read_bytes(pit_runtime *rt, pit_value v); + +/* working with the symbol table */ +pit_value pit_intern(pit_runtime *rt, u8 *nm, i64 len); +pit_value pit_intern_cstr(pit_runtime *rt, char *nm); +bool pit_symbol_name_match(pit_runtime *rt, pit_value sym, u8 *buf, i64 len); +bool pit_symbol_name_match_cstr(pit_runtime *rt, pit_value sym, char *s); +pit_symtab_entry *pit_symtab_lookup(pit_runtime *rt, pit_value sym); +pit_value pit_get_value_cell(pit_runtime *rt, pit_value sym); +pit_value pit_get_function_cell(pit_runtime *rt, pit_value sym); +pit_value pit_get(pit_runtime *rt, pit_value sym); +void pit_set(pit_runtime *rt, pit_value sym, pit_value v); +pit_value pit_fget(pit_runtime *rt, pit_value sym); +void pit_fset(pit_runtime *rt, pit_value sym, pit_value v); +bool pit_is_symbol_macro(pit_runtime *rt, pit_value sym); +void pit_symbol_is_macro(pit_runtime *rt, pit_value sym); +void pit_mset(pit_runtime *rt, pit_value sym, pit_value v); +bool pit_is_symbol_special_form(pit_runtime *rt, pit_value sym); +void pit_symbol_is_special_form(pit_runtime *rt, pit_value sym); +void pit_sfset(pit_runtime *rt, pit_value sym, pit_value v); +void pit_bind(pit_runtime *rt, pit_value sym, pit_value v); +pit_value pit_unbind(pit_runtime *rt, pit_value sym); + +/* working with cells */ +pit_value pit_cell_new(pit_runtime *rt, pit_value v); +pit_value pit_cell_get(pit_runtime *rt, pit_value cell); +void pit_cell_set(pit_runtime *rt, pit_value cell, pit_value v); + +/* working with cons cells */ +pit_value pit_cons(pit_runtime *rt, pit_value car, pit_value cdr); +pit_value pit_list(pit_runtime *rt, i64 num, ...); +pit_value pit_car(pit_runtime *rt, pit_value v); +pit_value pit_cdr(pit_runtime *rt, pit_value v); +void pit_setcar(pit_runtime *rt, pit_value v, pit_value x); +void pit_setcdr(pit_runtime *rt, pit_value v, pit_value x); +pit_value pit_append(pit_runtime *rt, pit_value xs, pit_value ys); +pit_value pit_reverse(pit_runtime *rt, pit_value xs); +pit_value pit_contains_eq(pit_runtime *rt, pit_value needle, pit_value haystack); + +/* working with functions */ +pit_value pit_free_vars(pit_runtime *rt, pit_value args, pit_value body); +pit_value pit_lambda(pit_runtime *rt, pit_value args, pit_value body); +pit_value pit_nativefunc_new(pit_runtime *rt, pit_nativefunc f); +pit_value pit_apply(pit_runtime *rt, pit_value f, pit_value args); + +/* working with native data */ +pit_value pit_nativedata_new(pit_runtime *rt, pit_value tag, void *d); + + +/* evaluation! */ +pit_value pit_expand_macros(pit_runtime *rt, pit_value top); +pit_value pit_eval(pit_runtime *rt, pit_value e); + +#endif diff --git a/include/lcq/pit/types.h b/include/lcq/pit/types.h new file mode 100644 index 0000000..384dc77 --- /dev/null +++ b/include/lcq/pit/types.h @@ -0,0 +1,17 @@ +#ifndef LCOLONQ_PIT_TYPES_H +#define LCOLONQ_PIT_TYPES_H + +#include +#include + +typedef int8_t i8; +typedef int16_t i16; +typedef int32_t i32; +typedef int64_t i64; + +typedef uint8_t u8; +typedef uint16_t u16; +typedef uint32_t u32; +typedef uint64_t u64; + +#endif diff --git a/include/lcq/pit/utils.h b/include/lcq/pit/utils.h new file mode 100644 index 0000000..36c74c1 --- /dev/null +++ b/include/lcq/pit/utils.h @@ -0,0 +1,12 @@ +#ifndef LCOLONQ_PIT_UTILS_H +#define LCOLONQ_PIT_UTILS_H + +#include + +#define PIT_STRSTR(x) #x +#define PIT_STR(x) PIT_STRSTR(x) +void pit_panic(const char *format, ...); +void pit_debug(const char *format, ...); +#define pit_mul(result, a, b) if (ckd_mul(result, a, b)) pit_panic("integer overflow during multiplication%s",""); + +#endif diff --git a/src/lexer.c b/src/lexer.c index ac59400..019dcc5 100644 --- a/src/lexer.c +++ b/src/lexer.c @@ -3,9 +3,9 @@ #include #include -#include "utils.h" -#include "lexer.h" -#include "types.h" +#include +#include +#include const char *PIT_LEX_TOKEN_NAMES[PIT_LEX_TOKEN__SENTINEL] = { /* [PIT_LEX_TOKEN_EOF] = */ "eof", @@ -77,16 +77,14 @@ void pit_lex_bytes(pit_lexer *ret, char *buf, i64 len) { } void pit_lex_file(pit_lexer *ret, char *path) { FILE *f = fopen(path, "r"); - i64 len = 0; - char *buf = NULL; if (f == NULL) { pit_panic("failed to open file for lexing: %s", path); return; } fseek(f, 0, SEEK_END); - len = ftell(f); + i64 len = ftell(f); fseek(f, 0, SEEK_SET); - buf = calloc((size_t) ret->len, sizeof(char)); + char *buf = calloc((size_t) ret->len, sizeof(char)); if ((size_t) ret->len != fread(ret->input, sizeof(char), (size_t) ret->len, f)) { pit_panic("failed to read file for lexing: %s", path); return; @@ -96,12 +94,11 @@ void pit_lex_file(pit_lexer *ret, char *path) { } pit_lex_token pit_lex_next(pit_lexer *st) { - char c = 0; restart: st->start = st->end; st->start_line = st->line; st->start_column = st->column; - c = advance(st); + char c = advance(st); switch (c) { case 0: return PIT_LEX_TOKEN_EOF; case ';': while (is_more_input(st) && advance(st) != '\n'); goto restart; diff --git a/src/lexer.h b/src/lexer.h deleted file mode 100644 index 19f8d71..0000000 --- a/src/lexer.h +++ /dev/null @@ -1,34 +0,0 @@ -#ifndef LEXER_H -#define LEXER_H - -#include "types.h" - -typedef enum { - PIT_LEX_TOKEN_ERROR=-1, - PIT_LEX_TOKEN_EOF=0, - PIT_LEX_TOKEN_LPAREN, - PIT_LEX_TOKEN_RPAREN, - PIT_LEX_TOKEN_DOT, - PIT_LEX_TOKEN_QUOTE, - PIT_LEX_TOKEN_INTEGER_LITERAL, - PIT_LEX_TOKEN_STRING_LITERAL, - PIT_LEX_TOKEN_SYMBOL, - PIT_LEX_TOKEN__SENTINEL -} pit_lex_token; - -typedef struct { - char *input; - i64 len; /* length of input */ - i64 start, end; /* bounds of the current token */ - i64 line, column; /* for error reporting only; current line and column */ - i64 start_line, start_column; /* for error reporting only; line and column of token start */ - char *error; -} pit_lexer; - -void pit_lex_cstr(pit_lexer *ret, char *buf); -void pit_lex_bytes(pit_lexer *ret, char *buf, i64 len); -void pit_lex_file(pit_lexer *ret, char *path); -pit_lex_token pit_lex_next(pit_lexer *st); -const char *pit_lex_token_name(pit_lex_token t); - -#endif diff --git a/src/library.c b/src/library.c index de15db7..3175e27 100644 --- a/src/library.c +++ b/src/library.c @@ -1,15 +1,16 @@ #include +#include +#include -#include "lexer.h" -#include "parser.h" -#include "runtime.h" -#include "library.h" +#include +#include +#include +#include static pit_value impl_sf_quote(pit_runtime *rt, pit_value args) { pit_runtime_eval_program_push_literal(rt, rt->program, pit_car(rt, args)); return PIT_NIL; } - static pit_value impl_sf_if(pit_runtime *rt, pit_value args) { pit_value c = pit_car(rt, args); if (pit_eval(rt, c) != PIT_NIL) { @@ -19,7 +20,6 @@ static pit_value impl_sf_if(pit_runtime *rt, pit_value args) { } return PIT_NIL; } - static pit_value impl_sf_progn(pit_runtime *rt, pit_value args) { pit_value bodyforms = args; pit_value final = PIT_NIL; @@ -30,34 +30,30 @@ static pit_value impl_sf_progn(pit_runtime *rt, pit_value args) { pit_runtime_eval_program_push_literal(rt, rt->program, final); return PIT_NIL; } - static pit_value impl_sf_lambda(pit_runtime *rt, pit_value args) { pit_value as = pit_car(rt, args); pit_value body = pit_cdr(rt, args); pit_runtime_eval_program_push_literal(rt, rt->program, pit_lambda(rt, as, body)); return PIT_NIL; } - static pit_value impl_m_defun(pit_runtime *rt, pit_value args) { pit_value nm = pit_car(rt, args); pit_value as = pit_car(rt, pit_cdr(rt, args)); pit_value body = pit_cdr(rt, pit_cdr(rt, args)); return pit_list(rt, 3, - pit_intern_cstr(rt, "fset"), + pit_intern_cstr(rt, "fset!"), pit_list(rt, 2, pit_intern_cstr(rt, "quote"), nm), pit_cons(rt, pit_intern_cstr(rt, "lambda"), pit_cons(rt, as, body)) ); } - static pit_value impl_m_defmacro(pit_runtime *rt, pit_value args) { pit_value nm = pit_car(rt, args); return pit_list(rt, 3, pit_intern_cstr(rt, "progn"), - pit_cons(rt, pit_intern_cstr(rt, "defun"), args), - pit_list(rt, 2, pit_intern_cstr(rt, "set-symbol-macro"), nm) + pit_cons(rt, pit_intern_cstr(rt, "defun!"), args), + pit_list(rt, 2, pit_intern_cstr(rt, "set-symbol-macro!"), nm) ); } - static pit_value impl_m_let(pit_runtime *rt, pit_value args) { pit_value lparams = PIT_NIL; pit_value largs = PIT_NIL; @@ -76,7 +72,6 @@ static pit_value impl_m_let(pit_runtime *rt, pit_value args) { application = pit_cons(rt, lambda, largs); return application; } - static pit_value impl_m_and(pit_runtime *rt, pit_value args) { pit_value ret = PIT_NIL; args = pit_reverse(rt, args); @@ -90,40 +85,35 @@ static pit_value impl_m_and(pit_runtime *rt, pit_value args) { } return ret; } - static pit_value impl_m_setq(pit_runtime *rt, pit_value args) { pit_value sym = pit_car(rt, args); pit_value v = pit_car(rt, pit_cdr(rt, args)); return pit_list(rt, 3, - pit_intern_cstr(rt, "set"), + pit_intern_cstr(rt, "set!"), pit_list(rt, 2, pit_intern_cstr(rt, "quote"), sym), v ); } - static pit_value impl_set(pit_runtime *rt, pit_value args) { pit_value sym = pit_car(rt, args); pit_value v = pit_car(rt, pit_cdr(rt, args)); pit_set(rt, sym, v); return v; } - static pit_value impl_fset(pit_runtime *rt, pit_value args) { pit_value sym = pit_car(rt, args); pit_value v = pit_car(rt, pit_cdr(rt, args)); pit_fset(rt, sym, v); return v; } - static pit_value impl_symbol_is_macro(pit_runtime *rt, pit_value args) { pit_value sym = pit_car(rt, args); pit_symbol_is_macro(rt, sym); return PIT_NIL; } - static pit_value impl_funcall(pit_runtime *rt, pit_value args) { pit_value fsym = pit_car(rt, args); - pit_value f; + pit_value f = PIT_NIL; if (pit_is_symbol(rt, fsym)) { f = pit_fget(rt, fsym); } else { @@ -134,37 +124,40 @@ static pit_value impl_funcall(pit_runtime *rt, pit_value args) { } return pit_apply(rt, f, pit_cdr(rt, args)); } - static pit_value impl_eval(pit_runtime *rt, pit_value args) { + return pit_eval(rt, pit_car(rt, args)); +} +static pit_value impl_eq_p(pit_runtime *rt, pit_value args) { pit_value x = pit_car(rt, args); - return pit_eval(rt, x); + pit_value y = pit_car(rt, pit_cdr(rt, args)); + return pit_eq(x, y); } - -static pit_value impl_load(pit_runtime *rt, pit_value args) { - pit_value path = pit_car(rt, args); - char pathbuf[1024] = {0}; - i64 len = pit_as_bytes(rt, path, (u8 *) pathbuf, sizeof(pathbuf) - 1); - pit_value bs, ret, p; - pit_lexer lex; - pit_parser parse; - bool eof; - if (len < 0) { pit_error(rt, "path was not a string"); return PIT_NIL; } - pathbuf[len] = 0; - bs = pit_bytes_new_file(rt, pathbuf); - if (!pit_lexer_from_bytes(rt, &lex, bs)) { - pit_error(rt, "failed to initialize lexer"); - return PIT_NIL; - } - pit_parser_from_lexer(&parse, &lex); - ret = PIT_NIL; - eof = false; - p = PIT_NIL; - while (p = pit_parse(rt, &parse, &eof), !eof) { - ret = pit_eval(rt, p); - } - return ret; +static pit_value impl_equal_p(pit_runtime *rt, pit_value args) { + pit_value x = pit_car(rt, args); + pit_value y = pit_car(rt, pit_cdr(rt, args)); + return pit_equal(rt, x, y); +} +static pit_value impl_integer_p(pit_runtime *rt, pit_value args) { + return pit_is_integer(rt, pit_car(rt, args)); +} +static pit_value impl_double_p(pit_runtime *rt, pit_value args) { + return pit_is_double(rt, pit_car(rt, args)); +} +static pit_value impl_symbol_p(pit_runtime *rt, pit_value args) { + return pit_is_symbol(rt, pit_car(rt, args)); +} +static pit_value impl_cons_p(pit_runtime *rt, pit_value args) { + return pit_is_cons(rt, pit_car(rt, args)); +} +static pit_value impl_array_p(pit_runtime *rt, pit_value args) { + return pit_is_array(rt, pit_car(rt, args)); +} +static pit_value impl_bytes_p(pit_runtime *rt, pit_value args) { + return pit_is_bytes(rt, pit_car(rt, args)); +} +static pit_value impl_function_p(pit_runtime *rt, pit_value args) { + return pit_is_bytes(rt, pit_car(rt, args)); } - static pit_value impl_cons(pit_runtime *rt, pit_value args) { return pit_cons(rt, pit_car(rt, args), pit_car(rt, pit_cdr(rt, args))); } @@ -174,73 +167,269 @@ static pit_value impl_car(pit_runtime *rt, pit_value args) { static pit_value impl_cdr(pit_runtime *rt, pit_value args) { return pit_cdr(rt, pit_car(rt, args)); } - -static pit_value impl_print(pit_runtime *rt, pit_value args) { - pit_value x = pit_car(rt, args); - char buf[1024] = {0}; - pit_dump(rt, buf, sizeof(buf), x, true); - buf[1023] = 0; - puts(buf); - return x; +static pit_value impl_setcar(pit_runtime *rt, pit_value args) { + pit_value v = pit_car(rt, pit_cdr(rt, args)); + pit_setcar(rt, pit_car(rt, args), v); + return v; } - -static pit_value impl_princ(pit_runtime *rt, pit_value args) { - pit_value x = pit_car(rt, args); - char buf[1024] = {0}; - pit_dump(rt, buf, sizeof(buf), x, false); - buf[1023] = 0; - puts(buf); - return x; +static pit_value impl_setcdr(pit_runtime *rt, pit_value args) { + pit_value v = pit_car(rt, pit_cdr(rt, args)); + pit_setcdr(rt, pit_car(rt, args), v); + return v; +} +static pit_value impl_list(pit_runtime *rt, pit_value args) { + (void) rt; + return args; +} +static pit_value impl_list_map(pit_runtime *rt, pit_value args) { + pit_value func = pit_car(rt, args); + pit_value xs = pit_car(rt, pit_cdr(rt, args)); + pit_value ret = PIT_NIL; + while (xs != PIT_NIL) { + pit_value y = pit_apply(rt, func, pit_cons(rt, pit_car(rt, xs), PIT_NIL)); + ret = pit_cons(rt, y, ret); + xs = pit_cdr(rt, xs); + } + return pit_reverse(rt, ret); } - static pit_value impl_add(pit_runtime *rt, pit_value args) { - i64 x = pit_as_integer(rt, pit_car(rt, args)); - i64 y = pit_as_integer(rt, pit_car(rt, pit_cdr(rt, args))); - return pit_integer_new(rt, x + y); + i64 total = 0; + while (args != PIT_NIL) { + total += pit_as_integer(rt, pit_car(rt, args)); + args = pit_cdr(rt, args); + } + return pit_integer_new(rt, total); } - static pit_value impl_sub(pit_runtime *rt, pit_value args) { - i64 x = pit_as_integer(rt, pit_car(rt, args)); - i64 y = pit_as_integer(rt, pit_car(rt, pit_cdr(rt, args))); - return pit_integer_new(rt, x - y); + i64 total = pit_as_integer(rt, pit_car(rt, args)); + args = pit_cdr(rt, args); + while (args != PIT_NIL) { + total -= pit_as_integer(rt, pit_car(rt, args)); + args = pit_cdr(rt, args); + } + return pit_integer_new(rt, total); +} +static pit_value impl_mul(pit_runtime *rt, pit_value args) { + i64 total = 1; + while (args != PIT_NIL) { + total *= pit_as_integer(rt, pit_car(rt, args)); + args = pit_cdr(rt, args); + } + return pit_integer_new(rt, total); +} +static pit_value impl_div(pit_runtime *rt, pit_value args) { + i64 total = pit_as_integer(rt, pit_car(rt, args)); + args = pit_cdr(rt, args); + while (args != PIT_NIL) { + i64 denom = pit_as_integer(rt, pit_car(rt, args)); + if (denom == 0) { + pit_error(rt, "divide by zero"); + return PIT_NIL; + } + total /= denom; + args = pit_cdr(rt, args); + } + return pit_integer_new(rt, total); } - void pit_install_library_essential(pit_runtime *rt) { /* special forms */ pit_sfset(rt, pit_intern_cstr(rt, "quote"), pit_nativefunc_new(rt, impl_sf_quote)); pit_sfset(rt, pit_intern_cstr(rt, "if"), pit_nativefunc_new(rt, impl_sf_if)); pit_sfset(rt, pit_intern_cstr(rt, "progn"), pit_nativefunc_new(rt, impl_sf_progn)); pit_sfset(rt, pit_intern_cstr(rt, "lambda"), pit_nativefunc_new(rt, impl_sf_lambda)); - /* macros */ - pit_mset(rt, pit_intern_cstr(rt, "defun"), pit_nativefunc_new(rt, impl_m_defun)); - pit_mset(rt, pit_intern_cstr(rt, "defmacro"), pit_nativefunc_new(rt, impl_m_defmacro)); + pit_mset(rt, pit_intern_cstr(rt, "defun!"), pit_nativefunc_new(rt, impl_m_defun)); + pit_mset(rt, pit_intern_cstr(rt, "defmacro!"), pit_nativefunc_new(rt, impl_m_defmacro)); pit_mset(rt, pit_intern_cstr(rt, "let"), pit_nativefunc_new(rt, impl_m_let)); pit_mset(rt, pit_intern_cstr(rt, "and"), pit_nativefunc_new(rt, impl_m_and)); - pit_mset(rt, pit_intern_cstr(rt, "setq"), pit_nativefunc_new(rt, impl_m_setq)); - + pit_mset(rt, pit_intern_cstr(rt, "setq!"), pit_nativefunc_new(rt, impl_m_setq)); /* eval */ - pit_fset(rt, pit_intern_cstr(rt, "eval"), pit_nativefunc_new(rt, impl_eval)); - + pit_fset(rt, pit_intern_cstr(rt, "eval!"), pit_nativefunc_new(rt, impl_eval)); + /* predicates */ + pit_fset(rt, pit_intern_cstr(rt, "eq?"), pit_nativefunc_new(rt, impl_eq_p)); + pit_fset(rt, pit_intern_cstr(rt, "equal?"), pit_nativefunc_new(rt, impl_equal_p)); + pit_fset(rt, pit_intern_cstr(rt, "integer?"), pit_nativefunc_new(rt, impl_integer_p)); + pit_fset(rt, pit_intern_cstr(rt, "double?"), pit_nativefunc_new(rt, impl_double_p)); + pit_fset(rt, pit_intern_cstr(rt, "symbol?"), pit_nativefunc_new(rt, impl_symbol_p)); + pit_fset(rt, pit_intern_cstr(rt, "cons?"), pit_nativefunc_new(rt, impl_cons_p)); + pit_fset(rt, pit_intern_cstr(rt, "array?"), pit_nativefunc_new(rt, impl_array_p)); + pit_fset(rt, pit_intern_cstr(rt, "bytes?"), pit_nativefunc_new(rt, impl_bytes_p)); + pit_fset(rt, pit_intern_cstr(rt, "function?"), pit_nativefunc_new(rt, impl_function_p)); /* symbols */ - pit_fset(rt, pit_intern_cstr(rt, "set"), pit_nativefunc_new(rt, impl_set)); - pit_fset(rt, pit_intern_cstr(rt, "fset"), pit_nativefunc_new(rt, impl_fset)); - pit_fset(rt, pit_intern_cstr(rt, "symbol-is-macro"), pit_nativefunc_new(rt, impl_symbol_is_macro)); + pit_fset(rt, pit_intern_cstr(rt, "set!"), pit_nativefunc_new(rt, impl_set)); + pit_fset(rt, pit_intern_cstr(rt, "fset!"), pit_nativefunc_new(rt, impl_fset)); + pit_fset(rt, pit_intern_cstr(rt, "symbol-is-macro!"), pit_nativefunc_new(rt, impl_symbol_is_macro)); pit_fset(rt, pit_intern_cstr(rt, "funcall"), pit_nativefunc_new(rt, impl_funcall)); - /* cons cells */ pit_fset(rt, pit_intern_cstr(rt, "cons"), pit_nativefunc_new(rt, impl_cons)); pit_fset(rt, pit_intern_cstr(rt, "car"), pit_nativefunc_new(rt, impl_car)); pit_fset(rt, pit_intern_cstr(rt, "cdr"), pit_nativefunc_new(rt, impl_cdr)); - + pit_fset(rt, pit_intern_cstr(rt, "setcar!"), pit_nativefunc_new(rt, impl_setcar)); + pit_fset(rt, pit_intern_cstr(rt, "setcdr!"), pit_nativefunc_new(rt, impl_setcdr)); + /* cons lists*/ + pit_fset(rt, pit_intern_cstr(rt, "list"), pit_nativefunc_new(rt, impl_list)); + pit_fset(rt, pit_intern_cstr(rt, "list/map"), pit_nativefunc_new(rt, impl_list_map)); /* arithmetic */ pit_fset(rt, pit_intern_cstr(rt, "+"), pit_nativefunc_new(rt, impl_add)); pit_fset(rt, pit_intern_cstr(rt, "-"), pit_nativefunc_new(rt, impl_sub)); + pit_fset(rt, pit_intern_cstr(rt, "*"), pit_nativefunc_new(rt, impl_mul)); + pit_fset(rt, pit_intern_cstr(rt, "/"), pit_nativefunc_new(rt, impl_div)); +} +static pit_value impl_print(pit_runtime *rt, pit_value args) { + pit_value x = pit_car(rt, args); + char buf[1024] = {0}; + pit_dump(rt, buf, sizeof(buf), x, true); + buf[1023] = 0; + puts(buf); + return x; +} +static pit_value impl_princ(pit_runtime *rt, pit_value args) { + pit_value x = pit_car(rt, args); + char buf[1024] = {0}; + pit_dump(rt, buf, sizeof(buf), x, false); + buf[1023] = 0; + puts(buf); + return x; +} +static pit_value impl_load(pit_runtime *rt, pit_value args) { + pit_value path = pit_car(rt, args); + char pathbuf[1024] = {0}; + i64 len = pit_as_bytes(rt, path, (u8 *) pathbuf, sizeof(pathbuf) - 1); + if (len < 0) { pit_error(rt, "path was not a string"); return PIT_NIL; } + pathbuf[len] = 0; + pit_value bs = pit_bytes_new_file(rt, pathbuf); + pit_lexer lex = {0}; + if (!pit_lexer_from_bytes(rt, &lex, bs)) { + pit_error(rt, "failed to initialize lexer"); + return PIT_NIL; + } + pit_parser parse = {0}; + pit_parser_from_lexer(&parse, &lex); + pit_value ret = PIT_NIL; + bool eof = false; + pit_value p = PIT_NIL; + while (p = pit_parse(rt, &parse, &eof), !eof) { + ret = pit_eval(rt, p); + } + return ret; +} +void pit_install_library_io(pit_runtime *rt) { /* stream IO */ - pit_fset(rt, pit_intern_cstr(rt, "print"), pit_nativefunc_new(rt, impl_print)); - pit_fset(rt, pit_intern_cstr(rt, "princ"), pit_nativefunc_new(rt, impl_princ)); - + pit_fset(rt, pit_intern_cstr(rt, "print!"), pit_nativefunc_new(rt, impl_print)); + pit_fset(rt, pit_intern_cstr(rt, "princ!"), pit_nativefunc_new(rt, impl_princ)); /* disk IO */ - pit_fset(rt, pit_intern_cstr(rt, "load"), pit_nativefunc_new(rt, impl_load)); + pit_fset(rt, pit_intern_cstr(rt, "load!"), pit_nativefunc_new(rt, impl_load)); +} + +struct bytestring { + i64 len, cap; + u8 *data; +}; +static struct bytestring *bytestring_get(pit_runtime *rt, pit_value v) { + if (pit_value_sort(v) != PIT_VALUE_SORT_REF) { + pit_error(rt, "value was not a reference (to a bytestring)"); + return NULL; + } + pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, v)); + if (!h) { pit_error(rt, "bad ref"); return NULL; } + if (h->hsort != PIT_VALUE_HEAVY_SORT_NATIVEDATA) { + pit_error(rt, "invalid use of value as bytestring nativedata"); + return NULL; + } + if (!pit_eq(h->in.nativedata.tag, pit_intern_cstr(rt, "bs"))) { + pit_error(rt, "native value is not a bytestring"); + return NULL; + } + if (!h->in.nativedata.data) { + pit_error(rt, "bytestring was already freed"); + return NULL; + } + return h->in.nativedata.data; +} +static pit_value impl_bs_new(pit_runtime *rt, pit_value args) { + (void) args; + i64 cap = 256; + struct bytestring *bs = malloc(sizeof(struct bytestring)); + bs->len = 0; + bs->cap = cap; + bs->data = calloc((size_t) cap, 1); + return pit_nativedata_new(rt, pit_intern_cstr(rt, "bs"), (void *) bs); +} +static pit_value impl_bs_delete(pit_runtime *rt, pit_value args) { + pit_value v = pit_car(rt, args); + pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, v)); + if (!h) { pit_error(rt, "bad ref"); return PIT_NIL; } + if (h->hsort != PIT_VALUE_HEAVY_SORT_NATIVEDATA) { + pit_error(rt, "invalid use of value as bytestring nativedata"); + return PIT_NIL; + } + if (!pit_eq(h->in.nativedata.tag, pit_intern_cstr(rt, "bs"))) { + pit_error(rt, "native value is not a bytestring"); + return PIT_NIL; + } + if (!h->in.nativedata.data) { + pit_error(rt, "bytestring was already freed"); + return PIT_NIL; + } + struct bytestring *bs = h->in.nativedata.data; + if (bs->data) free(bs->data); bs->data = NULL; + free(bs); h->in.nativedata.data = NULL; + return PIT_T; +} +static pit_value impl_bs_grow(pit_runtime *rt, pit_value args) { + pit_value vsz = pit_car(rt, args); + pit_value v = pit_car(rt, pit_cdr(rt, args)); + struct bytestring *bs = bytestring_get(rt, v); + if (!bs) return PIT_NIL; + i64 sz = pit_as_integer(rt, vsz); + if (sz > bs->len) { + if (sz > bs->cap) { + while (bs->cap < sz) bs->cap <<= 1; + bs->data = realloc(bs->data, (size_t) bs->cap); + } + bs->len = sz; + } +} +static pit_value impl_bs_spit(pit_runtime *rt, pit_value args) { + pit_value path = pit_car(rt, args); + char pathbuf[1024] = {0}; + i64 len = pit_as_bytes(rt, path, (u8 *) pathbuf, sizeof(pathbuf) - 1); + if (len < 0) { pit_error(rt, "path was not a string"); return PIT_NIL; } + pathbuf[len] = 0; + pit_value v = pit_car(rt, pit_cdr(rt, args)); + struct bytestring *bs = bytestring_get(rt, v); + if (!bs) return PIT_NIL; + FILE *f = fopen(pathbuf, "w+"); + if (!f) { pit_error(rt, "failed to open file: %s", pathbuf); return PIT_NIL; } + size_t written = fwrite(bs->data, 1, (size_t) bs->len, f); + fclose(f); + if (written != (size_t) bs->len) { + pit_error(rt, "failed to write bytestring to file: %s", pathbuf); + return PIT_NIL; + } + return v; +} +static pit_value impl_bs_write8(pit_runtime *rt, pit_value args) { + pit_value v = pit_car(rt, args); + pit_value vidx = pit_car(rt, pit_cdr(rt, args)); + pit_value vx = pit_car(rt, pit_cdr(rt, pit_cdr(rt, args))); + struct bytestring *bs = bytestring_get(rt, v); + if (!bs) return PIT_NIL; + i64 idx = pit_as_integer(rt, vidx); + u8 x = (u8) pit_as_integer(rt, vx); + if (idx >= bs->len) { + pit_error(rt, "index %d out of bounds in bytestring (length %d)", idx, bs->len); + return PIT_NIL; + } + bs->data[idx] = x; + return v; +} +void pit_install_library_bytestring(pit_runtime *rt) { + /* bytestrings */ + pit_fset(rt, pit_intern_cstr(rt, "bs/new!"), pit_nativefunc_new(rt, impl_bs_new)); + pit_fset(rt, pit_intern_cstr(rt, "bs/delete!"), pit_nativefunc_new(rt, impl_bs_delete)); + pit_fset(rt, pit_intern_cstr(rt, "bs/grow!"), pit_nativefunc_new(rt, impl_bs_grow)); + pit_fset(rt, pit_intern_cstr(rt, "bs/spit!"), pit_nativefunc_new(rt, impl_bs_spit)); + pit_fset(rt, pit_intern_cstr(rt, "bs/write8!"), pit_nativefunc_new(rt, impl_bs_write8)); } diff --git a/src/library.h b/src/library.h deleted file mode 100644 index a472642..0000000 --- a/src/library.h +++ /dev/null @@ -1,8 +0,0 @@ -#ifndef LIBRARY_H -#define LIBRARY_H - -#include "runtime.h" - -void pit_install_library_essential(pit_runtime *rt); - -#endif diff --git a/src/main.c b/src/main.c index 8d2fa5a..2ea5ef8 100644 --- a/src/main.c +++ b/src/main.c @@ -1,10 +1,10 @@ #include #include -#include "utils.h" -#include "lexer.h" -#include "parser.h" -#include "runtime.h" +#include +#include +#include +#include int main(int argc, char **argv) { pit_runtime *rt = pit_runtime_new(); @@ -12,6 +12,7 @@ int main(int argc, char **argv) { char buf[1024] = {0}; i64 len = 0; pit_runtime_freeze(rt); + if (pit_runtime_print_error(rt)) { exit(1); } setbuf(stdout, NULL); printf("> "); while (len < (i64) sizeof(buf) && (buf[len++] = (char) getchar()) != EOF) { diff --git a/src/parser.c b/src/parser.c index 1a9f663..4403323 100644 --- a/src/parser.c +++ b/src/parser.c @@ -2,10 +2,10 @@ #include #include -#include "types.h" -#include "lexer.h" -#include "parser.h" -#include "runtime.h" +#include "lcq/pit/types.h" +#include "lcq/pit/lexer.h" +#include "lcq/pit/parser.h" +#include "lcq/pit/runtime.h" static pit_lex_token peek(pit_parser *st) { if (!st) return PIT_LEX_TOKEN_ERROR; @@ -50,9 +50,8 @@ void pit_parser_from_lexer(pit_parser *ret, pit_lexer *lex) { /* parse a single expression */ pit_value pit_parse(pit_runtime *rt, pit_parser *st, bool *eof) { char buf[256] = {0}; - pit_lex_token t; if (rt == NULL || st == NULL) return PIT_NIL; - t = advance(st); + pit_lex_token t = advance(st); rt->source_line = st->cur.line; rt->source_column = st->cur.column; switch (t) { @@ -74,13 +73,15 @@ pit_value pit_parse(pit_runtime *rt, pit_parser *st, bool *eof) { */ i64 scratch_reset = rt->scratch->next; pit_value ret = PIT_NIL; - i64 i; while (!match(st, PIT_LEX_TOKEN_RPAREN)) { pit_value *cell = pit_arena_alloc_bulk(rt->scratch, sizeof(pit_value)); *cell = pit_parse(rt, st, eof); if (rt->error != PIT_NIL) return PIT_NIL; /* if we hit an error, stop!*/ } - for (i = rt->scratch->next - (i64) sizeof(pit_value); i >= scratch_reset; i -= (i64) sizeof(pit_value)) { + for (i64 i = rt->scratch->next - (i64) sizeof(pit_value); + i >= scratch_reset; + i -= (i64) sizeof(pit_value) + ) { pit_value *v = pit_arena_idx(rt->scratch, (i32) i); ret = pit_cons(rt, *v, ret); } @@ -93,11 +94,10 @@ pit_value pit_parse(pit_runtime *rt, pit_parser *st, bool *eof) { get_token_string(st, buf, sizeof(buf)); return pit_integer_new(rt, atoi(buf)); case PIT_LEX_TOKEN_STRING_LITERAL: { - i64 len, cur, i; get_token_string(st, buf, sizeof(buf)); - len = (i64) strlen(buf); - cur = 0; - for (i = 1; i < len; ++i) { + i64 len = (i64) strlen(buf); + i64 cur = 0; + for (i64 i = 1; i < len; ++i) { if (buf[i] == '\\' && i + 1 < len) buf[cur++] = buf[++i]; else if (buf[i] != '"') buf[cur++] = buf[i]; else break; diff --git a/src/parser.h b/src/parser.h deleted file mode 100644 index 08c0bee..0000000 --- a/src/parser.h +++ /dev/null @@ -1,21 +0,0 @@ -#ifndef PIT_PARSER_H -#define PIT_PARSER_H - -#include "lexer.h" -#include "runtime.h" - -typedef struct { - pit_lex_token token; - i64 start, end; - i64 line, column; /* for error reporting */ -} pit_parser_token_info; - -typedef struct { - pit_lexer *lexer; - pit_parser_token_info cur, next; -} pit_parser; - -void pit_parser_from_lexer(pit_parser *ret, pit_lexer *lex); -pit_value pit_parse(pit_runtime *rt, pit_parser *st, bool *eof); - -#endif diff --git a/src/runtime.c b/src/runtime.c index 6c9add8..d0386ef 100644 --- a/src/runtime.c +++ b/src/runtime.c @@ -5,11 +5,11 @@ #include #include -#include "utils.h" -#include "lexer.h" -#include "parser.h" -#include "runtime.h" -#include "library.h" +#include +#include +#include +#include +#include pit_arena *pit_arena_new(i64 capacity, i64 elem_size) { pit_arena *a = malloc(sizeof(pit_arena) + (size_t) capacity * (size_t) elem_size); @@ -19,7 +19,7 @@ pit_arena *pit_arena_new(i64 capacity, i64 elem_size) { return a; } i32 pit_arena_next_idx(pit_arena *a) { - i32 byte_idx; pit_mul(&byte_idx, a->elem_size, a->next); + i32 byte_idx = 0; pit_mul(&byte_idx, a->elem_size, a->next); return byte_idx; } i32 pit_arena_alloc_idx(pit_arena *a) { @@ -30,7 +30,7 @@ i32 pit_arena_alloc_idx(pit_arena *a) { } i32 pit_arena_alloc_bulk_idx(pit_arena *a, i64 num) { i32 byte_idx = pit_arena_next_idx(a); - i32 byte_len; pit_mul(&byte_len, a->elem_size, num); + i32 byte_len = 0; pit_mul(&byte_len, a->elem_size, num); if (byte_idx + byte_len > a->capacity) { return -1; } a->next += num; return byte_idx; @@ -68,10 +68,9 @@ u64 pit_value_data(pit_value v) { pit_runtime *pit_runtime_new() { pit_runtime *ret = malloc(sizeof(*ret)); - pit_value nil, truth; ret->values = pit_arena_new(64 * 1024, sizeof(pit_value_heavy)); ret->bytes = pit_arena_new(64 * 1024, sizeof(u8)); - ret->symtab = pit_arena_new(1024, sizeof(pit_symtab_entry)); + ret->symtab = pit_arena_new(64 * 1024, sizeof(pit_symtab_entry)); ret->symtab_len = 0; ret->scratch = pit_arena_new(64 * 1024, sizeof(u8)); ret->expr_stack = pit_values_new(1024); @@ -84,11 +83,13 @@ pit_runtime *pit_runtime_new() { ret->error = PIT_NIL; ret->source_line = ret->source_column = -1; ret->error_line = ret->error_column = -1; - nil = pit_intern_cstr(ret, "nil"); /* nil must be the 0th symbol for PIT_NIL to work */ + pit_value nil = pit_intern_cstr(ret, "nil"); /* nil must be the 0th symbol for PIT_NIL to work */ pit_set(ret, nil, PIT_NIL); - truth = pit_intern_cstr(ret, "t"); + pit_value truth = pit_intern_cstr(ret, "t"); pit_set(ret, truth, truth); pit_install_library_essential(ret); + pit_install_library_io(ret); + pit_install_library_bytestring(ret); pit_runtime_freeze(ret); return ret; } @@ -171,11 +172,10 @@ i64 pit_dump(pit_runtime *rt, char *buf, i64 len, pit_value v, bool readable) { return buf - start; } case PIT_VALUE_HEAVY_SORT_BYTES: { - i64 i, maxlen, j; - i = 0; + i64 i = 0; if (readable) buf[i++] = '"'; - maxlen = len - i; - for (j = 0; i < maxlen && j < h->in.bytes.len;) { + i64 maxlen = len - i; + for (i64 j = 0; i < maxlen && j < h->in.bytes.len;) { if (buf[i - 1] != '\\' && (h->in.bytes.data[j] == '\\' || h->in.bytes.data[j] == '"')) buf[i++] = '\\'; else buf[i++] = (char) h->in.bytes.data[j++]; @@ -200,13 +200,14 @@ void pit_trace_(pit_runtime *rt, const char *format, pit_value v) { } void pit_error(pit_runtime *rt, const char *format, ...) { - if (pit_eq(rt->error, PIT_NIL)) { /* only record the first error encountered */ + if (rt->error == PIT_NIL) { /* only record the first error encountered */ char buf[1024] = {0}; va_list vargs; va_start(vargs, format); vsnprintf(buf, sizeof(buf), format, vargs); va_end(vargs); - rt->error = pit_bytes_new_cstr(rt, buf); + rt->error = PIT_T; /* we set the error now to prevent infinite recursion */ + rt->error = pit_bytes_new_cstr(rt, buf); /* in case this errs also */ rt->error_line = rt->source_line; rt->error_column = rt->source_column; } @@ -242,12 +243,11 @@ pit_value pit_double_new(pit_runtime *rt, double d) { } i64 pit_as_integer(pit_runtime *rt, pit_value v) { - u64 lo; if (pit_value_sort(v) != PIT_VALUE_SORT_INTEGER) { pit_error(rt, "invalid use of value as integer"); return -1; } - lo = pit_value_data(v); + u64 lo = pit_value_data(v); return ((i64) (lo << 15)) >> 15; /* sign-extend low 49 bits */ } @@ -328,6 +328,9 @@ bool pit_is_func(pit_runtime *rt, pit_value a) { bool pit_is_nativefunc(pit_runtime *rt, pit_value a) { return pit_is_value_heavy_sort(rt, a, PIT_VALUE_HEAVY_SORT_NATIVEFUNC); } +bool pit_is_nativedata(pit_runtime *rt, pit_value a) { + return pit_is_value_heavy_sort(rt, a, PIT_VALUE_HEAVY_SORT_NATIVEDATA); +} bool pit_eq(pit_value a, pit_value b) { return a == b; } @@ -339,10 +342,9 @@ bool pit_equal(pit_runtime *rt, pit_value a, pit_value b) { case PIT_VALUE_SORT_SYMBOL: return pit_value_data(a) == pit_value_data(b); case PIT_VALUE_SORT_REF: { - pit_value_heavy *ha, *hb; - ha = pit_deref(rt, pit_as_ref(rt, a)); + pit_value_heavy *ha = pit_deref(rt, pit_as_ref(rt, a)); if (!ha) { pit_error(rt, "bad ref"); return false; } - hb = pit_deref(rt, pit_as_ref(rt, b)); + pit_value_heavy *hb = pit_deref(rt, pit_as_ref(rt, b)); if (!hb) { pit_error(rt, "bad ref"); return false; } if (ha->hsort != hb->hsort) return false; switch (ha->hsort) { @@ -352,17 +354,15 @@ bool pit_equal(pit_runtime *rt, pit_value a, pit_value b) { return pit_equal(rt, ha->in.cons.car, hb->in.cons.car) && pit_equal(rt, ha->in.cons.cdr, hb->in.cons.cdr); case PIT_VALUE_HEAVY_SORT_ARRAY: { - i64 i = 0; if (ha->in.array.len != hb->in.array.len) return false; - for (i = 0; i < ha->in.array.len; ++i) { + for (i64 i = 0; i < ha->in.array.len; ++i) { if (!pit_equal(rt, ha->in.array.data[i], hb->in.array.data[i])) return false; } return true; } case PIT_VALUE_HEAVY_SORT_BYTES: { - i64 i = 0; if (ha->in.bytes.len != hb->in.bytes.len) return false; - for (i = 0; i < ha->in.bytes.len; ++i) { + for (i64 i = 0; i < ha->in.bytes.len; ++i) { if (ha->in.bytes.data[i] != hb->in.bytes.data[i]) return false; } return true; @@ -374,19 +374,21 @@ bool pit_equal(pit_runtime *rt, pit_value a, pit_value b) { && pit_equal(rt, ha->in.func.body, hb->in.func.body); case PIT_VALUE_HEAVY_SORT_NATIVEFUNC: return ha->in.nativefunc == hb->in.nativefunc; + case PIT_VALUE_HEAVY_SORT_NATIVEDATA: + return + pit_eq(ha->in.nativedata.tag, hb->in.nativedata.tag) + && ha->in.nativedata.data == hb->in.nativedata.data; } } } return false; } pit_value pit_bytes_new(pit_runtime *rt, u8 *buf, i64 len) { - pit_value ret; - pit_value_heavy *h; u8 *dest = pit_arena_alloc_bulk(rt->bytes, len); if (!dest) { pit_error(rt, "failed to allocate bytes"); return PIT_NIL; } memcpy(dest, buf, (size_t) len); - ret = pit_heavy_new(rt); - h = pit_deref(rt, pit_as_ref(rt, ret)); + pit_value ret = pit_heavy_new(rt); + pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, ret)); if (!h) { pit_error(rt, "failed to create new heavy value for bytes"); return PIT_NIL; } h->hsort = PIT_VALUE_HEAVY_SORT_BYTES; h->in.bytes.data = dest; @@ -397,19 +399,16 @@ pit_value pit_bytes_new_cstr(pit_runtime *rt, char *s) { return pit_bytes_new(rt, (u8 *) s, (i64) strlen(s)); } pit_value pit_bytes_new_file(pit_runtime *rt, char *path) { + if (rt->error != PIT_NIL) return PIT_NIL; FILE *f = fopen(path, "r"); - i64 len; - u8 *dest; - pit_value ret; - pit_value_heavy *h; if (f == NULL) { pit_error(rt, "failed to open file: %s", path); return PIT_NIL; } fseek(f, 0, SEEK_END); - len = ftell(f); + i64 len = ftell(f); fseek(f, 0, SEEK_SET); - dest = pit_arena_alloc_bulk(rt->bytes, len); + u8 *dest = pit_arena_alloc_bulk(rt->bytes, len); if (!dest) { pit_error(rt, "failed to allocate bytes"); fclose(f); return PIT_NIL; } if ((size_t) len != fread(dest, sizeof(char), (size_t) len, f)) { fclose(f); @@ -417,8 +416,8 @@ pit_value pit_bytes_new_file(pit_runtime *rt, char *path) { return PIT_NIL; } fclose(f); - ret = pit_heavy_new(rt); - h = pit_deref(rt, pit_as_ref(rt, ret)); + pit_value ret = pit_heavy_new(rt); + pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, ret)); if (!h) { pit_error(rt, "failed to create new heavy value for bytes"); return PIT_NIL; } h->hsort = PIT_VALUE_HEAVY_SORT_BYTES; h->in.bytes.data = dest; @@ -427,39 +426,34 @@ pit_value pit_bytes_new_file(pit_runtime *rt, char *path) { } /* return true if v is a reference to bytes that are the same as those in buf */ bool pit_bytes_match(pit_runtime *rt, pit_value v, u8 *buf, i64 len) { - pit_value_heavy *h; - i64 i; if (pit_value_sort(v) != PIT_VALUE_SORT_REF) return false; - h = pit_deref(rt, pit_as_ref(rt, v)); + pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, v)); if (!h) { pit_error(rt, "bad ref"); return false; } if (h->hsort != PIT_VALUE_HEAVY_SORT_BYTES) return false; if (h->in.bytes.len != len) return false; - for (i = 0; i < len; ++i) + for (i64 i = 0; i < len; ++i) if (h->in.bytes.data[i] != buf[i]) { return false; } return true; } i64 pit_as_bytes(pit_runtime *rt, pit_value v, u8 *buf, i64 maxlen) { - pit_value_heavy *h; - i64 len, i; if (pit_value_sort(v) != PIT_VALUE_SORT_REF) return -1; - h = pit_deref(rt, pit_as_ref(rt, v)); + pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, v)); if (!h) { pit_error(rt, "bad ref"); return -1; } if (h->hsort != PIT_VALUE_HEAVY_SORT_BYTES) { pit_error(rt, "invalid use of value as bytes"); return -1; } - len = maxlen < h->in.bytes.len ? maxlen : h->in.bytes.len; - for (i = 0; i < len; ++i) { + i64 len = maxlen < h->in.bytes.len ? maxlen : h->in.bytes.len; + for (i64 i = 0; i < len; ++i) { buf[i] = h->in.bytes.data[i]; } return len; } bool pit_lexer_from_bytes(pit_runtime *rt, pit_lexer *ret, pit_value v) { - pit_value_heavy *h; if (pit_value_sort(v) != PIT_VALUE_SORT_REF) return false; - h = pit_deref(rt, pit_as_ref(rt, v)); + pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, v)); if (!h) { pit_error(rt, "bad ref"); return false; } if (h->hsort != PIT_VALUE_HEAVY_SORT_BYTES) { pit_error(rt, "invalid use of value as bytes"); @@ -469,8 +463,8 @@ bool pit_lexer_from_bytes(pit_runtime *rt, pit_lexer *ret, pit_value v) { return true; } pit_value pit_read_bytes(pit_runtime *rt, pit_value v) { /* read a single lisp form from a bytestring */ - pit_lexer lex; - pit_parser parse; + pit_lexer lex = {0}; + pit_parser parse = {0}; if (!pit_lexer_from_bytes(rt, &lex, v)) { pit_error(rt, "failed to initialize lexer"); return PIT_NIL; @@ -480,17 +474,15 @@ pit_value pit_read_bytes(pit_runtime *rt, pit_value v) { /* read a single lisp f } pit_value pit_intern(pit_runtime *rt, u8 *nm, i64 len) { - i64 i; - i32 idx; - pit_symtab_entry *ent; - for (i = 0; i < rt->symtab_len; ++i) { + if (rt->error != PIT_NIL) return PIT_NIL; + for (i64 i = 0; i < rt->symtab_len; ++i) { pit_symbol sidx = (pit_symbol) (i * (i64) sizeof(pit_symtab_entry)); pit_symtab_entry *sent = pit_arena_idx(rt->symtab, sidx); if (!sent) { pit_error(rt, "corrupted symbol table"); return PIT_NIL; } if (pit_bytes_match(rt, sent->name, nm, len)) return pit_symbol_new(rt, sidx); } - idx = pit_arena_alloc_idx(rt->symtab); - ent = pit_arena_idx(rt->symtab, idx); + i32 idx = pit_arena_alloc_idx(rt->symtab); + pit_symtab_entry *ent = pit_arena_idx(rt->symtab, idx); if (!ent) { pit_error(rt, "failed to allocate symtab entry"); return PIT_NIL; } ent->name = pit_bytes_new(rt, nm, len); ent->value = PIT_NIL; @@ -530,9 +522,8 @@ pit_value pit_get(pit_runtime *rt, pit_value sym) { } void pit_set(pit_runtime *rt, pit_value sym, pit_value v) { pit_symbol idx = pit_as_symbol(rt, sym); - pit_symtab_entry *ent; if (idx < rt->frozen_symtab) { pit_error(rt, "attempted to modify frozen symbol"); return; } - ent = pit_symtab_lookup(rt, sym); + pit_symtab_entry *ent = pit_symtab_lookup(rt, sym); if (!ent) { pit_error(rt, "bad symbol"); return; } if (pit_value_sort(ent->value) != PIT_VALUE_SORT_REF) { ent->value = pit_cell_new(rt, PIT_NIL); @@ -544,9 +535,8 @@ pit_value pit_fget(pit_runtime *rt, pit_value sym) { } void pit_fset(pit_runtime *rt, pit_value sym, pit_value v) { pit_symbol idx = pit_as_symbol(rt, sym); - pit_symtab_entry *ent; if (idx < rt->frozen_symtab) { pit_error(rt, "attempted to modify frozen symbol"); return; } - ent = pit_symtab_lookup(rt, sym); + pit_symtab_entry *ent = pit_symtab_lookup(rt, sym); if (!ent) { pit_error(rt, "bad symbol"); return; } if (pit_value_sort(ent->function) != PIT_VALUE_SORT_REF) { ent->function = pit_cell_new(rt, PIT_NIL); @@ -590,9 +580,8 @@ void pit_bind(pit_runtime *rt, pit_value sym, pit_value cell) { } pit_value pit_unbind(pit_runtime *rt, pit_value sym) { pit_symtab_entry *ent = pit_symtab_lookup(rt, sym); - pit_value old; if (!ent) { pit_error(rt, "bad symbol"); return PIT_NIL; } - old = ent->value; + pit_value old = ent->value; ent->value = pit_values_pop(rt, rt->saved_bindings); return old; } @@ -606,12 +595,11 @@ pit_value pit_cell_new(pit_runtime *rt, pit_value v) { return ret; } pit_value pit_cell_get(pit_runtime *rt, pit_value cell) { - pit_value_heavy *h; if (pit_value_sort(cell) != PIT_VALUE_SORT_REF) { pit_error(rt, "attempted to get cell value that is not ref"); return PIT_NIL; } - h = pit_deref(rt, pit_as_ref(rt, cell)); + pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, cell)); if (!h) { pit_error(rt, "bad ref"); return PIT_NIL; } if (h->hsort != PIT_VALUE_HEAVY_SORT_CELL) { pit_error(rt, "cell value ref does not point to cell"); @@ -620,15 +608,13 @@ pit_value pit_cell_get(pit_runtime *rt, pit_value cell) { return h->in.cell; } void pit_cell_set(pit_runtime *rt, pit_value cell, pit_value v) { - pit_ref idx; - pit_value_heavy *h; if (pit_value_sort(cell) != PIT_VALUE_SORT_REF) { pit_error(rt, "attempted to set cell value that is not ref"); return; } - idx = pit_as_ref(rt, cell); + pit_ref idx = pit_as_ref(rt, cell); if (idx < rt->frozen_values) { pit_error(rt, "attempt to modify frozen cell"); return; } - h = pit_deref(rt, idx); + pit_value_heavy *h = pit_deref(rt, idx); if (!h) { pit_error(rt, "bad ref"); return; } if (h->hsort != PIT_VALUE_HEAVY_SORT_CELL) { pit_error(rt, "cell value ref does not point to cell"); @@ -647,55 +633,48 @@ pit_value pit_cons(pit_runtime *rt, pit_value car, pit_value cdr) { return ret; } pit_value pit_list(pit_runtime *rt, i64 num, ...) { - pit_value temp[64]; - va_list elems; - i64 i; + pit_value temp[64] = {0}; pit_value ret = PIT_NIL; if (num > 64) { pit_error(rt, "failed to create list of size %d\n", num); return PIT_NIL; } + va_list elems; va_start(elems, num); - for (i = 0; i < num; ++i) { + for (i64 i = 0; i < num; ++i) { temp[i] = va_arg(elems, pit_value); } va_end(elems); - for (i = 0; i < num; ++i) { + for (i64 i = 0; i < num; ++i) { ret = pit_cons(rt, temp[num - i - 1], ret); } return ret; } pit_value pit_car(pit_runtime *rt, pit_value v) { - pit_value_heavy *h; if (pit_value_sort(v) != PIT_VALUE_SORT_REF) return PIT_NIL; - h = pit_deref(rt, pit_as_ref(rt, v)); + pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, v)); if (!h) { pit_error(rt, "bad ref"); return PIT_NIL; } if (h->hsort != PIT_VALUE_HEAVY_SORT_CONS) return PIT_NIL; return h->in.cons.car; } pit_value pit_cdr(pit_runtime *rt, pit_value v) { - pit_value_heavy *h; if (pit_value_sort(v) != PIT_VALUE_SORT_REF) return PIT_NIL; - h = pit_deref(rt, pit_as_ref(rt, v)); + pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, v)); if (!h) { pit_error(rt, "bad ref"); return PIT_NIL; } if (h->hsort != PIT_VALUE_HEAVY_SORT_CONS) return PIT_NIL; return h->in.cons.cdr; } void pit_setcar(pit_runtime *rt, pit_value v, pit_value x) { - pit_ref idx; - pit_value_heavy *h; if (pit_value_sort(v) != PIT_VALUE_SORT_REF) { pit_error(rt, "not a ref"); return; } - idx = pit_as_ref(rt, v); + pit_ref idx = pit_as_ref(rt, v); if (idx < rt->frozen_values) { pit_error(rt, "attempted to modify frozen cons"); return; } - h = pit_deref(rt, idx); + pit_value_heavy *h = pit_deref(rt, idx); if (!h) { pit_error(rt, "bad ref"); return; } if (h->hsort != PIT_VALUE_HEAVY_SORT_CONS) { pit_error(rt, "not a cons"); return; } h->in.cons.car = x; } void pit_setcdr(pit_runtime *rt, pit_value v, pit_value x) { - pit_ref idx; - pit_value_heavy *h; if (pit_value_sort(v) != PIT_VALUE_SORT_REF) { pit_error(rt, "not a ref"); return; } - idx = pit_as_ref(rt, v); + pit_ref idx = pit_as_ref(rt, v); if (idx < rt->frozen_values) { pit_error(rt, "attempted to modify frozen cons"); return; } - h = pit_deref(rt, idx); + pit_value_heavy *h = pit_deref(rt, idx); if (!h) { pit_error(rt, "bad ref"); return; } if (h->hsort != PIT_VALUE_HEAVY_SORT_CONS) { pit_error(rt, "not a cons"); return; } h->in.cons.cdr = x; @@ -761,11 +740,10 @@ pit_value pit_free_vars(pit_runtime *rt, pit_value bound, pit_value body) { pit_value pit_lambda(pit_runtime *rt, pit_value args, pit_value body) { pit_value ret = pit_heavy_new(rt); pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, ret)); - pit_value expanded, freevars, env, arg_cells; if (!h) { pit_error(rt, "failed to create new heavy value for lambda"); return PIT_NIL; } - expanded = pit_expand_macros(rt, pit_cons(rt, pit_intern_cstr(rt, "progn"), body)); - freevars = pit_free_vars(rt, args, expanded); - env = PIT_NIL; + pit_value expanded = pit_expand_macros(rt, pit_cons(rt, pit_intern_cstr(rt, "progn"), body)); + pit_value freevars = pit_free_vars(rt, args, expanded); + pit_value env = PIT_NIL; while (freevars != PIT_NIL) { pit_value sym = pit_car(rt, freevars); pit_value cell = pit_get_value_cell(rt, sym); @@ -773,7 +751,7 @@ pit_value pit_lambda(pit_runtime *rt, pit_value args, pit_value body) { freevars = pit_cdr(rt, freevars); } h->hsort = PIT_VALUE_HEAVY_SORT_FUNC; - arg_cells = PIT_NIL; + pit_value arg_cells = PIT_NIL; while (args != PIT_NIL) { pit_value nm = pit_car(rt, args); pit_value ent = pit_cons(rt, nm, pit_cell_new(rt, PIT_NIL)); @@ -803,7 +781,6 @@ pit_value pit_apply(pit_runtime *rt, pit_value f, pit_value args) { /* calling a Lisp function is simple! */ pit_value bound = PIT_NIL; pit_value env = h->in.func.env; - pit_value anames, ret; while (env != PIT_NIL) { /* first, bind all entries in the closure */ pit_value b = pit_car(rt, env); pit_value nm = pit_car(rt, b); @@ -811,7 +788,7 @@ pit_value pit_apply(pit_runtime *rt, pit_value f, pit_value args) { bound = pit_cons(rt, nm, bound); env = pit_cdr(rt, env); } - anames = h->in.func.args; + pit_value anames = h->in.func.args; while (anames != PIT_NIL) { /* bind all argument names to their values */ pit_value aform = pit_car(rt, anames); pit_value nm = pit_car(rt, aform); @@ -822,7 +799,7 @@ pit_value pit_apply(pit_runtime *rt, pit_value f, pit_value args) { args = pit_cdr(rt, args); anames = pit_cdr(rt, anames); } - ret = pit_eval(rt, h->in.func.body); /* evaluate the body */ + pit_value ret = pit_eval(rt, h->in.func.body); /* evaluate the body */ while (bound != PIT_NIL) { /* unbind everything we bound earlier, in reverse */ pit_unbind(rt, pit_car(rt, bound)); bound = pit_cdr(rt, bound); @@ -842,6 +819,16 @@ pit_value pit_apply(pit_runtime *rt, pit_value f, pit_value args) { } } +pit_value pit_nativedata_new(pit_runtime *rt, pit_value tag, void *d) { + pit_value ret = pit_heavy_new(rt); + pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, ret)); + if (!h) { pit_error(rt, "failed to create new heavy value for nativedata"); return PIT_NIL; } + h->hsort = PIT_VALUE_HEAVY_SORT_NATIVEDATA; + h->in.nativedata.tag = tag; + h->in.nativedata.data = d; + return ret; +} + pit_values *pit_values_new(i64 capacity) { i64 cap = capacity / (i64) sizeof(pit_value); pit_values *ret = malloc(sizeof(*ret) + (size_t) cap * sizeof(pit_value)); @@ -885,7 +872,6 @@ pit_value pit_expand_macros(pit_runtime *rt, pit_value top) { i64 expr_stack_reset = rt->expr_stack->top; i64 result_stack_reset = rt->result_stack->top; i64 program_reset = rt->program->top; - i64 idx; pit_values_push(rt, rt->expr_stack, top); while (rt->expr_stack->top > expr_stack_reset) { pit_value cur; @@ -939,7 +925,7 @@ pit_value pit_expand_macros(pit_runtime *rt, pit_value top) { pit_runtime_eval_program_push_literal(rt, rt->program, cur); } } - for (idx = rt->program->top - 1; idx >= program_reset; --idx) { + for (i64 idx = rt->program->top - 1; idx >= program_reset; --idx) { pit_runtime_eval_program_entry *ent; if (rt->error != PIT_NIL) goto end; ent = &rt->program->data[idx]; @@ -950,8 +936,7 @@ pit_value pit_expand_macros(pit_runtime *rt, pit_value top) { case EVAL_PROGRAM_ENTRY_APPLY: { pit_value f = pit_values_pop(rt, rt->result_stack); pit_value args = PIT_NIL; - i64 i; - for (i = 0; i < ent->in.apply; ++i) { + for (i64 i = 0; i < ent->in.apply; ++i) { args = pit_cons(rt, pit_values_pop(rt, rt->result_stack), args); } pit_values_push(rt, rt->result_stack, pit_cons(rt, f, args)); @@ -975,7 +960,6 @@ pit_value pit_eval(pit_runtime *rt, pit_value top) { i64 expr_stack_reset = rt->expr_stack->top; i64 result_stack_reset = rt->result_stack->top; i64 program_reset = rt->program->top; - i64 idx; pit_values_push(rt, rt->expr_stack, top); /* first, convert the expression tree into "polish notation" in program */ while (rt->expr_stack->top > expr_stack_reset) { @@ -1021,7 +1005,7 @@ pit_value pit_eval(pit_runtime *rt, pit_value top) { } /* then, execute the polish notation program from right to left this has the nice consequence of putting the arguments in the right order */ - for (idx = rt->program->top - 1; idx >= program_reset; --idx) { + for (i64 idx = rt->program->top - 1; idx >= program_reset; --idx) { pit_runtime_eval_program_entry *ent; if (rt->error != PIT_NIL) goto end; ent = &rt->program->data[idx]; @@ -1032,8 +1016,7 @@ pit_value pit_eval(pit_runtime *rt, pit_value top) { case EVAL_PROGRAM_ENTRY_APPLY: { pit_value f = pit_values_pop(rt, rt->result_stack); pit_value args = PIT_NIL; - i64 i; - for (i = 0; i < ent->in.apply; ++i) { + for (i64 i = 0; i < ent->in.apply; ++i) { args = pit_cons(rt, pit_values_pop(rt, rt->result_stack), args); } pit_values_push(rt, rt->result_stack, pit_apply(rt, f, args)); diff --git a/src/runtime.h b/src/runtime.h deleted file mode 100644 index 2014d41..0000000 --- a/src/runtime.h +++ /dev/null @@ -1,206 +0,0 @@ -#ifndef PIT_RUNTIME_H -#define PIT_RUNTIME_H - -#include "types.h" -#include "utils.h" -#include "lexer.h" - -struct pit_runtime; - -/* arenas */ -typedef struct { - i64 elem_size, capacity, next; - u8 data[1]; /* flexible array member */ -} pit_arena; -pit_arena *pit_arena_new(i64 capacity, i64 elem_size); -i32 pit_arena_next_idx(pit_arena *a); -i32 pit_arena_alloc_idx(pit_arena *a); -i32 pit_arena_alloc_bulk_idx(pit_arena *a, i64 num); -void *pit_arena_idx(pit_arena *a, i32 idx); -void *pit_arena_alloc(pit_arena *a); -void *pit_arena_alloc_bulk(pit_arena *a, i64 num); - -/* nil is always the symbol with index 0 */ -#define PIT_NIL 0xfff4000000000000 /* 0b1111111111110100000000000000000000000000000000000000000000000000 */ - -enum pit_value_sort { - PIT_VALUE_SORT_DOUBLE = 0, /* 0b00 - double */ - PIT_VALUE_SORT_INTEGER = 1, /* 0b01 - NaN-boxed 49-bit integer */ - PIT_VALUE_SORT_SYMBOL = 2, /* 0b10 - NaN-boxed index into symbol table */ - PIT_VALUE_SORT_REF = 3 /* 0b11 - NaN-boxed index into "heavy object" arena */ -}; -typedef i32 pit_symbol; /* a symbol at runtime is an index into the runtime's symbol table */ -typedef i32 pit_ref; /* a reference is an index into the runtime's arena */ -typedef u64 pit_value; -enum pit_value_sort pit_value_sort(pit_value v); -u64 pit_value_data(pit_value v); - -typedef struct { - i64 top, cap; - pit_value data[1]; /* flexible array member */ -} pit_values; -pit_values *pit_values_new(i64 capacity); -void pit_values_push(struct pit_runtime *rt, pit_values *s, pit_value x); -pit_value pit_values_pop(struct pit_runtime *rt, pit_values *s); - -typedef pit_value (*pit_nativefunc)(struct pit_runtime *rt, pit_value args); -typedef struct { /* "heavy" values, the targets of refs */ - enum pit_value_heavy_sort { - PIT_VALUE_HEAVY_SORT_CELL=0, /* value cell - basically, a "location" referred to by a variable binding */ - PIT_VALUE_HEAVY_SORT_CONS, /* cons cell - a pair of two values */ - PIT_VALUE_HEAVY_SORT_ARRAY, /* fixed-size array of values */ - PIT_VALUE_HEAVY_SORT_BYTES, /* bytestring */ - PIT_VALUE_HEAVY_SORT_FUNC, /* Lisp closure */ - PIT_VALUE_HEAVY_SORT_NATIVEFUNC /* native function */ - } hsort; - union { - pit_value cell; - struct { pit_value car, cdr; } cons; - struct { pit_value *data; i64 len; } array; - struct { u8 *data; i64 len; } bytes; - struct { pit_value env; pit_value args; pit_value body; } func; - pit_nativefunc nativefunc; - } in; -} pit_value_heavy; - -typedef struct { - pit_value name; /* ref to bytestring */ - pit_value value; /* ref to cell */ - pit_value function; /* ref to cell */ - bool is_macro, is_special_form; -} pit_symtab_entry; - -/* "programs"; vectors of "instructions" for a very simple VM used by the evaluator */ -typedef struct { - enum { - EVAL_PROGRAM_ENTRY_LITERAL, - EVAL_PROGRAM_ENTRY_APPLY - } sort; - union { - pit_value literal; - i64 apply; /* arity of application */ - } in; -} pit_runtime_eval_program_entry; -typedef struct { - i64 top, cap; - pit_runtime_eval_program_entry data[1]; /* flexible array member */ -} pit_runtime_eval_program; -pit_runtime_eval_program *pit_runtime_eval_program_new(i64 capacity); -void pit_runtime_eval_program_push_literal(struct pit_runtime *rt, pit_runtime_eval_program *s, pit_value x); -void pit_runtime_eval_program_push_apply(struct pit_runtime *rt, pit_runtime_eval_program *s, i64 arity); - -typedef struct pit_runtime { - /* interpreter state */ - pit_arena *values; /* all heavy values - effectively an array of pit_value_heavy - MUTABLE! */ - pit_arena *bytes; /* all bytestrings (including symbol names) - immutable */ - pit_arena *symtab; i64 symtab_len; /* all symbols - effectively an array of pit_symtab_entry - MUTABLE! */ - /* temporary/"scratch" memory */ - pit_arena *scratch; /* temporary arena used during parsing and evaluation */ - pit_values *saved_bindings; /* stack used to save old values of bindings to be restored ("shallow binding") */ - pit_values *expr_stack; /* stack of subexpressions to evaluate during evaluation */ - pit_values *result_stack; /* stack of intermediate values during evaluation */ - pit_runtime_eval_program *program; /* intermediate stack-based program constructed during evaluation */ - /* bookkeeping */ - /* "frozen" values offsets: values before these offsets are immutable, and we can reset here later */ - i64 frozen_values, frozen_bytes, frozen_symtab; - pit_value error; /* error value - if this is non-nil, an error has occured! only tracks the first error */ - i64 source_line, source_column; /* for error reporting only; line and column of token start */ - i64 error_line, error_column; /* line and column of token start at time of error */ -} pit_runtime; -pit_runtime *pit_runtime_new(void); - -void pit_runtime_freeze(pit_runtime *rt); /* freeze the runtime at the current point - everything currently defined becomes immutable */ -void pit_runtime_reset(pit_runtime *rt); /* restore the runtime to the frozen point, resetting everything that has happened since */ -bool pit_runtime_print_error(pit_runtime *rt); /* return true if an error has occured, and print to stderr */ - -i64 pit_dump(pit_runtime *rt, char *buf, i64 len, pit_value v, bool readable); /* if readable is true, try to produce output that can be machine-read (quotes on strings, etc) */ -#define pit_trace(rt, v) pit_trace_(rt, "Trace [" __FILE__ ":" PIT_STR(__LINE__) "] %s\n", v) -void pit_trace_(pit_runtime *rt, const char *format, pit_value v); -void pit_error(pit_runtime *rt, const char *format, ...); - -/* working with small values */ -pit_value pit_value_new(pit_runtime *rt, enum pit_value_sort s, u64 data); -double pit_as_double(pit_runtime *rt, pit_value v); -pit_value pit_double_new(pit_runtime *rt, double d); -i64 pit_as_integer(pit_runtime *rt, pit_value v); -pit_value pit_integer_new(pit_runtime *rt, i64 i); -pit_symbol pit_as_symbol(pit_runtime *rt, pit_value v); -pit_value pit_symbol_new(pit_runtime *rt, pit_symbol s); -pit_ref pit_as_ref(pit_runtime *rt, pit_value v); -pit_value pit_ref_new(pit_runtime *rt, pit_ref r); - -/* working with heavy values and refs */ -pit_value pit_heavy_new(pit_runtime *rt); -pit_value_heavy *pit_deref(pit_runtime *rt, pit_ref p); - -/* convenient predicates */ -bool pit_is_integer(pit_runtime *rt, pit_value a); -bool pit_is_double(pit_runtime *rt, pit_value a); -bool pit_is_symbol(pit_runtime *rt, pit_value a); -bool pit_is_value_heavy_sort(pit_runtime *rt, pit_value a, enum pit_value_heavy_sort e); -bool pit_is_cell(pit_runtime *rt, pit_value a); -bool pit_is_cons(pit_runtime *rt, pit_value a); -bool pit_is_array(pit_runtime *rt, pit_value a); -bool pit_is_bytes(pit_runtime *rt, pit_value a); -bool pit_is_func(pit_runtime *rt, pit_value a); -bool pit_is_nativefunc(pit_runtime *rt, pit_value a); -bool pit_eq(pit_value a, pit_value b); -bool pit_equal(pit_runtime *rt, pit_value a, pit_value b); - -/* working with binary data */ -pit_value pit_bytes_new(pit_runtime *rt, u8 *buf, i64 len); -pit_value pit_bytes_new_cstr(pit_runtime *rt, char *s); -pit_value pit_bytes_new_file(pit_runtime *rt, char *path); -bool pit_bytes_match(pit_runtime *rt, pit_value v, u8 *buf, i64 len); -i64 pit_as_bytes(pit_runtime *rt, pit_value v, u8 *buf, i64 maxlen); -bool pit_lexer_from_bytes(pit_runtime *rt, pit_lexer *ret, pit_value v); -pit_value pit_read_bytes(pit_runtime *rt, pit_value v); - -/* working with the symbol table */ -pit_value pit_intern(pit_runtime *rt, u8 *nm, i64 len); -pit_value pit_intern_cstr(pit_runtime *rt, char *nm); -bool pit_symbol_name_match(pit_runtime *rt, pit_value sym, u8 *buf, i64 len); -bool pit_symbol_name_match_cstr(pit_runtime *rt, pit_value sym, char *s); -pit_symtab_entry *pit_symtab_lookup(pit_runtime *rt, pit_value sym); -pit_value pit_get_value_cell(pit_runtime *rt, pit_value sym); -pit_value pit_get_function_cell(pit_runtime *rt, pit_value sym); -pit_value pit_get(pit_runtime *rt, pit_value sym); -void pit_set(pit_runtime *rt, pit_value sym, pit_value v); -pit_value pit_fget(pit_runtime *rt, pit_value sym); -void pit_fset(pit_runtime *rt, pit_value sym, pit_value v); -bool pit_is_symbol_macro(pit_runtime *rt, pit_value sym); -void pit_symbol_is_macro(pit_runtime *rt, pit_value sym); -void pit_mset(pit_runtime *rt, pit_value sym, pit_value v); -bool pit_is_symbol_special_form(pit_runtime *rt, pit_value sym); -void pit_symbol_is_special_form(pit_runtime *rt, pit_value sym); -void pit_sfset(pit_runtime *rt, pit_value sym, pit_value v); -void pit_bind(pit_runtime *rt, pit_value sym, pit_value v); -pit_value pit_unbind(pit_runtime *rt, pit_value sym); - -/* working with cells */ -pit_value pit_cell_new(pit_runtime *rt, pit_value v); -pit_value pit_cell_get(pit_runtime *rt, pit_value cell); -void pit_cell_set(pit_runtime *rt, pit_value cell, pit_value v); - -/* working with cons cells */ -pit_value pit_cons(pit_runtime *rt, pit_value car, pit_value cdr); -pit_value pit_list(pit_runtime *rt, i64 num, ...); -pit_value pit_car(pit_runtime *rt, pit_value v); -pit_value pit_cdr(pit_runtime *rt, pit_value v); -void pit_setcar(pit_runtime *rt, pit_value v, pit_value x); -void pit_setcdr(pit_runtime *rt, pit_value v, pit_value x); -pit_value pit_append(pit_runtime *rt, pit_value xs, pit_value ys); -pit_value pit_reverse(pit_runtime *rt, pit_value xs); -pit_value pit_contains_eq(pit_runtime *rt, pit_value needle, pit_value haystack); - -/* working with functions */ -pit_value pit_free_vars(pit_runtime *rt, pit_value args, pit_value body); -pit_value pit_lambda(pit_runtime *rt, pit_value args, pit_value body); -pit_value pit_nativefunc_new(pit_runtime *rt, pit_nativefunc f); -pit_value pit_apply(pit_runtime *rt, pit_value f, pit_value args); - -/* evaluation! */ -pit_value pit_expand_macros(pit_runtime *rt, pit_value top); -pit_value pit_eval(pit_runtime *rt, pit_value e); - -#endif diff --git a/src/types.h b/src/types.h deleted file mode 100644 index fcebfeb..0000000 --- a/src/types.h +++ /dev/null @@ -1,17 +0,0 @@ -#ifndef PIT_TYPES_H -#define PIT_TYPES_H - -#include -#include - -typedef int8_t i8; -typedef int16_t i16; -typedef int32_t i32; -typedef int64_t i64; - -typedef uint8_t u8; -typedef uint16_t u16; -typedef uint32_t u32; -typedef uint64_t u64; - -#endif diff --git a/src/utils.c b/src/utils.c index fcc4762..ebff4a7 100644 --- a/src/utils.c +++ b/src/utils.c @@ -2,7 +2,7 @@ #include #include -#include "utils.h" +#include void pit_panic(const char *format, ...) { va_list vargs; diff --git a/src/utils.h b/src/utils.h deleted file mode 100644 index 303055a..0000000 --- a/src/utils.h +++ /dev/null @@ -1,13 +0,0 @@ -#ifndef PIT_UTILS_H -#define PIT_UTILS_H - -#include - -#define PIT_STRSTR(x) #x -#define PIT_STR(x) PIT_STRSTR(x) -void pit_panic(const char *format, ...); -void pit_debug(const char *format, ...); -#define pit_mul(result, a, b) if (ckd_mul(result, a, b)) pit_panic("integer overflow during multiplication%s",""); - - -#endif diff --git a/test2.lisp b/test2.lisp new file mode 100644 index 0000000..79a9791 --- /dev/null +++ b/test2.lisp @@ -0,0 +1 @@ +(print "hello from test2") diff --git a/test3.lisp b/test3.lisp new file mode 100644 index 0000000..304533c --- /dev/null +++ b/test3.lisp @@ -0,0 +1,6 @@ +(let ((bs (bs/new!))) + (print! bs) + (bs/grow! 1 bs) + (bs/write8! bs 0 67) + (bs/spit! "test3.bin" bs) + ) -- cgit v1.2.3