lib/ql.c

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