7 #ifdef _MSC_VER // sigh...
8 #define vsnprintf _vsnprintf
14 #define NEWSTR(c, s, l) naStr_fromdata(naNewString(c), s, l)
15 #define NEWCSTR(c, s) NEWSTR(c, s, strlen(s))
17 static naRef size(naContext c, naRef me, int argc, naRef* args)
19 if(argc == 0) return naNil();
20 if(naIsString(args[0])) return naNum(naStr_len(args[0]));
21 if(naIsVector(args[0])) return naNum(naVec_size(args[0]));
22 if(naIsHash(args[0])) return naNum(naHash_size(args[0]));
23 naRuntimeError(c, "object has no size()");
27 static naRef keys(naContext c, naRef me, int argc, naRef* args)
30 if(!naIsHash(h)) return naNil();
36 static naRef append(naContext c, naRef me, int argc, naRef* args)
39 if(argc < 2) return naNil();
40 if(!naIsVector(args[0])) return naNil();
41 for(i=1; i<argc; i++) naVec_append(args[0], args[i]);
45 static naRef pop(naContext c, naRef me, int argc, naRef* args)
47 if(argc < 1 || !naIsVector(args[0])) return naNil();
48 return naVec_removelast(args[0]);
51 static naRef setsize(naContext c, naRef me, int argc, naRef* args)
54 if(argc < 2) return naNil();
55 sz = (int)naNumValue(args[1]).num;
56 if(!naIsVector(args[0])) return naNil();
57 naVec_setsize(args[0], sz);
61 static naRef subvec(naContext c, naRef me, int argc, naRef* args)
64 naRef nlen, result, v = args[0];
65 int len = 0, start = (int)naNumValue(args[1]).num;
66 if(argc < 2) return naNil();
67 nlen = argc > 2 ? naNumValue(args[2]) : naNil();
70 if(!naIsVector(v) || start < 0 || start >= naVec_size(v) || len < 0)
72 if(len > naVec_size(v) - start) len = naVec_size(v) - start;
73 result = naNewVector(c);
74 naVec_setsize(result, len);
76 naVec_set(result, i, naVec_get(v, start + i));
80 static naRef delete(naContext c, naRef me, int argc, naRef* args)
82 if(argc > 1 && naIsHash(args[0])) naHash_delete(args[0], args[1]);
86 static naRef intf(naContext c, naRef me, int argc, naRef* args)
89 naRef n = naNumValue(args[0]);
90 if(naIsNil(n)) return n;
91 if(n.num < 0) n.num = -floor(-n.num);
92 else n.num = floor(n.num);
94 } else return naNil();
97 static naRef num(naContext c, naRef me, int argc, naRef* args)
99 return argc > 0 ? naNumValue(args[0]) : naNil();
102 static naRef streq(naContext c, naRef me, int argc, naRef* args)
104 return argc > 1 ? naNum(naStrEqual(args[0], args[1])) : naNil();
107 static naRef f_cmp(naContext c, naRef me, int argc, naRef* args)
111 if(argc < 2 || !naIsString(args[0]) || !naIsString(args[1]))
112 naRuntimeError(c, "bad argument to cmp");
113 a = naStr_data(args[0]);
114 alen = naStr_len(args[0]);
115 b = naStr_data(args[1]);
116 blen = naStr_len(args[1]);
117 for(i=0; i<alen && i<blen; i++) {
118 int diff = a[i] - b[i];
119 if(diff) return naNum(diff < 0 ? -1 : 1);
121 return naNum(alen == blen ? 0 : (alen < blen ? -1 : 1));
124 static naRef substr(naContext c, naRef me, int argc, naRef* args)
126 naRef src = argc > 1 ? args[0] : naNil();
127 naRef startR = argc > 1 ? naNumValue(args[1]) : naNil();
128 naRef lenR = argc > 2 ? naNumValue(args[2]) : naNil();
130 if(!naIsString(src)) return naNil();
131 if(naIsNil(startR)) return naNil();
132 start = (int)startR.num;
134 len = naStr_len(src) - start;
135 if(len < 0) return naNil();
137 lenR = naNumValue(lenR);
138 if(naIsNil(lenR)) return naNil();
141 return naStr_substr(naNewString(c), src, start, len);
144 static naRef f_chr(naContext c, naRef me, int argc, naRef* args)
147 naRef cr = argc ? naNumValue(args[0]) : naNil();
148 if(IS_NIL(cr)) naRuntimeError(c, "chr argument not string");
149 chr[0] = (char)cr.num;
150 return NEWSTR(c, chr, 1);
153 static naRef contains(naContext c, naRef me, int argc, naRef* args)
155 naRef hash = argc > 0 ? args[0] : naNil();
156 naRef key = argc > 1 ? args[1] : naNil();
157 if(naIsNil(hash) || naIsNil(key)) return naNil();
158 if(!naIsHash(hash)) return naNil();
159 return naHash_get(hash, key, &key) ? naNum(1) : naNum(0);
162 static naRef typeOf(naContext c, naRef me, int argc, naRef* args)
164 naRef r = argc > 0 ? args[0] : naNil();
166 if(naIsNil(r)) t = "nil";
167 else if(naIsNum(r)) t = "scalar";
168 else if(naIsString(r)) t = "scalar";
169 else if(naIsVector(r)) t = "vector";
170 else if(naIsHash(r)) t = "hash";
171 else if(naIsFunc(r)) t = "func";
172 else if(naIsGhost(r)) t = "ghost";
177 static naRef f_compile(naContext c, naRef me, int argc, naRef* args)
180 naRef script, code, fname;
181 script = argc > 0 ? args[0] : naNil();
182 if(!naIsString(script)) return naNil();
183 fname = NEWCSTR(c, "<compile>");
184 code = naParseCode(c, fname, 1,
185 naStr_data(script), naStr_len(script), &errLine);
186 if(!naIsCode(code)) return naNil(); // FIXME: export error to caller...
187 return naBindToContext(c, code);
190 static naRef f_call(naContext c, naRef me, int argc, naRef* args)
193 naRef callargs, callme, callns, result;
195 callargs = argc > 1 ? args[1] : naNil();
196 callme = argc > 2 ? args[2] : naNil(); // Might be nil, that's OK
197 callns = argc > 3 ? args[3] : naNil(); // ditto
198 if(!IS_HASH(callme)) callme = naNil();
199 if(!IS_HASH(callns)) callns = naNil();
200 if(!IS_FUNC(args[0]) || (!IS_NIL(callargs) && !IS_VEC(callargs)))
201 naRuntimeError(c, "bad argument to call()");
202 subc = naNewContext();
203 subc->callParent = c;
205 vr = IS_NIL(callargs) ? 0 : callargs.ref.ptr.vec->rec;
206 result = naCall(subc, args[0], vr ? vr->size : 0, vr ? vr->array : 0,
209 if(argc > 2 && IS_VEC(args[argc-1])) {
210 if(!IS_NIL(subc->dieArg)) naVec_append(args[argc-1], subc->dieArg);
211 else if(naGetError(subc))
212 naVec_append(args[argc-1], NEWCSTR(subc, naGetError(subc)));
218 static naRef f_die(naContext c, naRef me, int argc, naRef* args)
220 c->dieArg = argc > 0 ? args[0] : naNil();
221 naRuntimeError(c, "__die__");
222 return naNil(); // never executes
225 // Wrapper around vsnprintf, iteratively increasing the buffer size
226 // until it fits. Returned buffer should be freed by the caller.
227 char* dosprintf(char* f, ...)
235 olen = vsnprintf(buf, len, f, va);
236 if(olen >= 0 && olen < len) {
246 // Inspects a printf format string f, and finds the next "%..." format
247 // specifier. Stores the start of the specifier in out, the length in
248 // len, and the type in type. Returns a pointer to the remainder of
249 // the format string, or 0 if no format string was found. Recognizes
250 // all of ANSI C's syntax except for the "length modifier" feature.
251 // Note: this does not validate the format character returned in
252 // "type". That is the caller's job.
253 static char* nextFormat(naContext ctx, char* f, char** out, int* len, char* type)
255 // Skip to the start of the format string
256 while(*f && *f != '%') f++;
260 while(*f && (*f=='-' || *f=='+' || *f==' ' || *f=='0' || *f=='#')) f++;
262 // Test for duplicate flags. This is pure pedantry and could
263 // be removed on all known platforms, but just to be safe...
265 for(p1 = *out + 1; p1 < f; p1++)
266 for(p2 = p1+1; p2 < f; p2++)
268 naRuntimeError(ctx, "duplicate flag in format string"); }
270 while(*f && *f >= '0' && *f <= '9') f++;
271 if(*f && *f == '.') f++;
272 while(*f && *f >= '0' && *f <= '9') f++;
273 if(!*f) naRuntimeError(ctx, "invalid format string");
280 #define ERR(m) naRuntimeError(ctx, m)
281 #define APPEND(r) result = naStr_concat(naNewString(ctx), result, r)
282 static naRef f_sprintf(naContext ctx, naRef me, int argc, naRef* args)
284 char t, nultmp, *fstr, *next, *fout=0, *s;
286 naRef format, arg, result = naNewString(ctx);
288 if(argc < 1) ERR("not enough arguments to sprintf");
289 format = naStringValue(ctx, argc > 0 ? args[0] : naNil());
290 if(naIsNil(format)) ERR("bad format string in sprintf");
291 s = naStr_data(format);
293 while((next = nextFormat(ctx, s, &fstr, &flen, &t))) {
294 APPEND(NEWSTR(ctx, s, fstr-s)); // stuff before the format string
295 if(flen == 2 && fstr[1] == '%') {
296 APPEND(NEWSTR(ctx, "%", 1));
300 if(argn >= argc) ERR("not enough arguments to sprintf");
302 nultmp = fstr[flen]; // sneaky nul termination...
305 arg = naStringValue(ctx, arg);
306 if(naIsNil(arg)) fout = dosprintf(fstr, "nil");
307 else fout = dosprintf(fstr, naStr_data(arg));
309 arg = naNumValue(arg);
311 fout = dosprintf(fstr, "nil");
312 else if(t=='d' || t=='i' || t=='c')
313 fout = dosprintf(fstr, (int)naNumValue(arg).num);
314 else if(t=='o' || t=='u' || t=='x' || t=='X')
315 fout = dosprintf(fstr, (unsigned int)naNumValue(arg).num);
316 else if(t=='e' || t=='E' || t=='f' || t=='F' || t=='g' || t=='G')
317 fout = dosprintf(fstr, naNumValue(arg).num);
319 ERR("invalid sprintf format type");
322 APPEND(NEWSTR(ctx, fout, strlen(fout)));
326 APPEND(NEWSTR(ctx, s, strlen(s)));
330 // FIXME: handle ctx->callParent frames too!
331 static naRef f_caller(naContext ctx, naRef me, int argc, naRef* args)
335 naRef result, fr = argc ? naNumValue(args[0]) : naNum(1);
336 if(IS_NIL(fr)) naRuntimeError(ctx, "non numeric argument to caller()");
338 if(fidx > ctx->fTop - 1) return naNil();
339 frame = &ctx->fStack[ctx->fTop - 1 - fidx];
340 result = naNewVector(ctx);
341 naVec_append(result, frame->locals);
342 naVec_append(result, frame->func);
343 naVec_append(result, frame->func.ref.ptr.func->code.ref.ptr.code->srcFile);
344 naVec_append(result, naNum(naGetLine(ctx, fidx)));
348 static naRef f_closure(naContext ctx, naRef me, int argc, naRef* args)
353 func = argc > 0 ? args[0] : naNil();
354 idx = argc > 1 ? naNumValue(args[1]) : naNil();
355 if(!IS_FUNC(func) || IS_NIL(idx))
356 naRuntimeError(ctx, "bad arguments to closure()");
358 f = func.ref.ptr.func;
359 while(i > 0 && f) { i--; f = f->next.ref.ptr.func; }
360 if(!f) return naNil();
364 static int match(unsigned char* a, unsigned char* b, int l)
367 for(i=0; i<l; i++) if(a[i] != b[i]) return 0;
371 static int find(unsigned char* a, int al, unsigned char* s, int sl, int start)
374 if(al == 0) return 0;
375 for(i=start; i<sl-al+1; i++) if(match(a, s+i, al)) return i;
379 static naRef f_find(naContext ctx, naRef me, int argc, naRef* args)
382 if(argc < 2 || !IS_STR(args[0]) || !IS_STR(args[1]))
383 naRuntimeError(ctx, "bad/missing argument to find");
384 if(argc > 2) start = (int)(naNumValue(args[2]).num);
385 return naNum(find(args[0].ref.ptr.str->data, args[0].ref.ptr.str->len,
386 args[1].ref.ptr.str->data, args[1].ref.ptr.str->len,
390 static naRef f_split(naContext ctx, naRef me, int argc, naRef* args)
395 if(argc < 2 || !IS_STR(args[0]) || !IS_STR(args[1]))
396 naRuntimeError(ctx, "bad/missing argument to split");
397 d = naStr_data(args[0]); dl = naStr_len(args[0]);
398 s = naStr_data(args[1]); sl = naStr_len(args[1]);
399 result = naNewVector(ctx);
400 if(dl == 0) { // special case zero-length delimiter
401 for(i=0; i<sl; i++) naVec_append(result, NEWSTR(ctx, s+i, 1));
405 for(i=0; i <= sl-dl; i++) {
406 if(match((unsigned char*)(s+i), (unsigned char*)d, dl)) {
407 naVec_append(result, NEWSTR(ctx, s0, s+i-s0));
412 if(s0 - s <= sl) naVec_append(result, NEWSTR(ctx, s0, s+sl-s0));
416 // This is a comparatively weak RNG, based on the C library's rand()
417 // function, which is usually not threadsafe and often of limited
418 // precision. The 5x loop guarantees that we get a full double worth
419 // of precision even for 15 bit (Win32...) rand() implementations.
420 static naRef f_rand(naContext ctx, naRef me, int argc, naRef* args)
425 if(!IS_NUM(args[0])) naRuntimeError(ctx, "rand() seed not number");
426 srand((unsigned int)args[0].num);
429 for(i=0; i<5; i++) r = (r + rand()) * (1.0/(RAND_MAX+1.0));
433 static naRef f_bind(naContext ctx, naRef me, int argc, naRef* args)
435 naRef func = argc > 0 ? args[0] : naNil();
436 naRef hash = argc > 1 ? args[1] : naNewHash(ctx);
437 naRef next = argc > 2 ? args[2] : naNil();
438 if(!IS_FUNC(func) || (!IS_NIL(next) && !IS_FUNC(next)) || !IS_HASH(hash))
439 naRuntimeError(ctx, "bad argument to bind");
440 func = naNewFunc(ctx, func.ref.ptr.func->code);
441 func.ref.ptr.func->namespace = hash;
442 func.ref.ptr.func->next = next;
446 struct func { char* name; naCFunction func; };
447 static struct func funcs[] = {
450 { "append", append },
452 { "setsize", setsize },
453 { "subvec", subvec },
454 { "delete", delete },
459 { "substr", substr },
461 { "contains", contains },
462 { "typeof", typeOf },
463 { "compile", f_compile },
466 { "sprintf", f_sprintf },
467 { "caller", f_caller },
468 { "closure", f_closure },
470 { "split", f_split },
475 naRef naStdLib(naContext c)
477 naRef namespace = naNewHash(c);
478 int i, n = sizeof(funcs)/sizeof(struct func);
480 naRef code = naNewCCode(c, funcs[i].func);
481 naRef name = NEWSTR(c, funcs[i].name, strlen(funcs[i].name));
482 name = naInternSymbol(name);
483 naHash_set(namespace, name, naNewFunc(c, code));