diff options
| -rw-r--r-- | .envrc | 1 | ||||
| -rw-r--r-- | .gitignore | 4 | ||||
| -rw-r--r-- | Makefile | 34 | ||||
| -rw-r--r-- | flake.lock | 27 | ||||
| -rw-r--r-- | flake.nix | 17 | ||||
| -rw-r--r-- | src/lexer.c | 86 | ||||
| -rw-r--r-- | src/lexer.h | 28 | ||||
| -rw-r--r-- | src/main.c | 37 | ||||
| -rw-r--r-- | src/parser.c | 96 | ||||
| -rw-r--r-- | src/parser.h | 20 | ||||
| -rw-r--r-- | src/runtime.c | 429 | ||||
| -rw-r--r-- | src/runtime.h | 111 | ||||
| -rw-r--r-- | src/types.h | 17 | ||||
| -rw-r--r-- | src/utils.c | 20 | ||||
| -rw-r--r-- | src/utils.h | 15 |
15 files changed, 942 insertions, 0 deletions
@@ -0,0 +1 @@ +use_flake diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..102cce0 --- /dev/null +++ b/.gitignore @@ -0,0 +1,4 @@ +/build/ +/.direnv/ +/pit +TAGS
\ No newline at end of file diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..ed444ea --- /dev/null +++ b/Makefile @@ -0,0 +1,34 @@ +SRCS := src/main.c src/utils.c src/lexer.c src/parser.c src/runtime.c +OBJECTS := $(SRCS:src/%.c=build/%.o) +EXE := pit + +CC := musl-gcc +CHK_SOURCES ?= $(SRCS) +CPPFLAGS ?= -MMD -MP +CFLAGS ?= -Ideps/ -Isrc/ -Wall -Wextra -Wpedantic -ftrapv --std=c23 -O0 -g +LDFLAGS ?= -g -static + +.PHONY: all clean check-syntax + +all: $(EXE) + +$(EXE): $(OBJECTS) + $(CC) -o $@ $^ $(LDFLAGS) + +build: + mkdir build/ + +build/%.o: src/%.c | build + $(CC) $(CPPFLAGS) $(CFLAGS) -o $@ -c $< + +clean: + -rm $(EXE) + -rm -r build/ + +TAGS: $(SRCS) + etags $^ + +check-syntax: TAGS + gcc $(CFLAGS) -fsyntax-only $(CHK_SOURCES) + +-include $(OBJECTS:.o=.d) diff --git a/flake.lock b/flake.lock new file mode 100644 index 0000000..edf2a85 --- /dev/null +++ b/flake.lock @@ -0,0 +1,27 @@ +{ + "nodes": { + "nixpkgs": { + "locked": { + "lastModified": 1738553537, + "narHash": "sha256-HrrsuYIOl14dreCDUsXQGrWxdiU8LPKxcIo759jUk6Q=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "2d31b9476b7c6f5b029e595586b0b112a7ad130b", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-unstable", + "repo": "nixpkgs", + "type": "github" + } + }, + "root": { + "inputs": { + "nixpkgs": "nixpkgs" + } + } + }, + "root": "root", + "version": 7 +} diff --git a/flake.nix b/flake.nix new file mode 100644 index 0000000..eff6434 --- /dev/null +++ b/flake.nix @@ -0,0 +1,17 @@ +{ + inputs = { + nixpkgs.url = "github:NixOS/nixpkgs/nixpkgs-unstable"; + }; + + outputs = { self, nixpkgs, ... }@inputs: + let + system = "x86_64-linux"; + pkgs = nixpkgs.legacyPackages.${system}; + in { + devShells.x86_64-linux.default = pkgs.mkShell { + buildInputs = [ + pkgs.musl + ]; + }; + }; +} diff --git a/src/lexer.c b/src/lexer.c new file mode 100644 index 0000000..159f73b --- /dev/null +++ b/src/lexer.c @@ -0,0 +1,86 @@ +#include <stdlib.h> +#include <stdio.h> +#include <ctype.h> + +#include "utils.h" +#include "lexer.h" +#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", +}; + +const char *pit_lex_token_name(pit_lex_token t) { + return PIT_LEX_TOKEN_NAMES[t]; +} + +static bool is_more_input(pit_lexer *st) { + return st && st->end < st->len; +} + +static int is_symchar(int c) { + return c != '(' && c != ')' && c != '.' && c != '\'' && c != '"' && isprint(c) && !isspace(c); +} + +static char peek(pit_lexer *st) { + if (is_more_input(st)) return st->input[st->end]; + else return 0; +} + +static char advance(pit_lexer *st) { + if (is_more_input(st)) return st->input[st->end++]; + else return 0; +} + +static bool match(pit_lexer *st, int (*f)(int)) { + if (f(peek(st))) { + st->end += 1; + return true; + } else return false; +} + +pit_lexer *pit_lex_file(char *path) { + pit_lexer *ret = malloc(sizeof(*ret)); + FILE *f = fopen(path, "r"); + if (!f) pit_panic("failed to open file for lexing: %s", path); + fseek(f, 0, SEEK_END); + ret->len = ftell(f); + fseek(f, 0, SEEK_SET); + ret->input = calloc(ret->len, sizeof(char)); + fread(ret->input, sizeof(char), ret->len, f); + ret->start = 0; + ret->end = 0; + return ret; +} + +pit_lex_token pit_lex_next(pit_lexer *st) { +restart: + st->start = st->end; + char c = advance(st); + switch (c) { + case 0: return PIT_LEX_TOKEN_EOF; + case ';': while (is_more_input(st) && advance(st) != '\n'); goto restart; + case '(': return PIT_LEX_TOKEN_LPAREN; + case ')': return PIT_LEX_TOKEN_RPAREN; + case '.': return PIT_LEX_TOKEN_DOT; + case '\'': return PIT_LEX_TOKEN_QUOTE; + case '"': + while (peek(st) != '"') { + if (peek(st) == '\\') advance(st); // skip escaped characters + if (!advance(st)) pit_panic("unterminated string starting at: %d", st->start); + } + advance(st); + return PIT_LEX_TOKEN_STRING_LITERAL; + default: + if (isspace(c)) goto restart; + if (isdigit(c)) { while (match(st, isdigit)); return PIT_LEX_TOKEN_INTEGER_LITERAL; } + else { while (match(st, is_symchar)); return PIT_LEX_TOKEN_SYMBOL; } + } +} diff --git a/src/lexer.h b/src/lexer.h new file mode 100644 index 0000000..dabe534 --- /dev/null +++ b/src/lexer.h @@ -0,0 +1,28 @@ +#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 start, end, len; +} pit_lexer; + +pit_lexer *pit_lex_file(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/main.c b/src/main.c new file mode 100644 index 0000000..d543acf --- /dev/null +++ b/src/main.c @@ -0,0 +1,37 @@ +#include <stdio.h> + +#include "utils.h" +#include "lexer.h" +#include "parser.h" +#include "runtime.h" + +pit_value test_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); +} + +int main(int argc, char **argv) { + if (argc < 2) pit_panic("usage: %s FILE", argv[0]); + pit_lexer *lex = pit_lex_file(argv[1]); + /* pit_lex_token t; */ + /* while ((t = pit_lex_next(lex)) > PIT_LEX_TOKEN_EOF) { */ + /* printf("%s ", pit_lex_token_name(t)); */ + /* } */ + /* puts(pit_lex_token_name(t)); */ + + pit_runtime *rt = pit_runtime_new(); + pit_check_error_maybe_panic(rt); + // pit_fset(rt, pit_intern_cstr(rt, "add"), pit_nativefunc_new(rt, test_add)); + // pit_trace(rt, pit_list(rt, 2, pit_integer_new(rt, 1), pit_integer_new(rt, 2))); + // pit_trace(rt, pit_cons(rt, pit_cons(rt, pit_integer_new(rt, 1), pit_bytes_new_cstr(rt, "foobarbaz")), pit_cons(rt, pit_integer_new(rt, 2), pit_integer_new(rt, 3)))); + // pit_check_error_maybe_panic(rt); + // pit_value res = pit_apply(rt, pit_fget(rt, pit_intern_cstr(rt, "add")), pit_list(rt, 2, pit_integer_new(rt, 1), pit_integer_new(rt, 2))); + // pit_check_error_maybe_panic(rt); + // pit_trace(rt, res); + + pit_parser *parse = pit_parser_from_lexer(lex); + pit_value v = pit_parse(rt, parse); + pit_check_error_maybe_panic(rt); + pit_trace(rt, v); +} diff --git a/src/parser.c b/src/parser.c new file mode 100644 index 0000000..99efe03 --- /dev/null +++ b/src/parser.c @@ -0,0 +1,96 @@ +#include <stdlib.h> +#include <stdio.h> +#include <string.h> + +#include "types.h" +#include "lexer.h" +#include "parser.h" +#include "runtime.h" + +static pit_lex_token peek(pit_parser *st) { + if (!st) return PIT_LEX_TOKEN_ERROR; + return st->next.token; +} + +static pit_lex_token advance(pit_parser *st) { + if (!st) return PIT_LEX_TOKEN_ERROR; + st->cur = st->next; + st->next.token = pit_lex_next(st->lexer); + st->next.start = st->lexer->start; + st->next.end = st->lexer->end; + return st->cur.token; +} + +static bool match(pit_parser *st, pit_lex_token t) { + if (peek(st) == t) { + advance(st); + return true; + } else return false; +} + +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); + buf[tlen] = 0; +} + +pit_parser *pit_parser_from_lexer(pit_lexer *lex) { + pit_parser *ret = malloc(sizeof(*ret)); + ret->lexer = lex; + ret->cur.token = ret->next.token = PIT_LEX_TOKEN_ERROR; + ret->cur.start = ret->next.start = 0; + ret->cur.end = ret->next.end = 0; + advance(ret); + return ret; +} + +// parse a single expression +pit_value pit_parse(pit_runtime *rt, pit_parser *st) { + char buf[256] = {0}; + pit_lex_token t = advance(st); + printf("token: %s\n", pit_lex_token_name(t)); + switch (t) { + case PIT_LEX_TOKEN_ERROR: + pit_error(rt, "encountered an error token while parsing"); + return PIT_NIL; + case PIT_LEX_TOKEN_EOF: + pit_error(rt, "end-of-file while parsing"); + return PIT_NIL; + case PIT_LEX_TOKEN_LPAREN: { + i64 arg = 0; i64 args_cap = 32; + pit_value *args = calloc(args_cap, sizeof(pit_value)); + while (!match(st, PIT_LEX_TOKEN_RPAREN)) { + args[arg++] = pit_parse(rt, st); + if (rt->error != PIT_NIL) return PIT_NIL; // if we hit an error, stop! + if (arg >= args_cap) args = realloc(args, (args_cap <<= 1) * sizeof(pit_value)); + } + pit_value ret = PIT_NIL; + for (int i = 0; i < arg; ++i) { + ret = pit_cons(rt, args[arg - i - 1], ret); + } + return ret; + } + case PIT_LEX_TOKEN_QUOTE: + return pit_list(rt, 2, pit_intern_cstr(rt, "quote"), pit_parse(rt, st)); + 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: + get_token_string(st, buf, sizeof(buf)); + i64 len = 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; + } + 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); + default: + pit_error(rt, "unexpected token: %s", pit_lex_token_name(t)); + return PIT_NIL; + } +} diff --git a/src/parser.h b/src/parser.h new file mode 100644 index 0000000..73c489a --- /dev/null +++ b/src/parser.h @@ -0,0 +1,20 @@ +#ifndef PIT_PARSER_H +#define PIT_PARSER_H + +#include "lexer.h" +#include "runtime.h" + +typedef struct { + pit_lex_token token; + i64 start, end; +} pit_parser_token_info; + +typedef struct { + pit_lexer *lexer; + pit_parser_token_info cur, next; +} pit_parser; + +pit_parser *pit_parser_from_lexer(pit_lexer *lex); +pit_value pit_parse(pit_runtime *rt, pit_parser *st); + +#endif diff --git a/src/runtime.c b/src/runtime.c new file mode 100644 index 0000000..ba5d131 --- /dev/null +++ b/src/runtime.c @@ -0,0 +1,429 @@ +#include <stddef.h> +#include <stdlib.h> +#include <stdarg.h> +#include <stdio.h> +#include <string.h> +#include <math.h> + +#include "utils.h" +#include "runtime.h" + +pit_arena *pit_arena_new(i64 capacity, i64 elem_size) { + pit_arena *a = malloc(sizeof(pit_arena) + capacity * elem_size); + a->elem_size = elem_size; + a->capacity = capacity; + a->next = 0; + return a; +} + +i32 pit_arena_alloc_idx(pit_arena *a) { + i32 byte_idx; pit_mul(&byte_idx, a->elem_size, a->next); + if (byte_idx >= a->capacity) { return -1; } + a->next += 1; + return byte_idx; +} + +i32 pit_arena_alloc_bulk_idx(pit_arena *a, i64 num) { + i32 byte_idx; pit_mul(&byte_idx, a->elem_size, a->next); + i32 byte_len; pit_mul(&byte_len, a->elem_size, num); + if (byte_idx + byte_len > a->capacity) { return -1; } + a->next += num; + return byte_idx; +} + +void *pit_arena_idx(pit_arena *a, i32 idx) { + if (idx < 0 || idx >= a->capacity) return NULL; + return &a->data[idx]; +} + +void *pit_arena_alloc(pit_arena *a) { + i32 byte_idx = pit_arena_alloc_idx(a); + return pit_arena_idx(a, byte_idx); +} + +void *pit_arena_alloc_bulk(pit_arena *a, i64 num) { + i32 byte_idx = pit_arena_alloc_bulk_idx(a, num); + return pit_arena_idx(a, byte_idx); +} + +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; +} + +u64 pit_value_data(pit_value v) { + return v & 0b0000000000000001111111111111111111111111111111111111111111111111; +} + +pit_runtime *pit_runtime_new() { + pit_runtime *ret = malloc(sizeof(*ret)); + 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_len = 0; + ret->error = PIT_NIL; + pit_intern_cstr(ret, "nil"); + return ret; +} + +i64 pit_dump(pit_runtime *rt, char *buf, i64 len, pit_value v) { + pit_value_heavy *h = NULL; + 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)); + case PIT_VALUE_SORT_INTEGER: + return snprintf(buf, 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]; + } + return i; + } else { + return snprintf(buf, len, "<broken symbol %d>", pit_as_symbol(rt, v)); + } + 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); + else { + switch (h->hsort) { + case PIT_VALUE_HEAVY_SORT_CONS: + char *end = buf + len; + char *start = buf; + pit_value cur = v; + do { + if (pit_is_cons(rt, cur)) { + *(buf++) = ' '; if (buf >= end) return end - buf; + buf += pit_dump(rt, buf, end - buf, pit_car(rt, cur)); + if (buf >= end) return end - buf; + } else { + buf += snprintf(buf, end - buf, " . "); + if (buf >= end) return end - buf; + buf += pit_dump(rt, buf, end - buf, cur); + if (buf >= end) return end - buf; + } + } while (!pit_eq((cur = pit_cdr(rt, cur)), PIT_NIL)); + *start = '('; + *(buf++) = ')'; + return buf - start; + case PIT_VALUE_HEAVY_SORT_BYTES: + buf[0] = '"'; + i64 i = 1; + for (i64 j = 0; i < len - 1 && j < h->bytes.len;) { + if (buf[i - 1] != '\\' && (h->bytes.data[j] == '\\' || h->bytes.data[j] == '"')) + buf[i++] = '\\'; + else buf[i++] = h->bytes.data[j++]; + } + if (i < len - 1) buf[i++] = '"'; + return i; + default: + return snprintf(buf, len, "<ref %d>", r); + } + } + break; + } + return 0; +} + +void pit_trace_(pit_runtime *rt, const char *format, pit_value v) { + char buf[1024] = {0}; + pit_dump(rt, buf, sizeof(buf), v); + fprintf(stderr, format, buf); +} + +void pit_error(pit_runtime *rt, const char *format, ...) { + if (pit_eq(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); + } +} + +void pit_check_error_maybe_panic(pit_runtime *rt) { + if (!pit_eq(rt->error, PIT_NIL)) { + char buf[1024] = {0}; + pit_dump(rt, buf, sizeof(buf), rt->error); + pit_panic("runtime error: %s", buf); + } +} + +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) { + pit_error(rt, "attempted to create a signalling NaN double"); + return PIT_NIL; + } + return data; + } + return + 0b1111111111110000000000000000000000000000000000000000000000000000 + | (((u64) (s & 0b11)) << 49) + | (data & 0b1111111111111111111111111111111111111111111111111); +} + +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 (double) v; +} +pit_value pit_double_new(pit_runtime *rt, double d) { + return pit_value_new(rt, PIT_VALUE_SORT_DOUBLE, (u64) d); +} + +i64 pit_as_integer(pit_runtime *rt, pit_value v) { + 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 +} +pit_value pit_integer_new(pit_runtime *rt, i64 i) { + return pit_value_new(rt, PIT_VALUE_SORT_INTEGER, (u64) i); +} + +pit_symbol pit_as_symbol(pit_runtime *rt, pit_value v) { + if (pit_value_sort(v) != PIT_VALUE_SORT_SYMBOL) { + pit_error(rt, "invalid use of value as symbol"); + return -1; + } + return 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); +} + +pit_ref pit_as_ref(pit_runtime *rt, pit_value v) { + if (pit_value_sort(v) != PIT_VALUE_SORT_REF) { + pit_error(rt, "invalid use of value as ref"); + return -1; + } + return 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); +} + +pit_value pit_heavy_new(pit_runtime *rt) { + i32 idx = pit_arena_alloc_idx(rt->values); + return pit_ref_new(rt, idx); +} + +pit_value_heavy *pit_deref(pit_runtime *rt, pit_ref p) { + return pit_arena_idx(rt->values, p); +} + +bool pit_is_cons(pit_runtime *rt, pit_value a) { + switch (pit_value_sort(a)) { + case PIT_VALUE_SORT_REF: + pit_value_heavy *ha = pit_deref(rt, a); + if (!ha) { pit_error(rt, "bad ref"); return false; } + switch (ha->hsort) { + case PIT_VALUE_HEAVY_SORT_CONS: + return true; + default: + break; + } + default: + break; + } + return false; +} +bool pit_eq(pit_value a, pit_value b) { + return a == b; +} +bool pit_equal(pit_runtime *rt, pit_value a, pit_value b) { + if (pit_value_sort(a) != pit_value_sort(b)) return false; + switch (pit_value_sort(a)) { + case PIT_VALUE_SORT_DOUBLE: + 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); + if (!ha) { pit_error(rt, "bad ref"); return false; } + pit_value_heavy *hb = pit_deref(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_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 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; + } + return true; + case PIT_VALUE_HEAVY_SORT_NATIVEFUNC: + return ha->nativefunc == hb->nativefunc; + } + } + return false; +} + +pit_value pit_bytes_new(pit_runtime *rt, u8 *buf, i64 len) { + 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); + if (!dest) return PIT_NIL; + pit_value ret = pit_heavy_new(rt); + pit_value_heavy *h = pit_deref(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; + return ret; +} + +pit_value pit_bytes_new_cstr(pit_runtime *rt, char *s) { + return pit_bytes_new(rt, (u8 *) s, strlen(s)); +} + +// 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) { + if (pit_value_sort(v) != PIT_VALUE_SORT_REF) return false; + 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->bytes.len != len) return false; + for (i64 i = 0; i < len; ++i) + if (h->bytes.data[i] != buf[i]) { + return false; + } + return true; +} + +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); + 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; + ent->function = PIT_NIL; + 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); +} +pit_value pit_get(pit_runtime *rt, pit_value sym) { + pit_symtab_entry *ent = pit_symtab_lookup(rt, sym); + if (!ent) { pit_error(rt, "bad symbol"); return PIT_NIL; } + return ent->value; +} +void pit_set(pit_runtime *rt, pit_value sym, pit_value v) { + pit_symtab_entry *ent = pit_symtab_lookup(rt, sym); + if (!ent) { pit_error(rt, "bad symbol"); return; } + ent->value = v; +} +pit_value pit_fget(pit_runtime *rt, pit_value sym) { + pit_symtab_entry *ent = pit_symtab_lookup(rt, sym); + if (!ent) { pit_error(rt, "bad symbol"); return PIT_NIL; } + return ent->function; +} +void pit_fset(pit_runtime *rt, pit_value sym, pit_value v) { + pit_symtab_entry *ent = pit_symtab_lookup(rt, sym); + if (!ent) { pit_error(rt, "bad symbol"); return; } + ent->function = 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); + 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; + return ret; +} + +pit_value pit_list(pit_runtime *rt, i64 num, ...) { + pit_value *temp = calloc(num, sizeof(pit_value)); + va_list elems; + va_start(elems, num); + for (i64 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) { + ret = pit_cons(rt, temp[num - i - 1], ret); + } + return ret; +} + +pit_value pit_car(pit_runtime *rt, pit_value v) { + if (pit_value_sort(v) != PIT_VALUE_SORT_REF) return PIT_NIL; + 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->cons.car; +} +pit_value pit_cdr(pit_runtime *rt, pit_value v) { + if (pit_value_sort(v) != PIT_VALUE_SORT_REF) return PIT_NIL; + 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->cons.cdr; +} + +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); + 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; + 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: + 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_NATIVEFUNC) { + pit_error(rt, "attempt to apply non-nativefunc ref"); + return PIT_NIL; + } + return h->nativefunc(rt, args); + default: + pit_error(rt, "attempted to apply non-function value"); + return PIT_NIL; + } +} diff --git a/src/runtime.h b/src/runtime.h new file mode 100644 index 0000000..dcdb274 --- /dev/null +++ b/src/runtime.h @@ -0,0 +1,111 @@ +#ifndef PIT_RUNTIME_H +#define PIT_RUNTIME_H + +#include "types.h" +#include "utils.h" + +typedef struct { + i64 elem_size, capacity, next; + u8 data[]; +} pit_arena; +pit_arena *pit_arena_new(i64 capacity, i64 elem_size); +i32 pit_arena_alloc_idx(pit_arena *a); +void *pit_arena_alloc(pit_arena *a); + +// nil is always the symbol with index 0 +#define PIT_NIL 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 +}; +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); + +struct pit_runtime; +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_CONS=0, + PIT_VALUE_HEAVY_SORT_ARRAY, + PIT_VALUE_HEAVY_SORT_BYTES, + PIT_VALUE_HEAVY_SORT_NATIVEFUNC, + } hsort; + union { + struct { pit_value car, cdr; } cons; + struct { pit_value *data; i64 len; } array; + struct { u8 *data; i64 len; } bytes; + pit_nativefunc nativefunc; + }; +} pit_value_heavy; + +typedef struct { + pit_value name; + pit_value value; + pit_value function; +} pit_symtab_entry; + +typedef struct pit_runtime { + pit_arena *values; + pit_arena *bytes; + pit_arena *symtab; i64 symtab_len; + pit_value error; +} pit_runtime; + +pit_runtime *pit_runtime_new(); + +i64 pit_dump(pit_runtime *rt, char *buf, i64 len, pit_value v); +#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, ...); +void pit_check_error_maybe_panic(pit_runtime *rt); + +// 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_cons(pit_runtime *rt, pit_value a); +bool pit_truthful(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); +bool pit_bytes_match(pit_runtime *rt, pit_value v, u8 *buf, i64 len); + +// 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); +pit_symtab_entry *pit_symtab_lookup(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); + +// 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); + +// working with functions +pit_value pit_nativefunc_new(pit_runtime *rt, pit_nativefunc f); +pit_value pit_apply(pit_runtime *rt, pit_value f, pit_value args); +#endif diff --git a/src/types.h b/src/types.h new file mode 100644 index 0000000..fcebfeb --- /dev/null +++ b/src/types.h @@ -0,0 +1,17 @@ +#ifndef PIT_TYPES_H +#define PIT_TYPES_H + +#include <stdbool.h> +#include <stdint.h> + +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 new file mode 100644 index 0000000..a928de4 --- /dev/null +++ b/src/utils.c @@ -0,0 +1,20 @@ +#include <stdio.h> +#include <stdlib.h> +#include <stdarg.h> + +#include "utils.h" + +void pit_panic_(const char *format, ...) { + va_list vargs; + va_start(vargs, format); + vfprintf(stderr, format, vargs); + va_end(vargs); + exit(1); +} + +void pit_debug_(const char *format, ...) { + va_list vargs; + va_start(vargs, format); + vfprintf(stderr, format, vargs); + va_end(vargs); +} diff --git a/src/utils.h b/src/utils.h new file mode 100644 index 0000000..9a740e5 --- /dev/null +++ b/src/utils.h @@ -0,0 +1,15 @@ +#ifndef PIT_UTILS_H +#define PIT_UTILS_H + +#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"); + + +#endif |
