/*
* builtin.c: builtin primitives
*
* Copyright (C) 2007-2016 David Lutterkort
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
* License as published by the Free Software Foundation; either
* version 2.1 of the License, or (at your option) any later version.
*
* This library is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
* Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*
* Author: David Lutterkort <dlutter@redhat.com>
*/
#include <config.h>
#include <stdio.h>
#include <stdarg.h>
#include <errno.h>
#include <stdlib.h>
#include "syntax.h"
#include "memory.h"
#include "transform.h"
#include "errcode.h"
#define UNIMPL_BODY(name) \
{ \
FIXME(#name " called"); \
abort(); \
}
/*
* Lenses
*/
/* V_REGEXP -> V_STRING -> V_LENS */
static struct value *lns_del(struct info *info, struct value **argv) {
struct value *rxp = argv[0];
struct value *dflt = argv[1];
assert(rxp->tag == V_REGEXP);
assert(dflt->tag == V_STRING);
return lns_make_prim(L_DEL, ref(info),
ref(rxp->regexp), ref(dflt->string));
}
/* V_REGEXP -> V_LENS */
static struct value *lns_store(struct info *info, struct value **argv) {
struct value *rxp = argv[0];
assert(rxp->tag == V_REGEXP);
return lns_make_prim(L_STORE, ref(info), ref(rxp->regexp), NULL);
}
/* V_STRING -> V_LENS */
static struct value *lns_value(struct info *info, struct value **argv) {
struct value *str = argv[0];
assert(str->tag == V_STRING);
return lns_make_prim(L_VALUE, ref(info), NULL, ref(str->string));
}
/* V_REGEXP -> V_LENS */
static struct value *lns_key(struct info *info, struct value **argv) {
struct value *rxp = argv[0];
assert(rxp->tag == V_REGEXP);
return lns_make_prim(L_KEY, ref(info), ref(rxp->regexp), NULL);
}
/* V_STRING -> V_LENS */
static struct value *lns_label(struct info *info, struct value **argv) {
struct value *str = argv[0];
assert(str->tag == V_STRING);
return lns_make_prim(L_LABEL, ref(info), NULL, ref(str->string));
}
/* V_STRING -> V_LENS */
static struct value *lns_seq(struct info *info, struct value **argv) {
struct value *str = argv[0];
assert(str->tag == V_STRING);
return lns_make_prim(L_SEQ, ref(info), NULL, ref(str->string));
}
/* V_STRING -> V_LENS */
static struct value *lns_counter(struct info *info, struct value **argv) {
struct value *str = argv[0];
assert(str->tag == V_STRING);
return lns_make_prim(L_COUNTER, ref(info), NULL, ref(str->string));
}
/* V_LENS -> V_LENS -> V_LENS -> V_LENS */
static struct value *lns_square(struct info *info, struct value **argv) {
struct value *l1 = argv[0];
struct value *l2 = argv[1];
struct value *l3 = argv[2];
assert(l1->tag == V_LENS);
assert(l2->tag == V_LENS);
assert(l3->tag == V_LENS);
int check = typecheck_p(info);
return lns_make_square(ref(info), ref(l1->lens), ref(l2->lens), ref(l3->lens), check);
}
static void exn_lns_error_detail(struct value *exn, const char *label,
struct lens *lens) {
if (lens == NULL)
return;
char *s = format_info(lens->info);
exn_printf_line(exn, "%s: %s", label, s);
free(s);
}
static struct value *make_exn_lns_error(struct info *info,
struct lns_error *err,
const char *text) {
struct value *v;
if (HAS_ERR(info))
return info->error->exn;
v = make_exn_value(ref(info), "%s", err->message);
exn_lns_error_detail(v, "Lens", err->lens);
exn_lns_error_detail(v, " Last match", err->last);
exn_lns_error_detail(v, " Not matching", err->next);
if (err->pos >= 0) {
char *pos = format_pos(text, err->pos);
size_t line, ofs;
calc_line_ofs(text, err->pos, &line, &ofs);
exn_printf_line(v,
"Error encountered at %d:%d (%d characters into string)",
(int) line, (int) ofs, err->pos);
if (pos != NULL)
exn_printf_line(v, "%s", pos);
free(pos);
} else {
exn_printf_line(v, "Error encountered at path %s", err->path);
}
return v;
}
static void exn_print_tree(struct value *exn, struct tree *tree) {
struct memstream ms;
init_memstream(&ms);
dump_tree(ms.stream, tree);
close_memstream(&ms);
exn_printf_line(exn, "%s", ms.buf);
FREE(ms.buf);
}
static struct value *make_pathx_exn(struct info *info, struct pathx *p) {
struct value *v;
char *msg;
const char *txt, *px_err;
int pos;
px_err = pathx_error(p, &txt, &pos);
v = make_exn_value(ref(info), "syntax error in path expression: %s",
px_err);
if (ALLOC_N(msg, strlen(txt) + 4) >= 0) {
strncpy(msg, txt, pos);
strcat(msg, "|=|");
strcat(msg, txt + pos);
exn_add_lines(v, 1, msg);
}
return v;
}
static struct value *pathx_parse_glue(struct info *info, struct value *tree,
struct value *path, struct pathx **p) {
assert(path->tag == V_STRING);
assert(tree->tag == V_TREE);
if (pathx_parse(tree->origin, info->error, path->string->str, true,
NULL, NULL, p) != PATHX_NOERROR) {
return make_pathx_exn(info, *p);
} else {
return NULL;
}
}
/* V_LENS -> V_STRING -> V_TREE */
static struct value *lens_get(struct info *info, struct value **argv) {
struct value *l = argv[0];
struct value *str = argv[1];
assert(l->tag == V_LENS);
assert(str->tag == V_STRING);
struct lns_error *err;
struct value *v;
const char *text = str->string->str;
struct tree *tree = lns_get(info, l->lens, text, 0, &err);
if (err == NULL && ! HAS_ERR(info)) {
v = make_value(V_TREE, ref(info));
v->origin = make_tree_origin(tree);
} else {
struct tree *t = make_tree_origin(tree);
if (t == NULL)
free_tree(tree);
tree = t;
v = make_exn_lns_error(info, err, text);
if (tree != NULL) {
exn_printf_line(v, "Tree generated so far:");
exn_print_tree(v, tree);
free_tree(tree);
}
free_lns_error(err);
}
return v;
}
/* V_LENS -> V_TREE -> V_STRING -> V_STRING */
static struct value *lens_put(struct info *info, struct value **argv) {
struct value *l = argv[0];
struct value *tree = argv[1];
struct value *str = argv[2];
assert(l->tag == V_LENS);
assert(tree->tag == V_TREE);
assert(str->tag == V_STRING);
struct memstream ms;
struct value *v;
struct lns_error *err;
init_memstream(&ms);
lns_put(info, ms.stream, l->lens, tree->origin->children,
str->string->str, 0, &err);
close_memstream(&ms);
if (err == NULL && ! HAS_ERR(info)) {
v = make_value(V_STRING, ref(info));
v->string = make_string(ms.buf);
} else {
v = make_exn_lns_error(info, err, str->string->str);
free_lns_error(err);
FREE(ms.buf);
}
return v;
}
/* V_STRING -> V_STRING -> V_TREE -> V_TREE */
static struct value *tree_set_glue(struct info *info, struct value **argv) {
// FIXME: This only works if TREE is not referenced more than once;
// otherwise we'll have some pretty weird semantics, and would really
// need to copy TREE first
struct value *path = argv[0];
struct value *val = argv[1];
struct value *tree = argv[2];
assert(path->tag == V_STRING);
assert(val->tag == V_STRING);
assert(tree->tag == V_TREE);
struct tree *fake = NULL;
struct pathx *p = NULL;
struct value *result = NULL;
if (tree->origin->children == NULL) {
tree->origin->children = make_tree(NULL, NULL, tree->origin, NULL);
fake = tree->origin->children;
}
result = pathx_parse_glue(info, tree, path, &p);
if (result != NULL)
goto done;
if (tree_set(p, val->string->str) == NULL) {
result = make_exn_value(ref(info),
"Tree set of %s to '%s' failed",
path->string->str, val->string->str);
goto done;
}
if (fake != NULL) {
list_remove(fake, tree->origin->children);
free_tree(fake);
}
result = ref(tree);
done:
free_pathx(p);
return result;
}
/* V_STRING -> V_TREE -> V_TREE */
static struct value *tree_clear_glue(struct info *info, struct value **argv) {
// FIXME: This only works if TREE is not referenced more than once;
// otherwise we'll have some pretty weird semantics, and would really
// need to copy TREE first
struct value *path = argv[0];
struct value *tree = argv[1];
assert(path->tag == V_STRING);
assert(tree->tag == V_TREE);
struct tree *fake = NULL;
struct pathx *p = NULL;
struct value *result = NULL;
if (tree->origin->children == NULL) {
tree->origin->children = make_tree(NULL, NULL, tree->origin, NULL);
fake = tree->origin->children;
}
result = pathx_parse_glue(info, tree, path, &p);
if (result != NULL)
goto done;
if (tree_set(p, NULL) == NULL) {
result = make_exn_value(ref(info),
"Tree set of %s to NULL failed",
path->string->str);
goto done;
}
if (fake != NULL) {
list_remove(fake, tree->origin->children);
free_tree(fake);
}
result = ref(tree);
done:
free_pathx(p);
return result;
}
static struct value *tree_insert_glue(struct info *info, struct value *label,
struct value *path, struct value *tree,
int before) {
// FIXME: This only works if TREE is not referenced more than once;
// otherwise we'll have some pretty weird semantics, and would really
// need to copy TREE first
assert(label->tag == V_STRING);
assert(path->tag == V_STRING);
assert(tree->tag == V_TREE);
int r;
struct pathx *p = NULL;
struct value *result = NULL;
result = pathx_parse_glue(info, tree, path, &p);
if (result != NULL)
goto done;
r = tree_insert(p, label->string->str, before);
if (r != 0) {
result = make_exn_value(ref(info),
"Tree insert of %s at %s failed",
label->string->str, path->string->str);
goto done;
}
result = ref(tree);
done:
free_pathx(p);
return result;
}
/* Insert after */
/* V_STRING -> V_STRING -> V_TREE -> V_TREE */
static struct value *tree_insa_glue(struct info *info, struct value **argv) {
struct value *label = argv[0];
struct value *path = argv[1];
struct value *tree = argv[2];
return tree_insert_glue(info, label, path, tree, 0);
}
/* Insert before */
/* V_STRING -> V_STRING -> V_TREE -> V_TREE */
static struct value *tree_insb_glue(struct info *info, struct value **argv) {
struct value *label = argv[0];
struct value *path = argv[1];
struct value *tree = argv[2];
return tree_insert_glue(info, label, path, tree, 1);
}
/* V_STRING -> V_TREE -> V_TREE */
static struct value *tree_rm_glue(struct info *info, struct value **argv) {
// FIXME: This only works if TREE is not referenced more than once;
// otherwise we'll have some pretty weird semantics, and would really
// need to copy TREE first
struct value *path = argv[0];
struct value *tree = argv[1];
assert(path->tag == V_STRING);
assert(tree->tag == V_TREE);
struct pathx *p = NULL;
struct value *result = NULL;
result = pathx_parse_glue(info, tree, path, &p);
if (result != NULL)
goto done;
if (tree_rm(p) == -1) {
result = make_exn_value(ref(info), "Tree rm of %s failed",
path->string->str);
goto done;
}
result = ref(tree);
done:
free_pathx(p);
return result;
}
/* V_STRING -> V_STRING */
static struct value *gensym(struct info *info, struct value **argv) {
struct value *prefix = argv[0];
assert(prefix->tag == V_STRING);
static unsigned int count = 0;
struct value *v;
char *s;
int r;
r = asprintf(&s, "%s%u", prefix->string->str, count);
if (r == -1)
return NULL;
v = make_value(V_STRING, ref(info));
v->string = make_string(s);
return v;
}
/* V_STRING -> V_FILTER */
static struct value *xform_incl(struct info *info, struct value **argv) {
struct value *s = argv[0];
assert(s->tag == V_STRING);
struct value *v = make_value(V_FILTER, ref(info));
v->filter = make_filter(ref(s->string), 1);
return v;
}
/* V_STRING -> V_FILTER */
static struct value *xform_excl(struct info *info, struct value **argv) {
struct value *s = argv[0];
assert(s->tag == V_STRING);
struct value *v = make_value(V_FILTER, ref(info));
v->filter = make_filter(ref(s->string), 0);
return v;
}
/* V_LENS -> V_FILTER -> V_TRANSFORM */
static struct value *xform_transform(struct info *info, struct value **argv) {
struct value *l = argv[0];
struct value *f = argv[1];
assert(l->tag == V_LENS);
assert(f->tag == V_FILTER);
if (l->lens->value || l->lens->key) {
return make_exn_value(ref(info), "Can not build a transform "
"from a lens that leaves a %s behind",
l->lens->key ? "key" : "value");
}
struct value *v = make_value(V_TRANSFORM, ref(info));
v->transform = make_transform(ref(l->lens), ref(f->filter));
return v;
}
static struct value *sys_getenv(struct info *info, struct value **argv) {
assert(argv[0]->tag == V_STRING);
struct value *v = make_value(V_STRING, ref(info));
v->string = dup_string(getenv(argv[0]->string->str));
return v;
}
static struct value *sys_read_file(struct info *info, struct value **argv) {
struct value *n = argv[0];
assert(n->tag == V_STRING);
char *str = NULL;
str = xread_file(n->string->str);
if (str == NULL) {
char error_buf[1024];
const char *errmsg;
errmsg = xstrerror(errno, error_buf, sizeof(error_buf));
struct value *exn = make_exn_value(ref(info),
"reading file %s failed:", n->string->str);
exn_printf_line(exn, "%s", errmsg);
return exn;
}
struct value *v = make_value(V_STRING, ref(info));
v->string = make_string(str);
return v;
}
/* V_LENS -> V_LENS */
static struct value *lns_check_rec_glue(struct info *info,
struct value **argv) {
struct value *l = argv[0];
struct value *r = argv[1];
assert(l->tag == V_LENS);
assert(r->tag == V_LENS);
int check = typecheck_p(info);
return lns_check_rec(info, l->lens, r->lens, check);
}
/*
* Print functions
*/
/* V_STRING -> V_UNIT */
static struct value *pr_string(struct info *info, struct value **argv) {
printf("%s", argv[0]->string->str);
return make_unit(ref(info));
}
/* V_REGEXP -> V_UNIT */
static struct value *pr_regexp(struct info *info, struct value **argv) {
print_regexp(stdout, argv[0]->regexp);
return make_unit(ref(info));
}
/* V_STRING -> V_UNIT */
static struct value *pr_endline(struct info *info, struct value **argv) {
printf("%s\n", argv[0]->string->str);
return make_unit(ref(info));
}
/* V_TREE -> V_TREE */
static struct value *pr_tree(ATTRIBUTE_UNUSED struct info *info,
struct value **argv) {
print_tree_braces(stdout, 0, argv[0]->origin);
return ref(argv[0]);
}
/*
* Lens inspection
*/
static struct value *lns_value_of_type(struct info *info, struct regexp *rx) {
struct value *result = make_value(V_REGEXP, ref(info));
if (rx)
result->regexp = ref(rx);
else
result->regexp = regexp_make_empty(ref(info));
return result;
}
/* V_LENS -> V_REGEXP */
static struct value *lns_ctype(struct info *info, struct value **argv) {
return lns_value_of_type(info, argv[0]->lens->ctype);
}
/* V_LENS -> V_REGEXP */
static struct value *lns_atype(struct info *info, struct value **argv) {
return lns_value_of_type(info, argv[0]->lens->atype);
}
/* V_LENS -> V_REGEXP */
static struct value *lns_vtype(struct info *info, struct value **argv) {
return lns_value_of_type(info, argv[0]->lens->vtype);
}
/* V_LENS -> V_REGEXP */
static struct value *lns_ktype(struct info *info, struct value **argv) {
return lns_value_of_type(info, argv[0]->lens->ktype);
}
/* V_LENS -> V_STRING */
static struct value *lns_fmt_atype(struct info *info, struct value **argv) {
struct value *l = argv[0];
struct value *result = NULL;
char *s = NULL;
int r;
r = lns_format_atype(l->lens, &s);
if (r < 0)
return info->error->exn;
result = make_value(V_STRING, ref(info));
result->string = make_string(s);
return result;
}
/* V_REGEXP -> V_STRING -> V_STRING */
static struct value *rx_match(struct info *info, struct value **argv) {
struct value *rx = argv[0];
struct value *s = argv[1];
struct value *result = NULL;
const char *str = s->string->str;
struct re_registers regs;
int r;
MEMZERO(®s, 1);
r = regexp_match(rx->regexp, str, strlen(str), 0, ®s);
if (r < -1) {
result =
make_exn_value(ref(info), "regexp match failed (internal error)");
} else {
char *match = NULL;
if (r == -1) {
/* No match */
match = strdup("");
} else {
match = strndup(str + regs.start[0], regs.end[0] - regs.start[0]);
}
if (match == NULL) {
result = info->error->exn;
} else {
result = make_value(V_STRING, ref(info));
result->string = make_string(match);
}
}
return result;
}
struct module *builtin_init(struct error *error) {
struct module *modl = module_create("Builtin");
int r;
#define DEFINE_NATIVE(modl, name, nargs, impl, types ...) \
r = define_native(error, modl, name, nargs, impl, ##types); \
if (r < 0) goto error;
DEFINE_NATIVE(modl, "gensym", 1, gensym, T_STRING, T_STRING);
/* Primitive lenses */
DEFINE_NATIVE(modl, "del", 2, lns_del, T_REGEXP, T_STRING, T_LENS);
DEFINE_NATIVE(modl, "store", 1, lns_store, T_REGEXP, T_LENS);
DEFINE_NATIVE(modl, "value", 1, lns_value, T_STRING, T_LENS);
DEFINE_NATIVE(modl, "key", 1, lns_key, T_REGEXP, T_LENS);
DEFINE_NATIVE(modl, "label", 1, lns_label, T_STRING, T_LENS);
DEFINE_NATIVE(modl, "seq", 1, lns_seq, T_STRING, T_LENS);
DEFINE_NATIVE(modl, "counter", 1, lns_counter, T_STRING, T_LENS);
DEFINE_NATIVE(modl, "square", 3, lns_square, T_LENS, T_LENS, T_LENS, T_LENS);
/* Applying lenses (mostly for tests) */
DEFINE_NATIVE(modl, "get", 2, lens_get, T_LENS, T_STRING, T_TREE);
DEFINE_NATIVE(modl, "put", 3, lens_put, T_LENS, T_TREE, T_STRING,
T_STRING);
/* Tree manipulation used by the PUT tests */
DEFINE_NATIVE(modl, "set", 3, tree_set_glue, T_STRING, T_STRING, T_TREE,
T_TREE);
DEFINE_NATIVE(modl, "clear", 2, tree_clear_glue, T_STRING, T_TREE,
T_TREE);
DEFINE_NATIVE(modl, "rm", 2, tree_rm_glue, T_STRING, T_TREE, T_TREE);
DEFINE_NATIVE(modl, "insa", 3, tree_insa_glue, T_STRING, T_STRING, T_TREE,
T_TREE);
DEFINE_NATIVE(modl, "insb", 3, tree_insb_glue, T_STRING, T_STRING, T_TREE,
T_TREE);
/* Transforms and filters */
DEFINE_NATIVE(modl, "incl", 1, xform_incl, T_STRING, T_FILTER);
DEFINE_NATIVE(modl, "excl", 1, xform_excl, T_STRING, T_FILTER);
DEFINE_NATIVE(modl, "transform", 2, xform_transform, T_LENS, T_FILTER,
T_TRANSFORM);
DEFINE_NATIVE(modl, LNS_CHECK_REC_NAME,
2, lns_check_rec_glue, T_LENS, T_LENS, T_LENS);
/* Printing */
DEFINE_NATIVE(modl, "print_string", 1, pr_string, T_STRING, T_UNIT);
DEFINE_NATIVE(modl, "print_regexp", 1, pr_regexp, T_REGEXP, T_UNIT);
DEFINE_NATIVE(modl, "print_endline", 1, pr_endline, T_STRING, T_UNIT);
DEFINE_NATIVE(modl, "print_tree", 1, pr_tree, T_TREE, T_TREE);
/* Lens inspection */
DEFINE_NATIVE(modl, "lens_ctype", 1, lns_ctype, T_LENS, T_REGEXP);
DEFINE_NATIVE(modl, "lens_atype", 1, lns_atype, T_LENS, T_REGEXP);
DEFINE_NATIVE(modl, "lens_vtype", 1, lns_vtype, T_LENS, T_REGEXP);
DEFINE_NATIVE(modl, "lens_ktype", 1, lns_ktype, T_LENS, T_REGEXP);
DEFINE_NATIVE(modl, "lens_format_atype", 1, lns_fmt_atype,
T_LENS, T_STRING);
/* Regexp matching */
DEFINE_NATIVE(modl, "regexp_match", 2, rx_match, T_REGEXP, T_STRING,
T_STRING);
/* System functions */
struct module *sys = module_create("Sys");
modl->next = sys;
DEFINE_NATIVE(sys, "getenv", 1, sys_getenv, T_STRING, T_STRING);
DEFINE_NATIVE(sys, "read_file", 1, sys_read_file, T_STRING, T_STRING);
return modl;
error:
unref(modl, module);
return NULL;
}
/*
* Local variables:
* indent-tabs-mode: nil
* c-indent-level: 4
* c-basic-offset: 4
* tab-width: 4
* End:
*/