src/builtin.c

   1 /*
   2  * builtin.c: builtin primitives
   3  *
   4  * Copyright (C) 2007-2016 David Lutterkort
   5  *
   6  * This library is free software; you can redistribute it and/or
   7  * modify it under the terms of the GNU Lesser General Public
   8  * License as published by the Free Software Foundation; either
   9  * version 2.1 of the License, or (at your option) any later version.
  10  *
  11  * This library is distributed in the hope that it will be useful,
  12  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  13  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  14  * Lesser General Public License for more details.
  15  *
  16  * You should have received a copy of the GNU Lesser General Public
  17  * License along with this library; if not, write to the Free Software
  18  * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307  USA
  19  *
  20  * Author: David Lutterkort <dlutter@redhat.com>
  21  */
  22
  23 #include <config.h>
  24 #include <stdio.h>
  25 #include <stdarg.h>
  26 #include <errno.h>
  27 #include <stdlib.h>
  28
  29 #include "syntax.h"
  30 #include "memory.h"
  31 #include "transform.h"
  32 #include "errcode.h"
  33
  34 #define UNIMPL_BODY(name)                       \
  35     {                                           \
  36         FIXME(#name " called");                 \
  37         abort();                                \
  38     }
  39
  40 /*
  41  * Lenses
  42  */
  43
  44 /* V_REGEXP -> V_STRING -> V_LENS */
  45 static struct value *lns_del(struct info *info, struct value **argv) {
  46     struct value *rxp = argv[0];
  47     struct value *dflt = argv[1];
  48
  49     assert(rxp->tag == V_REGEXP);
  50     assert(dflt->tag == V_STRING);
  51     return lns_make_prim(L_DEL, ref(info),
  52                          ref(rxp->regexp), ref(dflt->string));
  53 }
  54
  55 /* V_REGEXP -> V_LENS */
  56 static struct value *lns_store(struct info *info, struct value **argv) {
  57     struct value *rxp = argv[0];
  58
  59     assert(rxp->tag == V_REGEXP);
  60     return lns_make_prim(L_STORE, ref(info), ref(rxp->regexp), NULL);
  61 }
  62
  63 /* V_STRING -> V_LENS */
  64 static struct value *lns_value(struct info *info, struct value **argv) {
  65     struct value *str = argv[0];
  66
  67     assert(str->tag == V_STRING);
  68     return lns_make_prim(L_VALUE, ref(info), NULL, ref(str->string));
  69 }
  70
  71 /* V_REGEXP -> V_LENS */
  72 static struct value *lns_key(struct info *info, struct value **argv) {
  73     struct value *rxp = argv[0];
  74
  75     assert(rxp->tag == V_REGEXP);
  76     return lns_make_prim(L_KEY, ref(info), ref(rxp->regexp), NULL);
  77 }
  78
  79 /* V_STRING -> V_LENS */
  80 static struct value *lns_label(struct info *info, struct value **argv) {
  81     struct value *str = argv[0];
  82
  83     assert(str->tag == V_STRING);
  84     return lns_make_prim(L_LABEL, ref(info), NULL, ref(str->string));
  85 }
  86
  87 /* V_STRING -> V_LENS */
  88 static struct value *lns_seq(struct info *info, struct value **argv) {
  89     struct value *str = argv[0];
  90
  91     assert(str->tag == V_STRING);
  92     return lns_make_prim(L_SEQ, ref(info), NULL, ref(str->string));
  93 }
  94
  95 /* V_STRING -> V_LENS */
  96 static struct value *lns_counter(struct info *info, struct value **argv) {
  97     struct value *str = argv[0];
  98
  99     assert(str->tag == V_STRING);
 100     return lns_make_prim(L_COUNTER, ref(info), NULL, ref(str->string));
 101 }
 102
 103 /* V_LENS -> V_LENS -> V_LENS -> V_LENS */
 104 static struct value *lns_square(struct info *info, struct value **argv) {
 105     struct value *l1 = argv[0];
 106     struct value *l2 = argv[1];
 107     struct value *l3 = argv[2];
 108
 109     assert(l1->tag == V_LENS);
 110     assert(l2->tag == V_LENS);
 111     assert(l3->tag == V_LENS);
 112     int check = typecheck_p(info);
 113
 114     return lns_make_square(ref(info), ref(l1->lens), ref(l2->lens), ref(l3->lens), check);
 115 }
 116
 117 static void exn_lns_error_detail(struct value *exn, const char *label,
 118                                  struct lens *lens) {
 119     if (lens == NULL)
 120         return;
 121
 122     char *s = format_info(lens->info);
 123     exn_printf_line(exn, "%s: %s", label, s);
 124     free(s);
 125 }
 126
 127 static struct value *make_exn_lns_error(struct info *info,
 128                                         struct lns_error *err,
 129                                         const char *text) {
 130     struct value *v;
 131
 132     if (HAS_ERR(info))
 133         return info->error->exn;
 134
 135     v = make_exn_value(ref(info), "%s", err->message);
 136     exn_lns_error_detail(v, "Lens", err->lens);
 137     exn_lns_error_detail(v, "  Last match", err->last);
 138     exn_lns_error_detail(v, "  Not matching", err->next);
 139     if (err->pos >= 0) {
 140         char *pos = format_pos(text, err->pos);
 141         size_t line, ofs;
 142         calc_line_ofs(text, err->pos, &line, &ofs);
 143         exn_printf_line(v,
 144                      "Error encountered at %d:%d (%d characters into string)",
 145                         (int) line, (int) ofs, err->pos);
 146         if (pos != NULL)
 147             exn_printf_line(v, "%s", pos);
 148         free(pos);
 149     } else {
 150         exn_printf_line(v, "Error encountered at path %s", err->path);
 151     }
 152
 153     return v;
 154 }
 155
 156 static void exn_print_tree(struct value *exn, struct tree *tree) {
 157     struct memstream ms;
 158
 159     init_memstream(&ms);
 160     dump_tree(ms.stream, tree);
 161     close_memstream(&ms);
 162     exn_printf_line(exn, "%s", ms.buf);
 163     FREE(ms.buf);
 164 }
 165
 166 static struct value *make_pathx_exn(struct info *info, struct pathx *p) {
 167     struct value *v;
 168     char *msg;
 169     const char *txt, *px_err;
 170     int pos;
 171
 172     px_err = pathx_error(p, &txt, &pos);
 173     v = make_exn_value(ref(info), "syntax error in path expression: %s",
 174                        px_err);
 175
 176     if (ALLOC_N(msg, strlen(txt) + 4) >= 0) {
 177         strncpy(msg, txt, pos);
 178         strcat(msg, "|=|");
 179         strcat(msg, txt + pos);
 180         exn_add_lines(v, 1, msg);
 181     }
 182     return v;
 183 }
 184
 185 static struct value *pathx_parse_glue(struct info *info, struct value *tree,
 186                                       struct value *path, struct pathx **p) {
 187     assert(path->tag == V_STRING);
 188     assert(tree->tag == V_TREE);
 189
 190     if (pathx_parse(tree->origin, info->error, path->string->str, true,
 191                     NULL, NULL, p) != PATHX_NOERROR) {
 192         return make_pathx_exn(info, *p);
 193     } else {
 194         return NULL;
 195     }
 196 }
 197
 198 /* V_LENS -> V_STRING -> V_TREE */
 199 static struct value *lens_get(struct info *info, struct value **argv) {
 200     struct value *l = argv[0];
 201     struct value *str = argv[1];
 202
 203     assert(l->tag == V_LENS);
 204     assert(str->tag == V_STRING);
 205     struct lns_error *err;
 206     struct value *v;
 207     const char *text = str->string->str;
 208
 209     struct tree *tree = lns_get(info, l->lens, text, 0, &err);
 210     if (err == NULL && ! HAS_ERR(info)) {
 211         v = make_value(V_TREE, ref(info));
 212         v->origin = make_tree_origin(tree);
 213     } else {
 214         struct tree *t = make_tree_origin(tree);
 215         if (t == NULL)
 216             free_tree(tree);
 217         tree = t;
 218
 219         v = make_exn_lns_error(info, err, text);
 220         if (tree != NULL) {
 221             exn_printf_line(v, "Tree generated so far:");
 222             exn_print_tree(v, tree);
 223             free_tree(tree);
 224         }
 225         free_lns_error(err);
 226     }
 227     return v;
 228 }
 229
 230
 231 /* V_LENS -> V_TREE -> V_STRING -> V_STRING */
 232 static struct value *lens_put(struct info *info, struct value **argv) {
 233     struct value *l    = argv[0];
 234     struct value *tree = argv[1];
 235     struct value *str  = argv[2];
 236
 237     assert(l->tag == V_LENS);
 238     assert(tree->tag == V_TREE);
 239     assert(str->tag == V_STRING);
 240
 241     struct memstream ms;
 242     struct value *v;
 243     struct lns_error *err;
 244
 245     init_memstream(&ms);
 246     lns_put(info, ms.stream, l->lens, tree->origin->children,
 247             str->string->str, 0, &err);
 248     close_memstream(&ms);
 249
 250     if (err == NULL && ! HAS_ERR(info)) {
 251         v = make_value(V_STRING, ref(info));
 252         v->string = make_string(ms.buf);
 253     } else {
 254         v = make_exn_lns_error(info, err, str->string->str);
 255         free_lns_error(err);
 256         FREE(ms.buf);
 257     }
 258     return v;
 259 }
 260
 261 /* V_STRING -> V_STRING -> V_TREE -> V_TREE */
 262 static struct value *tree_set_glue(struct info *info, struct value **argv) {
 263     // FIXME: This only works if TREE is not referenced more than once;
 264     // otherwise we'll have some pretty weird semantics, and would really
 265     // need to copy TREE first
 266     struct value *path = argv[0];
 267     struct value *val  = argv[1];
 268     struct value *tree = argv[2];
 269
 270     assert(path->tag == V_STRING);
 271     assert(val->tag == V_STRING);
 272     assert(tree->tag == V_TREE);
 273
 274     struct tree *fake = NULL;
 275     struct pathx *p = NULL;
 276     struct value *result = NULL;
 277
 278     if (tree->origin->children == NULL) {
 279         tree->origin->children = make_tree(NULL, NULL, tree->origin, NULL);
 280         fake = tree->origin->children;
 281     }
 282
 283     result = pathx_parse_glue(info, tree, path, &p);
 284     if (result != NULL)
 285         goto done;
 286
 287     if (tree_set(p, val->string->str) == NULL) {
 288         result = make_exn_value(ref(info),
 289                                 "Tree set of %s to '%s' failed",
 290                                 path->string->str, val->string->str);
 291         goto done;
 292     }
 293     if (fake != NULL) {
 294         list_remove(fake, tree->origin->children);
 295         free_tree(fake);
 296     }
 297     result = ref(tree);
 298
 299  done:
 300     free_pathx(p);
 301     return result;
 302 }
 303
 304 /* V_STRING -> V_TREE -> V_TREE */
 305 static struct value *tree_clear_glue(struct info *info, struct value **argv) {
 306     // FIXME: This only works if TREE is not referenced more than once;
 307     // otherwise we'll have some pretty weird semantics, and would really
 308     // need to copy TREE first
 309     struct value *path = argv[0];
 310     struct value *tree = argv[1];
 311
 312     assert(path->tag == V_STRING);
 313     assert(tree->tag == V_TREE);
 314
 315     struct tree *fake = NULL;
 316     struct pathx *p = NULL;
 317     struct value *result = NULL;
 318
 319     if (tree->origin->children == NULL) {
 320         tree->origin->children = make_tree(NULL, NULL, tree->origin, NULL);
 321         fake = tree->origin->children;
 322     }
 323
 324     result = pathx_parse_glue(info, tree, path, &p);
 325     if (result != NULL)
 326         goto done;
 327
 328     if (tree_set(p, NULL) == NULL) {
 329         result = make_exn_value(ref(info),
 330                                 "Tree set of %s to NULL failed",
 331                                 path->string->str);
 332         goto done;
 333     }
 334     if (fake != NULL) {
 335         list_remove(fake, tree->origin->children);
 336         free_tree(fake);
 337     }
 338     result = ref(tree);
 339
 340  done:
 341     free_pathx(p);
 342     return result;
 343 }
 344
 345 static struct value *tree_insert_glue(struct info *info, struct value *label,
 346                                       struct value *path, struct value *tree,
 347                                       int before) {
 348     // FIXME: This only works if TREE is not referenced more than once;
 349     // otherwise we'll have some pretty weird semantics, and would really
 350     // need to copy TREE first
 351     assert(label->tag == V_STRING);
 352     assert(path->tag == V_STRING);
 353     assert(tree->tag == V_TREE);
 354
 355     int r;
 356     struct pathx *p = NULL;
 357     struct value *result = NULL;
 358
 359     result = pathx_parse_glue(info, tree, path, &p);
 360     if (result != NULL)
 361         goto done;
 362
 363     r = tree_insert(p, label->string->str, before);
 364     if (r != 0) {
 365         result = make_exn_value(ref(info),
 366                                 "Tree insert of %s at %s failed",
 367                                 label->string->str, path->string->str);
 368         goto done;
 369     }
 370
 371     result = ref(tree);
 372  done:
 373     free_pathx(p);
 374     return result;
 375 }
 376
 377 /* Insert after */
 378 /* V_STRING -> V_STRING -> V_TREE -> V_TREE */
 379 static struct value *tree_insa_glue(struct info *info, struct value **argv) {
 380     struct value *label = argv[0];
 381     struct value *path  = argv[1];
 382     struct value *tree  = argv[2];
 383
 384     return tree_insert_glue(info, label, path, tree, 0);
 385 }
 386
 387 /* Insert before */
 388 /* V_STRING -> V_STRING -> V_TREE -> V_TREE */
 389 static struct value *tree_insb_glue(struct info *info, struct value **argv) {
 390     struct value *label = argv[0];
 391     struct value *path  = argv[1];
 392     struct value *tree  = argv[2];
 393
 394     return tree_insert_glue(info, label, path, tree, 1);
 395 }
 396
 397 /* V_STRING -> V_TREE -> V_TREE */
 398 static struct value *tree_rm_glue(struct info *info, struct value **argv) {
 399     // FIXME: This only works if TREE is not referenced more than once;
 400     // otherwise we'll have some pretty weird semantics, and would really
 401     // need to copy TREE first
 402     struct value *path  = argv[0];
 403     struct value *tree  = argv[1];
 404
 405     assert(path->tag == V_STRING);
 406     assert(tree->tag == V_TREE);
 407
 408     struct pathx *p = NULL;
 409     struct value *result = NULL;
 410
 411     result = pathx_parse_glue(info, tree, path, &p);
 412     if (result != NULL)
 413         goto done;
 414
 415     if (tree_rm(p) == -1) {
 416         result = make_exn_value(ref(info), "Tree rm of %s failed",
 417                                 path->string->str);
 418         goto done;
 419     }
 420     result = ref(tree);
 421  done:
 422     free_pathx(p);
 423     return result;
 424 }
 425
 426 /* V_STRING -> V_STRING */
 427 static struct value *gensym(struct info *info, struct value **argv) {
 428     struct value *prefix = argv[0];
 429
 430     assert(prefix->tag == V_STRING);
 431     static unsigned int count = 0;
 432     struct value *v;
 433     char *s;
 434     int r;
 435
 436     r = asprintf(&s, "%s%u", prefix->string->str, count);
 437     if (r == -1)
 438         return NULL;
 439     v = make_value(V_STRING, ref(info));
 440     v->string = make_string(s);
 441     return v;
 442 }
 443
 444 /* V_STRING -> V_FILTER */
 445 static struct value *xform_incl(struct info *info, struct value **argv) {
 446     struct value *s = argv[0];
 447
 448     assert(s->tag == V_STRING);
 449     struct value *v = make_value(V_FILTER, ref(info));
 450     v->filter = make_filter(ref(s->string), 1);
 451     return v;
 452 }
 453
 454 /* V_STRING -> V_FILTER */
 455 static struct value *xform_excl(struct info *info, struct value **argv) {
 456     struct value *s = argv[0];
 457
 458     assert(s->tag == V_STRING);
 459     struct value *v = make_value(V_FILTER, ref(info));
 460     v->filter = make_filter(ref(s->string), 0);
 461     return v;
 462 }
 463
 464 /* V_LENS -> V_FILTER -> V_TRANSFORM */
 465 static struct value *xform_transform(struct info *info, struct value **argv) {
 466     struct value *l = argv[0];
 467     struct value *f = argv[1];
 468
 469     assert(l->tag == V_LENS);
 470     assert(f->tag == V_FILTER);
 471     if (l->lens->value || l->lens->key) {
 472         return make_exn_value(ref(info), "Can not build a transform "
 473                               "from a lens that leaves a %s behind",
 474                               l->lens->key ? "key" : "value");
 475     }
 476     struct value *v = make_value(V_TRANSFORM, ref(info));
 477     v->transform = make_transform(ref(l->lens), ref(f->filter));
 478     return v;
 479 }
 480
 481 static struct value *sys_getenv(struct info *info, struct value **argv) {
 482     assert(argv[0]->tag == V_STRING);
 483     struct value *v = make_value(V_STRING, ref(info));
 484     v->string = dup_string(getenv(argv[0]->string->str));
 485     return v;
 486 }
 487
 488 static struct value *sys_read_file(struct info *info, struct value **argv) {
 489     struct value *n = argv[0];
 490
 491     assert(n->tag == V_STRING);
 492     char *str = NULL;
 493
 494     str = xread_file(n->string->str);
 495     if (str == NULL) {
 496         char error_buf[1024];
 497         const char *errmsg;
 498         errmsg = xstrerror(errno, error_buf, sizeof(error_buf));
 499         struct value *exn = make_exn_value(ref(info),
 500              "reading file %s failed:", n->string->str);
 501         exn_printf_line(exn, "%s", errmsg);
 502         return exn;
 503     }
 504     struct value *v = make_value(V_STRING, ref(info));
 505     v->string = make_string(str);
 506     return v;
 507 }
 508
 509 /* V_LENS -> V_LENS */
 510 static struct value *lns_check_rec_glue(struct info *info,
 511                                         struct value **argv) {
 512     struct value *l = argv[0];
 513     struct value *r = argv[1];
 514
 515     assert(l->tag == V_LENS);
 516     assert(r->tag == V_LENS);
 517     int check = typecheck_p(info);
 518
 519     return lns_check_rec(info, l->lens, r->lens, check);
 520 }
 521
 522 /*
 523  * Print functions
 524  */
 525
 526 /* V_STRING -> V_UNIT */
 527 static struct value *pr_string(struct info *info, struct value **argv) {
 528     printf("%s", argv[0]->string->str);
 529     return make_unit(ref(info));
 530 }
 531
 532 /* V_REGEXP -> V_UNIT */
 533 static struct value *pr_regexp(struct info *info, struct value **argv) {
 534     print_regexp(stdout, argv[0]->regexp);
 535     return make_unit(ref(info));
 536 }
 537
 538 /* V_STRING -> V_UNIT */
 539 static struct value *pr_endline(struct info *info, struct value **argv) {
 540     printf("%s\n", argv[0]->string->str);
 541     return make_unit(ref(info));
 542 }
 543
 544 /* V_TREE -> V_TREE */
 545 static struct value *pr_tree(ATTRIBUTE_UNUSED struct info *info,
 546                              struct value **argv) {
 547     print_tree_braces(stdout, 0, argv[0]->origin);
 548     return ref(argv[0]);
 549 }
 550
 551 /*
 552  * Lens inspection
 553  */
 554
 555 static struct value *lns_value_of_type(struct info *info, struct regexp *rx) {
 556     struct value *result = make_value(V_REGEXP, ref(info));
 557     if (rx)
 558         result->regexp = ref(rx);
 559     else
 560         result->regexp = regexp_make_empty(ref(info));
 561     return result;
 562 }
 563
 564 /* V_LENS -> V_REGEXP */
 565 static struct value *lns_ctype(struct info *info, struct value **argv) {
 566     return lns_value_of_type(info, argv[0]->lens->ctype);
 567 }
 568
 569 /* V_LENS -> V_REGEXP */
 570 static struct value *lns_atype(struct info *info, struct value **argv) {
 571     return lns_value_of_type(info, argv[0]->lens->atype);
 572 }
 573
 574 /* V_LENS -> V_REGEXP */
 575 static struct value *lns_vtype(struct info *info, struct value **argv) {
 576     return lns_value_of_type(info, argv[0]->lens->vtype);
 577 }
 578
 579 /* V_LENS -> V_REGEXP */
 580 static struct value *lns_ktype(struct info *info, struct value **argv) {
 581     return lns_value_of_type(info, argv[0]->lens->ktype);
 582 }
 583
 584 /* V_LENS -> V_STRING */
 585 static struct value *lns_fmt_atype(struct info *info, struct value **argv) {
 586     struct value *l = argv[0];
 587
 588     struct value *result = NULL;
 589     char *s = NULL;
 590     int r;
 591
 592     r = lns_format_atype(l->lens, &s);
 593     if (r < 0)
 594         return info->error->exn;
 595     result = make_value(V_STRING, ref(info));
 596     result->string = make_string(s);
 597     return result;
 598 }
 599
 600 /* V_REGEXP -> V_STRING -> V_STRING */
 601 static struct value *rx_match(struct info *info, struct value **argv) {
 602     struct value *rx = argv[0];
 603     struct value *s  = argv[1];
 604
 605     struct value *result = NULL;
 606     const char *str = s->string->str;
 607     struct re_registers regs;
 608     int r;
 609
 610     MEMZERO(&regs, 1);
 611     r = regexp_match(rx->regexp, str, strlen(str), 0, &regs);
 612     if (r < -1) {
 613         result =
 614             make_exn_value(ref(info), "regexp match failed (internal error)");
 615     } else {
 616         char *match = NULL;
 617         if (r == -1) {
 618             /* No match */
 619             match = strdup("");
 620         } else {
 621             match = strndup(str + regs.start[0], regs.end[0] - regs.start[0]);
 622         }
 623         if (match == NULL) {
 624             result = info->error->exn;
 625         } else {
 626             result = make_value(V_STRING, ref(info));
 627             result->string = make_string(match);
 628         }
 629     }
 630     return result;
 631 }
 632
 633 struct module *builtin_init(struct error *error) {
 634     struct module *modl = module_create("Builtin");
 635     int r;
 636
 637 #define DEFINE_NATIVE(modl, name, nargs, impl, types ...)               \
 638     r = define_native(error, modl, name, nargs, impl, ##types);         \
 639     if (r < 0) goto error;
 640
 641     DEFINE_NATIVE(modl, "gensym", 1, gensym, T_STRING, T_STRING);
 642
 643     /* Primitive lenses */
 644     DEFINE_NATIVE(modl, "del",     2, lns_del, T_REGEXP, T_STRING, T_LENS);
 645     DEFINE_NATIVE(modl, "store",   1, lns_store, T_REGEXP, T_LENS);
 646     DEFINE_NATIVE(modl, "value",   1, lns_value, T_STRING, T_LENS);
 647     DEFINE_NATIVE(modl, "key",     1, lns_key, T_REGEXP, T_LENS);
 648     DEFINE_NATIVE(modl, "label",   1, lns_label, T_STRING, T_LENS);
 649     DEFINE_NATIVE(modl, "seq",     1, lns_seq, T_STRING, T_LENS);
 650     DEFINE_NATIVE(modl, "counter", 1, lns_counter, T_STRING, T_LENS);
 651     DEFINE_NATIVE(modl, "square",  3, lns_square, T_LENS, T_LENS, T_LENS, T_LENS);
 652     /* Applying lenses (mostly for tests) */
 653     DEFINE_NATIVE(modl, "get",     2, lens_get, T_LENS, T_STRING, T_TREE);
 654     DEFINE_NATIVE(modl, "put",     3, lens_put, T_LENS, T_TREE, T_STRING,
 655                   T_STRING);
 656     /* Tree manipulation used by the PUT tests */
 657     DEFINE_NATIVE(modl, "set", 3, tree_set_glue, T_STRING, T_STRING, T_TREE,
 658                                                  T_TREE);
 659     DEFINE_NATIVE(modl, "clear", 2, tree_clear_glue, T_STRING, T_TREE,
 660                                                  T_TREE);
 661     DEFINE_NATIVE(modl, "rm", 2, tree_rm_glue, T_STRING, T_TREE, T_TREE);
 662     DEFINE_NATIVE(modl, "insa", 3, tree_insa_glue, T_STRING, T_STRING, T_TREE,
 663                                                    T_TREE);
 664     DEFINE_NATIVE(modl, "insb", 3, tree_insb_glue, T_STRING, T_STRING, T_TREE,
 665                                                    T_TREE);
 666     /* Transforms and filters */
 667     DEFINE_NATIVE(modl, "incl", 1, xform_incl, T_STRING, T_FILTER);
 668     DEFINE_NATIVE(modl, "excl", 1, xform_excl, T_STRING, T_FILTER);
 669     DEFINE_NATIVE(modl, "transform", 2, xform_transform, T_LENS, T_FILTER,
 670                                                          T_TRANSFORM);
 671     DEFINE_NATIVE(modl, LNS_CHECK_REC_NAME,
 672                   2, lns_check_rec_glue, T_LENS, T_LENS, T_LENS);
 673     /* Printing */
 674     DEFINE_NATIVE(modl, "print_string", 1, pr_string, T_STRING, T_UNIT);
 675     DEFINE_NATIVE(modl, "print_regexp", 1, pr_regexp, T_REGEXP, T_UNIT);
 676     DEFINE_NATIVE(modl, "print_endline", 1, pr_endline, T_STRING, T_UNIT);
 677     DEFINE_NATIVE(modl, "print_tree", 1, pr_tree, T_TREE, T_TREE);
 678
 679     /* Lens inspection */
 680     DEFINE_NATIVE(modl, "lens_ctype", 1, lns_ctype, T_LENS, T_REGEXP);
 681     DEFINE_NATIVE(modl, "lens_atype", 1, lns_atype, T_LENS, T_REGEXP);
 682     DEFINE_NATIVE(modl, "lens_vtype", 1, lns_vtype, T_LENS, T_REGEXP);
 683     DEFINE_NATIVE(modl, "lens_ktype", 1, lns_ktype, T_LENS, T_REGEXP);
 684     DEFINE_NATIVE(modl, "lens_format_atype", 1, lns_fmt_atype,
 685                   T_LENS, T_STRING);
 686
 687     /* Regexp matching */
 688     DEFINE_NATIVE(modl, "regexp_match", 2, rx_match, T_REGEXP, T_STRING,
 689                   T_STRING);
 690
 691     /* System functions */
 692     struct module *sys = module_create("Sys");
 693     modl->next = sys;
 694     DEFINE_NATIVE(sys, "getenv", 1, sys_getenv, T_STRING, T_STRING);
 695     DEFINE_NATIVE(sys, "read_file", 1, sys_read_file, T_STRING, T_STRING);
 696     return modl;
 697  error:
 698     unref(modl, module);
 699     return NULL;
 700 }
 701
 702 /*
 703  * Local variables:
 704  *  indent-tabs-mode: nil
 705  *  c-indent-level: 4
 706  *  c-basic-offset: 4
 707  *  tab-width: 4
 708  * End:
 709  */