diff --git a/lisp/kernel.gl b/lisp/kernel.gl index 9f731d5..c1663ec 100644 --- a/lisp/kernel.gl +++ b/lisp/kernel.gl @@ -23,4 +23,4 @@ (princ datum print-char-fun) (funcall (or print-char-fun 'write-byte) ?\n)) -(princln '#1=(a '#2=(a #1# c) . #1#)) +(princln '#'princ) diff --git a/src/base.c b/src/base.c index 7531dbb..eedfbb5 100644 --- a/src/base.c +++ b/src/base.c @@ -1,5 +1,6 @@ #include "base.h" +#include "function.h" #include "gc.h" #include "hashtable.h" #include "lisp.h" @@ -80,6 +81,16 @@ DEFSPECIAL(quote, "quote", (LispVal * form), "(form)", "") { return form; } +DEFSPECIAL(function, "function", (LispVal * form), "(form)", "") { + if (SYMBOLP(form)) { + LispVal *res = Fsymbol_function(form, Qt); + if (FUNCTIONP(res) && NILP(Fspecial_form_p(res))) { + return res; + } + } + return form; +} + // ################ // # Constructors # // ################ @@ -208,7 +219,7 @@ DEFINE_SYMBOL(string, "strin"); DEFINE_SYMBOL(symbol, "symbol"); // vector defined above DEFINE_SYMBOL(hash_table, "hash-table"); -DEFINE_SYMBOL(function, "function"); +// function defind above LispVal *symbol_for_type(LispValType type) { switch (type) { diff --git a/src/base.h b/src/base.h index b59d3c8..8042824 100644 --- a/src/base.h +++ b/src/base.h @@ -360,6 +360,7 @@ static ALWAYS_INLINE bool EQ(LispVal *val1, LispVal *val2) { DECLARE_FUNCTION(id, (LispVal * obj)); DECLARE_FUNCTION(eq, (LispVal * obj1, LispVal *obj2)); DECLARE_FUNCTION(quote, (LispVal * form)); +DECLARE_FUNCTION(function, (LispVal * form)); // TODO probably move these to another file LispVal *make_vector(LispVal **data, size_t length, bool take); diff --git a/src/print.c b/src/print.c index 5be0a72..7b7a325 100644 --- a/src/print.c +++ b/src/print.c @@ -267,7 +267,8 @@ static void print_numbered_reference(struct PrintContext *restrict pc, } static void print_cons(struct PrintContext *restrict pc, LispVal *val) { - if (pc->opts.quoted && EQ(XCAR(val), Qquote) && list_length_eq(val, 2)) { + if (pc->opts.quoted && (EQ(XCAR(val), Qquote) || EQ(XCAR(val), Qfunction)) + && list_length_eq(val, 2)) { if (recursive_object_p(pc, val)) { if (printed_seen_object_p(pc, val)) { print_numbered_reference(pc, val, '#'); @@ -276,6 +277,9 @@ static void print_cons(struct PrintContext *restrict pc, LispVal *val) { print_numbered_reference(pc, val, '='); mark_object_printed(pc, val); } + if (EQ(XCAR(val), Qfunction)) { + print_char(pc, '#'); + } print_char(pc, '\''); print_driver(pc, SECOND(val)); return; diff --git a/src/read.c b/src/read.c index 64d23d1..d232cad 100644 --- a/src/read.c +++ b/src/read.c @@ -540,13 +540,22 @@ static LispVal *hash_dispatcher(ReadStream *restrict stream) { int c; while ((c = peek_char(stream)) != READ_EOS) { switch (c) { + case '\'': + pop_char(stream); + return UNWIND_AND_RETURN(stack_ref, LIST(Qfunction, read(stream))); case '#': + if (!ss.nchars) { + read_error(stream, "numbered reference without a number"); + } pop_char(stream); return UNWIND_AND_RETURN( stack_ref, lookup_numbered_object( stream, convert_object_number(stream, ss.buffer))); case '=': + if (!ss.nchars) { + read_error(stream, "numbered object without a number"); + } pop_char(stream); return UNWIND_AND_RETURN( stack_ref, read_numbered(stream, convert_object_number(