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
|
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <assert.h>
#include "inter_builtins.h"
#include "interpreter.h"
#include "util.h"
InterRet builtin_do(InterState *is,int nargs,AST **args){
assert(args);
InterRet ir;
for(int i=0;i<nargs;i++){
assert(args[i]);
ir=inter_runcode(is,args[i]);
if(ir.errstr)return ir;
if(i<nargs-1)ast_free(ir.ast);
}
return ir;
}
InterRet builtin_print(InterState *is,int nargs,AST **args){
(void)is;
assert(args);
for(int i=0;i<nargs;i++){
assert(args[i]);
char *s=ast_stringify(args[i]);
if(i>0)putchar(' ');
printf("%s",s);
free(s);
}
putchar('\n');
return ir_ast(ast_list(0,malloc(1,AST*)));
}
#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*)));
}
|
