Function special form
This commit is contained in:
+12
-1
@@ -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) {
|
||||
|
||||
@@ -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);
|
||||
|
||||
+5
-1
@@ -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;
|
||||
|
||||
@@ -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(
|
||||
|
||||
Reference in New Issue
Block a user