diff options
| -rw-r--r-- | .gitignore | 2 | ||||
| -rw-r--r-- | Makefile | 30 | ||||
| -rw-r--r-- | flake.lock | 34 | ||||
| -rw-r--r-- | flake.nix | 40 | ||||
| -rw-r--r-- | src/lexer.c | 34 | ||||
| -rw-r--r-- | src/lexer.h | 11 | ||||
| -rw-r--r-- | src/library.c | 80 | ||||
| -rw-r--r-- | src/main.c | 25 | ||||
| -rw-r--r-- | src/parser.c | 36 | ||||
| -rw-r--r-- | src/parser.h | 2 | ||||
| -rw-r--r-- | src/runtime.c | 530 | ||||
| -rw-r--r-- | src/runtime.h | 120 | ||||
| -rw-r--r-- | src/utils.c | 4 | ||||
| -rw-r--r-- | src/utils.h | 8 |
14 files changed, 552 insertions, 404 deletions
@@ -1,4 +1,6 @@ /build/ /.direnv/ /pit +/*.a +/result TAGS
\ No newline at end of file @@ -1,20 +1,32 @@ -SRCS := src/main.c src/utils.c src/lexer.c src/parser.c src/runtime.c src/library.c +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 -CHK_SOURCES ?= $(SRCS) +AR ?= ar +CHK_SOURCES ?= src/main.c $(SRCS) CPPFLAGS ?= -MMD -MP -CFLAGS ?= -Ideps/ -Isrc/ -Wall -Wextra -Wpedantic -ftrapv --std=c23 -g +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 -.PHONY: all clean check-syntax +prefix ?= /usr/local +exec_prefix ?= $(prefix) +bindir ?= $(exec_prefix)/bin +includedir ?= $(prefix)/include +libdir ?= $(exec_prefix)/lib -all: $(EXE) +.PHONY: all clean install check-syntax -$(EXE): $(OBJECTS) +all: $(EXE) $(LIB) + +$(EXE): build/main.o $(LIB) $(CC) -o $@ $^ $(LDFLAGS) +$(LIB): $(OBJECTS) + ar rcs $@ $^ + build: mkdir build/ @@ -28,6 +40,12 @@ clean: TAGS: $(SRCS) 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) + check-syntax: TAGS gcc $(CFLAGS) -fsyntax-only $(CHK_SOURCES) @@ -1,5 +1,23 @@ { "nodes": { + "flake-utils": { + "inputs": { + "systems": "systems" + }, + "locked": { + "lastModified": 1731533236, + "narHash": "sha256-l0KFg5HjrsfsO/JpG+r7fRrqm12kzFHyUHqHCVpMMbI=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "11707dc2f618dd54ca8739b309ec4fc024de578b", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, "nixpkgs": { "locked": { "lastModified": 1738553537, @@ -18,8 +36,24 @@ }, "root": { "inputs": { + "flake-utils": "flake-utils", "nixpkgs": "nixpkgs" } + }, + "systems": { + "locked": { + "lastModified": 1681028828, + "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", + "owner": "nix-systems", + "repo": "default", + "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", + "type": "github" + }, + "original": { + "owner": "nix-systems", + "repo": "default", + "type": "github" + } } }, "root": "root", @@ -1,19 +1,35 @@ { inputs = { nixpkgs.url = "github:NixOS/nixpkgs/nixpkgs-unstable"; + flake-utils.url = "github:numtide/flake-utils"; }; outputs = { self, nixpkgs, ... }@inputs: - let - system = "x86_64-linux"; - pkgs = nixpkgs.legacyPackages.${system}; - in { - devShells.x86_64-linux.default = pkgs.mkShell { - hardeningDisable = [ "all" ]; - buildInputs = [ - pkgs.musl - pkgs.valgrind - ]; - }; - }; + inputs.flake-utils.lib.eachDefaultSystem + (system: + let + pkgs = nixpkgs.legacyPackages.${system}; + pit = pkgs.pkgsMusl.stdenv.mkDerivation { + pname = "pit"; + version = "git"; + src = ./.; + hardeningDisable = ["all"]; + installPhase = '' + make prefix=$out install + ''; + }; + in { + packages = { + inherit pit; + default = pit; + }; + devShells.default = pkgs.mkShell { + hardeningDisable = ["all"]; + buildInputs = [ + pkgs.musl + pkgs.valgrind + ]; + }; + } + ); } diff --git a/src/lexer.c b/src/lexer.c index f7cc05e..ac59400 100644 --- a/src/lexer.c +++ b/src/lexer.c @@ -8,14 +8,14 @@ #include "types.h" const char *PIT_LEX_TOKEN_NAMES[PIT_LEX_TOKEN__SENTINEL] = { - [PIT_LEX_TOKEN_EOF] = "eof", - [PIT_LEX_TOKEN_LPAREN] = "lparen", - [PIT_LEX_TOKEN_RPAREN] = "rparen", - [PIT_LEX_TOKEN_DOT] = "dot", - [PIT_LEX_TOKEN_QUOTE] = "quote", - [PIT_LEX_TOKEN_INTEGER_LITERAL] = "integer_literal", - [PIT_LEX_TOKEN_STRING_LITERAL] = "string_literal", - [PIT_LEX_TOKEN_SYMBOL] = "symbol", + /* [PIT_LEX_TOKEN_EOF] = */ "eof", + /* [PIT_LEX_TOKEN_LPAREN] = */ "lparen", + /* [PIT_LEX_TOKEN_RPAREN] = */ "rparen", + /* [PIT_LEX_TOKEN_DOT] = */ "dot", + /* [PIT_LEX_TOKEN_QUOTE] = */ "quote", + /* [PIT_LEX_TOKEN_INTEGER_LITERAL] = */ "integer_literal", + /* [PIT_LEX_TOKEN_STRING_LITERAL] = */ "string_literal", + /* [PIT_LEX_TOKEN_SYMBOL] = */ "symbol", }; const char *pit_lex_token_name(pit_lex_token t) { @@ -58,7 +58,7 @@ static bool match(pit_lexer *st, int (*f)(int)) { void pit_lex_cstr(pit_lexer *ret, char *buf) { ret->input = buf; - ret->len = strlen(buf); + ret->len = (i64) strlen(buf); ret->start = 0; ret->end = 0; ret->line = ret->start_line = 1; @@ -77,25 +77,31 @@ 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); - i64 len = ftell(f); + len = ftell(f); fseek(f, 0, SEEK_SET); - char *buf = calloc(ret->len, sizeof(char)); - fread(ret->input, sizeof(char), ret->len, f); + 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; + } fclose(f); pit_lex_bytes(ret, buf, len); } 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; - char c = advance(st); + c = advance(st); switch (c) { case 0: return PIT_LEX_TOKEN_EOF; case ';': while (is_more_input(st) && advance(st) != '\n'); goto restart; @@ -105,7 +111,7 @@ restart: case '\'': return PIT_LEX_TOKEN_QUOTE; case '"': while (peek(st) != '"') { - if (peek(st) == '\\') advance(st); // skip escaped characters + if (peek(st) == '\\') advance(st); /* skip escaped characters */ if (!advance(st)) { st->error = "unterminated string"; return PIT_LEX_TOKEN_ERROR; diff --git a/src/lexer.h b/src/lexer.h index 6f48d8f..19f8d71 100644 --- a/src/lexer.h +++ b/src/lexer.h @@ -13,18 +13,19 @@ typedef enum { PIT_LEX_TOKEN_INTEGER_LITERAL, PIT_LEX_TOKEN_STRING_LITERAL, PIT_LEX_TOKEN_SYMBOL, - PIT_LEX_TOKEN__SENTINEL, + 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 + 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); diff --git a/src/library.c b/src/library.c index 9aaadc3..de15db7 100644 --- a/src/library.c +++ b/src/library.c @@ -3,12 +3,10 @@ #include "lexer.h" #include "parser.h" #include "runtime.h" +#include "library.h" static pit_value impl_sf_quote(pit_runtime *rt, pit_value args) { - pit_runtime_eval_program_push(rt, rt->program, (pit_runtime_eval_program_entry) { - .sort = EVAL_PROGRAM_ENTRY_LITERAL, - .literal = pit_car(rt, args) - }); + pit_runtime_eval_program_push_literal(rt, rt->program, pit_car(rt, args)); return PIT_NIL; } @@ -29,20 +27,14 @@ static pit_value impl_sf_progn(pit_runtime *rt, pit_value args) { final = pit_eval(rt, pit_car(rt, bodyforms)); bodyforms = pit_cdr(rt, bodyforms); } - pit_runtime_eval_program_push(rt, rt->program, (pit_runtime_eval_program_entry) { - .sort = EVAL_PROGRAM_ENTRY_LITERAL, - .literal = final, - }); + 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(rt, rt->program, (pit_runtime_eval_program_entry) { - .sort = EVAL_PROGRAM_ENTRY_LITERAL, - .literal = pit_lambda(rt, as, body), - }); + pit_runtime_eval_program_push_literal(rt, rt->program, pit_lambda(rt, as, body)); return PIT_NIL; } @@ -71,6 +63,7 @@ static pit_value impl_m_let(pit_runtime *rt, pit_value args) { pit_value largs = PIT_NIL; pit_value binds = pit_car(rt, args); pit_value bodyforms = pit_cdr(rt, args); + pit_value lambda, application; while (binds != PIT_NIL) { pit_value bind = pit_car(rt, binds); pit_value sym = pit_car(rt, bind); @@ -79,14 +72,14 @@ static pit_value impl_m_let(pit_runtime *rt, pit_value args) { largs = pit_cons(rt, expr, largs); binds = pit_cdr(rt, binds); } - pit_value lambda = pit_cons(rt, pit_intern_cstr(rt, "lambda"), pit_cons(rt, lparams, bodyforms)); - pit_value application = pit_cons(rt, lambda, largs); + lambda = pit_cons(rt, pit_intern_cstr(rt, "lambda"), pit_cons(rt, lparams, bodyforms)); + application = pit_cons(rt, lambda, largs); return application; } static pit_value impl_m_and(pit_runtime *rt, pit_value args) { - args = pit_reverse(rt, args); pit_value ret = PIT_NIL; + args = pit_reverse(rt, args); if (args != PIT_NIL) { ret = pit_car(rt, args); args = pit_cdr(rt, args); @@ -134,13 +127,12 @@ static pit_value impl_funcall(pit_runtime *rt, pit_value args) { if (pit_is_symbol(rt, fsym)) { f = pit_fget(rt, fsym); } else { - // if f is not a symbol, assume it is a func or nativefunc - // most commonly, this happens when you funcall a variable - // with a function in the value cell, e.g. passing a lambda to a function + /* if f is not a symbol, assume it is a func or nativefunc + most commonly, this happens when you funcall a variable + with a function in the value cell, e.g. passing a lambda to a function */ f = fsym; } - pit_value as = pit_cdr(rt, args); - return pit_apply(rt, f, as); + return pit_apply(rt, f, pit_cdr(rt, args)); } static pit_value impl_eval(pit_runtime *rt, pit_value args) { @@ -152,25 +144,37 @@ 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; - pit_value bs = pit_bytes_new_file(rt, pathbuf); - pit_lexer lex; + 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 parse; pit_parser_from_lexer(&parse, &lex); - pit_value ret = PIT_NIL; - bool eof = false; - pit_value p = PIT_NIL; + 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_cons(pit_runtime *rt, pit_value args) { + return pit_cons(rt, pit_car(rt, args), pit_car(rt, pit_cdr(rt, args))); +} +static pit_value impl_car(pit_runtime *rt, pit_value args) { + return pit_car(rt, pit_car(rt, 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}; @@ -202,25 +206,41 @@ static pit_value impl_sub(pit_runtime *rt, pit_value args) { } 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, "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)); + /* eval */ + pit_fset(rt, pit_intern_cstr(rt, "eval"), pit_nativefunc_new(rt, impl_eval)); + + /* 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, "funcall"), pit_nativefunc_new(rt, impl_funcall)); - pit_fset(rt, pit_intern_cstr(rt, "eval"), pit_nativefunc_new(rt, impl_eval)); - pit_fset(rt, pit_intern_cstr(rt, "load"), pit_nativefunc_new(rt, impl_load)); - 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)); + + /* 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)); + + /* 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)); + + /* 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)); + + /* disk IO */ + pit_fset(rt, pit_intern_cstr(rt, "load"), pit_nativefunc_new(rt, impl_load)); } @@ -8,18 +8,19 @@ int main(int argc, char **argv) { pit_runtime *rt = pit_runtime_new(); - if (argc < 2) { // run repl + if (argc < 2) { /* run repl */ + char buf[1024] = {0}; + i64 len = 0; pit_runtime_freeze(rt); setbuf(stdout, NULL); printf("> "); - char buf[1024] = {0}; - i64 len = 0; - while (len < (i64) sizeof(buf) && (buf[len++] = getchar()) != EOF) { + while (len < (i64) sizeof(buf) && (buf[len++] = (char) getchar()) != EOF) { if (buf[len - 1] == '\n') { + pit_value bs, prog, res; buf[len - 1] = 0; - pit_value bs = pit_bytes_new_cstr(rt, buf); - pit_value prog = pit_read_bytes(rt, bs); - pit_value res = pit_eval(rt, prog); + bs = pit_bytes_new_cstr(rt, buf); + prog = pit_read_bytes(rt, bs); + res = pit_eval(rt, prog); if (pit_runtime_print_error(rt)) { rt->error = PIT_NIL; printf("> "); @@ -31,16 +32,16 @@ int main(int argc, char **argv) { len = 0; } } - } else { // run file + } else { /* run file */ pit_value bs = pit_bytes_new_file(rt, argv[1]); pit_lexer lex; + pit_parser parse; + bool eof = false; + pit_value p = PIT_NIL; if (!pit_lexer_from_bytes(rt, &lex, bs)) { pit_error(rt, "failed to initialize lexer"); } - pit_parser parse; pit_parser_from_lexer(&parse, &lex); - bool eof = false; - pit_value p = PIT_NIL; while (p = pit_parse(rt, &parse, &eof), !eof) { pit_eval(rt, p); if (pit_runtime_print_error(rt)) { @@ -48,5 +49,5 @@ int main(int argc, char **argv) { } } } - + return 0; } diff --git a/src/parser.c b/src/parser.c index 30e38e6..1a9f663 100644 --- a/src/parser.c +++ b/src/parser.c @@ -33,7 +33,7 @@ static bool match(pit_parser *st, pit_lex_token t) { static void get_token_string(pit_parser *st, char *buf, i64 len) { i64 diff = st->cur.end - st->cur.start; i64 tlen = diff >= len ? len - 1 : diff; - memcpy(buf, st->lexer->input + st->cur.start, tlen); + memcpy(buf, st->lexer->input + st->cur.start, (size_t) tlen); buf[tlen] = 0; } @@ -47,10 +47,12 @@ void pit_parser_from_lexer(pit_parser *ret, pit_lexer *lex) { advance(ret); } -// parse a single expression +/* parse a single expression */ pit_value pit_parse(pit_runtime *rt, pit_parser *st, bool *eof) { char buf[256] = {0}; - pit_lex_token t = advance(st); + pit_lex_token t; + if (rt == NULL || st == NULL) return PIT_NIL; + t = advance(st); rt->source_line = st->cur.line; rt->source_column = st->cur.column; switch (t) { @@ -65,19 +67,21 @@ pit_value pit_parse(pit_runtime *rt, pit_parser *st, bool *eof) { } return PIT_NIL; case PIT_LEX_TOKEN_LPAREN: { - // to construct a cons-list, we need the arguments "backwards" - // we could reverse or build up a temporary list - // (or use non-tail recursion, which is basically the temporary list on the stack) - // we choose to build a temporary list on the scratch arena + /* to construct a cons-list, we need the arguments "backwards" + we could reverse or build up a temporary list + (or use non-tail recursion, which is basically the temporary list on the stack) + we choose to build a temporary list on the scratch arena + */ 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! + if (rt->error != PIT_NIL) return PIT_NIL; /* if we hit an error, stop!*/ } - pit_value ret = PIT_NIL; - for (i64 i = rt->scratch->next - sizeof(pit_value); i >= scratch_reset; i -= sizeof(pit_value)) { - pit_value *v = pit_arena_idx(rt->scratch, i); + for (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); } rt->scratch->next = scratch_reset; @@ -88,16 +92,18 @@ pit_value pit_parse(pit_runtime *rt, pit_parser *st, bool *eof) { case PIT_LEX_TOKEN_INTEGER_LITERAL: get_token_string(st, buf, sizeof(buf)); return pit_integer_new(rt, atoi(buf)); - case PIT_LEX_TOKEN_STRING_LITERAL: + case PIT_LEX_TOKEN_STRING_LITERAL: { + i64 len, cur, i; get_token_string(st, buf, sizeof(buf)); - i64 len = strlen(buf); - i64 cur = 0; - for (i64 i = 1; i < len; ++i) { + len = (i64) strlen(buf); + cur = 0; + for (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; } return pit_bytes_new(rt, (u8 *) buf, cur); + } case PIT_LEX_TOKEN_SYMBOL: get_token_string(st, buf, sizeof(buf)); return pit_intern_cstr(rt, buf); diff --git a/src/parser.h b/src/parser.h index bcd5458..08c0bee 100644 --- a/src/parser.h +++ b/src/parser.h @@ -7,7 +7,7 @@ typedef struct { pit_lex_token token; i64 start, end; - i64 line, column; // for error reporting + i64 line, column; /* for error reporting */ } pit_parser_token_info; typedef struct { diff --git a/src/runtime.c b/src/runtime.c index 2d30420..6c9add8 100644 --- a/src/runtime.c +++ b/src/runtime.c @@ -12,7 +12,7 @@ #include "library.h" pit_arena *pit_arena_new(i64 capacity, i64 elem_size) { - pit_arena *a = malloc(sizeof(pit_arena) + capacity * elem_size); + pit_arena *a = malloc(sizeof(pit_arena) + (size_t) capacity * (size_t) elem_size); a->elem_size = elem_size; a->capacity = capacity; a->next = 0; @@ -49,22 +49,26 @@ void *pit_arena_alloc_bulk(pit_arena *a, i64 num) { } enum pit_value_sort pit_value_sort(pit_value v) { - // if this isn't a NaN, or it's a quiet NaN, this is a real double - if (((v >> 52) & 0b011111111111) != 0b011111111111 || ((v >> 51) & 0b1) == 1) return PIT_VALUE_SORT_DOUBLE; - // otherwise, we've packed something else in the significand - // 0 for signaling NaN -+ - // sign --+ +- 1 (NaN)| +- our sort tag + our data - // | | | | | - // s111111111110ttddddddddddddddddddddddddddddddddddddddddddddddddd - return (v & 0b0000000000000110000000000000000000000000000000000000000000000000) >> 49; + /* if this isn't a NaN, or it's a quiet NaN, this is a real double */ + /* if (((v >> 52) & 0b011111111111) != 0b011111111111 || ((v >> 51) & 0b1) == 1) return PIT_VALUE_SORT_DOUBLE; */ + if (((v >> 52) & 0x7ff) != 0x7ff || ((v >> 51) & 1) == 1) return PIT_VALUE_SORT_DOUBLE; + /* otherwise, we've packed something else in the significand + 0 for signaling NaN -+ + sign --+ +- 1 (NaN)| +- our sort tag + our data + | | | | | + s111111111110ttddddddddddddddddddddddddddddddddddddddddddddddddd */ + /* return (v & 0b0000000000000110000000000000000000000000000000000000000000000000) >> 49; */ + return (v & 0x6000000000000) >> 49; /* equivalent hex literal */ } u64 pit_value_data(pit_value v) { - return v & 0b0000000000000001111111111111111111111111111111111111111111111111; + /* return v & 0b0000000000000001111111111111111111111111111111111111111111111111; */ + return v & 0x1ffffffffffff; } 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)); @@ -80,9 +84,9 @@ pit_runtime *pit_runtime_new() { ret->error = PIT_NIL; ret->source_line = ret->source_column = -1; ret->error_line = ret->error_column = -1; - pit_value nil = pit_intern_cstr(ret, "nil"); // nil must be the 0th symbol for PIT_NIL to work + nil = pit_intern_cstr(ret, "nil"); /* nil must be the 0th symbol for PIT_NIL to work */ pit_set(ret, nil, PIT_NIL); - pit_value truth = pit_intern_cstr(ret, "t"); + truth = pit_intern_cstr(ret, "t"); pit_set(ret, truth, truth); pit_install_library_essential(ret); pit_runtime_freeze(ret); @@ -114,34 +118,35 @@ i64 pit_dump(pit_runtime *rt, char *buf, i64 len, pit_value v, bool readable) { if (len <= 0) return 0; switch (pit_value_sort(v)) { case PIT_VALUE_SORT_DOUBLE: - return snprintf(buf, len, "%lf", pit_as_double(rt, v)); + return snprintf(buf, (size_t) len, "%lf", pit_as_double(rt, v)); case PIT_VALUE_SORT_INTEGER: - return snprintf(buf, len, "%ld", pit_as_integer(rt, v)); - case PIT_VALUE_SORT_SYMBOL: + return snprintf(buf, (size_t) len, "%ld", pit_as_integer(rt, v)); + case PIT_VALUE_SORT_SYMBOL: { pit_symtab_entry *ent = pit_symtab_lookup(rt, v); if (ent && pit_value_sort(ent->name) == PIT_VALUE_SORT_REF && (h = pit_deref(rt, pit_as_ref(rt, ent->name))) ) { i64 i = 0; - for (; i < h->bytes.len && i < len - 1; ++i) { - buf[i] = h->bytes.data[i]; + for (; i < h->in.bytes.len && i < len - 1; ++i) { + buf[i] = (char) h->in.bytes.data[i]; } return i; } else { - return snprintf(buf, len, "<broken symbol %d>", pit_as_symbol(rt, v)); + return snprintf(buf, (size_t) len, "<broken symbol %d>", pit_as_symbol(rt, v)); } - case PIT_VALUE_SORT_REF: + } + case PIT_VALUE_SORT_REF: { pit_ref r = pit_as_ref(rt, v); h = pit_deref(rt, r); - if (!h) snprintf(buf, len, "<ref %d>", r); + if (!h) snprintf(buf, (size_t) len, "<ref %d>", r); else { switch (h->hsort) { case PIT_VALUE_HEAVY_SORT_CELL: { char *end = buf + len; char *start = buf; *(buf++) = '{'; - buf += pit_dump(rt, buf, end - buf, pit_car(rt, h->cell), readable); + buf += pit_dump(rt, buf, end - buf, pit_car(rt, h->in.cell), readable); *(buf++) = '}'; return buf - start; } @@ -155,7 +160,7 @@ i64 pit_dump(pit_runtime *rt, char *buf, i64 len, pit_value v, bool readable) { buf += pit_dump(rt, buf, end - buf, pit_car(rt, cur), readable); if (buf >= end) return end - buf; } else { - buf += snprintf(buf, end - buf, " . "); + buf += snprintf(buf, (size_t) (end - buf), " . "); if (buf >= end) return end - buf; buf += pit_dump(rt, buf, end - buf, cur, readable); if (buf >= end) return end - buf; @@ -165,23 +170,26 @@ i64 pit_dump(pit_runtime *rt, char *buf, i64 len, pit_value v, bool readable) { *(buf++) = ')'; return buf - start; } - case PIT_VALUE_HEAVY_SORT_BYTES: - i64 i = 0; + case PIT_VALUE_HEAVY_SORT_BYTES: { + i64 i, maxlen, j; + i = 0; if (readable) buf[i++] = '"'; - i64 maxlen = len - i; - for (i64 j = 0; i < maxlen && j < h->bytes.len;) { - if (buf[i - 1] != '\\' && (h->bytes.data[j] == '\\' || h->bytes.data[j] == '"')) + maxlen = len - i; + for (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++] = h->bytes.data[j++]; + else buf[i++] = (char) h->in.bytes.data[j++]; } if (readable && i < len - 1) buf[i++] = '"'; return i; + } default: - return snprintf(buf, len, "<ref %d>", r); + return snprintf(buf, (size_t) len, "<ref %d>", r); } } break; } + } return 0; } @@ -192,7 +200,7 @@ 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 (pit_eq(rt->error, PIT_NIL)) { /* only record the first error encountered */ char buf[1024] = {0}; va_list vargs; va_start(vargs, format); @@ -206,22 +214,26 @@ void pit_error(pit_runtime *rt, const char *format, ...) { pit_value pit_value_new(pit_runtime *rt, enum pit_value_sort s, u64 data) { if (s == PIT_VALUE_SORT_DOUBLE) { - if (((data >> 52) & 0b011111111111) == 0b011111111111 && ((data >> 51) & 0b1) == 0) { + /* if (((data >> 52) & 0b011111111111) == 0b011111111111 && ((data >> 51) & 0b1) == 0) { */ + if (((data >> 52) & 0x7ff) == 0x7ff && ((data >> 51) & 1) == 0) { pit_error(rt, "attempted to create a signalling NaN double"); return PIT_NIL; } return data; } return - 0b1111111111110000000000000000000000000000000000000000000000000000 - | (((u64) (s & 0b11)) << 49) - | (data & 0b1111111111111111111111111111111111111111111111111); + /* 0b1111111111110000000000000000000000000000000000000000000000000000 */ + 0xfff0000000000000 + /* | (((u64) (s & 0b11)) << 49) */ + | (((u64) (s & 3)) << 49) + /* | (data & 0b1111111111111111111111111111111111111111111111111); */ + | (data & 0x1ffffffffffff); } double pit_as_double(pit_runtime *rt, pit_value v) { if (pit_value_sort(v) != PIT_VALUE_SORT_DOUBLE) { pit_error(rt, "invalid use of value as double"); - return NAN; + return 0.0; } return (double) v; } @@ -230,12 +242,14 @@ 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; } - u64 lo = pit_value_data(v); - return ((i64) (lo << 15)) >> 15; // sign-extend low 49 bits + lo = pit_value_data(v); + return ((i64) (lo << 15)) >> 15; /* sign-extend low 49 bits */ + } pit_value pit_integer_new(pit_runtime *rt, i64 i) { return pit_value_new(rt, PIT_VALUE_SORT_INTEGER, (u64) i); @@ -246,7 +260,7 @@ pit_symbol pit_as_symbol(pit_runtime *rt, pit_value v) { pit_error(rt, "invalid use of value as symbol"); return -1; } - return pit_value_data(v) & 0xffffffff; + return (pit_symbol) (pit_value_data(v) & 0xffffffff); } pit_value pit_symbol_new(pit_runtime *rt, pit_symbol s) { return pit_value_new(rt, PIT_VALUE_SORT_SYMBOL, (u64) s); @@ -257,7 +271,7 @@ pit_ref pit_as_ref(pit_runtime *rt, pit_value v) { pit_error(rt, "invalid use of value as ref"); return -1; } - return pit_value_data(v) & 0xffffffff; + return (pit_ref) (pit_value_data(v) & 0xffffffff); } pit_value pit_ref_new(pit_runtime *rt, pit_ref r) { return pit_value_new(rt, PIT_VALUE_SORT_REF, (u64) r); @@ -286,10 +300,11 @@ 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) { switch (pit_value_sort(a)) { - case PIT_VALUE_SORT_REF: - pit_value_heavy *ha = pit_deref(rt, a); + case PIT_VALUE_SORT_REF: { + pit_value_heavy *ha = pit_deref(rt, pit_as_ref(rt, a)); if (!ha) { pit_error(rt, "bad ref"); return false; } return ha->hsort == e; + } default: break; } @@ -323,135 +338,159 @@ bool pit_equal(pit_runtime *rt, pit_value a, pit_value b) { case PIT_VALUE_SORT_INTEGER: case PIT_VALUE_SORT_SYMBOL: return pit_value_data(a) == pit_value_data(b); - case PIT_VALUE_SORT_REF: - pit_value_heavy *ha = pit_deref(rt, a); + case PIT_VALUE_SORT_REF: { + pit_value_heavy *ha, *hb; + ha = pit_deref(rt, pit_as_ref(rt, a)); if (!ha) { pit_error(rt, "bad ref"); return false; } - pit_value_heavy *hb = pit_deref(rt, b); + 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) { case PIT_VALUE_HEAVY_SORT_CELL: - return pit_equal(rt, ha->cell, hb->cell); + return pit_equal(rt, ha->in.cell, hb->in.cell); case PIT_VALUE_HEAVY_SORT_CONS: - return pit_equal(rt, ha->cons.car, hb->cons.car) && pit_equal(rt, ha->cons.cdr, hb->cons.cdr); - case PIT_VALUE_HEAVY_SORT_ARRAY: - if (ha->array.len != hb->array.len) return false; - for (i64 i = 0; i < ha->array.len; ++i) { - if (!pit_equal(rt, ha->array.data[i], hb->array.data[i])) return false; + 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) { + if (!pit_equal(rt, ha->in.array.data[i], hb->in.array.data[i])) return false; } return true; - case PIT_VALUE_HEAVY_SORT_BYTES: - if (ha->bytes.len != hb->bytes.len) return false; - for (i64 i = 0; i < ha->bytes.len; ++i) { - if (ha->bytes.data[i] != hb->bytes.data[i]) return false; + } + 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) { + if (ha->in.bytes.data[i] != hb->in.bytes.data[i]) return false; } return true; + } case PIT_VALUE_HEAVY_SORT_FUNC: return - pit_equal(rt, ha->func.env, hb->func.env) - && pit_equal(rt, ha->func.args, hb->func.args) - && pit_equal(rt, ha->func.body, hb->func.body); + pit_equal(rt, ha->in.func.env, hb->in.func.env) + && pit_equal(rt, ha->in.func.args, hb->in.func.args) + && pit_equal(rt, ha->in.func.body, hb->in.func.body); case PIT_VALUE_HEAVY_SORT_NATIVEFUNC: - return ha->nativefunc == hb->nativefunc; + return ha->in.nativefunc == hb->in.nativefunc; } } + } 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, len); - pit_value ret = pit_heavy_new(rt); - pit_value_heavy *h = pit_deref(rt, ret); + memcpy(dest, buf, (size_t) len); + ret = pit_heavy_new(rt); + 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->bytes.data = dest; - h->bytes.len = len; + h->in.bytes.data = dest; + h->in.bytes.len = len; return ret; } pit_value pit_bytes_new_cstr(pit_runtime *rt, char *s) { - return pit_bytes_new(rt, (u8 *) s, strlen(s)); + return pit_bytes_new(rt, (u8 *) s, (i64) strlen(s)); } pit_value pit_bytes_new_file(pit_runtime *rt, char *path) { 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); - i64 len = ftell(f); + len = ftell(f); fseek(f, 0, SEEK_SET); - u8 *dest = pit_arena_alloc_bulk(rt->bytes, len); + dest = pit_arena_alloc_bulk(rt->bytes, len); if (!dest) { pit_error(rt, "failed to allocate bytes"); fclose(f); return PIT_NIL; } - fread(dest, sizeof(char), len, f); + if ((size_t) len != fread(dest, sizeof(char), (size_t) len, f)) { + fclose(f); + pit_error(rt, "failed to read file: %s", path); + return PIT_NIL; + } fclose(f); - pit_value ret = pit_heavy_new(rt); - pit_value_heavy *h = pit_deref(rt, ret); + ret = pit_heavy_new(rt); + 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->bytes.data = dest; - h->bytes.len = len; + h->in.bytes.data = dest; + h->in.bytes.len = len; return ret; } -// return true if v is a reference to bytes that are the same as those in buf +/* 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; - pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, v)); + 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->bytes.len != len) return false; - for (i64 i = 0; i < len; ++i) - if (h->bytes.data[i] != buf[i]) { + if (h->in.bytes.len != len) return false; + for (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; - pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, v)); + 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; } - i64 len = maxlen < h->bytes.len ? maxlen : h->bytes.len; - for (i64 i = 0; i < len; ++i) { - buf[i] = h->bytes.data[i]; + len = maxlen < h->in.bytes.len ? maxlen : h->in.bytes.len; + for (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; - pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, v)); + 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"); return -1; } - pit_lex_bytes(ret, (char *) h->bytes.data, h->bytes.len); + pit_lex_bytes(ret, (char *) h->in.bytes.data, h->in.bytes.len); return true; } -pit_value pit_read_bytes(pit_runtime *rt, pit_value v) { // read a single lisp form from a bytestring +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; if (!pit_lexer_from_bytes(rt, &lex, v)) { pit_error(rt, "failed to initialize lexer"); return PIT_NIL; } - pit_parser parse; pit_parser_from_lexer(&parse, &lex); - pit_value program = pit_parse(rt, &parse, NULL); - return pit_eval(rt, program); + return pit_parse(rt, &parse, NULL); } pit_value pit_intern(pit_runtime *rt, u8 *nm, i64 len) { - for (i64 i = 0; i < rt->symtab_len; ++i) { - pit_symbol idx = i * sizeof(pit_symtab_entry); - pit_symtab_entry *ent = pit_arena_idx(rt->symtab, idx); - if (!ent) { pit_error(rt, "corrupted symbol table"); return PIT_NIL; } - if (pit_bytes_match(rt, ent->name, nm, len)) return pit_symbol_new(rt, idx); - } - i64 idx = pit_arena_alloc_idx(rt->symtab); - pit_symtab_entry *ent = pit_arena_idx(rt->symtab, idx); + i64 i; + i32 idx; + pit_symtab_entry *ent; + for (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); 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; @@ -461,14 +500,8 @@ pit_value pit_intern(pit_runtime *rt, u8 *nm, i64 len) { rt->symtab_len += 1; return pit_symbol_new(rt, idx); } - pit_value pit_intern_cstr(pit_runtime *rt, char *nm) { - return pit_intern(rt, (u8 *) nm, strlen(nm)); -} - -pit_symtab_entry *pit_symtab_lookup(pit_runtime *rt, pit_value sym) { - pit_symbol s = pit_as_symbol(rt, sym); - return pit_arena_idx(rt->symtab, s); + return pit_intern(rt, (u8 *) nm, (i64) strlen(nm)); } bool pit_symbol_name_match(pit_runtime *rt, pit_value sym, u8 *buf, i64 len) { pit_symtab_entry *ent = pit_symtab_lookup(rt, sym); @@ -476,7 +509,11 @@ bool pit_symbol_name_match(pit_runtime *rt, pit_value sym, u8 *buf, i64 len) { return pit_bytes_match(rt, ent->name, buf, len); } bool pit_symbol_name_match_cstr(pit_runtime *rt, pit_value sym, char *s) { - return pit_symbol_name_match(rt, sym, (u8 *) s, strlen(s)); + return pit_symbol_name_match(rt, sym, (u8 *) s, (i64) strlen(s)); +} +pit_symtab_entry *pit_symtab_lookup(pit_runtime *rt, pit_value sym) { + pit_symbol s = pit_as_symbol(rt, sym); + return pit_arena_idx(rt->symtab, s); } pit_value pit_get_value_cell(pit_runtime *rt, pit_value sym) { pit_symtab_entry *ent = pit_symtab_lookup(rt, sym); @@ -493,8 +530,9 @@ 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; } - pit_symtab_entry *ent = pit_symtab_lookup(rt, sym); + 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); @@ -506,8 +544,9 @@ 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; } - pit_symtab_entry *ent = pit_symtab_lookup(rt, sym); + 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); @@ -543,7 +582,7 @@ void pit_sfset(pit_runtime *rt, pit_value sym, pit_value v) { pit_symbol_is_special_form(rt, sym); } void pit_bind(pit_runtime *rt, pit_value sym, pit_value cell) { - // although we cannot set frozen symbols, we can still bind them temporarily - no need to check + /* although we cannot set frozen symbols, we can still bind them temporarily - no need to check */ pit_symtab_entry *ent = pit_symtab_lookup(rt, sym); if (!ent) { pit_error(rt, "bad symbol"); return; } pit_values_push(rt, rt->saved_bindings, ent->value); @@ -551,104 +590,115 @@ 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; } - pit_value old = ent->value; + old = ent->value; ent->value = pit_values_pop(rt, rt->saved_bindings); return old; } pit_value pit_cell_new(pit_runtime *rt, pit_value v) { pit_value ret = pit_heavy_new(rt); - pit_value_heavy *h = pit_deref(rt, ret); + pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, ret)); if (!h) { pit_error(rt, "failed to create new heavy value for cell"); return PIT_NIL; } h->hsort = PIT_VALUE_HEAVY_SORT_CELL; - h->cell = v; + h->in.cell = 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; } - pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, cell)); + 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"); return PIT_NIL; } - return h->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; } - pit_ref idx = pit_as_ref(rt, cell); + idx = pit_as_ref(rt, cell); if (idx < rt->frozen_values) { pit_error(rt, "attempt to modify frozen cell"); return; } - pit_value_heavy *h = pit_deref(rt, idx); + 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"); return; } - h->cell = v; + h->in.cell = v; } pit_value pit_cons(pit_runtime *rt, pit_value car, pit_value cdr) { pit_value ret = pit_heavy_new(rt); - pit_value_heavy *h = pit_deref(rt, ret); + pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, ret)); if (!h) { pit_error(rt, "failed to create new heavy value for cons"); return PIT_NIL; } h->hsort = PIT_VALUE_HEAVY_SORT_CONS; - h->cons.car = car; - h->cons.cdr = cdr; + h->in.cons.car = car; + h->in.cons.cdr = cdr; return ret; } pit_value pit_list(pit_runtime *rt, i64 num, ...) { pit_value temp[64]; - if (num > 64) { pit_error(rt, "failed to create list of size %d\n", num); return PIT_NIL; } va_list elems; + i64 i; + pit_value ret = PIT_NIL; + if (num > 64) { pit_error(rt, "failed to create list of size %d\n", num); return PIT_NIL; } va_start(elems, num); - for (i64 i = 0; i < num; ++i) { + for (i = 0; i < num; ++i) { temp[i] = va_arg(elems, pit_value); } va_end(elems); - pit_value ret = PIT_NIL; - for (i64 i = 0; i < num; ++i) { + for (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; - pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, v)); + 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->cons.car; + 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; - pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, v)); + 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->cons.cdr; + 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; } - pit_ref idx = pit_as_ref(rt, v); + idx = pit_as_ref(rt, v); if (idx < rt->frozen_values) { pit_error(rt, "attempted to modify frozen cons"); return; } - pit_value_heavy *h = pit_deref(rt, idx); + 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->cons.car = x; + 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; } - pit_ref idx = pit_as_ref(rt, v); + idx = pit_as_ref(rt, v); if (idx < rt->frozen_values) { pit_error(rt, "attempted to modify frozen cons"); return; } - pit_value_heavy *h = pit_deref(rt, idx); + 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->cons.cdr = x; + h->in.cons.cdr = x; } pit_value pit_append(pit_runtime *rt, pit_value xs, pit_value ys) { pit_value ret = ys; @@ -675,9 +725,8 @@ pit_value pit_contains_eq(pit_runtime *rt, pit_value needle, pit_value haystack) return PIT_NIL; } -pit_value pit_free_vars(pit_runtime *rt, pit_value args, pit_value body) { +pit_value pit_free_vars(pit_runtime *rt, pit_value bound, pit_value body) { i64 expr_stack_reset = rt->expr_stack->top; - pit_value bound = args; pit_value ret = PIT_NIL; pit_values_push(rt, rt->expr_stack, body); while (rt->expr_stack->top > 0) { @@ -685,16 +734,16 @@ pit_value pit_free_vars(pit_runtime *rt, pit_value args, pit_value body) { if (pit_is_cons(rt, cur)) { pit_value fsym = pit_car(rt, cur); bool is_symbol = pit_is_symbol(rt, fsym); - pit_value args = pit_cdr(rt, cur); + pit_value fargs = pit_cdr(rt, cur); if (is_symbol && pit_symbol_name_match_cstr(rt, fsym, "lambda")) { - bound = pit_append(rt, pit_car(rt, args), bound); + bound = pit_append(rt, pit_car(rt, fargs), bound); } else if (is_symbol && pit_symbol_name_match_cstr(rt, fsym, "quote")) { - // don't look inside quote! - // if we add other special forms, make sure to consider them here if necessary! + /* don't look inside quote! + if we add other special forms, make sure to consider them here if necessary! */ } else { - while (args != PIT_NIL) { - pit_values_push(rt, rt->expr_stack, pit_car(rt, args)); - args = pit_cdr(rt, args); + while (fargs != PIT_NIL) { + pit_values_push(rt, rt->expr_stack, pit_car(rt, fargs)); + fargs = pit_cdr(rt, fargs); } if (!is_symbol) { pit_values_push(rt, rt->expr_stack, fsym); @@ -711,11 +760,12 @@ 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 ret = pit_heavy_new(rt); - pit_value_heavy *h = pit_deref(rt, ret); + 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; } - 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; + expanded = pit_expand_macros(rt, pit_cons(rt, pit_intern_cstr(rt, "progn"), body)); + freevars = pit_free_vars(rt, args, expanded); + env = PIT_NIL; while (freevars != PIT_NIL) { pit_value sym = pit_car(rt, freevars); pit_value cell = pit_get_value_cell(rt, sym); @@ -723,7 +773,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; - pit_value arg_cells = PIT_NIL; + 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)); @@ -731,37 +781,38 @@ pit_value pit_lambda(pit_runtime *rt, pit_value args, pit_value body) { args = pit_cdr(rt, args); } arg_cells = pit_reverse(rt, arg_cells); - h->func.args = arg_cells; - h->func.env = env; - h->func.body = expanded; + h->in.func.args = arg_cells; + h->in.func.env = env; + h->in.func.body = expanded; return ret; } pit_value pit_nativefunc_new(pit_runtime *rt, pit_nativefunc f) { pit_value ret = pit_heavy_new(rt); - pit_value_heavy *h = pit_deref(rt, ret); + pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, ret)); if (!h) { pit_error(rt, "failed to create new heavy value for nativefunc"); return PIT_NIL; } h->hsort = PIT_VALUE_HEAVY_SORT_NATIVEFUNC; - h->nativefunc = f; + h->in.nativefunc = f; return ret; } pit_value pit_apply(pit_runtime *rt, pit_value f, pit_value args) { switch (pit_value_sort(f)) { - case PIT_VALUE_SORT_REF: + case PIT_VALUE_SORT_REF: { pit_value_heavy *h = pit_deref(rt, pit_as_ref(rt, f)); if (!h) { pit_error(rt, "bad ref"); return PIT_NIL; } if (h->hsort == PIT_VALUE_HEAVY_SORT_FUNC) { - // calling a Lisp function is simple! + /* calling a Lisp function is simple! */ pit_value bound = PIT_NIL; - pit_value env = h->func.env; - while (env != PIT_NIL) { // first, bind all entries in the closure + 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); pit_bind(rt, nm, pit_cdr(rt, b)); bound = pit_cons(rt, nm, bound); env = pit_cdr(rt, env); } - pit_value anames = h->func.args; - while (anames != PIT_NIL) { // bind all argument names to their values + 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); pit_value cell = pit_cdr(rt, aform); @@ -771,19 +822,20 @@ pit_value pit_apply(pit_runtime *rt, pit_value f, pit_value args) { args = pit_cdr(rt, args); anames = pit_cdr(rt, anames); } - pit_value ret = pit_eval(rt, h->func.body); // evaluate the body - while (bound != PIT_NIL) { // unbind everything we bound earlier, in reverse + 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); } return ret; } else if (h->hsort == PIT_VALUE_HEAVY_SORT_NATIVEFUNC) { - // calling native functions is even simpler - return h->nativefunc(rt, args); + /* calling native functions is even simpler */ + return h->in.nativefunc(rt, args); } else { pit_error(rt, "attempt to apply non-nativefunc ref"); return PIT_NIL; } + } default: pit_error(rt, "attempted to apply non-function value"); return PIT_NIL; @@ -791,8 +843,8 @@ pit_value pit_apply(pit_runtime *rt, pit_value f, pit_value args) { } pit_values *pit_values_new(i64 capacity) { - i64 cap = capacity / sizeof(pit_value); - pit_values *ret = malloc(sizeof(*ret) + cap * sizeof(pit_value)); + i64 cap = capacity / (i64) sizeof(pit_value); + pit_values *ret = malloc(sizeof(*ret) + (size_t) cap * sizeof(pit_value)); ret->top = 0; ret->cap = cap; return ret; @@ -808,26 +860,37 @@ pit_value pit_values_pop(pit_runtime *rt, pit_values *s) { } pit_runtime_eval_program *pit_runtime_eval_program_new(i64 capacity) { - i64 cap = capacity / sizeof(pit_runtime_eval_program_entry); - pit_runtime_eval_program *ret = malloc(sizeof(*ret) + cap * sizeof(pit_runtime_eval_program_entry)); + i64 cap = capacity / (i64) sizeof(pit_runtime_eval_program_entry); + pit_runtime_eval_program *ret = malloc(sizeof(*ret) + (size_t) cap * sizeof(pit_runtime_eval_program_entry)); ret->top = 0; ret->cap = cap; return ret; } -void pit_runtime_eval_program_push(pit_runtime *rt, pit_runtime_eval_program *s, pit_runtime_eval_program_entry x) { +void pit_runtime_eval_program_push_literal(pit_runtime *rt, pit_runtime_eval_program *s, pit_value x) { + pit_runtime_eval_program_entry *ent = &s->data[s->top++]; + ent->sort = EVAL_PROGRAM_ENTRY_LITERAL; + ent->in.literal = x; + if (s->top >= s->cap) { pit_error(rt, "evaluation program overflow"); } (void) rt; - s->data[s->top++] = x; +} +void pit_runtime_eval_program_push_apply(pit_runtime *rt, pit_runtime_eval_program *s, i64 arity) { + pit_runtime_eval_program_entry *ent = &s->data[s->top++]; + ent->sort = EVAL_PROGRAM_ENTRY_APPLY; + ent->in.apply = arity; if (s->top >= s->cap) { pit_error(rt, "evaluation program overflow"); } + (void) rt; } 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; if (rt->error != PIT_NIL) goto end; - pit_value cur = pit_values_pop(rt, rt->expr_stack); + cur = pit_values_pop(rt, rt->expr_stack); if (pit_is_cons(rt, cur)) { pit_value fsym = pit_car(rt, cur); bool is_symbol = pit_is_symbol(rt, fsym); @@ -838,35 +901,23 @@ pit_value pit_expand_macros(pit_runtime *rt, pit_value top) { pit_values_push(rt, rt->expr_stack, res); } else if (is_symbol && pit_symbol_name_match_cstr(rt, fsym, "defer")) { pit_value args = pit_cdr(rt, cur); - pit_runtime_eval_program_push(rt, rt->program, (pit_runtime_eval_program_entry) { - .sort = EVAL_PROGRAM_ENTRY_LITERAL, - .literal = pit_car(rt, args), - }); + pit_runtime_eval_program_push_literal(rt, rt->program, pit_car(rt, args)); } else if (is_symbol && pit_symbol_name_match_cstr(rt, fsym, "quote")) { - pit_runtime_eval_program_push(rt, rt->program, (pit_runtime_eval_program_entry) { - .sort = EVAL_PROGRAM_ENTRY_LITERAL, - .literal = cur, - }); + pit_runtime_eval_program_push_literal(rt, rt->program, cur); } else if (is_symbol && pit_symbol_name_match_cstr(rt, fsym, "lambda")) { pit_value args = pit_cdr(rt, cur); pit_value bindings = pit_car(rt, args); pit_value body = pit_cdr(rt, args); - pit_values_push(rt, rt->expr_stack, pit_list(rt, 2, pit_intern_cstr(rt, "defer"), bindings)); i64 argcount = 0; + pit_values_push(rt, rt->expr_stack, pit_list(rt, 2, pit_intern_cstr(rt, "defer"), bindings)); while (body != PIT_NIL) { pit_value a = pit_car(rt, body); pit_values_push(rt, rt->expr_stack, a); body = pit_cdr(rt, body); argcount += 1; } - pit_runtime_eval_program_push(rt, rt->program, (pit_runtime_eval_program_entry) { - .sort = EVAL_PROGRAM_ENTRY_APPLY, - .apply = argcount + 1, - }); - pit_runtime_eval_program_push(rt, rt->program, (pit_runtime_eval_program_entry) { - .sort = EVAL_PROGRAM_ENTRY_LITERAL, - .literal = fsym, - }); + pit_runtime_eval_program_push_apply(rt, rt->program, argcount + 1); + pit_runtime_eval_program_push_literal(rt, rt->program, fsym); } else { pit_value args = pit_cdr(rt, cur); i64 argcount = 0; @@ -879,76 +930,73 @@ pit_value pit_expand_macros(pit_runtime *rt, pit_value top) { if (!is_symbol) { pit_values_push(rt, rt->expr_stack, fsym); } - pit_runtime_eval_program_push(rt, rt->program, (pit_runtime_eval_program_entry) { - .sort = EVAL_PROGRAM_ENTRY_APPLY, - .apply = argcount, - }); + pit_runtime_eval_program_push_apply(rt, rt->program, argcount); if (is_symbol) { - pit_runtime_eval_program_push(rt, rt->program, (pit_runtime_eval_program_entry) { - .sort = EVAL_PROGRAM_ENTRY_LITERAL, - .literal = fsym, - }); + pit_runtime_eval_program_push_literal(rt, rt->program, fsym); } } } else { - pit_runtime_eval_program_push(rt, rt->program, (pit_runtime_eval_program_entry) { - .sort = EVAL_PROGRAM_ENTRY_LITERAL, - .literal = cur, - }); + pit_runtime_eval_program_push_literal(rt, rt->program, cur); } } - for (i64 idx = rt->program->top - 1; idx >= program_reset; --idx) { + for (idx = rt->program->top - 1; idx >= program_reset; --idx) { + pit_runtime_eval_program_entry *ent; if (rt->error != PIT_NIL) goto end; - pit_runtime_eval_program_entry *ent = &rt->program->data[idx]; + ent = &rt->program->data[idx]; switch (ent->sort) { case EVAL_PROGRAM_ENTRY_LITERAL: - pit_values_push(rt, rt->result_stack, ent->literal); + pit_values_push(rt, rt->result_stack, ent->in.literal); break; - case EVAL_PROGRAM_ENTRY_APPLY: + case EVAL_PROGRAM_ENTRY_APPLY: { pit_value f = pit_values_pop(rt, rt->result_stack); pit_value args = PIT_NIL; - for (i64 i = 0; i < ent->apply; ++i) { + i64 i; + for (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)); break; + } default: pit_error(rt, "unknown program entry"); goto end; } } -end: - pit_value ret = pit_values_pop(rt, rt->result_stack); - rt->expr_stack->top = expr_stack_reset; - rt->result_stack->top = result_stack_reset; - rt->program->top = program_reset; - return ret; +end: { + pit_value ret = pit_values_pop(rt, rt->result_stack); + rt->expr_stack->top = expr_stack_reset; + rt->result_stack->top = result_stack_reset; + rt->program->top = program_reset; + return ret; + } } 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 + /* first, convert the expression tree into "polish notation" in program */ while (rt->expr_stack->top > expr_stack_reset) { + pit_value cur; if (rt->error != PIT_NIL) goto end; - pit_value cur = pit_values_pop(rt, rt->expr_stack); - if (pit_is_cons(rt, cur)) { // compound expressions: function/macro application special forms + cur = pit_values_pop(rt, rt->expr_stack); + if (pit_is_cons(rt, cur)) { /* compound expressions: function/macro application special forms */ pit_value fsym = pit_car(rt, cur); bool is_symbol = pit_is_symbol(rt, fsym); - if (is_symbol && pit_is_symbol_special_form(rt, fsym)) { // special forms + if (is_symbol && pit_is_symbol_special_form(rt, fsym)) { /* special forms */ pit_value f = pit_fget(rt, fsym); pit_value args = pit_cdr(rt, cur); - // special forms are nativefuncs that directly manipulate the stacks - // basically macros, but we don't need to evaluate the return value + /* special forms are nativefuncs that directly manipulate the stacks + basically macros, but we don't need to evaluate the return value */ pit_apply(rt, f, args); - } else if (is_symbol && pit_is_symbol_macro(rt, fsym)) { // macros + } else if (is_symbol && pit_is_symbol_macro(rt, fsym)) { /* macros */ pit_value f = pit_fget(rt, fsym); pit_value args = pit_cdr(rt, cur); pit_value res = pit_apply(rt, f, args); pit_values_push(rt, rt->expr_stack, res); - } else { // normal functions + } else { /* normal functions */ pit_value args = pit_cdr(rt, cur); i64 argcount = 0; while (args != PIT_NIL) { @@ -959,56 +1007,48 @@ pit_value pit_eval(pit_runtime *rt, pit_value top) { if (!is_symbol) { pit_values_push(rt, rt->expr_stack, fsym); } - pit_runtime_eval_program_push(rt, rt->program, (pit_runtime_eval_program_entry) { - .sort = EVAL_PROGRAM_ENTRY_APPLY, - .apply = argcount, - }); + pit_runtime_eval_program_push_apply(rt, rt->program, argcount); if (is_symbol) { pit_value f = pit_fget(rt, fsym); - pit_runtime_eval_program_push(rt, rt->program, (pit_runtime_eval_program_entry) { - .sort = EVAL_PROGRAM_ENTRY_LITERAL, - .literal = f, - }); + pit_runtime_eval_program_push_literal(rt, rt->program, f); } } - } else if (pit_is_symbol(rt, cur)) { // unquoted symbols: variable lookup - pit_runtime_eval_program_push(rt, rt->program, (pit_runtime_eval_program_entry) { - .sort = EVAL_PROGRAM_ENTRY_LITERAL, - .literal = pit_get(rt, cur), - }); - } else { // other expressions evaluate to themselves! - pit_runtime_eval_program_push(rt, rt->program, (pit_runtime_eval_program_entry) { - .sort = EVAL_PROGRAM_ENTRY_LITERAL, - .literal = cur, - }); + } else if (pit_is_symbol(rt, cur)) { /* unquoted symbols: variable lookup */ + pit_runtime_eval_program_push_literal(rt, rt->program, pit_get(rt, cur)); + } else { /* other expressions evaluate to themselves! */ + pit_runtime_eval_program_push_literal(rt, rt->program, cur); } } - // then, execute the polish notation program from right to left - // this has the nice consequence of putting the arguments in the right order - for (i64 idx = rt->program->top - 1; idx >= program_reset; --idx) { + /* 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) { + pit_runtime_eval_program_entry *ent; if (rt->error != PIT_NIL) goto end; - pit_runtime_eval_program_entry *ent = &rt->program->data[idx]; + ent = &rt->program->data[idx]; switch (ent->sort) { case EVAL_PROGRAM_ENTRY_LITERAL: - pit_values_push(rt, rt->result_stack, ent->literal); + pit_values_push(rt, rt->result_stack, ent->in.literal); break; - case EVAL_PROGRAM_ENTRY_APPLY: + case EVAL_PROGRAM_ENTRY_APPLY: { pit_value f = pit_values_pop(rt, rt->result_stack); pit_value args = PIT_NIL; - for (i64 i = 0; i < ent->apply; ++i) { + i64 i; + for (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)); break; + } default: pit_error(rt, "unknown program entry"); goto end; } } -end: - pit_value ret = pit_values_pop(rt, rt->result_stack); - rt->expr_stack->top = expr_stack_reset; - rt->result_stack->top = result_stack_reset; - rt->program->top = program_reset; - return ret; +end: { + pit_value ret = pit_values_pop(rt, rt->result_stack); + rt->expr_stack->top = expr_stack_reset; + rt->result_stack->top = result_stack_reset; + rt->program->top = program_reset; + return ret; + } } diff --git a/src/runtime.h b/src/runtime.h index 101b677..2014d41 100644 --- a/src/runtime.h +++ b/src/runtime.h @@ -7,10 +7,10 @@ struct pit_runtime; -// arenas +/* arenas */ typedef struct { i64 elem_size, capacity, next; - u8 data[]; + 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); @@ -20,37 +20,38 @@ 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 0b1111111111110100000000000000000000000000000000000000000000000000 +/* nil is always the symbol with index 0 */ +#define PIT_NIL 0xfff4000000000000 /* 0b1111111111110100000000000000000000000000000000000000000000000000 */ + enum pit_value_sort { - PIT_VALUE_SORT_DOUBLE = 0b00, // double - PIT_VALUE_SORT_INTEGER = 0b01, // NaN-boxed 49-bit integer - PIT_VALUE_SORT_SYMBOL = 0b10, // NaN-boxed index into symbol table - PIT_VALUE_SORT_REF = 0b11, // NaN-boxed index into "heavy object" arena + 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 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_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 +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_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; @@ -59,64 +60,65 @@ typedef struct { // "heavy" values, the targets of refs 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 + 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 +/* "programs"; vectors of "instructions" for a very simple VM used by the evaluator */ typedef struct { enum { EVAL_PROGRAM_ENTRY_LITERAL, - EVAL_PROGRAM_ENTRY_APPLY, + EVAL_PROGRAM_ENTRY_APPLY } sort; union { pit_value literal; - i64 apply; // arity of application - }; + 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_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(struct pit_runtime *rt, pit_runtime_eval_program *s, pit_runtime_eval_program_entry x); +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 + /* 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_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(); +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 +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) +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 +/* 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); @@ -127,11 +129,11 @@ 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 +/* 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 +/* 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); @@ -145,7 +147,7 @@ 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 +/* 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); @@ -154,12 +156,14 @@ 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 +/* 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); @@ -173,27 +177,29 @@ 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 +/* 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 +/* 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 +/* 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! +/* evaluation! */ pit_value pit_expand_macros(pit_runtime *rt, pit_value top); pit_value pit_eval(pit_runtime *rt, pit_value e); diff --git a/src/utils.c b/src/utils.c index a928de4..fcc4762 100644 --- a/src/utils.c +++ b/src/utils.c @@ -4,7 +4,7 @@ #include "utils.h" -void pit_panic_(const char *format, ...) { +void pit_panic(const char *format, ...) { va_list vargs; va_start(vargs, format); vfprintf(stderr, format, vargs); @@ -12,7 +12,7 @@ void pit_panic_(const char *format, ...) { exit(1); } -void pit_debug_(const char *format, ...) { +void pit_debug(const char *format, ...) { va_list vargs; va_start(vargs, format); vfprintf(stderr, format, vargs); diff --git a/src/utils.h b/src/utils.h index 9a740e5..303055a 100644 --- a/src/utils.h +++ b/src/utils.h @@ -3,13 +3,11 @@ #include <stdckdint.h> -void pit_panic_(const char *format, ...); -void pit_debug_(const char *format, ...); #define PIT_STRSTR(x) #x #define PIT_STR(x) PIT_STRSTR(x) -#define pit_panic(format, ...) pit_panic_("error [" __FILE__ ":" PIT_STR(__LINE__) "] " format "\n" __VA_OPT__(,) __VA_ARGS__) -#define pit_debug(format, ...) pit_debug_("[" __FILE__ ":" PIT_STR(__LINE__) "] " format "\n" __VA_OPT__(,) __VA_ARGS__) -#define pit_mul(result, a, b) if (ckd_mul(result, a, b)) pit_panic("integer overflow during multiplication"); +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 |