aboutsummaryrefslogtreecommitdiffstats
path: root/src/bootstrap/primitives.c
diff options
context:
space:
mode:
Diffstat (limited to 'src/bootstrap/primitives.c')
-rw-r--r--src/bootstrap/primitives.c151
1 files changed, 151 insertions, 0 deletions
diff --git a/src/bootstrap/primitives.c b/src/bootstrap/primitives.c
new file mode 100644
index 0000000..50a2dfb
--- /dev/null
+++ b/src/bootstrap/primitives.c
@@ -0,0 +1,151 @@
1void
2display(Object *root) {
3 if (root == NULL) {
4 return;
5 }
6
7 switch (root->type) {
8 case OBJ_TYPE_FIXNUM: {
9 printf("%zd", root->fixnum);
10 } break;
11 case OBJ_TYPE_BOOL: {
12 if (root->boolean) {
13 printf("true");
14 } else {
15 printf("false");
16 }
17 } break;
18 case OBJ_TYPE_NIL: {
19 printf("()");
20 } break;
21 case OBJ_TYPE_STRING: {
22 printf("\"%.*s\"", (int)root->string_n, root->string);
23 } break;
24 case OBJ_TYPE_SYMBOL: {
25 printf(":%.*s", (int)root->symbol_n, root->symbol);
26 } break;
27 case OBJ_TYPE_PAIR: {
28 printf("(");
29 display_pair(root);
30 printf(")");
31 } break;
32 default: {
33 printf("TYPE NOT IMPLEMENTED FOR DISPLAY.");
34 } break;
35 }
36}
37
38Object *
39eval(Object *root) {
40 if (root == NULL) {
41 return NULL;
42 }
43
44 switch (root->type) {
45 case OBJ_TYPE_FIXNUM:
46 case OBJ_TYPE_BOOL:
47 case OBJ_TYPE_NIL:
48 case OBJ_TYPE_STRING:
49 case OBJ_TYPE_SYMBOL: {
50 return root;
51 } break;
52 case OBJ_TYPE_PAIR: {
53 if (root->car->type == OBJ_TYPE_SYMBOL) {
54 Object *value = find_environment_symbol(root->car);
55 if (value == NULL) {
56 printf("error: symbol not found: `");
57 display(root->car);
58 printf("`\n");
59 return NULL;
60 }
61 if (value->type == OBJ_TYPE_PROCEDURE) {
62 return value->proc(root->cdr);
63 }
64 }
65 } break;
66 default: {
67 printf("error: can't eval type %d.\n", root->type);
68 } break;
69 }
70
71 return NULL;
72}
73
74Object *
75proc_add(Object *args) {
76 ssize_t tot = 0;
77 while (args->type == OBJ_TYPE_PAIR) {
78 Object *car = eval(args->car);
79 if (car->type != OBJ_TYPE_FIXNUM) {
80 fprintf(stderr, "addition not supported for type %d\n", car->type);
81 return NULL;
82 }
83 tot += car->fixnum;
84 args = args->cdr;
85 }
86 return make_fixnum(tot);
87}
88
89Object *
90proc_sub(Object *args) {
91 if (args->type != OBJ_TYPE_PAIR) {
92 fprintf(stderr, "substraction not supported for type %d\n", args->type);
93 return NULL;
94 }
95
96 // Extract first parameter.
97 Object *car = eval(args->car);
98 args = args->cdr;
99 ssize_t tot = car->fixnum;
100
101 while (args->type == OBJ_TYPE_PAIR) {
102 Object *car = eval(args->car);
103 if (car->type != OBJ_TYPE_FIXNUM) {
104 fprintf(stderr, "substraction not supported for type %d\n", car->type);
105 return NULL;
106 }
107 tot -= car->fixnum;
108 args = args->cdr;
109 }
110 return make_fixnum(tot);
111}
112
113Object *
114proc_mul(Object *args) {
115 ssize_t tot = 1;
116 while (args->type == OBJ_TYPE_PAIR) {
117 Object *car = eval(args->car);
118 if (car->type != OBJ_TYPE_FIXNUM) {
119 fprintf(stderr, "multiply not supported for type %d\n", car->type);
120 return NULL;
121 }
122 tot *= car->fixnum;
123 args = args->cdr;
124 }
125 return make_fixnum(tot);
126}
127
128Object *
129proc_div(Object *args) {
130 if (args->type != OBJ_TYPE_PAIR) {
131 fprintf(stderr, "substraction not supported for type %d\n", args->type);
132 return NULL;
133 }
134
135 // Extract first parameter.
136 Object *car = eval(args->car);
137 args = args->cdr;
138 ssize_t tot = car->fixnum;
139
140 while (args->type == OBJ_TYPE_PAIR) {
141 Object *car = eval(args->car);
142 if (car->type != OBJ_TYPE_FIXNUM) {
143 fprintf(stderr, "div not supported for type %d\n", car->type);
144 return NULL;
145 }
146 tot /= car->fixnum;
147 args = args->cdr;
148 }
149 return make_fixnum(tot);
150}
151