Function special form
This commit is contained in:
+1
-1
@@ -23,4 +23,4 @@
|
|||||||
(princ datum print-char-fun)
|
(princ datum print-char-fun)
|
||||||
(funcall (or print-char-fun 'write-byte) ?\n))
|
(funcall (or print-char-fun 'write-byte) ?\n))
|
||||||
|
|
||||||
(princln '#1=(a '#2=(a #1# c) . #1#))
|
(princln '#'princ)
|
||||||
|
|||||||
+12
-1
@@ -1,5 +1,6 @@
|
|||||||
#include "base.h"
|
#include "base.h"
|
||||||
|
|
||||||
|
#include "function.h"
|
||||||
#include "gc.h"
|
#include "gc.h"
|
||||||
#include "hashtable.h"
|
#include "hashtable.h"
|
||||||
#include "lisp.h"
|
#include "lisp.h"
|
||||||
@@ -80,6 +81,16 @@ DEFSPECIAL(quote, "quote", (LispVal * form), "(form)", "") {
|
|||||||
return 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 #
|
// # Constructors #
|
||||||
// ################
|
// ################
|
||||||
@@ -208,7 +219,7 @@ DEFINE_SYMBOL(string, "strin");
|
|||||||
DEFINE_SYMBOL(symbol, "symbol");
|
DEFINE_SYMBOL(symbol, "symbol");
|
||||||
// vector defined above
|
// vector defined above
|
||||||
DEFINE_SYMBOL(hash_table, "hash-table");
|
DEFINE_SYMBOL(hash_table, "hash-table");
|
||||||
DEFINE_SYMBOL(function, "function");
|
// function defind above
|
||||||
|
|
||||||
LispVal *symbol_for_type(LispValType type) {
|
LispVal *symbol_for_type(LispValType type) {
|
||||||
switch (type) {
|
switch (type) {
|
||||||
|
|||||||
@@ -360,6 +360,7 @@ static ALWAYS_INLINE bool EQ(LispVal *val1, LispVal *val2) {
|
|||||||
DECLARE_FUNCTION(id, (LispVal * obj));
|
DECLARE_FUNCTION(id, (LispVal * obj));
|
||||||
DECLARE_FUNCTION(eq, (LispVal * obj1, LispVal *obj2));
|
DECLARE_FUNCTION(eq, (LispVal * obj1, LispVal *obj2));
|
||||||
DECLARE_FUNCTION(quote, (LispVal * form));
|
DECLARE_FUNCTION(quote, (LispVal * form));
|
||||||
|
DECLARE_FUNCTION(function, (LispVal * form));
|
||||||
|
|
||||||
// TODO probably move these to another file
|
// TODO probably move these to another file
|
||||||
LispVal *make_vector(LispVal **data, size_t length, bool take);
|
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) {
|
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 (recursive_object_p(pc, val)) {
|
||||||
if (printed_seen_object_p(pc, val)) {
|
if (printed_seen_object_p(pc, val)) {
|
||||||
print_numbered_reference(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, '=');
|
print_numbered_reference(pc, val, '=');
|
||||||
mark_object_printed(pc, val);
|
mark_object_printed(pc, val);
|
||||||
}
|
}
|
||||||
|
if (EQ(XCAR(val), Qfunction)) {
|
||||||
|
print_char(pc, '#');
|
||||||
|
}
|
||||||
print_char(pc, '\'');
|
print_char(pc, '\'');
|
||||||
print_driver(pc, SECOND(val));
|
print_driver(pc, SECOND(val));
|
||||||
return;
|
return;
|
||||||
|
|||||||
@@ -540,13 +540,22 @@ static LispVal *hash_dispatcher(ReadStream *restrict stream) {
|
|||||||
int c;
|
int c;
|
||||||
while ((c = peek_char(stream)) != READ_EOS) {
|
while ((c = peek_char(stream)) != READ_EOS) {
|
||||||
switch (c) {
|
switch (c) {
|
||||||
|
case '\'':
|
||||||
|
pop_char(stream);
|
||||||
|
return UNWIND_AND_RETURN(stack_ref, LIST(Qfunction, read(stream)));
|
||||||
case '#':
|
case '#':
|
||||||
|
if (!ss.nchars) {
|
||||||
|
read_error(stream, "numbered reference without a number");
|
||||||
|
}
|
||||||
pop_char(stream);
|
pop_char(stream);
|
||||||
return UNWIND_AND_RETURN(
|
return UNWIND_AND_RETURN(
|
||||||
stack_ref,
|
stack_ref,
|
||||||
lookup_numbered_object(
|
lookup_numbered_object(
|
||||||
stream, convert_object_number(stream, ss.buffer)));
|
stream, convert_object_number(stream, ss.buffer)));
|
||||||
case '=':
|
case '=':
|
||||||
|
if (!ss.nchars) {
|
||||||
|
read_error(stream, "numbered object without a number");
|
||||||
|
}
|
||||||
pop_char(stream);
|
pop_char(stream);
|
||||||
return UNWIND_AND_RETURN(
|
return UNWIND_AND_RETURN(
|
||||||
stack_ref, read_numbered(stream, convert_object_number(
|
stack_ref, read_numbered(stream, convert_object_number(
|
||||||
|
|||||||
Reference in New Issue
Block a user