1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
#ifndef BAMBOO_LISP_INTERP_H_
#define BAMBOO_LISP_INTERP_H_
#include <stdbool.h>
#include <algds/hash_table.h>
#include "algds/vec.h"
#include "sexp.h"
struct parser;
typedef struct parser Parser;
struct interp;
typedef struct interp Interp;
HASH_TABLE_DEF(SExpRef, SExpRef);
struct interp {
SExpVector objs;
SExpRef2SExpRefHashTable topbindings;
IntVector empty_space;
String2IntHashTable symbols;
SExpRef stack;
SExpRef t;
SExpRef f;
SExpRef reg;
SExpRef top_level;
SExpRef nil;
char *errmsg_buf;
Parser *parser;
int gensym_cnt;
bool alwaysgc;
int recursion_depth;
};
void Interp_init(Interp *self);
void Interp_free(Interp *self);
SExp* Interp_ref(Interp *self, SExpRef ref);
void Interp_gc(Interp *self, SExpRef tmp_root);
void Interp_add_primitive(Interp *self, const char *name, LispPrimitive fn);
void Interp_add_userfunc(Interp *self, const char *name, LispUserFunc fn);
SExpRef Interp_eval_string(Interp *interp, const char * str);
SExpRef Interp_load_file(Interp *interp, const char *filename);
#define REF(_x) (((_x).idx) >= 0 ? (&(interp->objs.buffer)[(_x).idx]) : NULL)
#define CONS(_x, _y) (lisp_cons(interp, (_x), (_y)))
#define NILP(_x) (lisp_nilp(interp, (_x)))
#define LENGTH(_x) (lisp_length(interp, (_x)))
#define EVAL(_x) (lisp_eval(interp, (_x), false))
#define EVALTAIL(_x) (lisp_eval(interp, (_x), true))
#define TRUEP(_x) (lisp_truep(interp, (_x)))
#define FOREACH(_x, _lst) for (SExpRef _x = _lst; !NILP(_x); _x = CDR(_x))
// control flow
#define CTL_FL(_x) \
(REF((_x))->type == kErrSignal \
|| REF((_x))->type == kReturnSignal \
|| REF((_x))->type == kExceptionSignal \
|| REF((_x))->type == kBreakSignal \
|| REF((_x))->type == kContinueSignal)
#define VALTYPE(_x) (REF((_x))->type)
#define CALLABLE(_x) (VALTYPE(_x) == kFuncSExp || VALTYPE(_x) == kUserFuncSExp)
#define NIL (interp->nil)
#define CAR(_x) (lisp_car(interp, (_x)))
#define CDR(_x) (lisp_cdr(interp, (_x)))
#define CADR(_x) CAR(CDR(_x))
#define CDDR(_x) CDR(CDR(_x))
#define CADDR(_x) CAR(CDDR(_x))
#define CDDDR(_x) CDR(CDDR(_x))
#define CADDDR(_x) CAR(CDDDR(_x))
#define CDDDDR(_x) CDR(CDDDR(_x))
#define CADDDDR(_x) CAR(CDDDDR(_x))
#define CDDDDDR(_x) CDR(CDDDDR(_x))
#define PUSH_REG(_x) { interp->reg = CONS((_x), interp->reg); }
#define POP_REG() { interp->reg = CDR(interp->reg); }
const char* lisp_to_string(Interp *interp, SExpRef val);
SExpRef lisp_macroexpand1(Interp *interp, SExpRef macro, SExpRef args);
SExpRef lisp_nreverse(Interp *interp, SExpRef lst);
SExpRef lisp_reverse(Interp *interp, SExpRef lst);
void lisp_defun(Interp *interp, SExpRef name, SExpRef val);
void lisp_defvar(Interp *interp, SExpRef name, SExpRef val);
void lisp_print(Interp *interp, SExpRef obj, FILE *fp);
SExpRef lisp_lookup(Interp *interp, SExpRef name);
SExpRef lisp_lookup_func(Interp *interp, SExpRef name);
SExpRef lisp_apply(Interp *interp, SExpRef fn, SExpRef args, bool istail);
SExpRef lisp_call(Interp *interp, SExpRef fn, SExpRef args);
SExpRef lisp_cons(Interp *interp, SExpRef a, SExpRef b);
SExpRef lisp_dup(Interp *interp, SExpRef arg);
bool lisp_nilp(Interp *interp, SExpRef arg);
bool lisp_truep(Interp *interp, SExpRef a);
bool lisp_check_list(Interp *interp, SExpRef lst);
SExpRef lisp_setq(Interp *interp, SExpRef name, SExpRef val);
int lisp_length(Interp *interp, SExpRef lst);
SExpRef lisp_car(Interp *interp, SExpRef arg);
SExpRef lisp_cdr(Interp *interp, SExpRef arg);
SExpRef lisp_eval(Interp *interp, SExpRef arg, bool istail);
SExpRef lisp_eval_args(Interp *interp, SExpRef args);
SExpRef lisp_add(Interp *interp, SExpRef args);
SExpRef lisp_sub(Interp *interp, SExpRef args);
SExpRef lisp_mul(Interp *interp, SExpRef args);
SExpRef lisp_div(Interp *interp, SExpRef args);
SExpRef new_error(Interp *interp, const char *format, ...);
SExpRef new_sexp(Interp *ctx);
SExpRef new_return(Interp *ctx, SExpRef ret);
SExpRef new_break(Interp *ctx);
SExpRef new_continue(Interp *ctx);
SExpRef new_boolean(Interp *ctx, bool val);
SExpRef new_char(Interp *ctx, char val);
SExpRef new_integer(Interp *ctx, int64_t val);
SExpRef new_real(Interp *ctx, double val);
SExpRef new_string(Interp *ctx, const char *val);
SExpRef new_symbol(Interp *ctx, const char *val);
SExpRef new_env(Interp *ctx);
SExpRef new_binding(Interp *ctx, SExpRef name, SExpRef val);
SExpRef new_userfunc(Interp *interp, LispUserFunc val);
SExpRef new_primitive(Interp *interp, LispPrimitive val);
SExpRef new_lambda(Interp *interp, SExpRef param, SExpRef body, SExpRef env);
SExpRef new_macro(Interp *interp, SExpRef param, SExpRef body);
SExpRef new_tailcall(Interp *interp, SExpRef fn, SExpRef args);
SExpRef new_exception(Interp *interp, SExpRef e);
SExpRef new_list1(Interp *ctx, SExpRef e1);
SExpRef new_list2(Interp *ctx, SExpRef e1, SExpRef e2);
SExpRef new_list3(Interp *ctx, SExpRef e1, SExpRef e2, SExpRef e3);
SExpRef new_list4(Interp *ctx, SExpRef e1, SExpRef e2, SExpRef e3, SExpRef e4);
SExpRef new_list5(Interp *ctx, SExpRef e1, SExpRef e2, SExpRef e3, SExpRef e4, SExpRef e5);
#endif
|