7 #ifdef _MSC_VER // sigh...
8 #define vsnprintf _vsnprintf
14 #define NEWSTR(c, s, l) naStr_fromdata(naNewString(c), s, l)
16 static naRef size(naContext c, naRef me, int argc, naRef* args)
18 if(argc == 0) return naNil();
19 if(naIsString(args[0])) return naNum(naStr_len(args[0]));
20 if(naIsVector(args[0])) return naNum(naVec_size(args[0]));
21 if(naIsHash(args[0])) return naNum(naHash_size(args[0]));
22 naRuntimeError(c, "object has no size()");
26 static naRef keys(naContext c, naRef me, int argc, naRef* args)
29 if(!naIsHash(h)) return naNil();
35 static naRef append(naContext c, naRef me, int argc, naRef* args)
38 if(argc < 2) return naNil();
39 if(!naIsVector(args[0])) return naNil();
40 for(i=1; i<argc; i++) naVec_append(args[0], args[i]);
44 static naRef pop(naContext c, naRef me, int argc, naRef* args)
46 if(argc < 1 || !naIsVector(args[0])) return naNil();
47 return naVec_removelast(args[0]);
50 static naRef setsize(naContext c, naRef me, int argc, naRef* args)
52 if(argc < 2) return naNil();
53 int sz = (int)naNumValue(args[1]).num;
54 if(!naIsVector(args[0])) return naNil();
55 naVec_setsize(args[0], sz);
59 static naRef subvec(naContext c, naRef me, int argc, naRef* args)
62 naRef nlen, result, v = args[0];
63 int len = 0, start = (int)naNumValue(args[1]).num;
64 if(argc < 2) return naNil();
65 nlen = argc > 2 ? naNumValue(args[2]) : naNil();
68 if(!naIsVector(v) || start < 0 || start >= naVec_size(v) || len < 0)
70 if(len == 0 || len > naVec_size(v) - start) len = naVec_size(v) - start;
71 result = naNewVector(c);
72 naVec_setsize(result, len);
74 naVec_set(result, i, naVec_get(v, start + i));
78 static naRef delete(naContext c, naRef me, int argc, naRef* args)
80 if(argc > 1 && naIsHash(args[0])) naHash_delete(args[0], args[1]);
84 static naRef intf(naContext c, naRef me, int argc, naRef* args)
87 naRef n = naNumValue(args[0]);
88 if(naIsNil(n)) return n;
89 if(n.num < 0) n.num = -floor(-n.num);
90 else n.num = floor(n.num);
92 } else return naNil();
95 static naRef num(naContext c, naRef me, int argc, naRef* args)
97 return argc > 0 ? naNumValue(args[0]) : naNil();
100 static naRef streq(naContext c, naRef me, int argc, naRef* args)
102 return argc > 1 ? naNum(naStrEqual(args[0], args[1])) : naNil();
105 static naRef substr(naContext c, naRef me, int argc, naRef* args)
107 naRef src = argc > 1 ? args[0] : naNil();
108 naRef startR = argc > 1 ? args[1] : naNil();
109 naRef lenR = argc > 2 ? args[2] : naNil();
111 if(!naIsString(src)) return naNil();
112 startR = naNumValue(startR);
113 if(naIsNil(startR)) return naNil();
114 start = (int)startR.num;
116 len = naStr_len(src) - start;
118 lenR = naNumValue(lenR);
119 if(naIsNil(lenR)) return naNil();
122 return naStr_substr(naNewString(c), src, start, len);
125 static naRef f_strc(naContext c, naRef me, int argc, naRef* args)
128 struct naStr* str = args[0].ref.ptr.str;
129 naRef idr = argc > 1 ? naNumValue(args[1]) : naNum(0);
130 if(argc < 2 || IS_NIL(idr) || !IS_STR(args[0]))
131 naRuntimeError(c, "bad arguments to strc");
132 idx = (int)naNumValue(idr).num;
133 if(idx > str->len) naRuntimeError(c, "strc index out of bounds");
134 return naNum(str->data[idx]);
137 static naRef f_chr(naContext c, naRef me, int argc, naRef* args)
140 naRef cr = argc ? naNumValue(args[0]) : naNil();
141 if(IS_NIL(cr)) naRuntimeError(c, "chr argument not string");
142 chr[0] = (char)cr.num;
143 return NEWSTR(c, chr, 1);
146 static naRef contains(naContext c, naRef me, int argc, naRef* args)
148 naRef hash = argc > 0 ? args[0] : naNil();
149 naRef key = argc > 1 ? args[1] : naNil();
150 if(naIsNil(hash) || naIsNil(key)) return naNil();
151 if(!naIsHash(hash)) return naNil();
152 return naHash_get(hash, key, &key) ? naNum(1) : naNum(0);
155 static naRef typeOf(naContext c, naRef me, int argc, naRef* args)
157 naRef r = argc > 0 ? args[0] : naNil();
159 if(naIsNil(r)) t = "nil";
160 else if(naIsNum(r)) t = "scalar";
161 else if(naIsString(r)) t = "scalar";
162 else if(naIsVector(r)) t = "vector";
163 else if(naIsHash(r)) t = "hash";
164 else if(naIsFunc(r)) t = "func";
165 else if(naIsGhost(r)) t = "ghost";
166 r = NEWSTR(c, t, strlen(t));
170 static naRef f_compile(naContext c, naRef me, int argc, naRef* args)
173 naRef script, code, fname;
174 script = argc > 0 ? args[0] : naNil();
175 if(!naIsString(script)) return naNil();
176 fname = NEWSTR(c, "<compile>", 9);
177 code = naParseCode(c, fname, 1,
178 naStr_data(script), naStr_len(script), &errLine);
179 if(!naIsCode(code)) return naNil(); // FIXME: export error to caller...
180 return naBindToContext(c, code);
183 // Funcation metacall API. Allows user code to generate an arg vector
184 // at runtime and/or call function references on arbitrary objects.
185 static naRef f_call(naContext c, naRef me, int argc, naRef* args)
188 naRef callargs, callme, result;
189 callargs = argc > 1 ? args[1] : naNil();
190 callme = argc > 2 ? args[2] : naNil(); // Might be nil, that's OK
191 if(!naIsFunc(args[0])) naRuntimeError(c, "call() on non-function");
192 if(naIsNil(callargs)) callargs = naNewVector(c);
193 else if(!naIsVector(callargs)) naRuntimeError(c, "call() args not vector");
194 if(!naIsHash(callme)) callme = naNil();
195 subc = naNewContext();
196 subc->callParent = c;
198 result = naCall(subc, args[0], callargs, callme, naNil());
200 if(argc > 2 && !IS_NIL(subc->dieArg))
201 if(naIsVector(args[argc-1]))
202 naVec_append(args[argc-1], subc->dieArg);
207 static naRef f_die(naContext c, naRef me, int argc, naRef* args)
209 c->dieArg = argc > 0 ? args[0] : naNil();
210 naRuntimeError(c, "__die__");
211 return naNil(); // never executes
214 // Wrapper around vsnprintf, iteratively increasing the buffer size
215 // until it fits. Returned buffer should be freed by the caller.
216 char* dosprintf(char* f, ...)
224 if(vsnprintf(buf, len, f, va) < len) {
234 // Inspects a printf format string f, and finds the next "%..." format
235 // specifier. Stores the start of the specifier in out, the length in
236 // len, and the type in type. Returns a pointer to the remainder of
237 // the format string, or 0 if no format string was found. Recognizes
238 // all of ANSI C's syntax except for the "length modifier" feature.
239 // Note: this does not validate the format character returned in
240 // "type". That is the caller's job.
241 static char* nextFormat(naContext ctx, char* f, char** out, int* len, char* type)
243 // Skip to the start of the format string
244 while(*f && *f != '%') f++;
248 while(*f && (*f=='-' || *f=='+' || *f==' ' || *f=='0' || *f=='#')) f++;
250 // Test for duplicate flags. This is pure pedantry and could
251 // be removed on all known platforms, but just to be safe...
253 for(p1 = *out + 1; p1 < f; p1++)
254 for(p2 = p1+1; p2 < f; p2++)
256 naRuntimeError(ctx, "duplicate flag in format string"); }
258 while(*f && *f >= '0' && *f <= '9') f++;
259 if(*f && *f == '.') f++;
260 while(*f && *f >= '0' && *f <= '9') f++;
261 if(!*f) naRuntimeError(ctx, "invalid format string");
268 #define ERR(m) naRuntimeError(ctx, m)
269 #define APPEND(r) result = naStr_concat(naNewString(ctx), result, r)
270 static naRef f_sprintf(naContext ctx, naRef me, int argc, naRef* args)
272 char t, nultmp, *fstr, *next, *fout=0, *s;
274 naRef format, arg, result = naNewString(ctx);
276 if(argc < 1) ERR("not enough arguments to sprintf");
277 format = naStringValue(ctx, argc > 0 ? args[0] : naNil());
278 if(naIsNil(format)) ERR("bad format string in sprintf");
279 s = naStr_data(format);
281 while((next = nextFormat(ctx, s, &fstr, &flen, &t))) {
282 APPEND(NEWSTR(ctx, s, fstr-s)); // stuff before the format string
283 if(flen == 2 && fstr[1] == '%') {
284 APPEND(NEWSTR(ctx, "%", 1));
288 if(argn >= argc) ERR("not enough arguments to sprintf");
290 nultmp = fstr[flen]; // sneaky nul termination...
293 arg = naStringValue(ctx, arg);
294 if(naIsNil(arg)) fout = dosprintf(fstr, "nil");
295 else fout = dosprintf(fstr, naStr_data(arg));
297 arg = naNumValue(arg);
299 fout = dosprintf(fstr, "nil");
300 else if(t=='d' || t=='i' || t=='c')
301 fout = dosprintf(fstr, (int)naNumValue(arg).num);
302 else if(t=='o' || t=='u' || t=='x' || t=='X')
303 fout = dosprintf(fstr, (unsigned int)naNumValue(arg).num);
304 else if(t=='e' || t=='E' || t=='f' || t=='F' || t=='g' || t=='G')
305 fout = dosprintf(fstr, naNumValue(arg).num);
307 ERR("invalid sprintf format type");
310 APPEND(NEWSTR(ctx, fout, strlen(fout)));
314 APPEND(NEWSTR(ctx, s, strlen(s)));
318 // FIXME: handle ctx->callParent frames too!
319 static naRef f_caller(naContext ctx, naRef me, int argc, naRef* args)
323 naRef result, fr = argc ? naNumValue(args[0]) : naNil();
324 if(IS_NIL(fr)) naRuntimeError(ctx, "non numeric argument to caller()");
326 if(fidx > ctx->fTop - 1) return naNil();
327 frame = &ctx->fStack[ctx->fTop - 1 - fidx];
328 result = naNewVector(ctx);
329 naVec_append(result, frame->locals);
330 naVec_append(result, frame->func);
331 naVec_append(result, frame->func.ref.ptr.func->code.ref.ptr.code->srcFile);
332 naVec_append(result, naNum(naGetLine(ctx, fidx)));
336 static naRef f_closure(naContext ctx, naRef me, int argc, naRef* args)
341 func = argc > 0 ? args[0] : naNil();
342 idx = argc > 1 ? naNumValue(args[1]) : naNil();
343 if(!IS_FUNC(func) || IS_NIL(idx))
344 naRuntimeError(ctx, "bad arguments to closure()");
346 f = func.ref.ptr.func;
347 while(i > 0 && f) { i--; f = f->next.ref.ptr.func; }
348 if(!f) return naNil();
352 static int match(char* a, char* b, int l)
355 for(i=0; i<l; i++) if(a[i] != b[i]) return 0;
359 static int find(char* a, int al, char* s, int sl)
362 if(al == 0) return 0;
363 for(i=0; i<sl-al+1; i++) if(match(a, s+i, al)) return i;
367 static naRef f_find(naContext ctx, naRef me, int argc, naRef* args)
369 if(argc < 2 || !IS_STR(args[0]) || !IS_STR(args[1]))
370 naRuntimeError(ctx, "bad/missing argument to split");
371 return naNum(find(args[0].ref.ptr.str->data, args[0].ref.ptr.str->len,
372 args[1].ref.ptr.str->data, args[1].ref.ptr.str->len));
375 static naRef f_split(naContext ctx, naRef me, int argc, naRef* args)
380 if(argc < 2 || !IS_STR(args[0]) || !IS_STR(args[1]))
381 naRuntimeError(ctx, "bad/missing argument to split");
382 d = naStr_data(args[0]); dl = naStr_len(args[0]);
383 s = naStr_data(args[1]); sl = naStr_len(args[1]);
384 result = naNewVector(ctx);
385 if(dl == 0) { // special case zero-length delimiter
386 for(i=0; i<sl; i++) naVec_append(result, NEWSTR(ctx, s+i, 1));
390 for(i=0; i <= sl-dl; i++) {
391 if(match(s+i, d, dl)) {
392 naVec_append(result, NEWSTR(ctx, s0, s+i-s0));
397 if(s0 - s <= sl) naVec_append(result, NEWSTR(ctx, s0, s+sl-s0));
401 // This is a comparatively weak RNG, based on the C library's rand()
402 // function, which is usually not threadsafe and often of limited
403 // precision. The 5x loop guarantees that we get a full double worth
404 // of precision even for 15 bit (Win32...) rand() implementations.
405 static naRef f_rand(naContext ctx, naRef me, int argc, naRef* args)
410 if(!IS_NUM(args[0])) naRuntimeError(ctx, "rand() seed not number");
411 srand((unsigned int)args[0].num);
414 for(i=0; i<5; i++) r = (r + rand()) * (1.0/(RAND_MAX+1.0));
418 struct func { char* name; naCFunction func; };
419 static struct func funcs[] = {
422 { "append", append },
424 { "setsize", setsize },
425 { "subvec", subvec },
426 { "delete", delete },
430 { "substr", substr },
433 { "contains", contains },
434 { "typeof", typeOf },
435 { "compile", f_compile },
438 { "sprintf", f_sprintf },
439 { "caller", f_caller },
440 { "closure", f_closure },
442 { "split", f_split },
446 naRef naStdLib(naContext c)
448 naRef namespace = naNewHash(c);
449 int i, n = sizeof(funcs)/sizeof(struct func);
451 naRef code = naNewCCode(c, funcs[i].func);
452 naRef name = NEWSTR(c, funcs[i].name, strlen(funcs[i].name));
453 name = naInternSymbol(name);
454 naHash_set(namespace, name, naNewFunc(c, code));