1 /* Copyright(C) 2006-2007 Brazil
2
3 This library is free software; you can redistribute it and/or
4 modify it under the terms of the GNU Lesser General Public
5 License as published by the Free Software Foundation; either
6 version 2.1 of the License, or (at your option) any later version.
7
8 This library is distributed in the hope that it will be useful,
9 but WITHOUT ANY WARRANTY; without even the implied warranty of
10 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
11 Lesser General Public License for more details.
12
13 You should have received a copy of the GNU Lesser General Public
14 License along with this library; if not, write to the Free Software
15 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
16 */
17
18 #include "senna_in.h"
19 #include <string.h>
20 #include <ctype.h>
21 #include "sym.h"
22 #include "ql.h"
23 #include "inv.h"
24 #include "snip.h"
25
26 static sen_obj *nf_records(sen_ctx *ctx, sen_obj *args, sen_ql_co *co);
27 static sen_obj *nf_object(sen_ctx *ctx, sen_obj *args, sen_ql_co *co);
28 static sen_obj *nf_void(sen_ctx *ctx, sen_obj *args, sen_ql_co *co);
29 static sen_obj *nf_snip(sen_ctx *ctx, sen_obj *args, sen_ql_co *co);
30 static sen_obj *nf_query(sen_ctx *ctx, sen_obj *args, sen_ql_co *co);
31
32 #define SYM_DO(sym,key,block) do {\
33 if (sym->flags & SEN_INDEX_NORMALIZE) {\
34 sen_nstr *nstr;\
35 if (!(nstr = sen_nstr_open(key, strlen(key), sym->encoding, 0))) {\
36 QLERR("nstr open failed");\
37 }\
38 {\
39 char *key = nstr->norm;\
40 block\
41 }\
42 sen_nstr_close(nstr);\
43 } else {\
44 block\
45 }\
46 } while (0)
47
48 #define PVALUE(obj,type) ((type *)((obj)->u.p.value))
49 #define RVALUE(obj) PVALUE(obj, sen_records)
50
51 inline static void
rec_obj_bind(sen_obj * obj,sen_records * rec,sen_id cls)52 rec_obj_bind(sen_obj *obj, sen_records *rec, sen_id cls)
53 {
54 obj->type = sen_ql_records;
55 obj->flags = SEN_OBJ_NATIVE|SEN_OBJ_ALLOCATED;
56 obj->class = cls;
57 obj->u.p.value = rec;
58 obj->u.p.func = nf_records;
59 }
60
61 inline static void
snip_obj_bind(sen_obj * obj,sen_snip * snip)62 snip_obj_bind(sen_obj *obj, sen_snip *snip)
63 {
64 obj->type = sen_ql_snip;
65 obj->flags = SEN_OBJ_NATIVE|SEN_OBJ_ALLOCATED;
66 obj->u.p.value = snip;
67 obj->u.p.func = nf_snip;
68 }
69
70 inline static void
obj_obj_bind(sen_obj * obj,sen_id cls,sen_id self)71 obj_obj_bind(sen_obj *obj, sen_id cls, sen_id self)
72 {
73 obj->type = sen_ql_object;
74 obj->flags = SEN_OBJ_NATIVE;
75 obj->class = cls;
76 obj->u.o.self = self;
77 obj->u.o.func = nf_object;
78 }
79
80 sen_obj *
sen_ql_mk_obj(sen_ctx * ctx,sen_id cls,sen_id self)81 sen_ql_mk_obj(sen_ctx *ctx, sen_id cls, sen_id self)
82 {
83 sen_obj *o;
84 SEN_OBJ_NEW(ctx, o);
85 obj_obj_bind(o, cls, self);
86 return o;
87 }
88
89 inline static sen_obj *
slot_value_obj(sen_ctx * ctx,sen_db_store * slot,sen_id id,const sen_obj * args,sen_obj * res)90 slot_value_obj(sen_ctx *ctx, sen_db_store *slot, sen_id id, const sen_obj *args, sen_obj *res)
91 {
92 sen_id *ip;
93 ip = (VOIDP(args) || (PAIRP(args) && VOIDP(CAR(args))))
94 ? sen_ra_at(slot->u.o.ra, id)
95 : sen_ra_get(slot->u.o.ra, id);
96 if (!ip) { return F; }
97 if (!VOIDP(args)) {
98 sen_obj *car;
99 POP(car, args);
100 switch (car->type) {
101 case sen_ql_object :
102 if (car->class != slot->u.o.class) { return F; }
103 *ip = car->u.o.self;
104 break;
105 case sen_ql_bulk :
106 {
107 char *name = car->u.b.value;
108 sen_db_store *cls = sen_db_store_by_id(slot->db, slot->u.o.class);
109 if (!cls) { return F; }
110 SYM_DO(cls->u.c.keys, name, { *ip = sen_sym_get(cls->u.c.keys, name); });
111 }
112 break;
113 default :
114 if (*ip && VOIDP(car)) {
115 sen_db_store *cls;
116 if (!(cls = sen_db_store_by_id(slot->db, slot->u.o.class))) { return F; }
117 /* todo : use sen_sym_del_with_sis if cls->u.c.keys->flags & SEN_SYM_WITH_SIS */
118 /* disable cascade delete */
119 // sen_sym_del(cls->u.c.keys, _sen_sym_key(cls->u.c.keys, *ip));
120 *ip = SEN_SYM_NIL;
121 }
122 return F;
123 break;
124 }
125 // todo : trigger
126 }
127 if (!*ip) { return F; }
128 if (!res) { SEN_OBJ_NEW(ctx, res); }
129 obj_obj_bind(res, slot->u.o.class, *ip);
130 return res;
131 }
132
133 #define STR2DBL(str,len,val) do {\
134 char *end, buf0[128], *buf = (len) < 128 ? buf0 : SEN_MALLOC((len) + 1);\
135 if (buf) {\
136 double d;\
137 memcpy(buf, (str), (len));\
138 buf[len] = '\0';\
139 errno = 0;\
140 d = strtod(buf, &end);\
141 if (!((len) < 128)) { SEN_FREE(buf); }\
142 if (!errno && buf + (len) == end) {\
143 (val) = d;\
144 } else { QLERR("cast failed"); }\
145 } else { QLERR("buf alloc failed"); }\
146 } while (0)
147
148 inline static sen_obj *
slot_value_ra(sen_ctx * ctx,sen_db_store * slot,sen_id id,const sen_obj * args,sen_obj * res)149 slot_value_ra(sen_ctx *ctx, sen_db_store *slot, sen_id id, const sen_obj *args, sen_obj *res)
150 {
151 void *vp;
152 vp = (VOIDP(args) || (PAIRP(args) && VOIDP(CAR(args))))
153 ? sen_ra_at(slot->u.f.ra, id)
154 : sen_ra_get(slot->u.f.ra, id);
155 if (!vp) { return F; }
156 if (!VOIDP(args)) {
157 sen_obj *car;
158 POP(car, args);
159 switch (car->type) {
160 case sen_ql_bulk :
161 switch (slot->u.f.class) {
162 case 1 : /* <int> */
163 {
164 int64_t iv = sen_atoll(STRVALUE(car), STRVALUE(car) + car->u.b.size, NULL);
165 *(int32_t *)vp = (int32_t) iv;
166 }
167 break;
168 case 2 : /* <uint> */
169 {
170 int64_t iv = sen_atoll(STRVALUE(car), STRVALUE(car) + car->u.b.size, NULL);
171 *(uint32_t *)vp = (uint32_t) iv;
172 }
173 break;
174 case 3 : /* <int64> */
175 {
176 int64_t iv = sen_atoll(STRVALUE(car), STRVALUE(car) + car->u.b.size, NULL);
177 *(int64_t *)vp = iv;
178 }
179 break;
180 case 4 : /* <float> */
181 { /* todo : support #i notation */
182 char *str = STRVALUE(car);
183 int len = STRSIZE(car);
184 STR2DBL(str, len, *(double *)vp);
185 }
186 break;
187 case 8 : /* <time> */
188 {
189 sen_timeval tv;
190 int len = STRSIZE(car);
191 char *str = STRVALUE(car);
192 if (sen_str2timeval(str, len, &tv)) {
193 if (len > 3 && *str == '#' && str[1] == ':' && str[2] == '<') {
194 const char *cur;
195 tv.tv_sec = sen_atoi(str + 3, str + len, &cur);
196 if (cur >= str + len || *cur != '.') {
197 QLERR("illegal time format '%s'", str);
198 }
199 tv.tv_usec = sen_atoi(cur + 1, str + len, &cur);
200 if (cur >= str + len || *cur != '>') {
201 QLERR("illegal time format '%s'", str);
202 }
203 } else {
204 double dval;
205 char *str = STRVALUE(car);
206 int len = car->u.b.size;
207 STR2DBL(str, len, dval);
208 tv.tv_sec = (int32_t) dval;
209 tv.tv_usec = (int32_t) ((dval - tv.tv_sec) * 1000000);
210 }
211 }
212 memcpy(vp, &tv, sizeof(sen_timeval));
213 }
214 break;
215 default :
216 if (car->u.b.size != slot->u.f.ra->header->element_size) { return F; }
217 memcpy(vp, car->u.b.value, car->u.b.size);
218 }
219 break;
220 case sen_ql_int :
221 switch (slot->u.f.class) {
222 case 1 : /* <int> */
223 *(int32_t *)vp = (int32_t) IVALUE(car);
224 break;
225 case 2 : /* <uint> */
226 *(uint32_t *)vp = (uint32_t) IVALUE(car);
227 break;
228 case 3 : /* <int64> */
229 *(int64_t *)vp = IVALUE(car);
230 break;
231 case 4 : /* <float> */
232 *(double *)vp = (double) IVALUE(car);
233 break;
234 case 8 : /* <time> */
235 {
236 sen_timeval tv;
237 tv.tv_sec = (int32_t) IVALUE(car);
238 tv.tv_usec = 0;
239 memcpy(vp, &tv, sizeof(sen_timeval));
240 }
241 break;
242 default :
243 if (slot->u.f.ra->header->element_size > sizeof(int64_t)) { return F; }
244 memcpy(vp, &IVALUE(car), slot->u.f.ra->header->element_size);
245 break;
246 }
247 break;
248 case sen_ql_float :
249 switch (slot->u.f.class) {
250 case 1 : /* <int> */
251 *(int32_t *)vp = (int32_t) FVALUE(car);
252 break;
253 case 2 : /* <uint> */
254 *(uint32_t *)vp = (uint32_t) FVALUE(car);
255 break;
256 case 3 : /* <int64> */
257 *(int64_t *)vp = (int64_t) FVALUE(car);
258 break;
259 case 4 : /* <float> */
260 *(double *)vp = FVALUE(car);
261 break;
262 case 8 : /* <time> */
263 {
264 sen_timeval tv;
265 tv.tv_sec = (int32_t) FVALUE(car);
266 tv.tv_usec = (int32_t) ((FVALUE(car) - tv.tv_sec) * 1000000);
267 memcpy(vp, &tv, sizeof(sen_timeval));
268 }
269 break;
270 default :
271 return F;
272 }
273 break;
274 case sen_ql_time :
275 switch (slot->u.f.class) {
276 case 1 : /* <int> */
277 *(int32_t *)vp = (int32_t) car->u.tv.tv_usec;
278 break;
279 case 2 : /* <uint> */
280 *(uint32_t *)vp = (uint32_t) car->u.tv.tv_usec;
281 break;
282 case 3 : /* <int64> */
283 *(int64_t *)vp = (int64_t) car->u.tv.tv_usec;
284 break;
285 case 4 : /* <float> */
286 *(double *)vp = ((double) car->u.tv.tv_usec) / 1000000 + car->u.tv.tv_sec;
287 break;
288 case 8 : /* <time> */
289 memcpy(vp, &car->u.tv, sizeof(sen_timeval));
290 break;
291 default :
292 return F;
293 }
294 break;
295 default :
296 if (VOIDP(car)) {
297 memset(vp, 0, slot->u.f.ra->header->element_size);
298 }
299 return F;
300 }
301 // todo : trigger
302 }
303 if (!res) { SEN_OBJ_NEW(ctx, res); }
304 switch (slot->u.f.class) {
305 case 1 : /* <int> */
306 SETINT(res, *(int32_t *)vp);
307 break;
308 case 2 : /* <uint> */
309 SETINT(res, *(uint32_t *)vp);
310 break;
311 case 3 : /* <int64> */
312 SETINT(res, *(int64_t *)vp);
313 break;
314 case 4 : /* <float> */
315 SETFLOAT(res, *(double *)vp);
316 break;
317 case 8 : /* <time> */
318 SETTIME(res, vp);
319 break;
320 default :
321 res->type = sen_ql_bulk;
322 res->u.b.size = slot->u.f.ra->header->element_size;
323 res->u.b.value = vp;
324 }
325 return res;
326 }
327
328 inline static sen_obj *
slot_value_ja(sen_ctx * ctx,sen_db_store * slot,sen_id id,const sen_obj * args,sen_obj * res)329 slot_value_ja(sen_ctx *ctx, sen_db_store *slot, sen_id id, const sen_obj *args, sen_obj *res)
330 {
331 void *vp;
332 uint32_t vs;
333 vp = (void *)sen_ja_ref(slot->u.v.ja, id, &vs);
334 // todo : unref
335 if (VOIDP(args)) {
336 if (!res) { SEN_OBJ_NEW(ctx, res); }
337 if (vp) {
338 res->flags = SEN_OBJ_ALLOCATED|SEN_OBJ_FROMJA;
339 res->type = sen_ql_bulk;
340 res->u.b.size = vs;
341 res->u.b.value = vp;
342 } else {
343 res->flags = 0;
344 res->type = sen_ql_bulk;
345 res->u.b.size = 0;
346 res->u.b.value = NULL;
347 }
348 return res;
349 } else {
350 sen_db_trigger *t;
351 char *nvp;
352 uint32_t nvs;
353 sen_obj *car;
354 POP(car, args);
355 // todo : support append and so on..
356 if (BULKP(car)) {
357 unsigned int max_element_size;
358 nvs = car->u.b.size;
359 nvp = car->u.b.value;
360 if (sen_ja_info(slot->u.v.ja, &max_element_size) ||
361 nvs > max_element_size) {
362 QLERR("too long value(%d) > max_element_size(%d)", nvs, max_element_size);
363 }
364 } else if (VOIDP(car)) {
365 nvs = 0;
366 nvp = NULL;
367 } else {
368 if (vp) { sen_ja_unref(slot->u.v.ja, id, vp, vs); }
369 return F;
370 }
371 if (vs == nvs && (!vs || (vp && nvp && !memcmp(vp, nvp, vs)))) {
372 if (vp) { sen_ja_unref(slot->u.v.ja, id, vp, vs); }
373 return car;
374 }
375 for (t = slot->triggers; t; t = t->next) {
376 if (t->type == sen_db_before_update_trigger) {
377 sen_db_store *index = sen_db_store_by_id(slot->db, t->target);
378 if (sen_inv_upd(index->u.i.inv, id, NULL, vp, vs, nvp, nvs)) {
379 SEN_LOG(sen_log_error, "sen_inv_upd failed. id=%d", id);
380 }
381 }
382 }
383 if (vp) { sen_ja_unref(slot->u.v.ja, id, vp, vs); }
384 return sen_ja_put(slot->u.v.ja, id, nvp, nvs, 0) ? F : car;
385 }
386 }
387
388 inline static sen_obj *
slot_value(sen_ctx * ctx,sen_db_store * slot,sen_id obj,sen_obj * args,sen_obj * res)389 slot_value(sen_ctx *ctx, sen_db_store *slot, sen_id obj, sen_obj *args, sen_obj *res)
390 {
391 switch (slot->type) {
392 case sen_db_obj_slot :
393 return slot_value_obj(ctx, slot, obj, args, res);
394 break;
395 case sen_db_ra_slot :
396 return slot_value_ra(ctx, slot, obj, args, res);
397 break;
398 case sen_db_ja_slot :
399 return slot_value_ja(ctx, slot, obj, args, res);
400 break;
401 case sen_db_idx_slot :
402 {
403 const char *key;
404 sen_records *rec;
405 sen_sym *lexicon = sen_inv_lexicon(slot->u.i.inv);
406 if (!lexicon || !(key = _sen_sym_key(lexicon, obj))) { return F; }
407 if (!(rec = sen_inv_sel(slot->u.i.inv, key, strlen(key)))) { return F; }
408 if (!res) { SEN_OBJ_NEW(ctx, res); }
409 rec_obj_bind(res, rec, slot->u.i.class);
410 return res;
411 }
412 break;
413 default :
414 return F;
415 break;
416 }
417 }
418
419 inline static sen_obj *
int2strobj(sen_ctx * ctx,int64_t i)420 int2strobj(sen_ctx *ctx, int64_t i)
421 {
422 char buf[32], *rest;
423 if (sen_str_lltoa(i, buf, buf + 32, &rest)) { return NULL; }
424 return sen_ql_mk_string(ctx, buf, rest - buf);
425 }
426
427 inline static char *
str_value(sen_ctx * ctx,sen_obj * o)428 str_value(sen_ctx *ctx, sen_obj *o)
429 {
430 if (o->flags & SEN_OBJ_SYMBOL) {
431 char *r = SEN_SET_STRKEY_BY_VAL(o);
432 return *r == ':' ? r + 1 : r;
433 } else if (o->type == sen_ql_bulk) {
434 return o->u.b.value;
435 } else if (o->type == sen_ql_int) {
436 sen_obj *p = int2strobj(ctx, IVALUE(o));
437 return p ? p->u.b.value : NULL;
438 }
439 return NULL;
440 }
441
442 inline static sen_obj *
obj2oid(sen_ctx * ctx,sen_obj * obj,sen_obj * res)443 obj2oid(sen_ctx *ctx, sen_obj *obj, sen_obj *res)
444 {
445 char buf[32];
446 sen_rbuf bogus_buf = { /*.head = */buf, /*.curr = */buf, /*.tail = */buf + 32 };
447 if (obj->type != sen_ql_object) { return F; }
448 sen_obj_inspect(ctx, obj, &bogus_buf, SEN_OBJ_INSPECT_ESC);
449 if (res) {
450 uint32_t size = SEN_RBUF_VSIZE(&bogus_buf);
451 char *value = SEN_MALLOC(size + 1);
452 if (!value) { return F; }
453 sen_obj_clear(ctx, res);
454 res->flags = SEN_OBJ_ALLOCATED;
455 res->type = sen_ql_bulk;
456 res->u.b.size = size;
457 res->u.b.value = value;
458 memcpy(res->u.b.value, buf, res->u.b.size + 1);
459 } else {
460 if (!(res = sen_ql_mk_string(ctx, buf, SEN_RBUF_VSIZE(&bogus_buf)))) { return F; }
461 }
462 return res;
463 }
464
465 #define SET_KEY_VALUE(ctx,v_,o_) do {\
466 const char *key;\
467 if (o_->class) {\
468 sen_db_store *cls = sen_db_store_by_id(ctx->db, o_->class);\
469 if (!cls) { QLERR("Invalid Object"); }\
470 switch (cls->type) {\
471 case sen_db_class :\
472 if (!(key = _sen_sym_key(cls->u.c.keys, o_->u.o.self))) { QLERR("Invalid Object"); }\
473 v_->flags = 0;\
474 v_->type = sen_ql_bulk;\
475 v_->u.b.value = (char *)key;\
476 v_->u.b.size = strlen(key);\
477 break;\
478 case sen_db_rel1 :\
479 v_->u.i.i = o_->u.o.self;\
480 v_->type = sen_ql_int;\
481 break;\
482 default :\
483 break;\
484 }\
485 } else {\
486 if (!(key = _sen_sym_key(ctx->db->keys, o_->u.o.self))) { QLERR("Invalid Object"); }\
487 v_->flags = 0;\
488 v_->type = sen_ql_bulk;\
489 v_->u.b.value = (char *)key;\
490 v_->u.b.size = strlen(key);\
491 }\
492 } while(0)
493
494 static sen_obj *
nf_object(sen_ctx * ctx,sen_obj * args,sen_ql_co * co)495 nf_object(sen_ctx *ctx, sen_obj *args, sen_ql_co *co)
496 {
497 char *msg;
498 sen_db_store *slot;
499 sen_obj *obj, *car, *res;
500 if (!(obj = res = ctx->code)) { QLERR("invalid receiver"); }
501 while (PAIRP(args)) {
502 POP(car, args);
503 if (!(msg = str_value(ctx, car))) { QLERR("invalid message"); }
504 if (*msg == ':') {
505 switch (msg[1]) {
506 case 'i' : /* :id */
507 case 'I' :
508 res = obj2oid(ctx, obj, NULL);
509 break;
510 case 'k' : /* :key */
511 case 'K' :
512 SEN_OBJ_NEW(ctx, res);
513 SET_KEY_VALUE(ctx, res, obj);
514 break;
515 case 'S' : /* :score */
516 case 's' :
517 if (ctx->currec) {
518 SEN_OBJ_NEW(ctx, res);
519 (res)->type = sen_ql_int;
520 (res)->u.i.i = ((sen_rset_recinfo *)(ctx->currec))->score;
521 } else {
522 res = F;
523 }
524 break;
525 case 'N' : /* :nsubrecs */
526 case 'n' :
527 if (ctx->currec) {
528 SEN_OBJ_NEW(ctx, res);
529 (res)->type = sen_ql_int;
530 (res)->u.i.i = ((sen_rset_recinfo *)(ctx->currec))->n_subrecs;
531 } else {
532 res = F;
533 }
534 break;
535 }
536 break;
537 } else {
538 if (!(slot = sen_db_class_slot(ctx->db, obj->class, msg))) {
539 QLERR("Invalid slot %s", msg);
540 }
541 if (VOIDP(args)) {
542 res = slot_value(ctx, slot, obj->u.o.self, args, NULL);
543 break;
544 } else {
545 if (sen_db_lock(ctx->db, -1)) {
546 SEN_LOG(sen_log_crit, "nf_object: lock failed");
547 } else {
548 res = slot_value(ctx, slot, obj->u.o.self, args, NULL);
549 sen_db_unlock(ctx->db);
550 }
551 POP(car, args);
552 }
553 }
554 }
555 return res;
556 }
557
558 sen_obj *
sen_ql_class_at(sen_ctx * ctx,sen_db_store * cls,const void * key,int flags,sen_obj * res)559 sen_ql_class_at(sen_ctx *ctx, sen_db_store *cls, const void *key, int flags, sen_obj *res)
560 {
561 sen_id id;
562 SYM_DO(cls->u.c.keys, key, {
563 id = flags ? sen_sym_get(cls->u.c.keys, key) : sen_sym_at(cls->u.c.keys, key);
564 });
565 if (id) {
566 if (!res) { SEN_OBJ_NEW(ctx, res); }
567 obj_obj_bind(res, cls->id, id);
568 return res;
569 } else {
570 return F;
571 }
572 }
573
574 static sen_obj *
nf_void(sen_ctx * ctx,sen_obj * args,sen_ql_co * co)575 nf_void(sen_ctx *ctx, sen_obj *args, sen_ql_co *co)
576 {
577 if (!ctx->code) { return F; }
578 return ctx->code;
579 }
580
581 #define DEF_COMPAR_FUNC(funcname,expr) \
582 static int funcname(sen_records *ra, sen_recordh *a, sen_records *rb, sen_recordh *b, void *arg)\
583 {\
584 void *va, *vb;\
585 sen_id *pa, *pb;\
586 sen_ra *raa = (sen_ra *)ra->userdata, *rab = (sen_ra *)rb->userdata;\
587 sen_set_element_info(ra, a, (void **)&pa, NULL);\
588 sen_set_element_info(rb, b, (void **)&pb, NULL);\
589 va = sen_ra_at(raa, *pa);\
590 vb = sen_ra_at(rab, *pb);\
591 if (va) {\
592 if (vb) {\
593 return expr;\
594 } else {\
595 return 1;\
596 }\
597 } else {\
598 return vb ? -1 : 0;\
599 }\
600 }
601
602 DEF_COMPAR_FUNC(compar_ra, (memcmp(va, vb, raa->header->element_size)));
603 DEF_COMPAR_FUNC(compar_int, (*((int32_t *)va) - *((int32_t *)vb)));
604 DEF_COMPAR_FUNC(compar_uint, (*((uint32_t *)va) - *((uint32_t *)vb)));
605 DEF_COMPAR_FUNC(compar_int64, (*((int64_t *)va) - *((int64_t *)vb)));
606 DEF_COMPAR_FUNC(compar_float,
607 (isgreater(*((double *)va), *((double *)vb)) ? 1 :
608 (isless(*((double *)va), *((double *)vb)) ? -1 : 0)));
609 DEF_COMPAR_FUNC(compar_time,
610 ((((sen_timeval *)va)->tv_sec != ((sen_timeval *)vb)->tv_sec) ?
611 (((sen_timeval *)va)->tv_sec - ((sen_timeval *)vb)->tv_sec) :
612 (((sen_timeval *)va)->tv_usec - ((sen_timeval *)vb)->tv_usec)));
613
614 static int
compar_ja(sen_records * ra,sen_recordh * a,sen_records * rb,sen_recordh * b,void * arg)615 compar_ja(sen_records *ra, sen_recordh *a, sen_records *rb, sen_recordh *b, void *arg)
616 {
617 int r;
618 void *va, *vb;
619 uint32_t la, lb;
620 sen_id *pa, *pb;
621 sen_ja *jaa = (sen_ja *)ra->userdata, *jab = (sen_ja *)rb->userdata;
622 sen_set_element_info(ra, a, (void **)&pa, NULL);
623 sen_set_element_info(rb, b, (void **)&pb, NULL);
624 va = sen_ja_ref(jaa, *pa, &la);
625 vb = sen_ja_ref(jab, *pb, &lb);
626 if (va) {
627 if (vb) {
628 if (la > lb) {
629 if (!(r = memcmp(va, vb, lb))) { r = 1; }
630 } else {
631 if (!(r = memcmp(va, vb, la))) { r = la == lb ? 0 : -1; }
632 }
633 sen_ja_unref(jab, *pb, vb, lb);
634 } else {
635 r = 1;
636 }
637 sen_ja_unref(jaa, *pa, va, la);
638 } else {
639 if (vb) {
640 sen_ja_unref(jab, *pb, vb, lb);
641 r = -1;
642 } else {
643 r = 0;
644 }
645 }
646 return r;
647 }
648
649 static int
compar_key(sen_records * ra,sen_recordh * a,sen_records * rb,sen_recordh * b,void * arg)650 compar_key(sen_records *ra, sen_recordh *a, sen_records *rb, sen_recordh *b, void *arg)
651 {
652 const char *va, *vb;
653 sen_id *pa, *pb;
654 sen_sym *ka = ra->userdata, *kb = rb->userdata;
655 sen_set_element_info(ra, a, (void **)&pa, NULL);
656 sen_set_element_info(rb, b, (void **)&pb, NULL);
657 va = _sen_sym_key(ka, *pa);
658 vb = _sen_sym_key(kb, *pb);
659 // todo : if (key_size)..
660 if (va) {
661 return vb ? strcmp(va, vb) : 1;
662 } else {
663 return vb ? -1 : 0;
664 }
665 }
666
667 static sen_obj sen_db_pslot_key = {
668 sen_db_pslot, SEN_OBJ_NATIVE, 0, 0, { { SEN_DB_PSLOT_FLAG, NULL } }
669 };
670
671 static sen_obj sen_db_pslot_id = {
672 sen_db_pslot, SEN_OBJ_NATIVE, 0, 0, { { SEN_DB_PSLOT_FLAG|SEN_DB_PSLOT_ID, NULL } }
673 };
674 static sen_obj sen_db_pslot_score = {
675 sen_db_pslot, SEN_OBJ_NATIVE, 0, 0, { { SEN_DB_PSLOT_FLAG|SEN_DB_PSLOT_SCORE, NULL } }
676 };
677 static sen_obj sen_db_pslot_nsubrecs = {
678 sen_db_pslot, SEN_OBJ_NATIVE, 0, 0, { { SEN_DB_PSLOT_FLAG|SEN_DB_PSLOT_NSUBRECS, NULL } }
679 };
680
681 inline static sen_obj *
class_slot(sen_ctx * ctx,sen_id base,char * msg,sen_records * records,int * recpslotp)682 class_slot(sen_ctx *ctx, sen_id base, char *msg, sen_records *records, int *recpslotp)
683 {
684 *recpslotp = 0;
685 if (*msg == ':') {
686 switch (msg[1]) {
687 case 'i' : /* :id */
688 case 'I' :
689 return &sen_db_pslot_id;
690 case 'K' : /* :key */
691 case 'k' :
692 return &sen_db_pslot_key;
693 case 'S' : /* :score */
694 case 's' :
695 if (records) {
696 *recpslotp = 1;
697 return &sen_db_pslot_score;
698 }
699 return F;
700 case 'N' : /* :nsubrecs */
701 case 'n' :
702 if (records) {
703 *recpslotp = 1;
704 return &sen_db_pslot_nsubrecs;
705 }
706 return F;
707 default :
708 return F;
709 }
710 } else {
711 sen_db_store *slot;
712 char buf[SEN_SYM_MAX_KEY_SIZE];
713 if (sen_db_class_slotpath(ctx->db, base, msg, buf)) {
714 QLERR("Invalid slot %s", msg);
715 }
716 if (!(slot = sen_db_store_open(ctx->db, buf))) {
717 QLERR("store open failed %s", buf);
718 }
719 return INTERN(buf);
720 }
721 }
722
723 static sen_obj *
slotexp_prepare(sen_ctx * ctx,sen_id base,sen_obj * e,sen_records * records)724 slotexp_prepare(sen_ctx *ctx, sen_id base, sen_obj *e, sen_records *records)
725 {
726 char *str;
727 const char *key;
728 int recpslotp;
729 sen_obj *slot, *r;
730 if (PAIRP(e)) {
731 for (r = NIL; PAIRP(CAR(e)); e = CAR(e)) {
732 if (PAIRP(CDR(e))) { r = CONS(CDR(e), r); }
733 }
734 if (CAR(e) == NIL) {
735 e = CDR(e);
736 } else {
737 if (CDR(e) != NIL) { QLERR("invalid slot expression"); }
738 }
739 if (e == NIL) {
740 r = CONS(CONS(T, NIL), r);
741 goto exit;
742 }
743 if (!PAIRP(e) || !(str = str_value(ctx, CAR(e)))) {
744 QLERR("invalid slotname");
745 }
746 if (*str == '\0') {
747 if (!records) {
748 QLERR(" ':' assigned without records");
749 }
750 base = records->subrec_id;
751 if (!(key = _sen_sym_key(ctx->db->keys, base))) { QLERR("invalid base class"); }
752 slot = INTERN(key);
753 if (!CLASSP(slot)) { QLERR("invalid class"); }
754 r = CONS(CONS(slot, CDR(e)), r);
755 } else {
756 if ((slot = class_slot(ctx, base, str, records, &recpslotp)) == F) {
757 QLERR("invalid slot");
758 }
759 if (recpslotp) { r = slot; goto exit; }
760 r = CONS(CONS(slot, CDR(e)), r);
761 base = slot->class;
762 }
763 for (e = CDR(r); PAIRP(e); e = CDR(e)) {
764 if (!(str = str_value(ctx, CAAR(e))) ||
765 (slot = class_slot(ctx, base, str, records, &recpslotp)) == F) {
766 QLERR("invalid slot");
767 }
768 if (recpslotp) { r = slot; goto exit; }
769 e->u.l.car = CONS(slot, CDAR(e));
770 base = slot->class;
771 }
772 } else {
773 if (!(str = str_value(ctx, e))) {
774 QLERR("invalid expr");
775 }
776 r = class_slot(ctx, base, str, records, &recpslotp);
777 }
778 exit :
779 return r;
780 }
781
782 /* SET_SLOT_VALUE doesn't update slot value */
783 #define SET_SLOT_VALUE(ctx,slot,value,args,ri) do {\
784 sen_id id = (slot)->u.o.self;\
785 if (id & SEN_DB_PSLOT_FLAG) {\
786 uint8_t pslot_type = id & SEN_DB_PSLOT_MASK;\
787 switch (pslot_type) {\
788 case 0 : /* SEN_DB_PSLOT_KEY */\
789 SET_KEY_VALUE((ctx), (value), (value));\
790 break;\
791 case SEN_DB_PSLOT_ID :\
792 obj2oid((ctx), (value), (value));\
793 break;\
794 case SEN_DB_PSLOT_SCORE :\
795 (value)->type = sen_ql_int;\
796 (value)->u.i.i = (ri)->score;\
797 break;\
798 case SEN_DB_PSLOT_NSUBRECS :\
799 (value)->type = sen_ql_int;\
800 (value)->u.i.i = (ri)->n_subrecs;\
801 break;\
802 }\
803 } else {\
804 sen_db_store *dbs = sen_db_store_by_id((ctx)->db, id);\
805 value = slot_value((ctx), dbs, (value)->u.o.self, /*(args)*/ NIL, (value));\
806 }\
807 } while(0)
808
809 typedef struct {
810 int score;
811 sen_id subid;
812 } subrec;
813
814 static sen_obj *
slotexp_exec(sen_ctx * ctx,sen_obj * expr,sen_obj * value,sen_rset_recinfo * ri)815 slotexp_exec(sen_ctx *ctx, sen_obj *expr, sen_obj *value, sen_rset_recinfo *ri)
816 {
817 sen_obj *t, *car;
818 if (PAIRP(expr)) {
819 POP(t, expr);
820 car = CAR(t);
821 if (CLASSP(car)) {
822 int i = 0;
823 subrec *sr;
824 if (INTP(CADR(t))) { i = CADR(t)->u.i.i; }
825 sr = (subrec *)SEN_RSET_SUBRECS_NTH(ri->subrecs, sizeof(sen_id), i);
826 obj_obj_bind(value, car->u.o.self, sr->subid);
827 } else {
828 SET_SLOT_VALUE(ctx, car, value, CDR(t), ri);
829 }
830 } else if (SLOTP(expr)) {
831 SET_SLOT_VALUE(ctx, expr, value, NIL, ri);
832 }
833 while (value != NIL && PAIRP(expr)) {
834 POP(t, expr);
835 if (!PAIRP(t)) { break; }
836 car = CAR(t);
837 SET_SLOT_VALUE(ctx, car, value, CDR(t), ri);
838 }
839 return value;
840 }
841
842 static void
ses_check(sen_obj * e,int * ns,int * ne)843 ses_check(sen_obj *e, int *ns, int *ne)
844 {
845 if (PAIRP(e)) {
846 sen_obj *x;
847 POP(x, e);
848 if (x == NIL) {
849 (*ns)++;
850 } else if (NATIVE_FUNCP(x)) {
851 (*ne)++;
852 } else {
853 ses_check(x, ns, ne);
854 }
855 while (PAIRP(e)) {
856 POP(x, e);
857 ses_check(x, ns, ne);
858 }
859 } else {
860 if (SYMBOLP(e) && !KEYWORDP(e)) { (*ne)++; }
861 }
862 }
863
864 static sen_obj *
ses_copy(sen_ctx * ctx,sen_obj * e)865 ses_copy(sen_ctx *ctx, sen_obj *e)
866 {
867 if (PAIRP(e)) {
868 sen_obj *x, *r, **d;
869 POP(x, e);
870 r = CONS(x == NIL ? &ctx->curobj : ses_copy(ctx, x), NIL);
871 d = &CDR(r);
872 while (PAIRP(e)) {
873 POP(x, e);
874 *d = CONS(ses_copy(ctx, x), NIL);
875 d = &CDR(*d);
876 }
877 return r;
878 } else {
879 return e;
880 }
881 }
882
883 static sen_obj *
ses_prepare(sen_ctx * ctx,sen_id base,sen_obj * e,sen_records * records)884 ses_prepare(sen_ctx *ctx, sen_id base, sen_obj *e, sen_records *records)
885 {
886 int ns = 0, ne = 0;
887 ses_check(e, &ns, &ne);
888 if (ne) {
889 obj_obj_bind(&ctx->curobj, base, 0);
890 return CONS(T, ns ? ses_copy(ctx, e) : e);
891 } else {
892 if (ns) {
893 return CONS(NIL, slotexp_prepare(ctx, base, e, records));
894 } else {
895 return CONS(F, e);
896 }
897 }
898 }
899
900 static sen_obj *
ses_exec(sen_ctx * ctx,sen_obj * e,sen_rset_recinfo * ri,sen_obj * objs)901 ses_exec(sen_ctx *ctx, sen_obj *e, sen_rset_recinfo *ri, sen_obj *objs)
902 {
903 sen_obj *x = CAR(e);
904 if (x == T) {
905 ctx->currec = ri;
906 return sen_ql_eval(ctx, CDR(e), objs);
907 } else if (x == F) {
908 return CDR(e);
909 } else {
910 return slotexp_exec(ctx, CDR(e), &ctx->curobj, ri);
911 }
912 }
913
914 static void
ses_clear(sen_ctx * ctx)915 ses_clear(sen_ctx *ctx)
916 {
917 sen_obj_clear(ctx, &ctx->curobj);
918 }
919
920 typedef struct {
921 sen_id base;
922 sen_obj *se;
923 sen_obj *proc;
924 } compar_expr_userdata;
925
926 static int
compar_expr(sen_records * ra,sen_recordh * a,sen_records * rb,sen_recordh * b,void * arg)927 compar_expr(sen_records *ra, sen_recordh *a, sen_records *rb, sen_recordh *b, void *arg)
928 {
929 int r;
930 sen_obj oa, ob, *va, *vb;
931 sen_id *pa, *pb;
932 sen_rset_recinfo *ria, *rib;
933 sen_ctx *ctx = (sen_ctx *) arg;
934 compar_expr_userdata *ceuda = (compar_expr_userdata *)ra->userdata;
935 compar_expr_userdata *ceudb = (compar_expr_userdata *)rb->userdata;
936 sen_obj *exa = ceuda->se, *exb = ceudb->se;
937 sen_set_element_info(ra, a, (void **)&pa, (void **)&ria);
938 sen_set_element_info(rb, b, (void **)&pb, (void **)&rib);
939 /*
940 oa.u.o.self = *pa;
941 ob.u.o.self = *pb;
942 va = slotexp_exec(ctx, exa, &oa, ria);
943 vb = slotexp_exec(ctx, exb, &ob, rib);
944 */
945 obj_obj_bind(&ctx->curobj, ceuda->base, *pa);
946 va = ses_exec(ctx, exa, ria, exa);
947 if (va != NIL) { memcpy(&oa, va, sizeof(sen_obj)); va = &oa; }
948 obj_obj_bind(&ctx->curobj, ceudb->base, *pb);
949 vb = ses_exec(ctx, exa, rib, exb);
950 if (vb != NIL) { memcpy(&ob, vb, sizeof(sen_obj)); vb = &ob; }
951 if (ceuda->proc == NIL) {
952 if (va == NIL) {
953 r = (vb == NIL) ? 0 : -1;
954 } else if (vb == NIL) {
955 r = 1;
956 } else {
957 if (va->type != vb->type) {
958 SEN_LOG(sen_log_error, "obj type unmatch in compar_expr");
959 r = 0;
960 } else {
961 switch (va->type) {
962 case sen_ql_object :
963 {
964 sen_db_store *ca, *cb;
965 if (!(ca = sen_db_store_by_id(ctx->db, va->class)) ||
966 (cb = sen_db_store_by_id(ctx->db, vb->class))) {
967 SEN_LOG(sen_log_error, "clas open failed in compar_expr");
968 r = 0;
969 } else {
970 const char *ka = _sen_sym_key(ca->u.c.keys, va->u.o.self);
971 const char *kb = _sen_sym_key(cb->u.c.keys, vb->u.o.self);
972 r = (ka && kb) ? strcmp(ka, kb) : 0;
973 }
974 }
975 break;
976 case sen_ql_bulk :
977 {
978 uint32_t la = va->u.b.size, lb = vb->u.b.size;
979 if (la > lb) {
980 if (!(r = memcmp(va->u.b.value, vb->u.b.value, lb))) { r = 1; }
981 } else {
982 if (!(r = memcmp(va->u.b.value, vb->u.b.value, la))) { r = la == lb ? 0 : -1; }
983 }
984 }
985 break;
986 case sen_ql_int :
987 r = IVALUE(va) - IVALUE(vb);
988 break;
989 case sen_ql_float :
990 if (isgreater(FVALUE(va), FVALUE(vb))) {
991 r = 1;
992 } else {
993 r = (isless(FVALUE(va), FVALUE(vb))) ? -1 : 0;
994 }
995 break;
996 case sen_ql_time :
997 if (va->u.tv.tv_sec != vb->u.tv.tv_sec) {
998 r = va->u.tv.tv_sec - vb->u.tv.tv_sec;
999 } else {
1000 r = va->u.tv.tv_usec - vb->u.tv.tv_usec;
1001 }
1002 break;
1003 default :
1004 SEN_LOG(sen_log_error, "invalid value in compar_expr");
1005 r = 0;
1006 break;
1007 }
1008 }
1009 }
1010 } else {
1011 sen_obj o0, o1, o2, *re;
1012 o0.type = sen_ql_list;
1013 o0.flags = SEN_OBJ_REFERER;
1014 o0.u.l.car = ceuda->proc;
1015 o0.u.l.cdr = &o1;
1016 o1.type = sen_ql_list;
1017 o1.flags = SEN_OBJ_REFERER;
1018 o1.u.l.car = va;
1019 o1.u.l.cdr = &o2;
1020 o2.type = sen_ql_list;
1021 o2.flags = SEN_OBJ_REFERER;
1022 o2.u.l.car = vb;
1023 o2.u.l.cdr = NIL;
1024 re = sen_ql_eval(ctx, &o0, exa);
1025 r = INTP(re) ? IVALUE(re) : (re == F ? 0 : 1);
1026 }
1027 sen_obj_clear(ctx, va);
1028 sen_obj_clear(ctx, vb);
1029 return r;
1030 }
1031
1032 static int
compar_obj(sen_records * ra,sen_recordh * a,sen_records * rb,sen_recordh * b,void * arg)1033 compar_obj(sen_records *ra, sen_recordh *a, sen_records *rb, sen_recordh *b, void *arg)
1034 {
1035 const char *va, *vb;
1036 sen_id *pa, *pb, *oa, *ob;
1037 sen_sym *key = (sen_sym *)arg;
1038 // todo : target class may not be identical
1039 sen_ra *raa = (sen_ra *)ra->userdata, *rab = (sen_ra *)rb->userdata;
1040 sen_set_element_info(ra, a, (void **)&pa, NULL);
1041 sen_set_element_info(rb, b, (void **)&pb, NULL);
1042 va = (oa = sen_ra_at(raa, *pa)) ? _sen_sym_key(key, *oa) : NULL;
1043 vb = (ob = sen_ra_at(rab, *pb)) ? _sen_sym_key(key, *ob) : NULL;
1044 // todo : if (key_size)..
1045 if (va) {
1046 return vb ? strcmp(va, vb) : 1;
1047 } else {
1048 return vb ? -1 : 0;
1049 }
1050 }
1051
1052 static int
group_obj(sen_records * ra,const sen_recordh * a,void * gkey,void * arg)1053 group_obj(sen_records *ra, const sen_recordh *a, void *gkey, void *arg)
1054 {
1055 sen_id *pa, *oa;
1056 sen_ra *raa = (sen_ra *)ra->userdata;
1057 sen_set_element_info(ra, a, (void **)&pa, NULL);
1058 if (!(oa = sen_ra_at(raa, *pa))) { return 1; }
1059 memcpy(gkey, oa, sizeof(sen_id));
1060 return 0;
1061 }
1062
1063 inline static sen_obj *
rec_obj_new(sen_ctx * ctx,sen_db_store * cls,sen_rec_unit record_unit,sen_rec_unit subrec_unit,unsigned int max_n_subrecs)1064 rec_obj_new(sen_ctx *ctx, sen_db_store *cls, sen_rec_unit record_unit,
1065 sen_rec_unit subrec_unit, unsigned int max_n_subrecs)
1066 {
1067 sen_records *r;
1068 sen_obj *res;
1069 SEN_OBJ_NEW(ctx, res);
1070 if (!(r = sen_records_open(record_unit, subrec_unit, max_n_subrecs))) {
1071 QLERR("sen_records_open failed");
1072 }
1073 if (cls) {
1074 r->keys = cls->u.c.keys;
1075 rec_obj_bind(res, r, cls->id);
1076 } else {
1077 r->keys = ctx->db->keys;
1078 rec_obj_bind(res, r, 0);
1079 }
1080 return res;
1081 }
1082
1083 typedef struct {
1084 sen_obj *func;
1085 sen_obj *exprs;
1086 sen_obj *args;
1087 sen_sel_operator op;
1088 sen_obj *objs;
1089 int32_t offset;
1090 int32_t limit;
1091 sen_sort_mode mode;
1092 char *from;
1093 char *to;
1094 } match_spec;
1095
1096 inline static int
slotexpp(sen_obj * expr)1097 slotexpp(sen_obj *expr)
1098 {
1099 while (PAIRP(expr)) { expr = CAR(expr); }
1100 return expr == NIL;
1101 }
1102
1103 inline static sen_obj*
match_prepare(sen_ctx * ctx,match_spec * spec,sen_id base,sen_obj * args)1104 match_prepare(sen_ctx *ctx, match_spec *spec, sen_id base, sen_obj *args)
1105 {
1106 int ns = 0, ne = 0;
1107 sen_obj *car, *expr, **ap = &spec->args, **ep = &spec->exprs;
1108 POP(expr, args);
1109 ses_check(expr, &ns, &ne);
1110 if (ne == 1 && PAIRP(expr) && NATIVE_FUNCP(CAR(expr))) {
1111 POP(car, expr);
1112 spec->func = car;
1113 for (*ap = NIL, *ep = NIL; POP(car, expr) != NIL; ap = &CDR(*ap)) {
1114 sen_obj *v;
1115 if (slotexpp(car)) {
1116 v = slotexp_prepare(ctx, base, car, NULL);
1117 if (ERRP(ctx, SEN_WARN)) { return F; }
1118 *ep = CONS(v, NIL);
1119 if (ERRP(ctx, SEN_WARN)) { return F; }
1120 ep = &CDR(*ep);
1121 v = sen_obj_new(ctx);
1122 *ep = CONS(v, NIL);
1123 if (ERRP(ctx, SEN_WARN)) { return F; }
1124 ep = &CDR(*ep);
1125 } else {
1126 v = car;
1127 }
1128 *ap = CONS(v, NIL);
1129 if (ERRP(ctx, SEN_WARN)) { return F; }
1130 }
1131 } else {
1132 spec->func = NULL;
1133 spec->exprs = ses_prepare(ctx, base, expr, NULL);
1134 }
1135 spec->offset = 0;
1136 spec->limit = 0;
1137 spec->mode = 0;
1138 POP(expr, args);
1139 if (RECORDSP(expr)) {
1140 char *ops;
1141 if (expr->class != base) { QLERR("class unmatch"); }
1142 POP(car, args);
1143 spec->op = sen_sel_and;
1144 if ((ops = str_value(ctx, car))) {
1145 switch (*ops) {
1146 case '+': spec->op = sen_sel_or; break;
1147 case '-': spec->op = sen_sel_but; break;
1148 case '*': spec->op = sen_sel_and; break;
1149 case '>': spec->op = sen_sel_adjust; break;
1150 }
1151 }
1152 } else {
1153 char *str;
1154 sen_db_store *cls = sen_db_store_by_id(ctx->db, base);
1155 if (INTP(expr)) { spec->offset = IVALUE(expr); }
1156 POP(expr, args);
1157 if (INTP(expr)) { spec->limit = IVALUE(expr); }
1158 if (spec->limit <= 0) { spec->limit += sen_sym_size(cls->u.c.keys); }
1159 POP(expr, args);
1160 if ((str = str_value(ctx, expr))) {
1161 while (*str) {
1162 switch (*str) {
1163 case 'a' : spec->mode |= SEN_SYM_ASCENDING; break;
1164 case 'g' : spec->mode |= SEN_SYM_GT; break;
1165 case 'l' : spec->mode |= SEN_SYM_LT; break;
1166 }
1167 str++;
1168 }
1169 }
1170 POP(expr, args);
1171 spec->from = BULKP(expr) ? STRVALUE(expr) : NULL;
1172 POP(expr, args);
1173 spec->to = BULKP(expr) ? STRVALUE(expr) : NULL;
1174 expr = rec_obj_new(ctx, cls, sen_rec_document, sen_rec_none, 0);
1175 if (ERRP(ctx, SEN_WARN)) { return F; }
1176 spec->op = sen_sel_or;
1177 }
1178 spec->objs = CONS(expr, spec->exprs);
1179 return expr;
1180 }
1181
1182 inline static void
slotexps_exec(sen_ctx * ctx,sen_obj * exprs,sen_id base,sen_id id)1183 slotexps_exec(sen_ctx *ctx, sen_obj *exprs, sen_id base, sen_id id)
1184 {
1185 sen_obj *value, *expr;
1186 while (POP(expr, exprs) != NIL) {
1187 POP(value, exprs);
1188 obj_obj_bind(value, base, id);
1189 /* todo : slotexp_exec may return F */
1190 slotexp_exec(ctx, expr, value, NULL);
1191 }
1192 }
1193
1194 inline static void
slotexps_clear(sen_ctx * ctx,sen_obj * exprs)1195 slotexps_clear(sen_ctx *ctx, sen_obj *exprs)
1196 {
1197 sen_obj *value, *expr;
1198 while (POP(expr, exprs) != NIL) {
1199 POP(value, exprs);
1200 sen_obj_clear(ctx, value);
1201 }
1202 }
1203
1204 inline static int
match_exec(sen_ctx * ctx,match_spec * spec,sen_id base,sen_id id)1205 match_exec(sen_ctx *ctx, match_spec *spec, sen_id base, sen_id id)
1206 {
1207 sen_obj *res;
1208 if (spec->func) {
1209 sen_obj *code = ctx->code;
1210 ctx->code = spec->func;
1211 slotexps_exec(ctx, spec->exprs, base, id);
1212 res = spec->func->u.o.func(ctx, spec->args, &ctx->co);
1213 slotexps_clear(ctx, spec->exprs);
1214 ctx->code = code;
1215 } else {
1216 obj_obj_bind(&ctx->curobj, base, id);
1217 res = ses_exec(ctx, spec->exprs, NULL, spec->objs);
1218 ses_clear(ctx);
1219 }
1220 return res != F;
1221 }
1222
1223 static sen_obj *
nf_records(sen_ctx * ctx,sen_obj * args,sen_ql_co * co)1224 nf_records(sen_ctx *ctx, sen_obj *args, sen_ql_co *co)
1225 {
1226 char *msg;
1227 sen_obj *car, *res;
1228 if (!(res = ctx->code)) { QLERR("invalid receiver"); }
1229 POP(car, args);
1230 if (!(msg = str_value(ctx, car))) { QLERR("invalid message"); }
1231 switch (*msg) {
1232 case '\0' : /* get instance by key */
1233 {
1234 char *name;
1235 sen_db_store *cls;
1236 POP(car, args);
1237 if (!(name = str_value(ctx, car))) { return F; }
1238 if (ctx->code->class) {
1239 if (!(cls = sen_db_store_by_id(ctx->db, ctx->code->class))) {
1240 QLERR("class open failed");
1241 }
1242 res = sen_ql_class_at(ctx, cls, name, 0, NULL);
1243 if (res != F &&
1244 !sen_set_at(RVALUE(ctx->code), &res->u.o.self, NULL)) {
1245 res = F;
1246 }
1247 } else {
1248 res = sen_ql_at(ctx, name);
1249 if (!res || !(res->flags & SEN_OBJ_NATIVE) ||
1250 !sen_set_at(RVALUE(ctx->code), &res->u.o.self, NULL)) {
1251 res = F;
1252 }
1253 }
1254 }
1255 break;
1256 case ':' :
1257 switch (msg[1]) {
1258 case 'd' : /* :difference */
1259 case 'D' :
1260 {
1261 sen_records *r = RVALUE(ctx->code);
1262 if (PAIRP(args)) {
1263 POP(car, args);
1264 if (RECORDSP(car)) {
1265 sen_records_difference(r, RVALUE(car));
1266 }
1267 }
1268 }
1269 break;
1270 case 'g' : /* :group */
1271 case 'G' :
1272 {
1273 char *str;
1274 int limit = 0;
1275 sen_db_store *cls, *slot;
1276 sen_group_optarg arg;
1277 sen_obj *rec = ctx->code;
1278 POP(car, args);
1279 if (!(str = str_value(ctx, car))) { break; }
1280 if (!(slot = sen_db_class_slot(ctx->db, rec->class, str))) { break; }
1281 if (!(cls = sen_db_store_by_id(ctx->db, slot->u.o.class))) { break; }
1282 if (slot->type != sen_db_obj_slot) { break; } // todo : support others
1283 RVALUE(rec)->userdata = slot->u.o.ra;
1284 arg.mode = sen_sort_descending;
1285 arg.func = group_obj;
1286 arg.func_arg = NULL;
1287 arg.key_size = sizeof(sen_id);
1288 POP(car, args);
1289 if (!sen_obj2int(ctx, car)) { limit = car->u.i.i; }
1290 POP(car, args);
1291 if ((str = str_value(ctx, car)) && (*str == 'a')) {
1292 arg.mode = sen_sort_ascending;
1293 }
1294 if (!sen_records_group(RVALUE(rec), limit, &arg)) {
1295 RVALUE(rec)->subrec_id = rec->class;
1296 rec->class = slot->u.o.class;
1297 RVALUE(rec)->keys = cls->u.c.keys;
1298 res = rec;
1299 }
1300 }
1301 break;
1302 case 'i' : /* :intersect */
1303 case 'I' :
1304 {
1305 sen_records *r = RVALUE(ctx->code);
1306 while (PAIRP(args)) {
1307 POP(car, args);
1308 if (!RECORDSP(car)) { continue; }
1309 sen_records_intersect(r, RVALUE(car));
1310 car->type = sen_ql_void;
1311 car->u.o.func = nf_void;
1312 car->flags &= ~SEN_OBJ_ALLOCATED;
1313 }
1314 }
1315 break;
1316 case 'n' : /* :nrecs */
1317 case 'N' :
1318 SEN_OBJ_NEW(ctx, res);
1319 res->type = sen_ql_int;
1320 res->u.i.i = sen_records_nhits(RVALUE(ctx->code));
1321 break;
1322 case 's' :
1323 case 'S' :
1324 {
1325 switch (msg[2]) {
1326 case 'c' : /* :scan-select */
1327 case 'C' :
1328 {
1329 sen_rset_recinfo *ri;
1330 sen_id *rid, base = ctx->code->class;
1331 match_spec spec;
1332 res = match_prepare(ctx, &spec, base, args);
1333 if (ERRP(ctx, SEN_WARN)) { return F; }
1334 switch (spec.op) {
1335 case sen_sel_or :
1336 SEN_SET_EACH(RVALUE(ctx->code), eh, &rid, NULL, {
1337 if (match_exec(ctx, &spec, base, *rid)) {
1338 sen_set_get(RVALUE(res), rid, (void **)&ri);
1339 }
1340 });
1341 break;
1342 case sen_sel_and :
1343 SEN_SET_EACH(RVALUE(res), eh, &rid, &ri, {
1344 if (!sen_set_at(RVALUE(ctx->code), rid, NULL) ||
1345 !match_exec(ctx, &spec, base, *rid)) {
1346 sen_set_del(RVALUE(res), eh);
1347 }
1348 });
1349 break;
1350 case sen_sel_but :
1351 SEN_SET_EACH(RVALUE(res), eh, &rid, &ri, {
1352 if (sen_set_at(RVALUE(ctx->code), rid, NULL) &&
1353 match_exec(ctx, &spec, base, *rid)) {
1354 sen_set_del(RVALUE(res), eh);
1355 }
1356 });
1357 break;
1358 case sen_sel_adjust :
1359 /* todo : support it */
1360 break;
1361 }
1362 }
1363 break;
1364 case 'o' : /* :sort */
1365 case 'O' :
1366 {
1367 int limit = 10;
1368 const char *str;
1369 sen_sort_optarg arg;
1370 sen_obj *rec = ctx->code;
1371 compar_expr_userdata ceud;
1372 arg.compar = NULL;
1373 arg.compar_arg = (void *)(intptr_t)RVALUE(rec)->record_size;
1374 arg.mode = sen_sort_descending;
1375 POP(car, args);
1376 if ((str = str_value(ctx, car))) {
1377 if (*str == ':') {
1378 switch (str[1]) {
1379 case 's' : /* :score */
1380 break;
1381 case 'k' : /* :key */
1382 if (rec->class) {
1383 sen_db_store *cls = sen_db_store_by_id(ctx->db, rec->class);
1384 if (cls) {
1385 RVALUE(rec)->userdata = cls->u.c.keys;
1386 arg.compar = compar_key;
1387 }
1388 } else {
1389 RVALUE(rec)->userdata = ctx->db->keys;
1390 arg.compar = compar_key;
1391 }
1392 break;
1393 case 'n' :
1394 arg.compar_arg =
1395 (void *)(intptr_t)(RVALUE(rec)->record_size + sizeof(int));
1396 break;
1397 }
1398 } else {
1399 sen_db_store *slot = sen_db_class_slot(ctx->db, rec->class, str);
1400 if (slot) {
1401 switch (slot->type) {
1402 case sen_db_ra_slot :
1403 RVALUE(rec)->userdata = slot->u.f.ra;
1404 switch (slot->u.f.class) {
1405 case 1 : /* <int> */
1406 arg.compar = compar_int;
1407 break;
1408 case 2 : /* <uint> */
1409 arg.compar = compar_uint;
1410 break;
1411 case 3 : /* <int64> */
1412 arg.compar = compar_int64;
1413 break;
1414 case 4 : /* <float> */
1415 arg.compar = compar_float;
1416 break;
1417 case 8 : /* <time> */
1418 arg.compar = compar_time;
1419 break;
1420 default :
1421 arg.compar = compar_ra;
1422 break;
1423 }
1424 break;
1425 case sen_db_ja_slot :
1426 RVALUE(rec)->userdata = slot->u.v.ja;
1427 arg.compar = compar_ja;
1428 break;
1429 case sen_db_obj_slot :
1430 {
1431 sen_db_store *cls = sen_db_store_by_id(ctx->db, slot->u.o.class);
1432 if (cls) {
1433 RVALUE(rec)->userdata = slot->u.o.ra;
1434 arg.compar = compar_obj;
1435 arg.compar_arg = cls->u.c.keys;
1436 }
1437 }
1438 break;
1439 default :
1440 break;
1441 }
1442 }
1443 }
1444 } else {
1445 sen_obj *se;
1446 se = ses_prepare(ctx, rec->class, car, RVALUE(rec));
1447 /* se = slotexp_prepare(ctx, rec->class, car, RVALUE(rec)); */
1448 if (ERRP(ctx, SEN_WARN)) { return F; }
1449 ceud.base = rec->class;
1450 ceud.se = se;
1451 ceud.proc = NIL;
1452 RVALUE(rec)->userdata = &ceud;
1453 arg.compar = compar_expr;
1454 arg.compar_arg = ctx;
1455 }
1456 POP(car, args);
1457 if (!sen_obj2int(ctx, car)) { limit = car->u.i.i; }
1458 if (limit <= 0) { limit += RVALUE(rec)->n_entries; }
1459 POP(car, args);
1460 if ((str = str_value(ctx, car)) && *str == 'a') {
1461 arg.mode = sen_sort_ascending;
1462 }
1463 POP(car, args);
1464 if (PROCEDUREP(car)) {
1465 ceud.proc = car;
1466 }
1467 if (!sen_records_sort(RVALUE(rec), limit, &arg)) { res = rec; }
1468 }
1469 break;
1470 case 'u' : /* :subtract */
1471 case 'U' :
1472 {
1473 sen_records *r = RVALUE(ctx->code);
1474 while (PAIRP(args)) {
1475 POP(car, args);
1476 if (!RECORDSP(car)) { continue; }
1477 sen_records_subtract(r, RVALUE(car));
1478 car->type = sen_ql_void;
1479 car->u.o.func = nf_void;
1480 car->flags &= ~SEN_OBJ_ALLOCATED;
1481 }
1482 }
1483 break;
1484 default :
1485 {
1486 /* ambiguous message. todo : return error */
1487 res = F;
1488 }
1489 }
1490 }
1491 break;
1492 case 'u' : /* :union */
1493 case 'U' :
1494 {
1495 sen_records *r = RVALUE(ctx->code);
1496 while (PAIRP(args)) {
1497 POP(car, args);
1498 if (!RECORDSP(car)) { continue; }
1499 sen_records_union(r, RVALUE(car));
1500 car->type = sen_ql_void;
1501 car->u.o.func = nf_void;
1502 car->flags &= ~SEN_OBJ_ALLOCATED;
1503 }
1504 }
1505 break;
1506 case '+' : /* :+ (iterator next) */
1507 {
1508 sen_id *rid;
1509 sen_records *r = RVALUE(ctx->code);
1510 if (ctx->code->class) {
1511 POP(res, args);
1512 if (res->type == sen_ql_object &&
1513 res->class == ctx->code->class &&
1514 sen_records_next(r, NULL, 0, NULL)) {
1515 sen_set_element_info(r, r->curr_rec, (void **)&rid, NULL);
1516 res->u.o.self = *rid;
1517 } else {
1518 res = F;
1519 }
1520 } else {
1521 if (sen_records_next(r, NULL, 0, NULL)) {
1522 const char *key;
1523 sen_set_element_info(r, r->curr_rec, (void **)&rid, NULL);
1524 if (!(key = _sen_sym_key(ctx->db->keys, *rid))) { QLERR("invalid key"); }
1525 res = INTERN(key);
1526 } else {
1527 res = F;
1528 }
1529 }
1530 }
1531 break;
1532 case '\0' : /* : (iterator begin) */
1533 {
1534 sen_id *rid;
1535 sen_records *r = RVALUE(ctx->code);
1536 sen_records_rewind(r);
1537 if (sen_records_next(r, NULL, 0, NULL)) {
1538 sen_set_element_info(r, r->curr_rec, (void **)&rid, NULL);
1539 if (ctx->code->class) {
1540 SEN_OBJ_NEW(ctx, res);
1541 obj_obj_bind(res, ctx->code->class, *rid);
1542 } else {
1543 const char *key;
1544 if (!(key = _sen_sym_key(ctx->db->keys, *rid))) { QLERR("invalid key"); }
1545 res = INTERN(key);
1546 }
1547 } else {
1548 res = F;
1549 }
1550 }
1551 break;
1552 }
1553 break;
1554 default : /* invalid message */
1555 res = F;
1556 break;
1557 }
1558 return res;
1559 }
1560
1561 struct _ins_stat {
1562 sen_obj *slots;
1563 int nslots;
1564 int nrecs;
1565 };
1566
1567 inline static void
clear_all_slot_values(sen_ctx * ctx,sen_id base,sen_id self)1568 clear_all_slot_values(sen_ctx *ctx, sen_id base, sen_id self)
1569 {
1570 sen_set *slots;
1571 {
1572 char buf[SEN_SYM_MAX_KEY_SIZE];
1573 if (sen_db_class_slotpath(ctx->db, base, "", buf)) { return; }
1574 slots = sen_sym_prefix_search(ctx->db->keys, buf);
1575 }
1576 if (slots) {
1577 sen_id *sid;
1578 sen_obj o = { sen_ql_list, SEN_OBJ_REFERER };
1579 o.u.l.car = NIL;
1580 o.u.l.cdr = NIL;
1581 SEN_SET_EACH(slots, eh, &sid, NULL, {
1582 sen_db_store *slot = sen_db_store_by_id(ctx->db, *sid);
1583 /* todo : if (!slot) error handling */
1584 if (slot && (slot->type != sen_db_idx_slot /* || virtualslot */)) {
1585 sen_obj dummy;
1586 slot_value(ctx, slot, self, &o, &dummy);
1587 }
1588 });
1589 sen_set_close(slots);
1590 }
1591 }
1592
1593 inline static void
unesc(sen_ctx * ctx,sen_obj * obj)1594 unesc(sen_ctx *ctx, sen_obj *obj)
1595 {
1596 char *src, *dest, *end = STRVALUE(obj) + STRSIZE(obj);
1597 for (src = dest = STRVALUE(obj);;) {
1598 unsigned int len;
1599 if (!(len = sen_str_charlen_nonnull(src, end, ctx->encoding))) { break; }
1600 if (src[0] == '\\' && src + 1 < end && len == 1) {
1601 src++;
1602 switch (*src) {
1603 case 'n' :
1604 *dest++ = '\n';
1605 break;
1606 case 'r' :
1607 *dest++ = '\r';
1608 break;
1609 case 't' :
1610 *dest++ = '\t';
1611 break;
1612 default :
1613 *dest++ = *src;
1614 break;
1615 }
1616 src++;
1617 } else {
1618 while (len--) { *dest++ = *src++; }
1619 }
1620 }
1621 STRSIZE(obj) = dest - STRVALUE(obj);
1622 }
1623
1624 sen_rc
sym_extract(sen_sym * sym,const char * str,unsigned int str_len,sen_set * h)1625 sym_extract(sen_sym *sym, const char *str, unsigned int str_len, sen_set *h)
1626 {
1627 sen_id tid;
1628 if (sym->flags & SEN_INDEX_NORMALIZE) {
1629 sen_nstr *nstr = sen_nstr_open(str, str_len, sym->encoding, SEN_STR_WITH_CHECKS);
1630 if (nstr) {
1631 int16_t *cp = nstr->checks;
1632 const char *sp = nstr->norm, *se = nstr->norm + nstr->norm_blen;
1633 while (sp < se) {
1634 if ((tid = sen_sym_common_prefix_search(sym, sp))) {
1635 sen_rset_recinfo *ri;
1636 sen_set_get(h, &tid, (void **)&ri);
1637 ri->n_subrecs++;
1638 }
1639 do { sp++; cp++; } while (sp < se && !*cp);
1640 }
1641 sen_nstr_close(nstr);
1642 } else {
1643 return sen_memory_exhausted;
1644 }
1645 } else {
1646 int len;
1647 const char *sp, *se = str + str_len;
1648 for (sp = str; sp < se; sp += len) {
1649 if ((tid = sen_sym_common_prefix_search(sym, sp))) {
1650 sen_rset_recinfo *ri;
1651 sen_set_get(h, &tid, (void **)&ri);
1652 ri->n_subrecs++;
1653 }
1654 if (!(len = sen_str_charlen_nonnull(sp, se, sym->encoding))) { break; }
1655 }
1656 }
1657 return sen_success;
1658 }
1659
1660 // todo : refine
1661 #define MAXSLOTS 0x100
1662
1663 static sen_obj *
nf_class(sen_ctx * ctx,sen_obj * args,sen_ql_co * co)1664 nf_class(sen_ctx *ctx, sen_obj *args, sen_ql_co *co)
1665 {
1666 char *msg;
1667 sen_id base;
1668 int load = 0;
1669 sen_sym *sym;
1670 sen_db_store *cls;
1671 sen_obj *car, *res;
1672 if (!(res = ctx->code)) { QLERR("invalid receiver"); }
1673 base = ctx->code->u.o.self;
1674 if (!(cls = sen_db_store_by_id(ctx->db, base))) { QLERR("invalid class"); }
1675 sym = cls->u.c.keys;
1676 SEN_QL_CO_BEGIN(co);
1677 POP(car, args);
1678 if (!(msg = str_value(ctx, car))) { QLERR("invalid message"); }
1679 switch (*msg) {
1680 case '\0' : /* get instance by key */
1681 {
1682 char *name;
1683 POP(car, args);
1684 if (!(name = str_value(ctx, car))) { return F; }
1685 res = sen_ql_class_at(ctx, cls, name, 0, NULL);
1686 }
1687 break;
1688 case ':' :
1689 switch (msg[1]) {
1690 case 'c' :
1691 case 'C' :
1692 switch (msg[2]) {
1693 case 'l' : /* :clearlock */
1694 case 'L' :
1695 {
1696 res = *sym->lock ? T : F;
1697 sen_sym_clear_lock(sym);
1698 }
1699 break;
1700 case 'o' : /* :common-prefix-search */
1701 case 'O' :
1702 {
1703 sen_id id;
1704 char *name;
1705 POP(car, args);
1706 if (!(name = str_value(ctx, car))) { return F; }
1707 SYM_DO(sym, name, { id = sen_sym_common_prefix_search(sym, name); });
1708 if (id) {
1709 SEN_OBJ_NEW(ctx, res);
1710 obj_obj_bind(res, base, id);
1711 } else {
1712 res = F;
1713 }
1714 }
1715 break;
1716 }
1717 break;
1718 case 'd' :
1719 case 'D' :
1720 switch (msg[2]) {
1721 case 'e' :
1722 case 'E' :
1723 switch (msg[3]) {
1724 case 'f' : /* :def */
1725 case 'F' :
1726 {
1727 char *name;
1728 sen_id target = 0;
1729 sen_db_store *slot;
1730 sen_db_store_spec spec;
1731 POP(car, args);
1732 if (!(name = str_value(ctx, car))) { return F; }
1733 if (sen_db_class_slot(ctx->db, base, name)) { return T; /* already exists */ }
1734 POP(car, args);
1735 spec.u.s.class = car->u.o.self;
1736 spec.u.s.size = 0;
1737 spec.u.s.flags = 0;
1738 spec.u.s.collection_type = 0;
1739 switch (car->type) {
1740 case sen_db_raw_class :
1741 {
1742 sen_db_store *tc = sen_db_store_by_id(ctx->db, spec.u.s.class);
1743 if (!tc) { return F; }
1744 /* todo : use tc->id instead of element_size */
1745 spec.type = (tc->u.bc.element_size > 8) ? sen_db_ja_slot : sen_db_ra_slot;
1746 spec.u.s.size = tc->u.bc.element_size;
1747 }
1748 break;
1749 case sen_db_rel1 :
1750 case sen_db_class :
1751 spec.type = sen_db_obj_slot;
1752 break;
1753 case sen_db_obj_slot :
1754 case sen_db_ra_slot :
1755 case sen_db_ja_slot :
1756 spec.type = sen_db_idx_slot;
1757 break;
1758 case sen_ql_void :
1759 /* keyword might be assigned */
1760 break;
1761 default :
1762 return F;
1763 }
1764 while (PAIRP(args)) {
1765 POP(car, args);
1766 if (PAIRP(car)) { /* view definition */
1767 char *opt = str_value(ctx, CADR(car));
1768 if (opt && !strcmp(opt, ":match")) { /* fulltext index */
1769 spec.type = sen_db_idx_slot;
1770 car = CAR(car);
1771 if (PAIRP(car)) {
1772 char *slotname;
1773 sen_db_store *ts;
1774 if (CAR(car)->type != sen_db_class &&
1775 CAR(car)->type != sen_db_rel1) {
1776 QLERR("class must be assigned as index target");
1777 }
1778 spec.u.s.class = CAR(car)->u.o.self;
1779 if (!(slotname = str_value(ctx, CADR(car))) ||
1780 !(ts = sen_db_class_slot(ctx->db, spec.u.s.class, slotname))) {
1781 return F;
1782 }
1783 target = ts->id;
1784 } else {
1785 sen_db_store *tc = sen_db_slot_class_by_id(ctx->db, car->u.o.self);
1786 if (!tc) { return F; }
1787 spec.u.s.class = tc->id;
1788 target = car->u.o.self;
1789 }
1790 }
1791 }
1792 }
1793 {
1794 char buf[SEN_SYM_MAX_KEY_SIZE];
1795 if (sen_db_class_slotpath(ctx->db, base, name, buf)) { return F; }
1796 if (!(slot = sen_db_store_create(ctx->db, buf, &spec))) { return F; }
1797 if (spec.type == sen_db_idx_slot && target) {
1798 sen_db_store_rel_spec rs;
1799 rs.type = sen_db_index_target;
1800 rs.target = target;
1801 sen_db_store_add_trigger(slot, &rs);
1802 sen_db_idx_slot_build(ctx->db, slot);
1803 }
1804 if ((res = INTERN(buf)) != F) {
1805 sen_ql_bind_symbol(slot, res);
1806 }
1807 }
1808 }
1809 break;
1810 case 'l' : /* :delete */
1811 case 'L' :
1812 {
1813 char *name;
1814 sen_id id;
1815 POP(car, args);
1816 if (!(name = str_value(ctx, car))) { return F; }
1817 SYM_DO(sym, name, { id = sen_sym_at(sym, name); });
1818 if (!id) { return F; }
1819 if (sen_db_lock(ctx->db, -1)) {
1820 SEN_LOG(sen_log_crit, "class::delete lock failed");
1821 QLERR("db lock error");
1822 }
1823 clear_all_slot_values(ctx, base, id);
1824 /* todo : use sen_sym_del_with_sis if sym->flags & SEN_SYM_WITH_SIS */
1825 /* todo : check foreign key constraint */
1826 SYM_DO(sym, name, { sen_sym_del(sym, name); });
1827 sen_db_unlock(ctx->db);
1828 }
1829 break;
1830 default :
1831 res = F;
1832 }
1833 break;
1834 default :
1835 res = F;
1836 }
1837 break;
1838 case 'e' : /* :extract */
1839 case 'E' :
1840 POP(car, args);
1841 if (!BULKP(car)) { QLERR("string expected"); }
1842 POP(res, args);
1843 if (res == NIL) {
1844 if (!(res = rec_obj_new(ctx, cls, sen_rec_document, sen_rec_none, 0))) { return F; }
1845 } else if (!RECORDSP(res)) {
1846 QLERR("records object expected");
1847 }
1848 if (sym_extract(cls->u.c.keys, STRVALUE(car), STRSIZE(car), RVALUE(res))) {
1849 QLERR("sym_extract failed");
1850 }
1851 break;
1852 case 'l' : /* :load */
1853 case 'L' :
1854 load = 1;
1855 break;
1856 case 'n' :
1857 case 'N' :
1858 {
1859 switch (msg[2]) {
1860 case 'e' : /* :new */
1861 case 'E' :
1862 {
1863 char *name;
1864 POP(car, args);
1865 if (!(name = str_value(ctx, car))) { return F; }
1866 if (sen_db_lock(ctx->db, -1)) {
1867 SEN_LOG(sen_log_crit, "nf_class::new: lock failed");
1868 } else {
1869 res = sen_ql_class_at(ctx, cls, name, 1, NULL);
1870 if (res != F) {
1871 sen_obj cons, dummy;
1872 sen_db_store *slot;
1873 cons.type = sen_ql_list;
1874 cons.flags = SEN_OBJ_REFERER;
1875 cons.u.l.cdr = NIL;
1876 while (PAIRP(args)) {
1877 POP(car, args);
1878 if (!(msg = str_value(ctx, car))) { break; }
1879 POP(car, args);
1880 if (!(slot = sen_db_class_slot(ctx->db, base, msg))) { break; }
1881 cons.u.l.car = car;
1882 slot_value(ctx, slot, res->u.o.self, &cons, &dummy);
1883 }
1884 }
1885 sen_db_unlock(ctx->db);
1886 }
1887 }
1888 break;
1889 case 'r' : /* :nrecs */
1890 case 'R' :
1891 {
1892 SEN_OBJ_NEW(ctx, res);
1893 res->type = sen_ql_int;
1894 res->u.i.i = sen_sym_size(sym);
1895 }
1896 break;
1897 default :
1898 {
1899 /* ambiguous message. todo : return error */
1900 res = F;
1901 }
1902 }
1903 }
1904 break;
1905 case 'p' : /* :prefix-search */
1906 case 'P' :
1907 {
1908 char *name;
1909 POP(car, args);
1910 if (!(name = str_value(ctx, car))) { return F; }
1911 res = rec_obj_new(ctx, cls, sen_rec_document, sen_rec_none, 0);
1912 if (ERRP(ctx, SEN_WARN)) { return F; }
1913 SYM_DO(sym, name, {
1914 sen_sym_prefix_search_with_set(sym, name, RVALUE(res));
1915 });
1916 }
1917 break;
1918 case 's' :
1919 case 'S' :
1920 switch (msg[2]) {
1921 case 'c' :
1922 case 'C' :
1923 switch (msg[3]) {
1924 case 'a' : /* :scan-select */
1925 case 'A' :
1926 {
1927 sen_rset_recinfo *ri;
1928 sen_id *rid;
1929 match_spec spec;
1930 res = match_prepare(ctx, &spec, base, args);
1931 if (ERRP(ctx, SEN_WARN)) { return F; }
1932 switch (spec.op) {
1933 case sen_sel_or :
1934 {
1935 sen_id id;
1936 sen_sym_cursor *c;
1937 sen_rset_posinfo *pi = (sen_rset_posinfo *) &id;
1938 int n = 0, o = spec.offset, l = spec.limit;
1939 if (l) {
1940 if ((c = sen_sym_cursor_open(sym, ctx, spec.from, spec.to, spec.mode))) {
1941 while ((id = sen_sym_cursor_next(c))) {
1942 if (match_exec(ctx, &spec, base, id)) {
1943 if (n++ >= o) {
1944 /* todo : use SEN_SET_INT_ADD if !n_entries */
1945 sen_set_get(RVALUE(res), pi, (void **)&ri);
1946 if (!--l) { break; }
1947 }
1948 }
1949 }
1950 sen_sym_cursor_close(c);
1951 }
1952 }
1953 }
1954 break;
1955 case sen_sel_and :
1956 SEN_SET_EACH(RVALUE(res), eh, &rid, &ri, {
1957 if (!match_exec(ctx, &spec, base, *rid)) {
1958 sen_set_del(RVALUE(res), eh);
1959 }
1960 });
1961 break;
1962 case sen_sel_but :
1963 SEN_SET_EACH(RVALUE(res), eh, &rid, &ri, {
1964 if (match_exec(ctx, &spec, base, *rid)) {
1965 sen_set_del(RVALUE(res), eh);
1966 }
1967 });
1968 break;
1969 case sen_sel_adjust :
1970 /* todo : support it */
1971 break;
1972 }
1973 }
1974 break;
1975 case 'h' : /* :schema */
1976 case 'H' :
1977 res = NIL;
1978 if (sym->flags & SEN_SYM_WITH_SIS) { res = CONS(INTERN(":sis"), res); }
1979 if (sym->flags & SEN_INDEX_NORMALIZE) { res = CONS(INTERN(":normalize"), res); }
1980 if (sym->flags & SEN_INDEX_NGRAM) { res = CONS(INTERN(":ngram"), res); }
1981 if (sym->flags & SEN_INDEX_DELIMITED) { res = CONS(INTERN(":delimited"), res); }
1982 {
1983 char encstr[32] = ":";
1984 strcpy(encstr + 1, sen_enctostr(sym->encoding));
1985 res = CONS(INTERN(encstr), res);
1986 }
1987 res = CONS(INTERN("ptable"),
1988 CONS(CONS(INTERN("quote"),
1989 CONS(INTERN(_sen_sym_key(ctx->db->keys, base)), NIL)), res));
1990 break;
1991 }
1992 break;
1993 case 'u' : /* :suffix-search */
1994 case 'U' :
1995 {
1996 char *name;
1997 POP(car, args);
1998 if (!(name = str_value(ctx, car))) { return F; }
1999 res = rec_obj_new(ctx, cls, sen_rec_document, sen_rec_none, 0);
2000 if (ERRP(ctx, SEN_WARN)) { return F; }
2001 SYM_DO(sym, name, {
2002 sen_sym_suffix_search_with_set(sym, name, RVALUE(res));
2003 });
2004 }
2005 break;
2006 case 'l' : /* :slots */
2007 case 'L' :
2008 {
2009 char *name;
2010 char buf[SEN_SYM_MAX_KEY_SIZE];
2011 POP(car, args);
2012 if (!(name = str_value(ctx, car))) { name = ""; }
2013 if (sen_db_class_slotpath(ctx->db, base, name, buf)) { return F; }
2014 if ((res = rec_obj_new(ctx, NULL, sen_rec_document, sen_rec_none, 0)) == F) {
2015 return F;
2016 }
2017 sen_sym_prefix_search_with_set(ctx->db->keys, buf, RVALUE(res));
2018 }
2019 break;
2020 }
2021 break;
2022 case 't' :
2023 {
2024 int n;
2025 sen_id id = SEN_SYM_NIL;
2026 for (n = 0; (id = sen_sym_next(sym, id)); n++) ;
2027 res = (n == sen_sym_size(sym)) ? T : F;
2028 }
2029 break;
2030 case 'T' :
2031 {
2032 int n = 0;
2033 sen_id id;
2034 sen_sym_cursor *c;
2035 if ((c = sen_sym_cursor_open(sym, ctx, NULL, NULL, sen_sort_descending))) {
2036 for (; (id = sen_sym_cursor_next(c)); n++) ;
2037 sen_sym_cursor_close(c);
2038 }
2039 res = (n == sen_sym_size(sym)) ? T : F;
2040 }
2041 break;
2042 case 'u' : /* :undef */
2043 case 'U' :
2044 {
2045 char *name;
2046 POP(car, args);
2047 if (!(name = str_value(ctx, car))) { return F; }
2048 res = sen_db_class_del_slot(ctx->db, base, name) ? F : T;
2049 }
2050 break;
2051 case '+' : /* :+ (iterator next) */
2052 {
2053 sen_id id;
2054 POP(res, args);
2055 if (res->type == sen_ql_object &&
2056 res->class == cls->id &&
2057 (id = sen_sym_next(sym, res->u.o.self))) {
2058 res->u.o.self = id;
2059 } else {
2060 res = F;
2061 }
2062 }
2063 break;
2064 case '\0' : /* : (iterator begin) */
2065 {
2066 sen_id id;
2067 id = sen_sym_next(sym, SEN_SYM_NIL);
2068 if (id == SEN_SYM_NIL) {
2069 res = F;
2070 } else {
2071 SEN_OBJ_NEW(ctx, res);
2072 obj_obj_bind(res, cls->id, id);
2073 }
2074 }
2075 break;
2076 }
2077 break;
2078 default : /* :slotname */
2079 {
2080 int recpslotp;
2081 res = class_slot(ctx, base, msg, NULL, &recpslotp);
2082 }
2083 break;
2084 }
2085 if (load) {
2086 int i, recpslotp;
2087 sen_obj *s;
2088 struct _ins_stat *stat;
2089 for (s = args, i = 0; PAIRP(s); s = CDR(s), i++) {
2090 car = CAR(s);
2091 if (!(msg = str_value(ctx, car))) { return F; }
2092 if ((s->u.l.car = class_slot(ctx, base, msg, NULL, &recpslotp)) == F) { return F; }
2093 }
2094 if (!(s = sen_obj_alloc(ctx, sizeof(struct _ins_stat)))) { return F; }
2095 stat = (struct _ins_stat *)s->u.b.value; // todo : not GC safe
2096 stat->slots = args;
2097 stat->nslots = i + 1;
2098 stat->nrecs = 0;
2099 do {
2100 SEN_QL_CO_WAIT(co, stat);
2101 if (BULKP(args) && args->u.b.size) {
2102 char *tokbuf[MAXSLOTS];
2103 sen_db_store *slot;
2104 sen_obj val, obj, cons, dummy;
2105 cons.type = sen_ql_list;
2106 cons.flags = SEN_OBJ_REFERER;
2107 cons.u.l.car = &val;
2108 cons.u.l.cdr = NIL;
2109 val.type = sen_ql_bulk;
2110 if (sen_str_tok(args->u.b.value, args->u.b.size, '\t', tokbuf, MAXSLOTS, NULL) == stat->nslots) {
2111 sen_obj *o;
2112 *tokbuf[0] = '\0';
2113 if (sen_db_lock(ctx->db, -1)) {
2114 SEN_LOG(sen_log_crit, "nf_class::load lock failed");
2115 } else {
2116 o = sen_ql_class_at(ctx, cls, args->u.b.value, 1, &obj);
2117 if (o != F) {
2118 for (s = stat->slots, i = 1; i < stat->nslots; s = CDR(s), i++) {
2119 val.u.b.value = tokbuf[i - 1] + 1;
2120 val.u.b.size = tokbuf[i] - val.u.b.value;
2121 unesc(ctx, &val);
2122 if (!(slot = sen_db_store_by_id(ctx->db, CAR(s)->u.o.self))) { /* todo */ }
2123 slot_value(ctx, slot, obj.u.o.self, &cons, &dummy); // todo : refine cons
2124 }
2125 stat->nrecs++;
2126 }
2127 sen_db_unlock(ctx->db);
2128 }
2129 }
2130 } else {
2131 co->mode |= SEN_CTX_TAIL;
2132 }
2133 } while (!(co->mode & (SEN_CTX_HEAD|SEN_CTX_TAIL)));
2134 if ((res = sen_obj_new(ctx))) {
2135 res->type = sen_ql_int;
2136 res->u.i.i = stat->nrecs;
2137 } else {
2138 res = F;
2139 }
2140 }
2141 SEN_QL_CO_END(co);
2142 return res;
2143 }
2144
2145 #define REL1_GET_INSTANCE_BY_KEY(rel,key,id) do {\
2146 char *name;\
2147 if (rel->u.f.class) {\
2148 sen_db_store *tcls = sen_db_store_by_id(ctx->db, rel->u.f.class);\
2149 if (!tcls || !(name = str_value(ctx, key))) {\
2150 id = SEN_SYM_NIL;\
2151 } else {\
2152 SYM_DO(tcls->u.c.keys, name, {\
2153 id = sen_sym_at(tcls->u.c.keys, name);\
2154 });\
2155 }\
2156 } else {\
2157 switch (key->type) {\
2158 case sen_ql_bulk :\
2159 name = key->u.b.value;\
2160 id = sen_atoi(name, name + key->u.b.size, NULL);\
2161 break;\
2162 case sen_ql_int :\
2163 id = key->u.i.i;\
2164 break;\
2165 default :\
2166 id = SEN_SYM_NIL;\
2167 }\
2168 }\
2169 } while(0)
2170
2171 static sen_obj *
nf_rel1(sen_ctx * ctx,sen_obj * args,sen_ql_co * co)2172 nf_rel1(sen_ctx *ctx, sen_obj *args, sen_ql_co *co)
2173 {
2174 char *msg;
2175 sen_id base;
2176 sen_db_store *cls;
2177 sen_obj *args0 = args, *car, *res;
2178 if (!(res = ctx->code)) { QLERR("invalid receiver"); }
2179 base = ctx->code->u.o.self;
2180 if (!(cls = sen_db_store_by_id(ctx->db, base))) { QLERR("invalid class"); }
2181 POP(car, args);
2182 if (!(msg = str_value(ctx, car))) { QLERR("invalid message"); }
2183 switch (*msg) {
2184 case '\0' : /* get instance by key */
2185 {
2186 sen_id id;
2187 uint8_t *v;
2188 POP(car, args);
2189 REL1_GET_INSTANCE_BY_KEY(cls, car, id);
2190 if (!id || !(v = (uint8_t *)sen_ra_at(cls->u.f.ra, id)) || !(*v & 1)) {
2191 return F;
2192 }
2193 res = sen_ql_mk_obj(ctx, base, id);
2194 return res;
2195 }
2196 break;
2197 case ':' :
2198 switch (msg[1]) {
2199 case 'c' :
2200 case 'C' :
2201 switch (msg[2]) {
2202 case 'l' : /* :clearlock */
2203 case 'L' :
2204 return res;
2205 break;
2206 }
2207 break;
2208 case 'd' :
2209 case 'D' :
2210 switch (msg[2]) {
2211 case 'e' :
2212 case 'E' :
2213 switch (msg[3]) {
2214 case 'l' : /* :delete */
2215 case 'L' :
2216 {
2217 sen_id id;
2218 uint8_t *v;
2219 POP(car, args);
2220 REL1_GET_INSTANCE_BY_KEY(cls, car, id);
2221 if (!id || !(v = (uint8_t *)sen_ra_at(cls->u.f.ra, id)) || !(*v & 1)) {
2222 return F;
2223 }
2224 if (sen_db_lock(ctx->db, -1)) {
2225 SEN_LOG(sen_log_crit, "rel1::delete lock failed");
2226 QLERR("db lock error");
2227 }
2228 clear_all_slot_values(ctx, base, id);
2229 sen_db_unlock(ctx->db);
2230 cls->u.f.ra->header->nrecords -= 1;
2231 *v &= ~1;
2232 return res;
2233 }
2234 break;
2235 }
2236 }
2237 break;
2238 case 'n' :
2239 case 'N' :
2240 {
2241 switch (msg[2]) {
2242 case 'e' : /* :new */
2243 case 'E' :
2244 {
2245 sen_id id;
2246 uint8_t *v;
2247 if (sen_db_lock(ctx->db, -1)) {
2248 SEN_LOG(sen_log_crit, "nf_rel1::new lock failed");
2249 } else {
2250 if (cls->u.f.class) {
2251 char *name;
2252 sen_db_store *tcls = sen_db_store_by_id(ctx->db, cls->u.f.class);
2253 res = F;
2254 if (tcls) {
2255 POP(car, args);
2256 if ((name = str_value(ctx, car))) {
2257 res = sen_ql_class_at(ctx, tcls, name, 0, NULL);
2258 if (res != F) {
2259 id = res->u.o.self;
2260 if ((v = (uint8_t *)sen_ra_get(cls->u.f.ra, id))) {
2261 if (!*v) {
2262 cls->u.f.ra->header->nrecords += 1;
2263 *v |= 1;
2264 }
2265 }
2266 }
2267 }
2268 }
2269 } else {
2270 id = cls->u.f.ra->header->curr_max + 1;
2271 if ((v = (uint8_t *)sen_ra_get(cls->u.f.ra, id))) {
2272 cls->u.f.ra->header->nrecords += 1;
2273 *v |= 1;
2274 res = sen_ql_mk_obj(ctx, base, id);
2275 } else {
2276 res = F;
2277 }
2278 }
2279 if (res != F) {
2280 sen_obj cons, dummy;
2281 sen_db_store *slot;
2282 cons.type = sen_ql_list;
2283 cons.flags = SEN_OBJ_REFERER;
2284 cons.u.l.cdr = NIL;
2285 while (PAIRP(args)) {
2286 POP(car, args);
2287 if (!(msg = str_value(ctx, car))) { continue; }
2288 POP(car, args);
2289 if (VOIDP(car)) { continue; }
2290 if (!(slot = sen_db_class_slot(ctx->db, base, msg))) { break; }
2291 cons.u.l.car = car;
2292 slot_value(ctx, slot, res->u.o.self, &cons, &dummy);
2293 }
2294 }
2295 sen_db_unlock(ctx->db);
2296 }
2297 return res;
2298 }
2299 break;
2300 case 'r' : /* :nrecs */
2301 case 'R' :
2302 {
2303 SEN_OBJ_NEW(ctx, res);
2304 res->type = sen_ql_int;
2305 res->u.i.i = cls->u.f.ra->header->nrecords;
2306 return res;
2307 }
2308 break;
2309 default :
2310 {
2311 /* ambiguous message. todo : return error */
2312 res = F;
2313 }
2314 }
2315 }
2316 break;
2317 case 's' :
2318 case 'S' :
2319 switch (msg[2]) {
2320 case 'c' : /* :scan-select */
2321 case 'C' :
2322 {
2323 sen_rset_recinfo *ri;
2324 sen_id *rid;
2325 match_spec spec;
2326 res = match_prepare(ctx, &spec, base, args);
2327 if (ERRP(ctx, SEN_WARN)) { return F; }
2328 switch (spec.op) {
2329 case sen_sel_or :
2330 {
2331 sen_id id = SEN_SYM_NIL, maxid = cls->u.f.ra->header->curr_max;
2332 sen_rset_posinfo *pi = (sen_rset_posinfo *) &id;
2333 while (++id <= maxid) {
2334 if (match_exec(ctx, &spec, base, id)) {
2335 sen_set_get(RVALUE(res), pi, (void **)&ri);
2336 }
2337 }
2338 }
2339 break;
2340 case sen_sel_and :
2341 SEN_SET_EACH(RVALUE(res), eh, &rid, &ri, {
2342 if (!match_exec(ctx, &spec, base, *rid)) {
2343 sen_set_del(RVALUE(res), eh);
2344 }
2345 });
2346 break;
2347 case sen_sel_but :
2348 SEN_SET_EACH(RVALUE(res), eh, &rid, &ri, {
2349 if (match_exec(ctx, &spec, base, *rid)) {
2350 sen_set_del(RVALUE(res), eh);
2351 }
2352 });
2353 break;
2354 case sen_sel_adjust :
2355 /* todo : support it */
2356 break;
2357 }
2358 }
2359 return res;
2360 break;
2361 case 'u' : /* :suffix-search is not available*/
2362 case 'U' :
2363 return res;
2364 break;
2365 default :
2366 break;
2367 }
2368 break;
2369 case '+' : /* :+ (iterator next) */
2370 {
2371 POP(res, args);
2372 if (res->type == sen_ql_object && res->class == cls->id) {
2373 uint8_t *v;
2374 sen_id id = res->u.o.self, maxid = cls->u.f.ra->header->curr_max;
2375 for (;;) {
2376 if (++id > maxid) {
2377 return F;
2378 }
2379 if ((v = (uint8_t *)sen_ra_at(cls->u.f.ra, id)) && (*v & 1)) { break; }
2380 }
2381 res->u.o.self = id;
2382 return res;
2383 } else { return F; /* cause error ? */ }
2384 }
2385 break;
2386 case '\0' : /* : (iterator begin) */
2387 {
2388 uint8_t *v;
2389 sen_id id = SEN_SYM_NIL + 1, maxid;
2390 maxid = cls->u.f.ra->header->curr_max;
2391 while (!(v = (uint8_t *)sen_ra_at(cls->u.f.ra, id)) || !(*v & 1)) {
2392 if (++id > maxid) { return F; }
2393 }
2394 res = sen_ql_mk_obj(ctx, base, id);
2395 return res;
2396 }
2397 break;
2398 }
2399 break;
2400 }
2401 return nf_class(ctx, args0, co);
2402 }
2403
2404 inline static sen_obj *
sen_obj_query(sen_ctx * ctx,const char * str,unsigned int str_len,sen_sel_operator default_op,int max_exprs,sen_encoding encoding)2405 sen_obj_query(sen_ctx *ctx, const char *str, unsigned int str_len,
2406 sen_sel_operator default_op, int max_exprs, sen_encoding encoding)
2407 {
2408 sen_query *q;
2409 sen_obj *res = sen_obj_new(ctx);
2410 if (!res || !(q = sen_query_open(str, str_len, default_op, max_exprs, encoding))) {
2411 return NULL;
2412 }
2413 res->type = sen_ql_query;
2414 res->flags = SEN_OBJ_NATIVE|SEN_OBJ_ALLOCATED;
2415 res->u.p.value = q;
2416 res->u.p.func = nf_query;
2417 return res;
2418 }
2419
2420 static sen_obj *
nf_toquery(sen_ctx * ctx,sen_obj * args,sen_ql_co * co)2421 nf_toquery(sen_ctx *ctx, sen_obj *args, sen_ql_co *co)
2422 {
2423 sen_obj *o = NULL, *s;
2424 POP(s, args);
2425 if (BULKP(s)) {
2426 /* TODO: operator, exprs, encoding */
2427 if (!(o = sen_obj_query(ctx, s->u.b.value, s->u.b.size, sen_sel_and, 32, ctx->encoding))) {
2428 QLERR("query_obj_new failed");
2429 }
2430 }
2431 return o;
2432 }
2433
2434 static sen_obj *
nf_slot(sen_ctx * ctx,sen_obj * args,sen_ql_co * co)2435 nf_slot(sen_ctx *ctx, sen_obj *args, sen_ql_co *co)
2436 {
2437 char *msg;
2438 sen_id base;
2439 sen_obj *car, *res;
2440 sen_db_store *slot;
2441 if (!(res = ctx->code)) { QLERR("invalid receiver"); }
2442 base = ctx->code->u.o.self;
2443 if (!(slot = sen_db_store_by_id(ctx->db, base))) { QLERR("sen_db_store_by_id failed"); }
2444 POP(car, args);
2445 if (!(msg = str_value(ctx, car))) { QLERR("invalid message"); }
2446 switch (*msg) {
2447 case '\0' :
2448 {
2449 if (IDX_SLOTP(ctx->code)) {
2450 sen_obj *q;
2451 sen_sel_operator op;
2452 POP(q, args);
2453 if (!QUERYP(q)) {
2454 if (!BULKP(q)) { return F; }
2455 if (!(q = sen_obj_query(ctx, q->u.b.value, q->u.b.size, sen_sel_and, 32, ctx->encoding))) {
2456 QLERR("query_obj_new failed");
2457 }
2458 }
2459 /* TODO: specify record unit */
2460 /* (idxslot query ((slot1 weight1) (slot2 weight2) ...) records operator+ */
2461 POP(car, args);
2462 /* TODO: handle weights */
2463 POP(res, args);
2464 if (RECORDSP(res)) {
2465 char *ops;
2466 op = sen_sel_and;
2467 POP(car, args);
2468 if ((ops = str_value(ctx, car))) {
2469 switch (*ops) {
2470 case '+': op = sen_sel_or; break;
2471 case '-': op = sen_sel_but; break;
2472 case '*': op = sen_sel_and; break;
2473 case '>': op = sen_sel_adjust; break;
2474 }
2475 }
2476 } else {
2477 sen_db_store *cls;
2478 if (!(cls = sen_db_store_by_id(ctx->db, slot->u.i.class))) { return F; }
2479 res = rec_obj_new(ctx, cls, sen_rec_document, sen_rec_none, 0);
2480 if (ERRP(ctx, SEN_WARN)) { return F; }
2481 op = sen_sel_or;
2482 }
2483 sen_query_select(slot->u.i.inv, PVALUE(q, sen_query), RVALUE(res), op);
2484 } else {
2485 char *name;
2486 sen_db_store *cls;
2487 POP(car, args);
2488 if (!(name = str_value(ctx, car))) { return F; }
2489 if (!(cls = sen_db_slot_class_by_id(ctx->db, base))) { return F; }
2490 res = sen_ql_class_at(ctx, cls, name, 0, NULL);
2491 if (res != F) {
2492 if (VOIDP(args)) {
2493 slot_value(ctx, slot, res->u.o.self, args, res);
2494 } else {
2495 if (sen_db_lock(ctx->db, -1)) {
2496 SEN_LOG(sen_log_crit, "nf_slot: lock failed");
2497 } else {
2498 slot_value(ctx, slot, res->u.o.self, args, res);
2499 sen_db_unlock(ctx->db);
2500 }
2501 }
2502 }
2503 }
2504 }
2505 break;
2506 case ':' :
2507 switch (msg[1]) {
2508 case 'd' : /* :defrag */
2509 case 'D' :
2510 if (JA_SLOTP(ctx->code)) {
2511 int threshold = 1, nsegs;
2512 POP(car, args);
2513 if (!sen_obj2int(ctx, car)) { threshold = car->u.i.i; }
2514 nsegs = sen_ja_defrag(slot->u.v.ja, threshold);
2515 SEN_OBJ_NEW(ctx, res);
2516 res->type = sen_ql_int;
2517 res->u.i.i = nsegs;
2518 } else {
2519 QLERR("invalid message");
2520 }
2521 break;
2522 case 's' : /* :schema */
2523 case 'S' :
2524 {
2525 const char *key;
2526 switch (slot->type) {
2527 case sen_db_obj_slot :
2528 if (!(key = _sen_sym_key(ctx->db->keys, slot->u.o.class))) {
2529 QLERR("invalid target as obj_slot");
2530 }
2531 res = CONS(INTERN(key), NIL);
2532 break;
2533 case sen_db_ra_slot :
2534 if (!(key = _sen_sym_key(ctx->db->keys, slot->u.f.class))) {
2535 QLERR("invalid target as ra_slot");
2536 }
2537 res = CONS(INTERN(key), NIL);
2538 break;
2539 case sen_db_ja_slot :
2540 if (!(key = _sen_sym_key(ctx->db->keys, slot->u.v.class))) {
2541 QLERR("invalid target as ja_slot");
2542 }
2543 res = CONS(INTERN(key), NIL);
2544 break;
2545 case sen_db_idx_slot :
2546 {
2547 sen_db_trigger *t;
2548 res = CONS(INTERN("::match"), CONS(NIL, NIL));
2549 for (t = slot->triggers; t; t = t->next) {
2550 if (t->type == sen_db_index_target) {
2551 if (!(key = _sen_sym_key(ctx->db->keys, t->target))) {
2552 QLERR("invalid target as idx_slot");
2553 }
2554 res = CONS(INTERN(key), res);
2555 }
2556 }
2557 // todo : support multi column
2558 res = CONS(INTERN(":as"), CONS(CONS(INTERN("quote"), CONS(res, NIL)), NIL));
2559 }
2560 break;
2561 case sen_db_vslot :
2562 QLERR("not supported yet");
2563 break;
2564 case sen_db_pslot :
2565 QLERR("not supported yet");
2566 break;
2567 default :
2568 QLERR("invalid slot type");
2569 break;
2570 }
2571 {
2572 char *p, buf[SEN_SYM_MAX_KEY_SIZE];
2573 strcpy(buf, _sen_sym_key(ctx->db->keys, base));
2574 if (!(p = strchr(buf, '.'))) { QLERR("invalid slotname %s", buf); }
2575 *p = ':';
2576 res = CONS(INTERN("::def"), CONS(INTERN(p), res));
2577 *p = '\0';
2578 res = CONS(INTERN(buf), res);
2579 }
2580 }
2581 break;
2582 }
2583 break;
2584 }
2585 return res;
2586 }
2587
2588 void
sen_ql_bind_symbol(sen_db_store * dbs,sen_obj * symbol)2589 sen_ql_bind_symbol(sen_db_store *dbs, sen_obj *symbol)
2590 {
2591 symbol->type = dbs->type;
2592 symbol->flags |= SEN_OBJ_NATIVE;
2593 symbol->u.o.self = dbs->id;
2594 switch (symbol->type) {
2595 case sen_db_class :
2596 symbol->u.o.func = nf_class;
2597 symbol->class = 0;
2598 break;
2599 case sen_db_obj_slot :
2600 symbol->u.o.func = nf_slot;
2601 symbol->class = dbs->u.o.class;
2602 break;
2603 case sen_db_ra_slot :
2604 symbol->u.o.func = nf_slot;
2605 symbol->class = dbs->u.f.class;
2606 break;
2607 case sen_db_ja_slot :
2608 symbol->u.o.func = nf_slot;
2609 symbol->class = dbs->u.v.class;
2610 break;
2611 case sen_db_idx_slot :
2612 symbol->u.o.func = nf_slot;
2613 symbol->class = dbs->u.i.class;
2614 break;
2615 case sen_db_rel1 :
2616 symbol->u.o.func = nf_rel1;
2617 symbol->class = 0;
2618 break;
2619 default :
2620 symbol->u.o.func = nf_void;
2621 symbol->class = 0;
2622 break;
2623 }
2624 }
2625
2626 struct _symsnip_spec {
2627 sen_db_store *cls;
2628 int width;
2629 int max_results;
2630 sen_obj tags;
2631 };
2632
2633 void
sen_ql_symsnip_spec_close(sen_ctx * ctx,symsnip_spec * ss)2634 sen_ql_symsnip_spec_close(sen_ctx *ctx, symsnip_spec *ss)
2635 {
2636 if (!ss) { return ; }
2637 sen_ql_obj_unmark(ctx, &ss->tags);
2638 SEN_FREE(ss);
2639 }
2640
2641 static sen_obj *
nf_query(sen_ctx * ctx,sen_obj * args,sen_ql_co * co)2642 nf_query(sen_ctx *ctx, sen_obj *args, sen_ql_co *co)
2643 {
2644 /* args: (str1@bulk) (str2@bulk) .. */
2645 sen_rc rc;
2646 sen_obj *x;
2647 const char **strs;
2648 sen_query *q;
2649 unsigned int *str_lens;
2650 int nstrs, found = 0, score = 0;
2651 if (!PAIRP(args) || !BULKP(CAR(args))) { QLERR("invalid argument"); }
2652 for (x = args, nstrs = 0; PAIRP(x) && BULKP(CAR(x)); x = CDR(x)) { nstrs++; }
2653 if (!(strs = SEN_MALLOC(sizeof(intptr_t) * nstrs * 2))) {
2654 QLERR("malloc failed");
2655 }
2656 str_lens = (unsigned int *)&strs[nstrs];
2657 for (x = args, nstrs = 0; PAIRP(x) && BULKP(CAR(x)); x = CDR(x)) {
2658 strs[nstrs] = STRVALUE(CAR(x));
2659 str_lens[nstrs] = STRSIZE(CAR(x));
2660 nstrs++;
2661 }
2662 q = ctx->code->u.p.value;
2663 rc = sen_query_scan(q, strs, str_lens, nstrs, SEN_QUERY_SCAN_NORMALIZE, &found, &score);
2664 SEN_FREE(strs);
2665 if (rc) { QLERR("sen_query_scan failed"); }
2666 if (!found) { return F; }
2667 SEN_OBJ_NEW(ctx, x);
2668 SETINT(x, score);
2669 return x;
2670 }
2671
2672 static sen_obj *
nf_snippet(sen_ctx * ctx,sen_obj * args,sen_ql_co * co)2673 nf_snippet(sen_ctx *ctx, sen_obj *args, sen_ql_co *co)
2674 {
2675 /* args: (cond width@int max_results@int opentag1@bulk closetag1@bulk..)
2676 cond: (keyword@bulk..) or cond@query or cond@class */
2677
2678 sen_obj *res, *cur, *cond;
2679 sen_snip *s;
2680 unsigned int width = 100, max_results = 3;
2681 if (!PAIRP(args)) { QLERR("cond expected"); }
2682 POP(cond, args);
2683 if (PAIRP(args)) {
2684 POP(cur, args);
2685 if (sen_obj2int(ctx, cur)) { QLERR("snippet failed (width expected)"); }
2686 width = IVALUE(cur);
2687 }
2688 if (PAIRP(args)) {
2689 POP(cur, args);
2690 if (sen_obj2int(ctx, cur)) { QLERR("snipped failed (max_result expected)"); }
2691 max_results = IVALUE(cur);
2692 }
2693 switch (cond->type) {
2694 case sen_ql_list :
2695 {
2696 sen_obj *tags = args;
2697 /* FIXME: mapping */
2698 if (!(s = sen_snip_open(ctx->encoding, SEN_SNIP_NORMALIZE, width, max_results,
2699 NULL, 0, NULL, 0, (sen_snip_mapping *)-1))) {
2700 QLERR("sen_snip_open failed");
2701 }
2702 SEN_OBJ_NEW(ctx, res);
2703 snip_obj_bind(res, s);
2704 s->flags |= SEN_SNIP_COPY_TAG;
2705 while (PAIRP(cond)) {
2706 char *ot = NULL, *ct = NULL;
2707 uint32_t ot_l = 0, ct_l = 0;
2708 sen_obj *kw;
2709 POP(kw, cond);
2710 if (!BULKP(kw)) { QLERR("snippet failed (invalid kw)"); }
2711 if (!PAIRP(args)) { args = tags; }
2712 POP(cur, args);
2713 if (BULKP(cur)) {
2714 ot = STRVALUE(cur);
2715 ot_l = STRSIZE(cur);
2716 }
2717 POP(cur, args);
2718 if (BULKP(cur)) {
2719 ct = STRVALUE(cur);
2720 ct_l = STRSIZE(cur);
2721 }
2722 if ((sen_snip_add_cond(s, kw->u.b.value, kw->u.b.size, ot, ot_l, ct, ct_l))) {
2723 QLERR("sen_snip_add_cond failed");
2724 }
2725 }
2726 }
2727 break;
2728 case sen_ql_query :
2729 {
2730 sen_obj *x;
2731 sen_query *q;
2732 unsigned int n_tags = 0;
2733 const char **opentags, **closetags;
2734 unsigned int *opentag_lens, *closetag_lens;
2735 q = cond->u.p.value;
2736 for (x = args; PAIRP(x); x = CDR(x)) { n_tags++; }
2737 if (!n_tags) { n_tags++; }
2738 if (!(opentags = SEN_MALLOC((sizeof(char *) + sizeof(unsigned int)) * 2 * n_tags))) {
2739 QLERR("malloc failed");
2740 }
2741 closetags = &opentags[n_tags];
2742 opentag_lens = (unsigned int *)&closetags[n_tags];
2743 closetag_lens = &opentag_lens[n_tags];
2744 n_tags = 0;
2745 for (x = args; PAIRP(x); x = CDR(x)) {
2746 if (BULKP(CAR(x))) {
2747 opentags[n_tags] = STRVALUE(CAR(x));
2748 opentag_lens[n_tags] = STRSIZE(CAR(x));
2749 if (PAIRP(CDR(x))) {
2750 x = CDR(x);
2751 if (BULKP(CAR(x))) {
2752 closetags[n_tags] = STRVALUE(CAR(x));
2753 closetag_lens[n_tags] = STRSIZE(CAR(x));
2754 n_tags++;
2755 }
2756 }
2757 }
2758 }
2759 if (!n_tags) {
2760 n_tags++;
2761 opentags[0] = NULL;
2762 closetags[0] = NULL;
2763 opentag_lens[0] = 0;
2764 closetag_lens[0] = 0;
2765 }
2766 s = sen_query_snip(q, SEN_SNIP_NORMALIZE|SEN_SNIP_COPY_TAG, width, max_results, n_tags,
2767 opentags, opentag_lens, closetags, closetag_lens,
2768 (sen_snip_mapping *)-1);
2769 SEN_FREE(opentags);
2770 if (!s) { QLERR("sen_query_snip failed"); }
2771 SEN_OBJ_NEW(ctx, res);
2772 snip_obj_bind(res, s);
2773 }
2774 break;
2775 case sen_db_class :
2776 {
2777 symsnip_spec *spec;
2778 sen_db_store *cls = sen_db_store_by_id(ctx->db, cond->u.o.self);
2779 if (!cls) { QLERR("cls get failed."); }
2780 SEN_OBJ_NEW(ctx, res);
2781 if (!(spec = SEN_MALLOC(sizeof(symsnip_spec)))) {
2782 QLERR("symsnip_spec malloc failed");
2783 }
2784 res->type = sen_ql_symsnip;
2785 res->flags = SEN_OBJ_NATIVE|SEN_OBJ_ALLOCATED;
2786 res->u.p.value = spec;
2787 res->u.p.func = nf_snip;
2788 spec->cls = cls;
2789 spec->width = width;
2790 spec->max_results = max_results;
2791 spec->tags.type = sen_ql_list;
2792 spec->tags.flags = SEN_OBJ_REFERER;
2793 POP(cur, args);
2794 spec->tags.u.l.car = ses_prepare(ctx, cond->u.o.self, cur, NULL);
2795 POP(cur, args);
2796 spec->tags.u.l.cdr = ses_prepare(ctx, cond->u.o.self, cur, NULL);
2797 sen_ql_obj_mark(ctx, &spec->tags);
2798 }
2799 break;
2800 default :
2801 QLERR("snippet failed. cond or query expected");
2802 break;
2803 }
2804 return res;
2805 }
2806
2807 static sen_obj *
nf_snip(sen_ctx * ctx,sen_obj * args,sen_ql_co * co)2808 nf_snip(sen_ctx *ctx, sen_obj *args, sen_ql_co *co)
2809 {
2810 /* args: (str@bulk) */
2811 if (!PAIRP(args) || !BULKP(CAR(args))) { QLERR("invalid argument"); }
2812 switch (ctx->code->type) {
2813 case sen_ql_snip :
2814 {
2815 sen_rbuf buf;
2816 unsigned int i, len, max_len, nresults;
2817 sen_snip *s = PVALUE(ctx->code, sen_snip);
2818 sen_obj *v, *str = CAR(args), *spc = PAIRP(CDR(args)) ? CADR(args) : NIL;
2819 if ((sen_snip_exec(s, str->u.b.value, str->u.b.size, &nresults, &max_len))) {
2820 QLERR("sen_snip_exec failed");
2821 }
2822 if (sen_rbuf_init(&buf, max_len)) { QLERR("sen_rbuf_init failed"); }
2823 if (nresults) {
2824 for (i = 0; i < nresults; i++) {
2825 if (i && spc != NIL) { sen_obj_inspect(ctx, spc, &buf, 0); }
2826 if (sen_rbuf_reserve(&buf, max_len)) {
2827 sen_rbuf_fin(&buf);
2828 QLERR("sen_rbuf_space failed");
2829 }
2830 if ((sen_snip_get_result(s, i, buf.curr, &len))) {
2831 sen_rbuf_fin(&buf);
2832 QLERR("sen_snip_get_result failed");
2833 }
2834 buf.curr += len;
2835 }
2836 } else {
2837 char *ss = str->u.b.value, *se = str->u.b.value + str->u.b.size;
2838 if (sen_substring(&ss, &se, 0, s->width, ctx->encoding)) {
2839 QLERR("sen_substring failed");
2840 }
2841 sen_rbuf_write(&buf, ss, se - ss);
2842 }
2843 SEN_RBUF2OBJ(ctx, &buf, v);
2844 return v;
2845 }
2846 break;
2847 case sen_ql_symsnip :
2848 {
2849 sen_rbuf buf;
2850 symsnip_spec *spec = PVALUE(ctx->code, symsnip_spec);
2851 off_t off = 0;
2852 const char *rest;
2853 sen_sym_scan_hit sh[1024];
2854 sen_obj *v, *str = CAR(args);
2855 char *string = STRVALUE(str);
2856 size_t len = STRSIZE(str);
2857 if (sen_rbuf_init(&buf, len)) { QLERR("sen_rbuf_init failed."); }
2858 while (off < len) {
2859 sen_db_store *cls = spec->cls;
2860 int i, nhits = sen_sym_scan(cls->u.c.keys, string + off, len - off, sh, 1024, &rest);
2861 for (i = 0, off = 0; i < nhits; i++) {
2862 if (sh[i].offset < off) { continue; } /* skip overlapping region. */
2863 sen_rbuf_write(&buf, string + off, sh[i].offset - off);
2864 obj_obj_bind(&ctx->curobj, cls->id, sh[i].id);
2865 v = ses_exec(ctx, spec->tags.u.l.car, NULL, &spec->tags);
2866 sen_obj_inspect(ctx, v, &buf, 0);
2867 sen_rbuf_write(&buf, string + sh[i].offset, sh[i].length);
2868 obj_obj_bind(&ctx->curobj, cls->id, sh[i].id);
2869 v = ses_exec(ctx, spec->tags.u.l.cdr, NULL, &spec->tags);
2870 sen_obj_inspect(ctx, v, &buf, 0);
2871 off = sh[i].offset + sh[i].length;
2872 }
2873 if (string + off < rest) {
2874 sen_rbuf_write(&buf, string + off, rest - (string + off));
2875 }
2876 off = rest - string;
2877 }
2878 SEN_RBUF2OBJ(ctx, &buf, v);
2879 return v;
2880 }
2881 break;
2882 default :
2883 QLERR("snip failed. invalid expr");
2884 }
2885 }
2886
2887 static sen_obj *
nf_db(sen_ctx * ctx,sen_obj * args,sen_ql_co * co)2888 nf_db(sen_ctx *ctx, sen_obj *args, sen_ql_co *co)
2889 {
2890 char *msg;
2891 sen_db_store *cls;
2892 sen_obj *car, *res = ctx->code;
2893 POP(car, args);
2894 if (!(msg = str_value(ctx, car))) { return res; }
2895 if (*msg == ':') {
2896 switch (msg[1]) {
2897 case 'c' : /* :clearlock */
2898 case 'C' :
2899 {
2900 sen_id id;
2901 sen_db_store *store;
2902 for (id = sen_sym_curr_id(ctx->db->keys); id; id--) {
2903 if (strchr(_sen_sym_key(ctx->db->keys, id), '.')) { continue; }
2904 if ((store = sen_db_store_by_id(ctx->db, id))) {
2905 if (store->type == sen_db_class) {
2906 sen_sym_clear_lock(store->u.c.keys);
2907 }
2908 }
2909 }
2910 res = *ctx->db->keys->lock ? T : F;
2911 sen_db_clear_lock(ctx->db);
2912 }
2913 break;
2914 case 'd' : /* :drop */
2915 case 'D' :
2916 {
2917 const char *name, *slotname;
2918 sen_set *slots;
2919 char buf[SEN_SYM_MAX_KEY_SIZE];
2920 POP(car, args);
2921 if (!(name = str_value(ctx, car))) { QLERR("Invalid argument"); }
2922 if (!(cls = sen_db_store_open(ctx->db, name)) || cls->type != sen_db_class) {
2923 QLERR("Invalid class %s", name);
2924 }
2925 if (sen_db_class_slotpath(ctx->db, cls->id, "", buf)) {
2926 QLERR("class open failed %s", name);
2927 }
2928 if ((slots = sen_sym_prefix_search(ctx->db->keys, buf))) {
2929 sen_id *sid;
2930 SEN_SET_EACH(slots, eh, &sid, NULL, {
2931 if ((slotname = _sen_sym_key(ctx->db->keys, *sid))) {
2932 sen_db_store_remove(ctx->db, slotname);
2933 }
2934 });
2935 sen_set_close(slots);
2936 }
2937 sen_db_store_remove(ctx->db, name);
2938 }
2939 break;
2940 case 'p' : /* :prefix-search */
2941 case 'P' :
2942 {
2943 char *name;
2944 POP(car, args);
2945 if (!(name = str_value(ctx, car))) { return F; }
2946 if ((res = rec_obj_new(ctx, NULL, sen_rec_document, sen_rec_none, 0)) == F) {
2947 return F;
2948 }
2949 sen_sym_prefix_search_with_set(ctx->db->keys, name, RVALUE(res));
2950 {
2951 sen_id *rid;
2952 SEN_SET_EACH(RVALUE(res), eh, &rid, NULL, {
2953 const char *key = _sen_sym_key(ctx->db->keys, *rid);
2954 if (key && strchr(key, '.')) { sen_set_del(RVALUE(res), eh); }
2955 });
2956 }
2957 }
2958 break;
2959 case 't' : /* :typedef */
2960 case 'T' :
2961 {
2962 char *name;
2963 sen_obj *cdr;
2964 sen_db_store_spec spec;
2965 spec.type = sen_db_class;
2966 spec.u.c.size = 0;
2967 spec.u.c.flags = SEN_INDEX_NORMALIZE|SEN_INDEX_SHARED_LEXICON;
2968 spec.u.c.encoding = ctx->encoding;
2969 spec.type = sen_db_raw_class;
2970 POP(car, args);
2971 if (!(name = str_value(ctx, car))) { return F; }
2972 if (sen_db_store_open(ctx->db, name)) { return T; /* already exists */ }
2973 for (cdr = args; PAIRP(cdr); cdr = CDR(cdr)) {
2974 if (!sen_obj2int(ctx, CAR(cdr))) { spec.u.c.size = CAR(cdr)->u.i.i; }
2975 }
2976 if (!spec.u.c.size) { return F; } /* size must be assigned */
2977 if (!(cls = sen_db_store_create(ctx->db, name, &spec))) { return F; }
2978 if ((res = INTERN(name)) != F) {
2979 sen_ql_bind_symbol(cls, res);
2980 }
2981 }
2982 break;
2983 case '+' : /* :+ (iterator next) */
2984 {
2985 POP(res, args);
2986 if (res->type == sen_db_raw_class ||
2987 res->type == sen_db_class ||
2988 res->type == sen_db_obj_slot ||
2989 res->type == sen_db_ra_slot ||
2990 res->type == sen_db_ja_slot ||
2991 res->type == sen_db_idx_slot ||
2992 res->type == sen_db_vslot ||
2993 res->type == sen_db_pslot ||
2994 res->type == sen_db_rel1 ||
2995 res->type == sen_db_rel2) {
2996 const char *key;
2997 sen_id id = res->u.o.self;
2998 while ((id = sen_sym_next(ctx->db->keys, id))) {
2999 key = _sen_sym_key(ctx->db->keys, id);
3000 if (key) { break; }
3001 }
3002 if (id == SEN_SYM_NIL) {
3003 res = F;
3004 } else {
3005 res = INTERN(key);
3006 }
3007 } else {
3008 res = F;
3009 }
3010 }
3011 break;
3012 case '\0' : /* : (iterator begin) */
3013 {
3014 const char *key;
3015 sen_id id = SEN_SYM_NIL;
3016 while ((id = sen_sym_next(ctx->db->keys, id))) {
3017 key = _sen_sym_key(ctx->db->keys, id);
3018 if (key) { break; }
3019 }
3020 if (id == SEN_SYM_NIL) {
3021 res = F;
3022 } else {
3023 res = INTERN(key);
3024 }
3025 }
3026 break;
3027 }
3028 }
3029 return res;
3030 }
3031
3032 static sen_obj *
nf_table(sen_ctx * ctx,sen_obj * args,sen_ql_co * co)3033 nf_table(sen_ctx *ctx, sen_obj *args, sen_ql_co *co)
3034 {
3035 char *opt;
3036 sen_db_store *cls;
3037 sen_obj *car, *res = F;
3038 sen_db_store_spec spec;
3039 spec.type = sen_db_class;
3040 spec.u.c.size = 0;
3041 spec.u.c.flags = SEN_INDEX_SHARED_LEXICON;
3042 spec.u.c.encoding = ctx->encoding;
3043 while (PAIRP(args)) {
3044 POP(car, args);
3045 switch (car->type) {
3046 case sen_db_raw_class :
3047 if (!(cls = sen_db_store_by_id(ctx->db, car->u.o.self))) { return F; }
3048 if ((spec.u.c.size = cls->u.bc.element_size) == SEN_SYM_MAX_KEY_SIZE) {
3049 spec.u.c.size = 0;
3050 }
3051 if (spec.u.c.size > SEN_SYM_MAX_KEY_SIZE) { return F; }
3052 break;
3053 case sen_db_class :
3054 if (!(cls = sen_db_store_by_id(ctx->db, car->u.o.self))) { return F; }
3055 /* todo : support subrecs */
3056 res = rec_obj_new(ctx, cls, sen_rec_document, sen_rec_none, 0);
3057 if (ERRP(ctx, SEN_WARN)) { return F; }
3058 break;
3059 default :
3060 if ((opt = str_value(ctx, car))) {
3061 switch (*opt) {
3062 case 'd' :
3063 case 'D' :
3064 switch (opt[2]) {
3065 case 'l' : /* delimited */
3066 case 'L' :
3067 spec.u.c.flags |= SEN_INDEX_DELIMITED;
3068 break;
3069 case 'f' : /* default */
3070 case 'F' :
3071 spec.u.c.encoding = sen_enc_default;
3072 break;
3073 }
3074 break;
3075 case 'e' : /* euc-jp */
3076 case 'E' :
3077 spec.u.c.encoding = sen_enc_euc_jp;
3078 break;
3079 case 'k' : /* koi8r */
3080 case 'K' :
3081 spec.u.c.encoding = sen_enc_koi8r;
3082 break;
3083 case 'l' : /* latin1 */
3084 case 'L' :
3085 spec.u.c.encoding = sen_enc_latin1;
3086 break;
3087 case 'n' :
3088 case 'N' :
3089 switch (opt[1]) {
3090 case 'g' : /* ngram */
3091 case 'G' :
3092 spec.u.c.flags |= SEN_INDEX_NGRAM;
3093 break;
3094 case 'o' : /* normalize */
3095 case 'O' :
3096 spec.u.c.flags |= SEN_INDEX_NORMALIZE;
3097 break;
3098 default :
3099 QLERR("ambiguous option %s", opt);
3100 }
3101 break;
3102 case 's' :
3103 case 'S' :
3104 switch (opt[1]) {
3105 case 'j' : /* shift-jis */
3106 case 'J' :
3107 spec.u.c.encoding = sen_enc_sjis;
3108 break;
3109 case 'i' : /* with-sis */
3110 case 'I' :
3111 spec.u.c.flags |= SEN_SYM_WITH_SIS;
3112 break;
3113 case 'u' : /* surrogate-key */
3114 case 'U' :
3115 spec.type = sen_db_rel1;
3116 spec.u.s.class = 0;
3117 spec.u.s.size = 1;
3118 break;
3119 default :
3120 QLERR("ambiguous option %s", opt);
3121 }
3122 break;
3123 case 'u' : /* utf8 */
3124 case 'U' :
3125 spec.u.c.encoding = sen_enc_utf8;
3126 break;
3127 case 'v' : /* view */
3128 case 'V' :
3129 /* todo */
3130 break;
3131 default : /* numeric */
3132 if (sen_obj2int(ctx, car)) {
3133 /* todo : illegal option */
3134 } else {
3135 spec.u.c.size = car->u.i.i;
3136 }
3137 break;
3138 }
3139 } else {
3140 /* todo : invalid arg */
3141 }
3142 }
3143 }
3144 /* todo : support anonymous class */
3145 return res;
3146 }
3147
3148 static sen_obj *
nf_ptable(sen_ctx * ctx,sen_obj * args,sen_ql_co * co)3149 nf_ptable(sen_ctx *ctx, sen_obj *args, sen_ql_co *co)
3150 {
3151 sen_obj *car;
3152 char *name, *opt;
3153 sen_db_store_spec spec;
3154 spec.type = sen_db_class;
3155 spec.u.c.size = 0;
3156 spec.u.c.flags = SEN_INDEX_SHARED_LEXICON;
3157 spec.u.c.encoding = ctx->encoding;
3158 POP(car, args);
3159 if (!(name = str_value(ctx, car))) { return F; }
3160 if (sen_db_store_open(ctx->db, name)) { return T; }
3161 while (PAIRP(args)) {
3162 POP(car, args);
3163 switch (car->type) {
3164 case sen_db_raw_class :
3165 {
3166 sen_db_store *cls = sen_db_store_by_id(ctx->db, car->u.o.self);
3167 if (!cls) { return F; }
3168 if ((spec.u.c.size = cls->u.bc.element_size) == SEN_SYM_MAX_KEY_SIZE) {
3169 spec.u.c.size = 0;
3170 }
3171 if (spec.u.c.size > SEN_SYM_MAX_KEY_SIZE) { return F; }
3172 }
3173 break;
3174 case sen_db_class :
3175 spec.type = sen_db_rel1;
3176 spec.u.s.class = car->u.o.self;
3177 spec.u.s.size = 1;
3178 break;
3179 default :
3180 if ((opt = str_value(ctx, car))) {
3181 switch (*opt) {
3182 case 'd' :
3183 case 'D' :
3184 switch (opt[2]) {
3185 case 'l' : /* delimited */
3186 case 'L' :
3187 spec.u.c.flags |= SEN_INDEX_DELIMITED;
3188 break;
3189 case 'f' : /* default */
3190 case 'F' :
3191 spec.u.c.encoding = sen_enc_default;
3192 break;
3193 }
3194 break;
3195 case 'e' : /* euc-jp */
3196 case 'E' :
3197 spec.u.c.encoding = sen_enc_euc_jp;
3198 break;
3199 case 'k' : /* koi8r */
3200 case 'K' :
3201 spec.u.c.encoding = sen_enc_koi8r;
3202 break;
3203 case 'l' : /* latin1 */
3204 case 'L' :
3205 spec.u.c.encoding = sen_enc_latin1;
3206 break;
3207 case 'n' :
3208 case 'N' :
3209 switch (opt[1]) {
3210 case 'g' : /* ngram */
3211 case 'G' :
3212 spec.u.c.flags |= SEN_INDEX_NGRAM;
3213 break;
3214 case 'o' : /* normalize */
3215 case 'O' :
3216 spec.u.c.flags |= SEN_INDEX_NORMALIZE;
3217 break;
3218 default :
3219 QLERR("ambiguous option %s", opt);
3220 }
3221 break;
3222 case 's' :
3223 case 'S' :
3224 switch (opt[1]) {
3225 case 'j' : /* shift-jis */
3226 case 'J' :
3227 spec.u.c.encoding = sen_enc_sjis;
3228 break;
3229 case 'i' : /* with-sis */
3230 case 'I' :
3231 spec.u.c.flags |= SEN_SYM_WITH_SIS;
3232 break;
3233 case 'u' : /* surrogate-key */
3234 case 'U' :
3235 spec.type = sen_db_rel1;
3236 spec.u.s.class = 0;
3237 spec.u.s.size = 1;
3238 break;
3239 default :
3240 QLERR("ambiguous option %s", opt);
3241 }
3242 break;
3243 case 'u' : /* utf8 */
3244 case 'U' :
3245 spec.u.c.encoding = sen_enc_utf8;
3246 break;
3247 case 'v' : /* view */
3248 case 'V' :
3249 /* todo */
3250 break;
3251 default : /* numeric */
3252 if (sen_obj2int(ctx, car)) {
3253 QLERR("illegal option");
3254 } else {
3255 spec.u.c.size = car->u.i.i;
3256 }
3257 break;
3258 }
3259 } else {
3260 QLERR("invalid arg");
3261 }
3262 }
3263 }
3264 {
3265 sen_obj *res;
3266 sen_db_store *cls;
3267 if (!(cls = sen_db_store_create(ctx->db, name, &spec))) { return F; }
3268 if ((res = INTERN(name)) != F) {
3269 sen_ql_bind_symbol(cls, res);
3270 }
3271 return res;
3272 }
3273 }
3274
3275 const char *
_sen_obj_key(sen_ctx * ctx,sen_obj * obj)3276 _sen_obj_key(sen_ctx *ctx, sen_obj *obj)
3277 {
3278 sen_db_store *cls;
3279 switch (obj->type) {
3280 case sen_ql_object :
3281 if (obj->class) {
3282 if (!(cls = sen_db_store_by_id(ctx->db, obj->class))) { return NULL; }
3283 switch (cls->type) {
3284 case sen_db_class :
3285 return _sen_sym_key(cls->u.c.keys, obj->u.o.self);
3286 case sen_db_rel1 :
3287 {
3288 /* todo : return key value when cls->u.f.class exists */
3289 sen_obj *p = int2strobj(ctx, obj->u.o.self);
3290 return p ? p->u.b.value : NULL;
3291 }
3292 default :
3293 return NULL;
3294 }
3295 } else {
3296 return _sen_sym_key(ctx->db->keys, obj->u.o.self);
3297 }
3298 case sen_db_raw_class :
3299 case sen_db_class :
3300 case sen_db_obj_slot :
3301 case sen_db_ra_slot :
3302 case sen_db_ja_slot :
3303 case sen_db_idx_slot :
3304 return _sen_sym_key(ctx->db->keys, obj->u.o.self);
3305 default :
3306 return NULL;
3307 }
3308 }
3309
3310 static void disp_j(sen_ctx *ctx, sen_obj *obj, sen_rbuf *buf);
3311
3312 static void
disp_j_with_format(sen_ctx * ctx,sen_obj * args,sen_rbuf * buf)3313 disp_j_with_format(sen_ctx *ctx, sen_obj *args, sen_rbuf *buf)
3314 {
3315 sen_obj *car;
3316 POP(car, args);
3317 switch (car->type) {
3318 case sen_db_class :
3319 {
3320 sen_sym *sym;
3321 sen_obj *slots, *s, **d, *se, *v;
3322 int i, o, hashp = 0, offset = 0, limit = 10;
3323 sen_id id = SEN_SYM_NIL, base = car->u.o.self;
3324 {
3325 sen_db_store *cls = sen_db_store_by_id(ctx->db, base);
3326 if (!cls) { return; }
3327 sym = cls->u.c.keys;
3328 }
3329 POP(slots, args);
3330 if (!PAIRP(slots)) {
3331 disp_j(ctx, car, buf);
3332 if (ERRP(ctx, SEN_WARN)) { return; }
3333 return;
3334 }
3335 if (CAR(slots) == INTERN("@")) {
3336 hashp = 1;
3337 slots = CDR(slots);
3338 }
3339 for (s = slots, d = &slots, o = 0; PAIRP(s); s = CDR(s), d = &CDR(*d), o = 1 - o) {
3340 if (hashp && !o) {
3341 se = CAR(s);
3342 } else {
3343 se = ses_prepare(ctx, base, CAR(s), NULL);
3344 /* se = slotexp_prepare(ctx, base, CAR(s), r); */
3345 if (ERRP(ctx, SEN_WARN)) { return; }
3346 }
3347 *d = CONS(se, NIL);
3348 }
3349 POP(car, args);
3350 if (!sen_obj2int(ctx, car)) { offset = car->u.i.i; }
3351 POP(car, args);
3352 if (!sen_obj2int(ctx, car)) { limit = car->u.i.i; }
3353 if (limit <= 0) { limit += sen_sym_size(sym); }
3354 for (i = 0; i < offset; i++) {
3355 if (!(id = sen_sym_next(sym, id))) { break; }
3356 }
3357 SEN_RBUF_PUTC(buf, '[');
3358 for (i = 0; i < limit; i++) {
3359 if (!(id = sen_sym_next(sym, id))) { break; }
3360 if (i) { SEN_RBUF_PUTS(buf, ", "); }
3361 SEN_RBUF_PUTC(buf, hashp ? '{' : '[');
3362 for (s = slots, o = 0;; o = 1 - o) {
3363 POP(se, s);
3364 if (hashp && !o) {
3365 v = se;
3366 disp_j(ctx, v, buf);
3367 } else {
3368 obj_obj_bind(&ctx->curobj, base, id);
3369 v = ses_exec(ctx, se, NULL, slots);
3370 /* v = slotexp_exec(ctx, se, &obj, ri); */
3371 disp_j(ctx, v, buf);
3372 ses_clear(ctx);
3373 }
3374 if (ERRP(ctx, SEN_WARN)) { return; }
3375 if (!PAIRP(s)) { break; }
3376 SEN_RBUF_PUTS(buf, (hashp && !o) ? ": " : ", ");
3377 }
3378 SEN_RBUF_PUTC(buf, hashp ? '}' : ']');
3379 }
3380 SEN_RBUF_PUTC(buf, ']');
3381 }
3382 break;
3383 case sen_ql_records :
3384 {
3385 sen_id *rp, base;
3386 sen_rset_recinfo *ri;
3387 sen_obj *slots, *s, **d, *se, *v;
3388 const sen_recordh *rh;
3389 int i, o, hashp = 0, offset = 0, limit = 10;
3390 sen_records *r = RVALUE(car);
3391 base = car->class;
3392 POP(slots, args);
3393 if (!PAIRP(slots)) {
3394 disp_j(ctx, car, buf);
3395 if (ERRP(ctx, SEN_WARN)) { return; }
3396 return;
3397 }
3398 if (CAR(slots) == INTERN("@")) {
3399 hashp = 1;
3400 slots = CDR(slots);
3401 }
3402 for (s = slots, d = &slots, o = 0; PAIRP(s); s = CDR(s), d = &CDR(*d), o = 1 - o) {
3403 if (hashp && !o) {
3404 se = CAR(s);
3405 } else {
3406 se = ses_prepare(ctx, base, CAR(s), r);
3407 /* se = slotexp_prepare(ctx, base, CAR(s), r); */
3408 if (ERRP(ctx, SEN_WARN)) { return; }
3409 }
3410 *d = CONS(se, NIL);
3411 }
3412 POP(car, args);
3413 if (!sen_obj2int(ctx, car)) { offset = car->u.i.i; }
3414 POP(car, args);
3415 if (!sen_obj2int(ctx, car)) { limit = car->u.i.i; }
3416 if (limit <= 0) { limit += r->n_entries; }
3417 sen_records_rewind(r);
3418 for (i = 0; i < offset; i++) {
3419 if (!sen_records_next(r, NULL, 0, NULL)) { break; }
3420 }
3421 SEN_RBUF_PUTC(buf, '[');
3422 for (i = 0; i < limit; i++) {
3423 if (!sen_records_next(r, NULL, 0, NULL) ||
3424 !(rh = sen_records_curr_rec(r)) ||
3425 sen_set_element_info(r, rh, (void **)&rp, (void **)&ri)) {
3426 break;
3427 }
3428 if (i) { SEN_RBUF_PUTS(buf, ", "); }
3429 SEN_RBUF_PUTC(buf, hashp ? '{' : '[');
3430 for (s = slots, o = 0;; o = 1 - o) {
3431 POP(se, s);
3432 if (hashp && !o) {
3433 v = se;
3434 disp_j(ctx, v, buf);
3435 } else {
3436 obj_obj_bind(&ctx->curobj, base, *rp);
3437 v = ses_exec(ctx, se, ri, slots);
3438 /* v = slotexp_exec(ctx, se, &obj, ri); */
3439 disp_j(ctx, v, buf);
3440 ses_clear(ctx);
3441 }
3442 if (ERRP(ctx, SEN_WARN)) { return; }
3443 if (!PAIRP(s)) { break; }
3444 SEN_RBUF_PUTS(buf, (hashp && !o) ? ": " : ", ");
3445 }
3446 SEN_RBUF_PUTC(buf, hashp ? '}' : ']');
3447 }
3448 SEN_RBUF_PUTC(buf, ']');
3449 }
3450 break;
3451 case sen_ql_object :
3452 {
3453 sen_id id = car->u.o.self, base = car->class;
3454 int o, hashp = 0;
3455 sen_obj *slots, *v;
3456 POP(slots, args);
3457 if (!PAIRP(slots)) {
3458 disp_j(ctx, car, buf);
3459 return;
3460 }
3461 if (CAR(slots) == INTERN("@")) {
3462 hashp = 1;
3463 slots = CDR(slots);
3464 if (!PAIRP(slots)) {
3465 disp_j(ctx, car, buf);
3466 return;
3467 }
3468 }
3469 SEN_RBUF_PUTC(buf, hashp ? '{' : '[');
3470 for (o = 0; ; o = 1 - o) {
3471 if (hashp && !o) {
3472 v = CAR(slots);
3473 disp_j(ctx, v, buf);
3474 } else {
3475 sen_obj *se;
3476 se = ses_prepare(ctx, base, CAR(slots), NULL);
3477 /* se = slotexp_prepare(ctx, base, CAR(slots), NULL); */
3478 if (ERRP(ctx, SEN_WARN)) { return; }
3479 obj_obj_bind(&ctx->curobj, base, id);
3480 v = ses_exec(ctx, se, NULL, se);
3481 /* v = slotexp_exec(ctx, se, &obj, NULL); */
3482 disp_j(ctx, v, buf);
3483 ses_clear(ctx);
3484 }
3485 if (ERRP(ctx, SEN_WARN)) { return; }
3486 slots = CDR(slots);
3487 if (!PAIRP(slots)) { break; }
3488 SEN_RBUF_PUTS(buf, (hashp && !o) ? ": " : ", ");
3489 }
3490 SEN_RBUF_PUTC(buf, hashp ? '}' : ']');
3491 }
3492 break;
3493 default :
3494 disp_j(ctx, car, buf);
3495 if (ERRP(ctx, SEN_WARN)) { return; }
3496 break;
3497 }
3498 }
3499
3500 static void
disp_j(sen_ctx * ctx,sen_obj * obj,sen_rbuf * buf)3501 disp_j(sen_ctx *ctx, sen_obj *obj, sen_rbuf *buf)
3502 {
3503 if (!obj || obj == NIL) {
3504 SEN_RBUF_PUTS(buf, "[]");
3505 } else if (obj == T) {
3506 SEN_RBUF_PUTS(buf, "true");
3507 } else if (obj == F) {
3508 SEN_RBUF_PUTS(buf, "false");
3509 } else {
3510 switch (obj->type) {
3511 case sen_ql_void :
3512 if (SYMBOLP(obj) && obj != INTERN("null")) {
3513 const char *r = SEN_SET_STRKEY_BY_VAL(obj);
3514 sen_rbuf_str_esc(buf, (*r == ':') ? r + 1 : r, -1, ctx->encoding);
3515 } else {
3516 SEN_RBUF_PUTS(buf, "null");
3517 }
3518 break;
3519 case sen_ql_records :
3520 {
3521 int i;
3522 sen_id *rp;
3523 sen_rset_recinfo *ri;
3524 sen_obj o;
3525 const sen_recordh *rh;
3526 sen_records *r = RVALUE(obj);
3527 sen_records_rewind(r);
3528 obj_obj_bind(&o, obj->class, 0);
3529 SEN_RBUF_PUTC(buf, '[');
3530 for (i = 0;; i++) {
3531 if (!sen_records_next(r, NULL, 0, NULL) ||
3532 !(rh = sen_records_curr_rec(r)) ||
3533 sen_set_element_info(r, rh, (void **)&rp, (void **)&ri)) {
3534 break;
3535 }
3536 if (i) { SEN_RBUF_PUTS(buf, ", "); }
3537 o.u.o.self = *rp;
3538 disp_j(ctx, &o, buf);
3539 if (ERRP(ctx, SEN_WARN)) { return; }
3540 }
3541 SEN_RBUF_PUTC(buf, ']');
3542 }
3543 break;
3544 case sen_ql_list :
3545 if (obj->u.l.car == INTERN(":")) {
3546 disp_j_with_format(ctx, obj->u.l.cdr, buf);
3547 if (ERRP(ctx, SEN_WARN)) { return; }
3548 } else if (obj->u.l.car == INTERN("@")) {
3549 int o;
3550 SEN_RBUF_PUTC(buf, '{');
3551 for (obj = obj->u.l.cdr, o = 0;; o = 1 - o) {
3552 if (PAIRP(obj)) {
3553 disp_j(ctx, obj->u.l.car, buf);
3554 if (ERRP(ctx, SEN_WARN)) { return; }
3555 }
3556 if ((obj = obj->u.l.cdr) && (obj != NIL)) {
3557 if (PAIRP(obj)) {
3558 SEN_RBUF_PUTS(buf, o ? ", " : ": ");
3559 } else {
3560 SEN_RBUF_PUTS(buf, " . ");
3561 disp_j(ctx, obj, buf);
3562 if (ERRP(ctx, SEN_WARN)) { return; }
3563 SEN_RBUF_PUTC(buf, '}');
3564 break;
3565 }
3566 } else {
3567 SEN_RBUF_PUTC(buf, '}');
3568 break;
3569 }
3570 }
3571 } else {
3572 SEN_RBUF_PUTC(buf, '[');
3573 for (;;) {
3574 disp_j(ctx, obj->u.l.car, buf);
3575 if (ERRP(ctx, SEN_WARN)) { return; }
3576 if ((obj = obj->u.l.cdr) && (obj != NIL)) {
3577 if (PAIRP(obj)) {
3578 SEN_RBUF_PUTS(buf, ", ");
3579 } else {
3580 SEN_RBUF_PUTS(buf, " . ");
3581 disp_j(ctx, obj, buf);
3582 if (ERRP(ctx, SEN_WARN)) { return; }
3583 SEN_RBUF_PUTC(buf, ']');
3584 break;
3585 }
3586 } else {
3587 SEN_RBUF_PUTC(buf, ']');
3588 break;
3589 }
3590 }
3591 }
3592 break;
3593 case sen_ql_object :
3594 {
3595 const char *key = _sen_obj_key(ctx, obj);
3596 if (key) {
3597 sen_rbuf_str_esc(buf, key, -1, ctx->encoding);
3598 } else {
3599 SEN_RBUF_PUTS(buf, "<LOSTKEY>");
3600 }
3601 }
3602 break;
3603 case sen_ql_time :
3604 {
3605 double dv= obj->u.tv.tv_sec;
3606 dv += obj->u.tv.tv_usec / 1000000.0;
3607 sen_rbuf_ftoa(buf, dv);
3608 }
3609 break;
3610 default :
3611 sen_obj_inspect(ctx, obj, buf, SEN_OBJ_INSPECT_ESC|SEN_OBJ_INSPECT_SYM_AS_STR);
3612 break;
3613 }
3614 }
3615 }
3616
3617 static void disp_t(sen_ctx *ctx, sen_obj *obj, sen_rbuf *buf, int *f);
3618
3619 static void
disp_t_with_format(sen_ctx * ctx,sen_obj * args,sen_rbuf * buf,int * f)3620 disp_t_with_format(sen_ctx *ctx, sen_obj *args, sen_rbuf *buf, int *f)
3621 {
3622 sen_obj *car;
3623 POP(car, args);
3624 switch (car->type) {
3625 case sen_db_class :
3626 {
3627 sen_sym *sym;
3628 sen_obj *slots, *s, **d, *se, *v;
3629 int i, o, hashp = 0, offset = 0, limit = 10;
3630 sen_id id = SEN_SYM_NIL, base = car->u.o.self;
3631 {
3632 sen_db_store *cls = sen_db_store_by_id(ctx->db, base);
3633 if (!cls) { return; }
3634 sym = cls->u.c.keys;
3635 }
3636 POP(slots, args);
3637 if (!PAIRP(slots)) {
3638 disp_t(ctx, car, buf, f);
3639 return;
3640 }
3641 if (CAR(slots) == INTERN("@")) {
3642 hashp = 1;
3643 slots = CDR(slots);
3644 }
3645 for (s = slots, d = &slots, o = 0; PAIRP(s); s = CDR(s), o = 1 - o) {
3646 if (hashp && !o) {
3647 if (s != slots) { SEN_RBUF_PUTC(buf, '\t'); *f = 1; }
3648 disp_t(ctx, CAR(s), buf, f);
3649 } else {
3650 se = ses_prepare(ctx, base, CAR(s), NULL);
3651 /* se = slotexp_prepare(ctx, base, CAR(s), r); */
3652 if (ERRP(ctx, SEN_WARN)) { return ; }
3653 *d = CONS(se, NIL);
3654 d = &CDR(*d);
3655 }
3656 }
3657 POP(car, args);
3658 if (!sen_obj2int(ctx, car)) { offset = car->u.i.i; }
3659 POP(car, args);
3660 if (!sen_obj2int(ctx, car)) { limit = car->u.i.i; }
3661 if (limit <= 0) { limit += sen_sym_size(sym); }
3662 for (i = 0; i < offset; i++) {
3663 if (!(id = sen_sym_next(sym, id))) { break; }
3664 }
3665 for (i = 0; i < limit; i++) {
3666 if (!(id = sen_sym_next(sym, id))) { break; }
3667 if (*f) { ctx->output(ctx, SEN_CTX_MORE, ctx->data.ptr); *f = 0; }
3668 for (s = slots;;) {
3669 POP(se, s);
3670 obj_obj_bind(&ctx->curobj, base, id);
3671 v = ses_exec(ctx, se, NULL, slots);
3672 /* v = slotexp_exec(ctx, t, &obj, ri); */
3673 disp_t(ctx, v, buf, f);
3674 ses_clear(ctx);
3675 *f = 1;
3676 if (!PAIRP(s)) { break; }
3677 SEN_RBUF_PUTC(buf, '\t');
3678 }
3679 }
3680 }
3681 break;
3682 case sen_ql_records :
3683 {
3684 sen_id *rp, base;
3685 sen_rset_recinfo *ri;
3686 sen_obj *slots, *s, **d, *se, *v;
3687 const sen_recordh *rh;
3688 int i, o, hashp = 0, offset = 0, limit = 10;
3689 sen_records *r = RVALUE(car);
3690 base = car->class;
3691 POP(slots, args);
3692 if (!PAIRP(slots)) {
3693 disp_t(ctx, car, buf, f);
3694 return;
3695 }
3696 if (CAR(slots) == INTERN("@")) {
3697 hashp = 1;
3698 slots = CDR(slots);
3699 }
3700 for (s = slots, d = &slots, o = 0; PAIRP(s); s = CDR(s), o = 1 - o) {
3701 if (hashp && !o) {
3702 if (s != slots) { SEN_RBUF_PUTC(buf, '\t'); *f = 1; }
3703 disp_t(ctx, CAR(s), buf, f);
3704 } else {
3705 se = ses_prepare(ctx, base, CAR(s), r);
3706 /* se = slotexp_prepare(ctx, base, CAR(s), r); */
3707 if (ERRP(ctx, SEN_WARN)) { return ; }
3708 *d = CONS(se, NIL);
3709 d = &CDR(*d);
3710 }
3711 }
3712 POP(car, args);
3713 if (!sen_obj2int(ctx, car)) { offset = car->u.i.i; }
3714 POP(car, args);
3715 if (!sen_obj2int(ctx, car)) { limit = car->u.i.i; }
3716 if (limit <= 0) { limit += r->n_entries; }
3717 sen_records_rewind(r);
3718 for (i = 0; i < offset; i++) {
3719 if (!sen_records_next(r, NULL, 0, NULL)) { break; }
3720 }
3721 for (i = 0; i < limit; i++) {
3722 if (!sen_records_next(r, NULL, 0, NULL) ||
3723 !(rh = sen_records_curr_rec(r)) ||
3724 sen_set_element_info(r, rh, (void **)&rp, (void **)&ri)) {
3725 break;
3726 }
3727 if (*f) { ctx->output(ctx, SEN_CTX_MORE, ctx->data.ptr); *f = 0; }
3728 for (s = slots;;) {
3729 POP(se, s);
3730 obj_obj_bind(&ctx->curobj, base, *rp);
3731 v = ses_exec(ctx, se, ri, slots);
3732 /* v = slotexp_exec(ctx, t, &obj, ri); */
3733 disp_t(ctx, v, buf, f);
3734 ses_clear(ctx);
3735 *f = 1;
3736 if (!PAIRP(s)) { break; }
3737 SEN_RBUF_PUTC(buf, '\t');
3738 }
3739 }
3740 }
3741 break;
3742 case sen_ql_object :
3743 {
3744 sen_id id = car->u.o.self, base = car->class;
3745 int o, hashp = 0;
3746 sen_obj *slots, *val, *v;
3747 POP(slots, args);
3748 if (!PAIRP(slots)) {
3749 disp_t(ctx, car, buf, f);
3750 return;
3751 }
3752 if (CAR(slots) == INTERN("@")) {
3753 hashp = 1;
3754 slots = CDR(slots);
3755 if (!PAIRP(slots)) {
3756 disp_t(ctx, car, buf, f);
3757 return;
3758 }
3759 if (*f) { ctx->output(ctx, SEN_CTX_MORE, ctx->data.ptr); *f = 0; }
3760 for (o = 0, val = slots; ; o = 1 - o) {
3761 if (!o) {
3762 if (val != slots) { SEN_RBUF_PUTC(buf, '\t'); *f = 1; }
3763 disp_t(ctx, CAR(val), buf, f);
3764 }
3765 val = CDR(val);
3766 if (!PAIRP(val)) { break; }
3767 }
3768 }
3769 for (o = 0, val = slots; ; o = 1 - o) {
3770 if (hashp && !o) {
3771 val = CDR(val);
3772 if (!PAIRP(val)) { break; }
3773 } else {
3774 sen_obj *se;
3775 se = ses_prepare(ctx, base, CAR(val), NULL);
3776 /* se = slotexp_prepare(ctx, base, CAR(val), NULL); */
3777 if (ERRP(ctx, SEN_WARN)) { return; }
3778 obj_obj_bind(&ctx->curobj, base, id);
3779 v = ses_exec(ctx, se, NULL, se);
3780 /* v = slotexp_exec(ctx, se, &obj, NULL); */
3781 disp_t(ctx, v, buf, f);
3782 ses_clear(ctx);
3783 val = CDR(val);
3784 if (!PAIRP(val)) { break; }
3785 if (val != slots) { SEN_RBUF_PUTC(buf, '\t'); *f = 1; }
3786 }
3787 }
3788 }
3789 break;
3790 default :
3791 disp_t(ctx, car, buf, f);
3792 break;
3793 }
3794 }
3795
3796 inline static void
rbuf_tsv_esc(sen_rbuf * buf,const char * s,int len,sen_encoding encoding)3797 rbuf_tsv_esc(sen_rbuf *buf, const char *s, int len, sen_encoding encoding)
3798 {
3799 const char *e;
3800 unsigned int l;
3801 for (e = s + len; s < e; s += l) {
3802 if (!(l = sen_str_charlen_nonnull(s, e, encoding))) { break; }
3803 if (l == 1) {
3804 switch (*s) {
3805 case '\t' :
3806 sen_rbuf_write(buf, "\\t", 2);
3807 break;
3808 case '\n' :
3809 sen_rbuf_write(buf, "\\n", 2);
3810 break;
3811 case '\r' :
3812 sen_rbuf_write(buf, "\\r", 2);
3813 break;
3814 case '\\' :
3815 sen_rbuf_write(buf, "\\\\", 2);
3816 break;
3817 default :
3818 SEN_RBUF_PUTC(buf, *s);
3819 }
3820 } else {
3821 sen_rbuf_write(buf, s, l);
3822 }
3823 }
3824 }
3825
3826 static void
disp_t(sen_ctx * ctx,sen_obj * obj,sen_rbuf * buf,int * f)3827 disp_t(sen_ctx *ctx, sen_obj *obj, sen_rbuf *buf, int *f)
3828 {
3829 if (!obj || obj == NIL) {
3830 SEN_RBUF_PUTS(buf, "()"); *f = 1;
3831 } else if (obj == T) {
3832 SEN_RBUF_PUTS(buf, "#t"); *f = 1;
3833 } else if (obj == F) {
3834 SEN_RBUF_PUTS(buf, "#f"); *f = 1;
3835 } else {
3836 switch (obj->type) {
3837 case sen_ql_records :
3838 {
3839 int i;
3840 sen_id *rp;
3841 sen_rset_recinfo *ri;
3842 sen_obj o;
3843 const sen_recordh *rh;
3844 sen_records *r = RVALUE(obj);
3845 sen_records_rewind(r);
3846 obj_obj_bind(&o, obj->class, 0);
3847 for (i = 0;; i++) {
3848 if (!sen_records_next(r, NULL, 0, NULL) ||
3849 !(rh = sen_records_curr_rec(r)) ||
3850 sen_set_element_info(r, rh, (void **)&rp, (void **)&ri)) {
3851 break;
3852 }
3853 o.u.o.self = *rp;
3854 if (*f) { ctx->output(ctx, SEN_CTX_MORE, ctx->data.ptr); *f = 0; }
3855 disp_t(ctx, &o, buf, f);
3856 }
3857 }
3858 break;
3859 case sen_ql_list :
3860 if (obj->u.l.car == INTERN(":")) {
3861 disp_t_with_format(ctx, obj->u.l.cdr, buf, f);
3862 } else if (obj->u.l.car == INTERN("@")) {
3863 int o0, o;
3864 sen_obj *val = obj->u.l.cdr;
3865 for (o0 = 0; o0 <= 1; o0++) {
3866 if (*f) { ctx->output(ctx, SEN_CTX_MORE, ctx->data.ptr); *f = 0; }
3867 for (obj = val, o = o0;; o = 1 - o) {
3868 if (!o) { disp_t(ctx, obj->u.l.car, buf, f); }
3869 if ((obj = obj->u.l.cdr) && (obj != NIL)) {
3870 if (PAIRP(obj)) {
3871 if (!o && PAIRP(CDR(obj))) { SEN_RBUF_PUTC(buf, '\t'); *f = 1; }
3872 } else {
3873 if (!o) {
3874 SEN_RBUF_PUTC(buf, '\t'); *f = 1; /* dot pair */
3875 disp_t(ctx, obj, buf, f);
3876 }
3877 break;
3878 }
3879 } else {
3880 break;
3881 }
3882 }
3883 }
3884 } else {
3885 for (;;) {
3886 disp_t(ctx, obj->u.l.car, buf, f);
3887 if ((obj = obj->u.l.cdr) && (obj != NIL)) {
3888 if (PAIRP(obj)) {
3889 SEN_RBUF_PUTC(buf, '\t'); *f = 1;
3890 } else {
3891 SEN_RBUF_PUTC(buf, '\t'); *f = 1; /* dot pair */
3892 disp_t(ctx, obj, buf, f);
3893 break;
3894 }
3895 } else {
3896 break;
3897 }
3898 }
3899 }
3900 break;
3901 case sen_ql_bulk :
3902 rbuf_tsv_esc(buf, obj->u.b.value, obj->u.b.size, ctx->encoding);
3903 break;
3904 case sen_ql_time :
3905 {
3906 double dv= obj->u.tv.tv_sec;
3907 dv += obj->u.tv.tv_usec / 1000000.0;
3908 sen_rbuf_ftoa(buf, dv);
3909 }
3910 break;
3911 default :
3912 sen_obj_inspect(ctx, obj, buf, 0); *f = 1;
3913 break;
3914 }
3915 }
3916 }
3917
3918 static sen_obj *
nf_disp(sen_ctx * ctx,sen_obj * args,sen_ql_co * co)3919 nf_disp(sen_ctx *ctx, sen_obj *args, sen_ql_co *co)
3920 {
3921 char *str;
3922 int f = 0;
3923 sen_obj *val, *fmt;
3924 POP(val, args);
3925 POP(fmt, args);
3926 if ((str = str_value(ctx, fmt))) {
3927 switch (str[0]) {
3928 case 'j' : /* json */
3929 case 'J' :
3930 disp_j(ctx, val, &ctx->outbuf);
3931 f = 1;
3932 if (ERRP(ctx, SEN_WARN)) { return F; }
3933 break;
3934 case 's' : /* sexp */
3935 case 'S' :
3936 break;
3937 case 't' : /* tsv */
3938 case 'T' :
3939 disp_t(ctx, val, &ctx->outbuf, &f);
3940 if (ERRP(ctx, SEN_WARN)) { return F; }
3941 break;
3942 case 'x' : /* xml */
3943 case 'X' :
3944 break;
3945 }
3946 } else {
3947 QLERR("Few arguments");
3948 }
3949 if (f) {
3950 ctx->output(ctx, SEN_CTX_MORE, ctx->data.ptr);
3951 if (ERRP(ctx, SEN_WARN)) { return F; }
3952 }
3953 return T;
3954 }
3955
3956 typedef struct {
3957 sen_encoding encoding;
3958 char *cur;
3959 char *str_end;
3960 } jctx;
3961
3962 inline static sen_obj *
mk_atom(sen_ctx * ctx,char * str,unsigned int len)3963 mk_atom(sen_ctx *ctx, char *str, unsigned int len)
3964 {
3965 const char *cur, *str_end = str + len;
3966 int64_t ivalue = sen_atoll(str, str_end, &cur);
3967 if (cur == str_end) {
3968 sen_obj *x;
3969 SEN_OBJ_NEW(ctx, x);
3970 SETINT(x, ivalue);
3971 return x;
3972 }
3973 switch (*str) {
3974 case 't' :
3975 if (len == 4 && !memcmp(str, "true", 4)) { return T; }
3976 break;
3977 case 'f' :
3978 if (len == 5 && !memcmp(str, "false", 5)) { return F; }
3979 break;
3980 /*
3981 case 'n' :
3982 if (len == 4 && !memcmp(str, "null", 4)) { return NIL; }
3983 break;
3984 */
3985 }
3986 if (0 < len && len < SEN_SYM_MAX_KEY_SIZE - 1) {
3987 char buf[SEN_SYM_MAX_KEY_SIZE];
3988 memcpy(buf, str, len);
3989 buf[len] = '\0';
3990 return INTERN(buf);
3991 } else {
3992 return F;
3993 }
3994 }
3995
3996 inline sen_obj *
json_readstr(sen_ctx * ctx,jctx * jc)3997 json_readstr(sen_ctx *ctx, jctx *jc)
3998 {
3999 char *start, *end;
4000 for (start = end = jc->cur;;) {
4001 unsigned int len;
4002 /* null check and length check */
4003 if (!(len = sen_str_charlen_nonnull(end, jc->str_end, jc->encoding))) {
4004 jc->cur = jc->str_end;
4005 break;
4006 }
4007 if (sen_isspace(end, jc->encoding)
4008 || *end == ':' || *end == ','
4009 || *end == '[' || *end == '{'
4010 || *end == ']' || *end == '}') {
4011 jc->cur = end;
4012 break;
4013 }
4014 end += len;
4015 }
4016 if (start < end || jc->cur < jc->str_end) {
4017 return mk_atom(ctx, start, end - start);
4018 } else {
4019 return F;
4020 }
4021 }
4022
4023 inline sen_obj *
json_readstrexp(sen_ctx * ctx,jctx * jc)4024 json_readstrexp(sen_ctx *ctx, jctx *jc)
4025 {
4026 sen_obj *res;
4027 char *start, *src, *dest;
4028 for (start = src = dest = jc->cur;;) {
4029 unsigned int len;
4030 /* null check and length check */
4031 if (!(len = sen_str_charlen_nonnull(src, jc->str_end, jc->encoding))) {
4032 jc->cur = jc->str_end;
4033 if (start < dest) {
4034 res = sen_ql_mk_string(ctx, start, dest - start);
4035 return res ? res : F;
4036 }
4037 return F;
4038 }
4039 if (src[0] == '"' && len == 1) {
4040 jc->cur = src + 1;
4041 res = sen_ql_mk_string(ctx, start, dest - start);
4042 return res ? res : F;
4043 } else if (src[0] == '\\' && src + 1 < jc->str_end && len == 1) {
4044 src++;
4045 *dest++ = *src++;
4046 } else {
4047 while (len--) { *dest++ = *src++; }
4048 }
4049 }
4050 }
4051
4052 static sen_obj *
json_read(sen_ctx * ctx,jctx * jc)4053 json_read(sen_ctx *ctx, jctx *jc)
4054 {
4055 for (;;) {
4056 SKIPSPACE(jc);
4057 if (jc->cur >= jc->str_end) { return NULL; }
4058 switch (*jc->cur) {
4059 case '[':
4060 jc->cur++;
4061 {
4062 sen_obj *o, *r = NIL, **p = &r;
4063 while ((o = json_read(ctx, jc)) && o != F) {
4064 *p = CONS(o, NIL);
4065 if (ERRP(ctx, SEN_WARN)) { return F; }
4066 p = &CDR(*p);
4067 }
4068 return r;
4069 }
4070 case '{':
4071 jc->cur++;
4072 {
4073 sen_obj *o, *r = CONS(INTERN("@"), NIL), **p = &(CDR(r));
4074 while ((o = json_read(ctx, jc)) && o != F) {
4075 *p = CONS(o, NIL);
4076 if (ERRP(ctx, SEN_WARN)) { return F; }
4077 p = &CDR(*p);
4078 }
4079 return r;
4080 }
4081 case '}':
4082 case ']':
4083 jc->cur++;
4084 return NULL;
4085 case ',':
4086 jc->cur++;
4087 break;
4088 case ':':
4089 jc->cur++;
4090 break;
4091 case '"':
4092 jc->cur++;
4093 return json_readstrexp(ctx, jc);
4094 default:
4095 return json_readstr(ctx, jc);
4096 }
4097 }
4098 }
4099
4100 static sen_obj *
nf_json_read(sen_ctx * ctx,sen_obj * args,sen_ql_co * co)4101 nf_json_read(sen_ctx *ctx, sen_obj *args, sen_ql_co *co)
4102 {
4103 sen_obj *car;
4104 POP(car, args); // todo : delete when called with (())
4105 if (BULKP(car)) {
4106 sen_obj *r;
4107 jctx jc;
4108 jc.encoding = ctx->encoding;
4109 jc.cur = car->u.b.value;
4110 jc.str_end = car->u.b.value + car->u.b.size;
4111 if ((r = json_read(ctx, &jc))) { return r; }
4112 }
4113 return F;
4114 }
4115
4116 void
sen_ql_def_db_funcs(sen_ctx * ctx)4117 sen_ql_def_db_funcs(sen_ctx *ctx)
4118 {
4119 sen_ql_def_native_func(ctx, "<db>", nf_db);
4120 sen_ql_def_native_func(ctx, "table", nf_table);
4121 sen_ql_def_native_func(ctx, "ptable", nf_ptable);
4122 sen_ql_def_native_func(ctx, "snippet", nf_snippet);
4123 sen_ql_def_native_func(ctx, "disp", nf_disp);
4124 sen_ql_def_native_func(ctx, "json-read", nf_json_read);
4125 sen_ql_def_native_func(ctx, "x->query", nf_toquery);
4126 }
4127