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
|
#include "value.h"
#define PROCEDURES(X) \
/* X(symbol, name, argc) */ \
X(plus, "+", 2) \
X(equal, "=", 2) \
X(minus, "-", 2) \
X(cons, "cons", 2) \
X(car, "car", 1) \
X(cdr, "cdr", 1) \
X(display,"display", 1) \
X(is_nil, "nil?", 1) \
// Number of builtin procedures
#define PLUS_ONE(_symbol, _name, _argc) 1 +
#define BUILTIN_PROCEDURES PROCEDURES(PLUS_ONE) 0
// Forward decalration of the procedures
#define FORWARD_DECLARATION(symbol, _name, _argc) \
value_t symbol(value_t *args);
PROCEDURES(FORWARD_DECLARATION)
// Fill procedure struct for the value_t
#define PROC_DESCRIPTION(symbol, _name, argc) \
{argc, symbol},
struct proc_builtin builtin_proc_descriptions[] = {
PROCEDURES(PROC_DESCRIPTION)
};
// List of ordered names of procedures
#define PROC_NAME(symbol, name, _argc) \
name,
const char *builtin_proc_name_list[] = {
PROCEDURES(PROC_NAME)
};
// ----- Definitions -----
#define ASSERT_TYPE(proc, args, pos, vtype, fail) \
if(args[pos]->type != vtype) { \
err("Expected arg %d of '%s' to be %s instead of %s", \
pos, #proc, \
value_type_string[vtype], \
value_type_string[args[pos]->type]); \
fail; \
}
value_t plus(value_t *args)
{
ASSERT_TYPE(plus, args, 0, VALUE_INT, return VALUE_EMPTY);
ASSERT_TYPE(plus, args, 1, VALUE_INT, return VALUE_EMPTY);
int sum = args[0]->value.num + args[1]->value.num;
return value_create(VALUE_INT, &sum);
}
value_t minus(value_t *args)
{
ASSERT_TYPE(minus, args, 0, VALUE_INT, return VALUE_EMPTY);
ASSERT_TYPE(minus, args, 1, VALUE_INT, return VALUE_EMPTY);
int difference = args[0]->value.num - args[1]->value.num;
return value_create(VALUE_INT, &difference);
}
value_t equal(value_t *args)
{
int f = 0;
int t = 1;
if(args[0]->type != args[1]->type) goto l_false;
switch(args[0]->type) {
case VALUE_INT:
if(args[0]->value.num == args[1]->value.num) goto l_true;
default: break;
}
l_false:
return value_create(VALUE_INT, &f);
l_true:
return value_create(VALUE_INT, &t);
}
value_t cons(value_t *args)
{
struct cons cons = {value_copy(args[0]), value_copy(args[1])};
return value_create(VALUE_CONS, &cons);
}
value_t car(value_t *args)
{
ASSERT_TYPE(car, args, 0, VALUE_CONS, return VALUE_EMPTY);
value_t left = value_copy(args[0]->value.cons.left);
return left;
}
value_t cdr(value_t *args)
{
ASSERT_TYPE(cdr, args, 0, VALUE_CONS, return VALUE_EMPTY);
value_t right = value_copy(args[0]->value.cons.right);
return right;
}
value_t display(value_t *args)
{
char buf[256];
value_string(args[0], sizeof(buf), buf);
// if(bytes > sizeof(buf)) ...
printf("%s\n", buf);
return value_copy(args[0]);
}
value_t is_nil(value_t *args)
{
int f = 0, t = 1;
if(args[0]->type == VALUE_NIL)
return value_create(VALUE_INT, &t);
return value_create(VALUE_INT, &f);
}
|
