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
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
|
#define _GNU_SOURCE //asprintf
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <assert.h>
#include "inter_builtins.h"
#include "interpreter.h"
#include "util.h"
extern InterRet interpret(InterState *is,const AST *ast);
InterRet builtin_do(InterState *is,int nargs,AST **args){
assert(args);
InterRet ir;
for(int i=0;i<nargs;i++){
assert(args[i]);
ir=interpret(is,args[i]);
if(ir.errstr)return ir;
if(i<nargs-1)ast_free(ir.ast);
}
return ir;
}
InterRet builtin_if(InterState *is,int nargs,AST **args){
assert(args);
if(nargs!=2&&nargs!=3){
char *buf;
asprintf(&buf,"Builtin 'if' needs 2 or 3 arguments, got %d",nargs);
if(!buf)outofmem();
return ir_err(buf);
}
bool cond;
switch(args[0]->type){
case AST_LIST: cond=args[0]->li.len!=0; break;
case AST_LAMBDAARG: assert(false);
case AST_WORD: assert(false);
case AST_NUMBER: cond=args[0]->nu.num!=0; break;
case AST_STRING: cond=args[0]->st.len!=0; break;
default:
return ir_err_c("Invalid node type in condition of builtin 'if'");
}
if(cond)return interpret(is,args[1]);
else if(nargs==3)return interpret(is,args[2]);
else return ir_ast(ast_list(0,malloc(1,AST*)));
}
InterRet builtin_print(InterState *is,int nargs,AST **args){
(void)is;
assert(args);
for(int i=0;i<nargs;i++){
assert(args[i]);
if(i>0)putchar(' ');
if(args[i]->type==AST_STRING){
fwrite(args[i]->st.str,1,args[i]->st.len,stdout);
} else {
char *s=ast_stringify(args[i]);
printf("%s",s);
free(s);
}
}
putchar('\n');
return ir_ast(ast_list(0,malloc(1,AST*)));
}
#define BUILTIN_LOGICAL_OP(op,name) \
InterRet builtin_##name(InterState *is,int nargs,AST **args){ \
(void)is; \
assert(args); \
if(nargs!=2||args[0]->type!=AST_NUMBER||args[1]->type!=AST_NUMBER){ \
return ir_err_c("Logical operator '" #op "' expects two number arguments"); \
} \
return ir_ast(ast_number(args[0]->nu.num op args[1]->nu.num)); \
}
BUILTIN_LOGICAL_OP(==,equals);
BUILTIN_LOGICAL_OP(>,greater);
BUILTIN_LOGICAL_OP(>=,greaterequals);
BUILTIN_LOGICAL_OP(<,less);
BUILTIN_LOGICAL_OP(<=,lessequals);
#undef BUILTIN_LOGICAL_OP
#define BUILTIN_ARITH_OP(op,name,defval,expr) \
InterRet builtin_##name(InterState *is,int nargs,AST **args){ \
(void)is; \
assert(args); \
if(nargs==0)return ir_ast(ast_number(defval)); \
for(int i=0;i<nargs;i++){ \
assert(args[i]); \
if(args[i]->type!=AST_NUMBER){ \
return ir_err_c("Non-number argument passed to builtin '" #op "'"); \
} \
} \
double res=args[0]->nu.num; \
for(int i=1;i<nargs;i++){ \
double n=args[i]->nu.num; \
res=expr; \
} \
return ir_ast(ast_number(res)); \
}
BUILTIN_ARITH_OP(+,sum,0,res+n);
BUILTIN_ARITH_OP(-,difference,0,res-n);
BUILTIN_ARITH_OP(*,product,1,res*n);
BUILTIN_ARITH_OP(/,quotient,1,res/n);
BUILTIN_ARITH_OP(%,remainder,1,floatmod(res,n));
#undef BUILTIN_ARITH_OP
static void convert_arguments(AST *ast,int nargs,const char **args){
switch(ast->type){
case AST_LIST:
for(int i=0;i<ast->li.len;i++)convert_arguments(ast->li.nodes[i],nargs,args);
break;
case AST_LAMBDA:
break;
case AST_WORD:{
int i;
for(i=0;i<nargs;i++){
if(strcmp(ast->wo.word,args[i])==0)break;
}
if(i==nargs)break;
free(ast->wo.word);
ast->type=AST_LAMBDAARG;
ast->ar.idx=i;
break;
}
case AST_QUOTED:
convert_arguments(ast->qu.ast,nargs,args);
break;
case AST_LAMBDAARG:
case AST_NUMBER:
case AST_STRING:
case AST_SYMBOL:
break;
default:
assert(false);
}
}
InterRet builtin_define(InterState *is,int nargs,AST **args){
if(nargs!=3)return ir_err_c("Invalid number of arguments to builtin 'define'");
if(args[0]->type!=AST_SYMBOL){
return ir_err_c("First argument to builtin 'define' should be symbol");
}
if(args[1]->type!=AST_LIST){
return ir_err_c("Second argument to builtin 'define' should be quoted list");
}
const AST *arglist=args[1];
for(int i=0;i<arglist->li.len;i++){
if(arglist->li.nodes[i]->type!=AST_WORD){
return ir_err_c("Second argument to builtin 'define' should contain words");
}
}
const char *funcname=args[0]->sy.name;
AST *body=args[2];
const char *argnames[arglist->li.len];
for(int i=0;i<arglist->li.len;i++)argnames[i]=arglist->li.nodes[i]->wo.word;
convert_arguments(body,arglist->li.len,argnames);
inter_assign(is,funcname,ast_lambda(NULL,ast_copy(body)));
return ir_ast(ast_list(0,malloc(1,AST*)));
}
|
