/*
* builtin.c: builtin primitives
*
- * Copyright (C) 2007-2011 David Lutterkort
+ * 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
*/
/* V_REGEXP -> V_STRING -> V_LENS */
-static struct value *lns_del(struct info *info,
- struct value *rxp, struct value *dflt) {
+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),
}
/* V_REGEXP -> V_LENS */
-static struct value *lns_store(struct info *info, struct value *rxp) {
+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 *str) {
+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 *rxp) {
+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 *str) {
+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 *str) {
+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 *str) {
+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_REGEXP -> V_LENS -> V_LENS */
-static struct value *lns_square(struct info *info, struct value *rxp,
- struct value *lns) {
- assert(rxp->tag == V_REGEXP);
- assert(lns->tag == V_LENS);
- int check = info->error->aug->flags & AUG_TYPE_CHECK;
+/* 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];
- return lns_make_square(ref(info), ref(rxp->regexp), ref(lns->lens), check);
+ 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 value *v;
if (HAS_ERR(info))
- return exn_error();
+ return info->error->exn;
v = make_exn_value(ref(info), "%s", err->message);
- if (err->lens != NULL) {
- char *s = format_info(err->lens->info);
- exn_printf_line(v, "Lens: %s", s);
- free(s);
- }
+ 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;
static struct value *make_pathx_exn(struct info *info, struct pathx *p) {
struct value *v;
char *msg;
- const char *txt;
+ const char *txt, *px_err;
int pos;
- msg = strdup(pathx_error(p, &txt, &pos));
- if (msg == NULL)
- return NULL;
+ px_err = pathx_error(p, &txt, &pos);
+ v = make_exn_value(ref(info), "syntax error in path expression: %s",
+ px_err);
- v = make_exn_value(ref(info), "syntax error in path expression: %s", msg);
if (ALLOC_N(msg, strlen(txt) + 4) >= 0) {
strncpy(msg, txt, pos);
strcat(msg, "|=|");
if (pathx_parse(tree->origin, info->error, path->string->str, true,
NULL, NULL, p) != PATHX_NOERROR) {
- return make_pathx_exn(ref(info), *p);
+ 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 *l,
- struct value *str) {
+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, &err);
+ 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);
/* V_LENS -> V_TREE -> V_STRING -> V_STRING */
-static struct value *lens_put(struct info *info, struct value *l,
- struct value *tree, struct value *str) {
+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 lns_error *err;
init_memstream(&ms);
- lns_put(ms.stream, l->lens, tree->origin->children,
- str->string->str, &err);
+ 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_STRING -> V_STRING -> V_TREE -> V_TREE */
-static struct value *tree_set_glue(struct info *info, struct value *path,
- struct value *val, struct value *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);
}
/* V_STRING -> V_TREE -> V_TREE */
-static struct value *tree_clear_glue(struct info *info, struct value *path,
- struct value *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);
/* Insert after */
/* V_STRING -> V_STRING -> V_TREE -> V_TREE */
-static struct value *tree_insa_glue(struct info *info, struct value *label,
- struct value *path, struct value *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 *label,
- struct value *path, struct value *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 *path,
- struct value *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);
}
/* V_STRING -> V_STRING */
-static struct value *gensym(struct info *info, struct value *prefix) {
+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;
}
/* V_STRING -> V_FILTER */
-static struct value *xform_incl(struct info *info, struct value *s) {
+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);
}
/* V_STRING -> V_FILTER */
-static struct value *xform_excl(struct info *info, struct value *s) {
+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);
}
/* V_LENS -> V_FILTER -> V_TRANSFORM */
-static struct value *xform_transform(struct info *info, struct value *l,
- struct value *f) {
+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 v;
}
-static struct value *sys_getenv(struct info *info, struct value *n) {
- assert(n->tag == V_STRING);
+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(n->string->str));
+ v->string = dup_string(getenv(argv[0]->string->str));
return v;
}
-static struct value *sys_read_file(struct info *info, struct value *n) {
+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;
/* V_LENS -> V_LENS */
static struct value *lns_check_rec_glue(struct info *info,
- struct value *l, struct value *r) {
+ 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 = info->error->aug->flags & AUG_TYPE_CHECK;
+ int check = typecheck_p(info);
return lns_check_rec(info, l->lens, r->lens, check);
}
*/
/* V_STRING -> V_UNIT */
-static struct value *pr_string(struct info *info, struct value *s) {
- printf("%s", s->string->str);
+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 *r) {
- print_regexp(stdout, r->regexp);
+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 *s) {
- printf("%s\n", s->string->str);
+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
*/
}
/* V_LENS -> V_REGEXP */
-static struct value *lns_ctype(struct info *info, struct value *l) {
- return lns_value_of_type(info, l->lens->ctype);
+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 *l) {
- return lns_value_of_type(info, l->lens->atype);
+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 *l) {
- return lns_value_of_type(info, l->lens->vtype);
+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 *l) {
- return lns_value_of_type(info, l->lens->ktype);
+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 *l) {
+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 exn_error();
+ 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 *rx, struct value *s) {
+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;
match = strndup(str + regs.start[0], regs.end[0] - regs.start[0]);
}
if (match == NULL) {
- result = exn_error();
+ result = info->error->exn;
} else {
result = make_value(V_STRING, ref(info));
result->string = make_string(match);
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", 2, lns_square, T_REGEXP, T_LENS, 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,
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);