Arithmatic

Makefile

@@ -1,6 +1,8 @@
 DEBUG=2
 LLVM_SAN=1
 
+FAST_MATH_BUILTINS=1
+
 ifeq ($(DEBUG),1)
 DEBUG_CFLAGS=-g -Og
 else ifeq ($(DEBUG),2)
@@ -17,11 +19,12 @@ else
 LLVM_SAN_FLAGS=
 endif
 
+LIBS=gmp
 CC=gcc
-CFLAGS=$(DEBUG_CFLAGS) $(LLVM_SAN_FLAGS) -std=c11 -Wall -Wpedantic $\
+CFLAGS=$(DEBUG_CFLAGS) $(LLVM_SAN_FLAGS) $(MATH_FLAGS) -std=c23 -Wall $\
-       -D_POSIX_C_SOURCE=200112L
+       -Wpedantic -D_POSIX_C_SOURCE=200112L `pkg-config --cflags $(LIBS)`
 LD=gcc
-LDFLAGS=-lm $(LLVM_SAN_FLAGS)
+LDFLAGS=-lm `pkg-config --libs $(LIBS)` $(LLVM_SAN_FLAGS)
 
 SRCS:=$(wildcard src/*.c)
 OBJS:=$(SRCS:src/%.c=bin/%.o)

lisp/kernel.gl

@@ -23,4 +23,4 @@
   (princ datum print-char-fun)
   (funcall (or print-char-fun 'write-byte) ?\n))
 
-(princln '#'princ)
+(princln (/ 1 0.0))

src/base.c

@@ -19,6 +19,7 @@ const char *LISP_TYPE_NAMES[N_LISP_TYPES] = {
     [TYPE_VECTOR] = "vector",
     [TYPE_HASH_TABLE] = "hash-table",
     [TYPE_FUNCTION] = "function",
+    [TYPE_GMP] = "bignum",
 };
 
 bool lisp_gc_on_alloc;
@@ -141,6 +142,14 @@ DEFUN(make_symbol, "make-symbol", (LispVal * name), "(name)",
     return obj;
 }
 
+DEFUN(vectorp, "vectorp", (LispVal * data), "(data)", "") {
+    return VECTORP(data) ? Qt : Qnil;
+}
+
+DEFUN(symbolp, "symbolp", (LispVal * data), "(data)", "") {
+    return SYMBOLP(data) ? Qt : Qnil;
+}
+
 DEFUN(intern, "intern", (LispVal * name), "(name)", "") {
     CHECK_TYPE(name, TYPE_STRING);
     LispVal *res = Fgethash(obarray, name, Qunbound);
@@ -220,6 +229,7 @@ DEFINE_SYMBOL(symbol, "symbol");
 // vector defined above
 DEFINE_SYMBOL(hash_table, "hash-table");
 // function defind above
+DEFINE_SYMBOL(bignum, "bignum");
 
 LispVal *symbol_for_type(LispValType type) {
     switch (type) {
@@ -239,6 +249,8 @@ LispVal *symbol_for_type(LispValType type) {
         return Qhash_table;
     case TYPE_FUNCTION:
         return Qfunction;
+    case TYPE_GMP:
+        return Qbignum;
     default:
         abort();
     }

src/base.h

@@ -99,6 +99,7 @@ typedef enum {
     TYPE_VECTOR = 5,
     TYPE_HASH_TABLE = 6,
     TYPE_FUNCTION = 7,
+    TYPE_GMP = 8,
     N_LISP_TYPES,
 } LispValType;
 extern const char *LISP_TYPE_NAMES[N_LISP_TYPES];
@@ -366,6 +367,8 @@ DECLARE_FUNCTION(function, (LispVal * form));
 LispVal *make_vector(LispVal **data, size_t length, bool take);
 DECLARE_FUNCTION(vector, (LispVal * data));
 DECLARE_FUNCTION(make_symbol, (LispVal * name));
+DECLARE_FUNCTION(vectorp, (LispVal * data));
+DECLARE_FUNCTION(symbolp, (LispVal * data));
 DECLARE_FUNCTION(intern, (LispVal * name));
 DECLARE_FUNCTION(symbol_value, (LispVal * sym));
 DECLARE_FUNCTION(symbol_function, (LispVal * sym, LispVal *resolve));
@@ -429,7 +432,8 @@ DECLARE_SYMBOL(string);
 DECLARE_SYMBOL(symbol);
 // vector defined above
 DECLARE_SYMBOL(hash_table);
-DECLARE_SYMBOL(function);
+// function defined above
+DECLARE_SYMBOL(bignum);
 
 LispVal *symbol_for_type(LispValType type);
 

src/function.c

@@ -491,6 +491,9 @@ DEFUN(apply, "apply", (LispVal * func, LispVal *args), "(func &rest args)",
     if (NILP(args)) {
         return CALL0(func);
     }
+    if (NILP(Fproper_list_p(XCDR(Flast(args))))) {
+        signal_type_error(args, Qlist);
+    }
     return Ffuncall(func, Flist_star(XCAR(args), XCDR(args)));
 }
 
@@ -554,6 +557,10 @@ DEFSPECIAL(lambda, "lambda", (LispVal * args, LispVal *body),
     return fobj;
 }
 
+DEFUN(functionp, "functionp", (LispVal * obj), "(obj)", "") {
+    return FUNCTIONP(obj) ? Qt : Qnil;
+}
+
 DEFUN(callablep, "callablep", (LispVal * obj), "(obj)", "") {
     if (FUNCTIONP(obj) || (CONSP(obj) && EQ(XCAR(obj), Qlambda))
         || (SYMBOLP(obj) && FUNCTIONP(Fsymbol_function(obj, Qt)))) {

src/function.h

@@ -101,6 +101,7 @@ DECLARE_FUNCTION(funcall, (LispVal * func, LispVal *args));
 DECLARE_FUNCTION(apply, (LispVal * func, LispVal *args));
 
 DECLARE_FUNCTION(lambda, (LispVal * args, LispVal *body));
+DECLARE_FUNCTION(functionp, (LispVal * obj));
 DECLARE_FUNCTION(callablep, (LispVal * obj));
 DECLARE_FUNCTION(function_arity, (LispVal * func));
 

src/gc.c

@@ -3,9 +3,11 @@
 #include "function.h"
 #include "hashtable.h"
 #include "lisp.h"
+#include "lisp_math.h"
 #include "list.h"
 #include "stack.h"
 
+#include <gmp.h>
 #include <stdlib.h>
 
 bool lisp_doing_gc;
@@ -172,6 +174,9 @@ static void free_object(LispVal *val) {
         lisp_free(vec->data);
         break;
     }
+    case TYPE_GMP:
+        mpz_clear(((LispGmp *) val)->val);
+        break;
     case TYPE_CONS:
     case TYPE_SYMBOL:
     case TYPE_FUNCTION:
@@ -236,6 +241,7 @@ static void mark_object(LispVal *val) {
         break;
     }
     case TYPE_STRING:
+    case TYPE_GMP:
         // no held refs
         break;
     case TYPE_FIXNUM:
@@ -335,7 +341,7 @@ static void unmark_the_stack(void) {
     }
 }
 
-static void mark_GRAY_objects(size_t *restrict limit) {
+static void mark_gray_objects(size_t *restrict limit) {
     while (gray_objects && saturating_dec(limit, 1)) {
         mark_object(gray_objects->obj);
     }
@@ -394,7 +400,7 @@ void lisp_gc_yield(struct timespec *restrict time_took, bool full) {
             mark_the_stack(&limit);
             break;
         case GC_STEP_HEAP:
-            mark_GRAY_objects(&limit);
+            mark_gray_objects(&limit);
             break;
         case GC_STEP_FREE:
             gc_sweep_objects(&limit);

src/hashtable.c

@@ -31,6 +31,10 @@ void release_hash_table_no_gc(LispVal *val) {
     lisp_free(ht);
 }
 
+DEFUN(hash_table_p, "hash-table-p", (LispVal * val), "(val)", "") {
+    return HASH_TABLE_P(val) ? Qt : Qnil;
+}
+
 DEFUN(make_hash_table, "make-hash-table", (LispVal * hash_fn, LispVal *eq_fn),
       "(hash-fn eq-fn)", "") {
     LispHashTable *obj =

src/hashtable.h

@@ -23,6 +23,7 @@ DEFOBJTYPE(HashTable, HASH_TABLE, HASH_TABLE_P, {
 LispVal *make_hash_table_no_gc(LispVal *hash_fn, LispVal *eq_fn);
 void release_hash_table_no_gc(LispVal *val);
 
+DECLARE_FUNCTION(hash_table_p, (LispVal * val));
 DECLARE_FUNCTION(make_hash_table, (LispVal * hash_fn, LispVal *eq_fn));
 DECLARE_FUNCTION(gethash, (LispVal * ht, LispVal *key, LispVal *def));
 DECLARE_FUNCTION(puthash, (LispVal * ht, LispVal *key, LispVal *val));

src/lisp.c

@@ -49,6 +49,7 @@ static void register_manual_symbols(void) {
 }
 
 void lisp_init(void) {
+    mp_set_memory_functions(lisp_malloc, lisp_realloc_gmp, lisp_free_gmp);
     construct_manual_symbols();
     Vlexical_environment = Qnil;
     obarray = Fmake_hash_table(Qhash_string, Qstrings_equal);
@@ -109,6 +110,7 @@ LispVal *eval(LispVal *form) {
         return form;
     }
     switch (((LispObject *) form)->type) {
+    case TYPE_GMP:
     case TYPE_HASH_TABLE:
     case TYPE_FUNCTION:
     case TYPE_STRING:

src/lisp.h

@@ -4,6 +4,7 @@
 #include "base.h"
 #include "function.h" // IWYU pragma: export
 #include "hashtable.h" // IWYU pragma: export
+#include "lisp_math.h" // IWYU pragma: export
 #include "lisp_string.h" // IWYU pragma: export
 #include "list.h" // IWYU pragma: export
 #include "macro.h" // IWYU pragma: export

src/lisp_math.c

@@ -0,0 +1,388 @@
+#include "lisp_math.h"
+
+#include "list.h"
+#include "stack.h"
+
+#include <errno.h>
+#include <stdckdint.h>
+
+LispVal *copy_lisp_gmp(LispVal *gmp) {
+    assert(LISP_GMP_P(gmp));
+    LispGmp *n = lisp_alloc_object(sizeof(LispGmp), TYPE_GMP);
+    mpz_init_set(n->val, ((LispGmp *) gmp)->val);
+    return n;
+}
+
+LispVal *make_gmp(fixnum_t value) {
+    LispGmp *n = lisp_alloc_object(sizeof(LispGmp), TYPE_GMP);
+    mpz_init_set_si(n->val, value);
+    return n;
+}
+
+LispVal *make_gmp_unsigned(unsigned long value) {
+    LispGmp *n = lisp_alloc_object(sizeof(LispGmp), TYPE_GMP);
+    mpz_init_set_ui(n->val, value);
+    return n;
+}
+
+LispVal *parse_gmp(const char *str, int base) {
+    LispGmp *n = lisp_alloc_object(sizeof(LispGmp), TYPE_GMP);
+    mpz_init(n->val);
+    int res = mpz_set_str(n->val, str, base);
+    if (res != 0) {
+        free(n);
+        return NULL;
+    }
+    return n;
+}
+
+LispVal *parse_number(const char *str, int base) {
+    char *endptr;
+    errno = 0;
+    intmax_t n = strtoimax(str, &endptr, base);
+    if ((n == INTMAX_MIN || n == INTMAX_MAX) && errno == ERANGE) {
+        return parse_gmp(str, base);
+    } else if (n < MOST_NEGATIVE_FIXNUM || n > MOST_POSITIVE_FIXNUM) {
+        return parse_gmp(str, base);
+    } else if (*endptr) { // trailing garbage
+        return NULL;
+    }
+    return MAKE_FIXNUM(n);
+}
+
+DEFUN(fixnump, "fixnump", (LispVal * val), "(val)", "") {
+    return FIXNUMP(val) ? Qt : Qnil;
+}
+
+DEFUN(integerp, "integerp", (LispVal * val), "(val)", "") {
+    return LISP_GMP_P(val) ? Qt : Qnil;
+}
+
+DEFUN(floatp, "floatp", (LispVal * val), "(val)", "") {
+    return LISP_FLOAT_P(val) ? Qt : Qnil;
+}
+
+DEFUN(numberp, "numberp", (LispVal * val), "(val)", "") {
+    return FIXNUMP(val) || LISP_FLOAT_P(val) || LISP_GMP_P(val) ? Qt : Qnil;
+}
+
+enum Operator {
+    OPERATOR_ADD,
+    OPERATOR_SUB,
+    OPERATOR_MUL,
+    OPERATOR_DIV,
+    OPERATOR_AND,
+    OPERATOR_IOR,
+    OPERATOR_XOR,
+};
+
+static inline LispVal *type_for_operator(enum Operator op) {
+    switch (op) {
+    case OPERATOR_ADD:
+    case OPERATOR_SUB:
+    case OPERATOR_MUL:
+    case OPERATOR_DIV:
+        return Qnumber;
+    case OPERATOR_AND:
+    case OPERATOR_IOR:
+    case OPERATOR_XOR:
+        return Qinteger;
+    default:
+        abort();
+    }
+}
+
+LispVal *float_math_driver(enum Operator op, bool first, lisp_float_t acc,
+                           LispVal *nums) {
+    assert(LISP_FLOAT_P(XCAR(nums)));
+    switch (op) {
+    case OPERATOR_AND:
+    case OPERATOR_IOR:
+    case OPERATOR_XOR:
+        signal_type_error(XCAR(nums), Qinteger);
+        break;
+    default:
+        break;
+    }
+    if (first) {
+        acc = XLISP_FLOAT(XCAR(nums));
+        nums = XCDR(nums);
+    }
+    DOLIST(cur, nums) {
+        lisp_float_t n;
+        if (FIXNUMP(cur)) {
+            n = XFIXNUM(cur);
+        } else if (LISP_FLOAT_P(cur)) {
+            n = XLISP_FLOAT(cur);
+        } else if (LISP_GMP_P(cur)) {
+            n = mpz_get_d(((LispGmp *) cur)->val);
+        } else {
+            signal_type_error(cur, Qnumber);
+        }
+        switch (op) {
+        case OPERATOR_ADD:
+            acc += n;
+            break;
+        case OPERATOR_SUB:
+            acc -= n;
+            break;
+        case OPERATOR_MUL:
+            acc *= n;
+            break;
+        case OPERATOR_DIV:
+            acc /= n;
+            break;
+        default:
+            abort();
+        }
+    }
+    return MAKE_LISP_FLOAT(acc);
+}
+
+LispVal *gmp_math_driver(enum Operator op, bool first, fixnum_t fixnum_acc,
+                         LispVal *nums) {
+    assert(LISP_GMP_P(XCAR(nums)));
+    LispGmp *acc = make_gmp(fixnum_acc);
+    if (first) {
+        mpz_set(acc->val, ((LispGmp *) XCAR(nums))->val);
+        nums = XCDR(nums);
+        first = false;
+    }
+    DOTAILS(rest, nums) {
+        LispVal *cur = XCAR(rest);
+        if (FIXNUMP(cur)) {
+            fixnum_t f = XFIXNUM(cur);
+            switch (op) {
+            case OPERATOR_ADD:
+                if (f < 0) {
+                    mpz_sub_ui(acc->val, acc->val, -f);
+                } else {
+                    mpz_add_ui(acc->val, acc->val, f);
+                }
+                break;
+            case OPERATOR_SUB:
+                if (f < 0) {
+                    mpz_add_ui(acc->val, acc->val, -f);
+                } else {
+                    mpz_sub_ui(acc->val, acc->val, f);
+                }
+                break;
+            case OPERATOR_MUL:
+                mpz_mul_si(acc->val, acc->val, f);
+                break;
+            case OPERATOR_DIV:
+                if (f == 0) {
+                    lisp_signal(Qdivision_by_zero, Qnil);
+                }
+                if (f > 0) {
+                    mpz_mul_si(acc->val, acc->val, -1);
+                }
+                mpz_tdiv_ui(acc->val, f);
+                break;
+#define BITWISE(o)                      \
+    {                                   \
+        mpz_t n;                        \
+        mpz_init_set_si(n, f);          \
+        mpz_##o(acc->val, acc->val, n); \
+        mpz_clear(n);                   \
+    }
+            case OPERATOR_AND:
+                BITWISE(and);
+                break;
+            case OPERATOR_IOR:
+                BITWISE(ior);
+                break;
+            case OPERATOR_XOR:
+                BITWISE(xor);
+                break;
+#undef BITWISE
+            default:
+                abort();
+            }
+        } else if (LISP_GMP_P(cur)) {
+            mpz_srcptr cv = ((LispGmp *) cur)->val;
+            switch (op) {
+            case OPERATOR_ADD:
+                mpz_add(acc->val, acc->val, cv);
+                break;
+            case OPERATOR_SUB:
+                mpz_sub(acc->val, acc->val, cv);
+                break;
+            case OPERATOR_MUL:
+                mpz_mul(acc->val, acc->val, cv);
+                break;
+            case OPERATOR_DIV:
+                mpz_tdiv_q(acc->val, acc->val, cv);
+                break;
+            case OPERATOR_AND:
+                mpz_and(acc->val, acc->val, cv);
+                break;
+            case OPERATOR_IOR:
+                mpz_ior(acc->val, acc->val, cv);
+                break;
+            case OPERATOR_XOR:
+                mpz_xor(acc->val, acc->val, cv);
+                break;
+            default:
+                abort();
+            }
+        } else if (LISP_FLOAT_P(cur)) {
+            return float_math_driver(op, first, mpz_get_d(acc->val), rest);
+        } else {
+            signal_type_error(cur, type_for_operator(op));
+        }
+    }
+    if (mpz_cmp_si(acc->val, MOST_POSITIVE_FIXNUM) <= 0
+        || mpz_cmp_si(acc->val, MOST_NEGATIVE_FIXNUM) >= 0) {
+        return MAKE_FIXNUM(mpz_get_si(acc->val));
+    }
+    return acc;
+}
+
+LispVal *math_driver(enum Operator op, LispVal *nums) {
+    assert(!NILP(nums));
+    bool first = true;
+    fixnum_t acc;
+    LispVal *rest;
+    if (FIXNUMP(XCAR(nums))) {
+        rest = XCDR(nums);
+        acc = XFIXNUM(XCAR(nums));
+        first = false;
+    } else {
+        rest = nums;
+        acc = 0;
+        goto change_type;
+    }
+    while (FIXNUMP(XCAR(rest))) {
+        bool did_overflow = false;
+        fixnum_t cur = XFIXNUM(XCAR(rest));
+        fixnum_t out;
+        switch (op) {
+        case OPERATOR_ADD:
+            did_overflow = ckd_add(&out, acc, cur);
+            break;
+        case OPERATOR_SUB:
+            did_overflow = ckd_sub(&out, acc, cur);
+            break;
+        case OPERATOR_MUL:
+            did_overflow = ckd_mul(&out, acc, cur);
+            break;
+        case OPERATOR_DIV:
+            if (cur == 0) {
+                lisp_signal(Qdivision_by_zero, Qnil);
+            }
+            out = acc / cur;
+            break;
+        case OPERATOR_AND:
+            out = acc & cur;
+            break;
+        case OPERATOR_IOR:
+            out = acc | cur;
+            break;
+        case OPERATOR_XOR:
+            out = acc ^ cur;
+            break;
+        default:
+            abort();
+        }
+        if (did_overflow) {
+            break;
+        }
+        acc = out;
+        rest = XCDR(rest);
+        if (NILP(rest)) {
+            return MAKE_FIXNUM(acc);
+        }
+    }
+change_type:
+    return LISP_FLOAT_P(XCAR(rest)) ? float_math_driver(op, first, acc, rest)
+                                    : gmp_math_driver(op, first, acc, rest);
+}
+
+DEFUN(plus, "+", (LispVal * nums), "(&rest nums)", "") {
+    if (NILP(nums)) {
+        return MAKE_FIXNUM(0);
+    }
+    return math_driver(OPERATOR_ADD, nums);
+}
+
+DEFUN(minus, "-", (LispVal * nums), "(&rest nums)", "") {
+    if (NILP(nums)) {
+        return MAKE_FIXNUM(0);
+    } else if (NILP(XCDR(nums))) {
+        LispVal *num = XCAR(nums);
+        if (FIXNUMP(num)) {
+            return MAKE_FIXNUM(-XFIXNUM(num));
+        } else if (LISP_FLOAT_P(num)) {
+            return MAKE_LISP_FLOAT(-XLISP_FLOAT(num));
+        } else if (LISP_GMP_P(num)) {
+            LispGmp *o = make_gmp(0);
+            LispGmp *a = num;
+            mpz_mul_si(o->val, a->val, -1);
+            return o;
+        }
+        signal_type_error(num, Qnumber);
+    }
+    return math_driver(OPERATOR_SUB, nums);
+}
+
+DEFUN(times, "*", (LispVal * nums), "(&rest nums)", "") {
+    if (NILP(nums)) {
+        return MAKE_FIXNUM(1);
+    }
+    return math_driver(OPERATOR_MUL, nums);
+}
+
+DEFUN(divide, "/", (LispVal * num, LispVal *nums), "(num &rest nums)", "") {
+    if (NILP(nums)) {
+        if (FIXNUMP(num)) {
+            fixnum_t fv = XFIXNUM(num);
+            if (fv == 0) {
+                lisp_signal(Qdivision_by_zero, Qnil);
+            } else if (fv == 1) {
+                return MAKE_FIXNUM(1);
+            } else if (fv == -1) {
+                return MAKE_FIXNUM(-1);
+            }
+            return MAKE_FIXNUM(0);
+        } else if (LISP_GMP_P(num)) {
+            mpz_srcptr n = ((LispGmp *) num)->val;
+            if (mpz_cmp_ui(n, 0) == 0) {
+                lisp_signal(Qdivision_by_zero, Qnil);
+            } else if (mpz_cmp_ui(n, 1) == 0) {
+                return MAKE_FIXNUM(1);
+            } else if (mpz_cmp_ui(n, -1) == 0) {
+                return MAKE_FIXNUM(-1);
+            }
+            return MAKE_FIXNUM(0);
+        }
+    }
+    return math_driver(OPERATOR_DIV, CONS(num, nums));
+}
+
+DEFUN(logand, "logand", (LispVal * nums), "(&rest nums)", "") {
+    if (NILP(nums)) {
+        return MAKE_FIXNUM(-1);
+    }
+    return math_driver(OPERATOR_AND, nums);
+}
+
+DEFUN(logior, "logior", (LispVal * nums), "(&rest nums)", "") {
+    if (NILP(nums)) {
+        return MAKE_FIXNUM(0);
+    }
+    return math_driver(OPERATOR_IOR, nums);
+}
+
+DEFUN(logxor, "logxor", (LispVal * nums), "(&rest nums)", "") {
+    if (NILP(nums)) {
+        return MAKE_FIXNUM(0);
+    }
+    return math_driver(OPERATOR_XOR, nums);
+}
+
+DEFINE_SYMBOL(integer, "integer");
+DEFINE_SYMBOL(number, "number");
+
+DEFINE_SYMBOL(division_by_zero, "division-by-zero");
+DEFINE_CONDITION_CLASS(division_by_zero, error);

src/lisp_math.h

@@ -0,0 +1,53 @@
+#ifndef INCLUDED_LISP_MATH_H
+#define INCLUDED_LISP_MATH_H
+
+#include "base.h"
+
+#include <gmp.h>
+
+DEFOBJTYPE(Gmp, GMP, LISP_GMP_P, {
+    mpz_t val; //
+});
+
+LispVal *copy_lisp_gmp(LispVal *gmp);
+
+LispVal *make_gmp(long value);
+static inline LispVal *make_number(long value) {
+    if (value <= MOST_POSITIVE_FIXNUM || value >= MOST_NEGATIVE_FIXNUM) {
+        return MAKE_FIXNUM(value);
+    }
+    return make_gmp(value);
+}
+
+LispVal *make_gmp_unsigned(unsigned long value);
+static inline LispVal *make_number_unsigned(unsigned long value) {
+    if (value <= MOST_POSITIVE_FIXNUM) {
+        return MAKE_FIXNUM(value);
+    }
+    return make_gmp_unsigned(value);
+}
+
+// these return NULL if the passed string is invalid
+LispVal *parse_gmp(const char *str, int base);
+LispVal *parse_number(const char *str, int base);
+
+DECLARE_FUNCTION(fixnump, (LispVal * val));
+DECLARE_FUNCTION(integerp, (LispVal * val));
+DECLARE_FUNCTION(floatp, (LispVal * val));
+DECLARE_FUNCTION(numberp, (LispVal * val));
+
+DECLARE_FUNCTION(plus, (LispVal * nums));
+DECLARE_FUNCTION(minus, (LispVal * nums));
+DECLARE_FUNCTION(times, (LispVal * nums));
+DECLARE_FUNCTION(divide, (LispVal * num, LispVal *nums));
+DECLARE_FUNCTION(logand, (LispVal * nums));
+DECLARE_FUNCTION(logior, (LispVal * nums));
+DECLARE_FUNCTION(logxor, (LispVal * nums));
+
+DECLARE_SYMBOL(integer);
+DECLARE_SYMBOL(number);
+
+DECLARE_SYMBOL(division_by_zero);
+MAKE_CONDITION_CLASS(division_by_zero);
+
+#endif

src/lisp_string.c

@@ -38,6 +38,10 @@ LispVal *lisp_vsprintf(const char *format, va_list args) {
     return make_lisp_string(buffer, printed, true, false);
 }
 
+DEFUN(stringp, "stringp", (LispVal * val), "(val)", "") {
+    return STRINGP(val) ? Qt : Qnil;
+}
+
 DEFUN(strings_equal, "strings-equal", (LispVal * string1, LispVal *string2),
       "(string1 string2)", "") {
     CHECK_TYPE(string1, TYPE_STRING);

src/lisp_string.h

@@ -15,6 +15,8 @@ LispVal *make_lisp_string(const char *data, size_t length, bool take,
 LispVal *lisp_sprintf(const char *format, ...) FORMAT(1, 2);
 LispVal *lisp_vsprintf(const char *format, va_list args);
 
+DECLARE_FUNCTION(stringp, (LispVal * val));
+
 DECLARE_FUNCTION(strings_equal, (LispVal * string1, LispVal *string2));
 DECLARE_FUNCTION(hash_string, (LispVal * string));
 

src/list.c

@@ -30,6 +30,14 @@ bool list_length_eq(LispVal *list, intptr_t size) {
     return size == 0 && NILP(list);
 }
 
+DEFUN(consp, "consp", (LispVal * val), "(val)", "") {
+    return CONSP(val) ? Qt : Qnil;
+}
+
+DEFUN(atom, "atom", (LispVal * val), "(val)", "") {
+    return ATOM(val) ? Qt : Qnil;
+}
+
 DEFUN(cons, "cons", (LispVal * car, LispVal *cdr), "(car cdr)",
       "Construct a new cons object from CAR and CDR.") {
     return CONS(car, cdr);

src/list.h

@@ -120,6 +120,8 @@ intptr_t list_length(LispVal *list);
 // Return true if the length of LIST == SIZE
 bool list_length_eq(LispVal *list, intptr_t size);
 
+DECLARE_FUNCTION(consp, (LispVal * val));
+DECLARE_FUNCTION(atom, (LispVal * val));
 DECLARE_FUNCTION(cons, (LispVal * car, LispVal *cdr));
 DECLARE_FUNCTION(car, (LispVal * list));
 DECLARE_FUNCTION(cdr, (LispVal * list));

src/macro.c

@@ -100,7 +100,7 @@ static LispVal *macroexpand_special_form(LispVal *fobj, LispVal *form,
 #define IS(n) (fobj == ((LispSymbol *) Q##n)->function)
     if (IS(lambda)) {
         return macroexpand_lambda_form(form, lexical_macros);
-    } else if (IS(quote)) {
+    } else if (IS(quote) || IS(function)) {
         return form;
     } else if (IS(progn) || IS(if) || IS(and) || IS(or)) {
         if (LISTP(XCDR(form))) {

src/memory.c

@@ -18,6 +18,10 @@ void *lisp_realloc(void *oldptr, size_t size) {
     }
 }
 
+void *lisp_realloc_gmp(void *oldptr, size_t oldsize, size_t size) {
+    return lisp_realloc(oldptr, size);
+}
+
 void *lisp_malloc(size_t size) {
     return lisp_realloc(NULL, size);
 }
@@ -37,6 +41,10 @@ void *lisp_aligned_alloc(size_t alignment, size_t size) {
     return ptr;
 }
 
+void lisp_free_gmp(void *ptr, size_t size) {
+    free(ptr);
+}
+
 #define STRING_STREAM_BLOCK_SIZE 32
 static void ensure_string_stream_space(StringStream *restrict stream,
                                        size_t space) {
@@ -99,7 +107,7 @@ bool strgetline(const char *restrict buf, size_t buf_length,
         *start += *length + 1;
     }
     size_t left = buf_length - (*start - buf);
-    char *found;
+    const char *found;
     if ((found = memchr(*start, '\n', left))) {
         *length = found - *start;
     } else {

src/memory.h

@@ -13,6 +13,9 @@
 #ifndef __has_attribute
 #    define __has_attribute(x) 0
 #endif
+#ifndef __has_builtin
+#    define __has_builtin(x) 0
+#endif
 
 #if __has_attribute(always_inline) && defined(_NDEBUG)
 #    define ALWAYS_INLINE inline __attribute__((always_inline))
@@ -123,10 +126,12 @@ static ALWAYS_INLINE lisp_float64_t LISP_FLOAT64_INF(void) {
 
 // Allocator
 void *lisp_realloc(void *oldptr, size_t size);
+void *lisp_realloc_gmp(void *oldptr, size_t oldsize, size_t size);
 void *lisp_malloc(size_t size);
 void *lisp_malloc0(size_t size);
 void *lisp_aligned_alloc(size_t alignment, size_t size);
 #define lisp_free free
+void lisp_free_gmp(void *ptr, size_t size);
 
 // other useful things
 static ALWAYS_INLINE void sub_timespecs(const struct timespec *t1,

src/print.c

@@ -212,6 +212,14 @@ static void print_float(struct PrintContext *restrict pc, LispVal *val) {
     }
 }
 
+static void print_gmp(struct PrintContext *restrict pc, LispVal *val) {
+    LispGmp *n = val;
+    int base = pc->opts.base_upper ? -pc->opts.base : pc->opts.base;
+    char *buffer = mpz_get_str(NULL, base, n->val);
+    print_buffer(pc, buffer, strlen(buffer));
+    free(buffer);
+}
+
 static bool seen_object_p(struct PrintContext *restrict pc, LispVal *val) {
     if (!pc->opts.circle) {
         return false;
@@ -488,6 +496,9 @@ static void print_driver(struct PrintContext *restrict pc, LispVal *val) {
     case TYPE_FLOAT:
         print_float(pc, val);
         break;
+    case TYPE_GMP:
+        print_gmp(pc, val);
+        break;
     case TYPE_CONS:
         print_cons(pc, val);
         break;
@@ -573,6 +584,9 @@ void debug_print(FILE *file, LispVal *obj) {
     case TYPE_FLOAT:
         fprintf(file, "%f", (double) XLISP_FLOAT(obj));
         break;
+    case TYPE_GMP:
+        gmp_fprintf(file, "%Z", ((LispGmp *) obj)->val);
+        break;
     case TYPE_STRING: {
         LispString *s = obj;
         fputc('"', file);

src/read.c

@@ -3,6 +3,7 @@
 #include "function.h"
 #include "hashtable.h"
 #include "io.h"
+#include "lisp_math.h"
 #include "lisp_string.h"
 #include "list.h"
 #include "stack.h"
@@ -125,18 +126,18 @@ static void skip_whitespace(ReadStream *restrict stream) {
     }
 }
 
-FORMAT(2, 3)
+FORMAT(4, 5)
-static noreturn void read_error(ReadStream *restrict stream,
+static noreturn void read_error_at(ReadStream *restrict stream, size_t line,
-                                const char *restrict msg, ...) {
+                                   size_t col, const char *restrict msg, ...) {
-    int c = pop_char(stream);
     va_list args;
     va_start(args, msg);
     LispVal *lmsg = lisp_vsprintf(msg, args);
     va_end(args);
-    lisp_signal(Qread_error,
+    lisp_signal(Qread_error, LIST(MAKE_FIXNUM(line), MAKE_FIXNUM(col), lmsg));
-                LIST(MAKE_FIXNUM(stream->line), MAKE_FIXNUM(stream->col), lmsg,
-                     c == READ_EOS ? Qnil : MAKE_FIXNUM(c)));
 }
+#define SAVE_POS(l, c, s) size_t l = (s)->line, c = (s)->col
+
+#define read_error(s, ...) read_error_at((s), (s)->line, (s)->col, __VA_ARGS__)
 
 static ALWAYS_INLINE bool DOT_SYMBOL_P(LispVal *val) {
     if (!SYMBOLP(val)) {
@@ -268,7 +269,7 @@ LispVal *next_char_literal(ReadStream *restrict stream) {
     if (c == READ_EOS) {
         read_error(stream, "unterminated character literal");
     } else if (c == '\\') {
-        ReadStream save = *stream;
+        SAVE_POS(line, col, stream);
         switch (pop_char(stream)) {
         case 'n':
             return MAKE_FIXNUM('\n');
@@ -281,7 +282,7 @@ LispVal *next_char_literal(ReadStream *restrict stream) {
         case READ_EOS:
             read_error(stream, "unterminated character escape sequence");
         default:
-            read_error(&save, "unknown escape sequence");
+            read_error_at(stream, line, col, "unknown escape sequence");
         }
     } else {
         return MAKE_FIXNUM(c);
@@ -290,6 +291,7 @@ LispVal *next_char_literal(ReadStream *restrict stream) {
 
 LispVal *next_symbol(const char *restrict first, size_t first_size,
                      ReadStream *restrict stream) {
+    // TODO error positions are off
     size_t read_from_first = 0;
     bool backslash = false;
     char *name = lisp_malloc(1);
@@ -476,20 +478,15 @@ LispVal *next_number_or_symbol(ReadStream *restrict stream, int base) {
         return UNWIND_AND_RETURN(stack_ref, MAKE_LISP_FLOAT(value));
     } else {
         // integer
-        // TODO handle large numbers
+        char *parse_buffer = lisp_malloc(len + 1);
-        size_t fixnum_len = ((sizeof(fixnum_t) * 8) / 3) + 1;
+        memcpy(parse_buffer, &ss.buffer[number_start], len);
-        char read_buf[fixnum_len + 1];
+        parse_buffer[len] = '\0';
-        if (len > fixnum_len) {
+        LispVal *num = parse_number(parse_buffer, base == ANY_BASE ? 10 : base);
-            read_error(stream, "numeric literal too large");
+        free(parse_buffer);
+        if (!num) {
+            read_error(stream, "invalid numeric literal");
         }
-        memcpy(read_buf, &ss.buffer[number_start], len);
+        return UNWIND_AND_RETURN(stack_ref, num);
-        read_buf[len] = '\0';
-        intmax_t value =
-            strtoimax(read_buf, NULL, base == ANY_BASE ? 10 : base);
-        if (value < MOST_NEGATIVE_FIXNUM || value > MOST_POSITIVE_FIXNUM) {
-            read_error(stream, "numeric literal too large");
-        }
-        return UNWIND_AND_RETURN(stack_ref, MAKE_FIXNUM(value));
     }
     abort();
 change_to_symbol:

src/stack.c

@@ -218,6 +218,7 @@ add_local_refs_for_object_sub_vals(StackFrame *restrict frame,
         break;
     }
     case TYPE_STRING:
+    case TYPE_GMP:
         // no held refs
         break;
     case TYPE_FIXNUM: