4 * Copyright (C) 2007-2016 David Lutterkort
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.
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.
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
20 * Author: David Lutterkort <dlutter@redhat.com>
31 #include <sys/types.h>
38 #include "transform.h"
41 /* Extension of source files */
42 #define AUG_EXT ".aug"
44 #define LNS_TYPE_CHECK(ctx) ((ctx)->aug->flags & AUG_TYPE_CHECK)
46 static const char *const builtin_module = "Builtin";
48 static const struct type string_type = { .ref = UINT_MAX, .tag = T_STRING };
49 static const struct type regexp_type = { .ref = UINT_MAX, .tag = T_REGEXP };
50 static const struct type lens_type = { .ref = UINT_MAX, .tag = T_LENS };
51 static const struct type tree_type = { .ref = UINT_MAX, .tag = T_TREE };
52 static const struct type filter_type = { .ref = UINT_MAX, .tag = T_FILTER };
53 static const struct type transform_type =
54 { .ref = UINT_MAX, .tag = T_TRANSFORM };
55 static const struct type unit_type = { .ref = UINT_MAX, .tag = T_UNIT };
57 const struct type *const t_string = &string_type;
58 const struct type *const t_regexp = ®exp_type;
59 const struct type *const t_lens = &lens_type;
60 const struct type *const t_tree = &tree_type;
61 const struct type *const t_filter = &filter_type;
62 const struct type *const t_transform = &transform_type;
63 const struct type *const t_unit = &unit_type;
65 static const char *const type_names[] = {
66 "string", "regexp", "lens", "tree", "filter",
67 "transform", "function", "unit", NULL
70 /* The anonymous identifier which we will never bind */
71 static const char anon_ident[] = "_";
73 static void print_value(FILE *out, struct value *v);
75 /* The evaluation context with all loaded modules and the bindings for the
76 * module we are working on in LOCAL
79 const char *name; /* The module we are working on */
81 struct binding *local;
84 static int init_fatal_exn(struct error *error) {
85 if (error->exn != NULL)
87 error->exn = make_exn_value(ref(error->info), "Error during evaluation");
88 if (error->exn == NULL)
90 error->exn->exn->seen = 1;
91 error->exn->exn->error = 1;
92 error->exn->exn->lines = NULL;
93 error->exn->exn->nlines = 0;
94 error->exn->ref = REF_MAX;
98 static void format_error(struct info *info, aug_errcode_t code,
99 const char *format, va_list ap) {
100 struct error *error = info->error;
101 char *si = NULL, *sf = NULL, *sd = NULL;
105 /* Only syntax errors are cumulative */
106 if (code != AUG_ESYNTAX)
107 FREE(error->details);
109 si = format_info(info);
110 r = vasprintf(&sf, format, ap);
113 if (error->details != NULL) {
114 r = xasprintf(&sd, "%s\n%s%s", error->details,
115 (si == NULL) ? "(no location)" : si,
116 (sf == NULL) ? "(no details)" : sf);
118 r = xasprintf(&sd, "%s%s",
119 (si == NULL) ? "(no location)" : si,
120 (sf == NULL) ? "(no details)" : sf);
123 free(error->details);
130 void syntax_error(struct info *info, const char *format, ...) {
131 struct error *error = info->error;
134 if (error->code != AUG_NOERROR && error->code != AUG_ESYNTAX)
137 va_start(ap, format);
138 format_error(info, AUG_ESYNTAX, format, ap);
142 void fatal_error(struct info *info, const char *format, ...) {
143 struct error *error = info->error;
146 if (error->code == AUG_EINTERNAL)
149 va_start(ap, format);
150 format_error(info, AUG_EINTERNAL, format, ap);
154 static void free_param(struct param *param) {
157 assert(param->ref == 0);
158 unref(param->info, info);
159 unref(param->name, string);
160 unref(param->type, type);
164 void free_term(struct term *term) {
167 assert(term->ref == 0);
171 free(term->autoload);
172 unref(term->decls, term);
176 unref(term->exp, term);
184 unref(term->left, term);
185 unref(term->right, term);
188 unref(term->value, value);
191 unref(term->ident, string);
194 unref(term->brexp, term);
197 unref(term->param, param);
198 unref(term->body, term);
201 unref(term->rexp, term);
204 unref(term->test, term);
205 unref(term->result, term);
211 unref(term->next, term);
212 unref(term->info, info);
213 unref(term->type, type);
217 static void free_binding(struct binding *binding) {
220 assert(binding->ref == 0);
221 unref(binding->next, binding);
222 unref(binding->ident, string);
223 unref(binding->type, type);
224 unref(binding->value, value);
228 void free_module(struct module *module) {
231 assert(module->ref == 0);
233 unref(module->next, module);
234 unref(module->bindings, binding);
235 unref(module->autoload, transform);
239 void free_type(struct type *type) {
242 assert(type->ref == 0);
244 if (type->tag == T_ARROW) {
245 unref(type->dom, type);
246 unref(type->img, type);
251 static void free_exn(struct exn *exn) {
255 unref(exn->info, info);
257 for (int i=0; i < exn->nlines; i++) {
264 void free_value(struct value *v) {
271 unref(v->string, string);
274 unref(v->regexp, regexp);
277 unref(v->lens, lens);
280 free_tree(v->origin);
283 unref(v->filter, filter);
286 unref(v->transform, transform);
290 unref(v->native->type, type);
294 unref(v->func, term);
295 unref(v->bindings, binding);
305 unref(v->info, info);
310 * Creation of (some) terms. Others are in parser.y
311 * Refernce counted arguments are now owned by the returned object, i.e.
312 * the make_* functions do not increment the count.
313 * Returned objects have a referece count of 1.
315 struct term *make_term(enum term_tag tag, struct info *info) {
317 if (make_ref(term) < 0) {
326 struct term *make_param(char *name, struct type *type, struct info *info) {
327 struct term *term = make_term(A_FUNC, info);
330 make_ref_err(term->param);
331 term->param->info = ref(term->info);
332 make_ref_err(term->param->name);
333 term->param->name->str = name;
334 term->param->type = type;
341 struct value *make_value(enum value_tag tag, struct info *info) {
342 struct value *value = NULL;
343 if (make_ref(value) < 0) {
352 struct value *make_unit(struct info *info) {
353 return make_value(V_UNIT, info);
356 struct term *make_app_term(struct term *lambda, struct term *arg,
358 struct term *app = make_term(A_APP, info);
369 struct term *make_app_ident(char *id, struct term *arg, struct info *info) {
370 struct term *ident = make_term(A_IDENT, ref(info));
371 ident->ident = make_string(id);
372 if (ident->ident == NULL) {
378 return make_app_term(ident, arg, info);
381 struct term *build_func(struct term *params, struct term *exp) {
382 assert(params->tag == A_FUNC);
383 if (params->next != NULL)
384 exp = build_func(params->next, exp);
391 /* Ownership is taken as needed */
392 static struct value *make_closure(struct term *func, struct binding *bnds) {
393 struct value *v = NULL;
394 if (make_ref(v) == 0) {
396 v->info = ref(func->info);
398 v->bindings = ref(bnds);
403 struct value *make_exn_value(struct info *info,
404 const char *format, ...) {
410 va_start(ap, format);
411 r = vasprintf(&message, format, ap);
416 v = make_value(V_EXN, ref(info));
419 v->exn->message = message;
424 void exn_add_lines(struct value *v, int nlines, ...) {
425 assert(v->tag == V_EXN);
428 if (REALLOC_N(v->exn->lines, v->exn->nlines + nlines) == -1)
430 va_start(ap, nlines);
431 for (int i=0; i < nlines; i++) {
432 char *line = va_arg(ap, char *);
433 v->exn->lines[v->exn->nlines + i] = line;
436 v->exn->nlines += nlines;
439 void exn_printf_line(struct value *exn, const char *format, ...) {
444 va_start(ap, format);
445 r = vasprintf(&line, format, ap);
448 exn_add_lines(exn, 1, line);
454 static int load_module(struct augeas *aug, const char *name);
455 static char *module_basename(const char *modname);
457 struct module *module_create(const char *name) {
458 struct module *module;
460 module->name = strdup(name);
464 static struct module *module_find(struct module *module, const char *name) {
465 list_for_each(e, module) {
466 if (STRCASEEQ(e->name, name))
472 static struct binding *bnd_lookup(struct binding *bindings, const char *name) {
473 list_for_each(b, bindings) {
474 if (STREQ(b->ident->str, name))
480 static char *modname_of_qname(const char *qname) {
481 char *dot = strchr(qname, '.');
485 return strndup(qname, dot - qname);
488 static int lookup_internal(struct augeas *aug, const char *ctx_modname,
489 const char *name, struct binding **bnd) {
490 char *modname = modname_of_qname(name);
494 if (modname == NULL) {
495 struct module *builtin =
496 module_find(aug->modules, builtin_module);
497 assert(builtin != NULL);
498 *bnd = bnd_lookup(builtin->bindings, name);
503 list_for_each(module, aug->modules) {
504 if (STRCASEEQ(module->name, modname)) {
505 *bnd = bnd_lookup(module->bindings, name + strlen(modname) + 1);
510 /* Try to load the module */
511 if (streqv(modname, ctx_modname)) {
515 int loaded = load_module(aug, modname) == 0;
523 struct lens *lens_lookup(struct augeas *aug, const char *qname) {
524 struct binding *bnd = NULL;
526 if (lookup_internal(aug, NULL, qname, &bnd) < 0)
528 if (bnd == NULL || bnd->value->tag != V_LENS)
530 return bnd->value->lens;
533 static struct binding *ctx_lookup_bnd(struct info *info,
534 struct ctx *ctx, const char *name) {
535 struct binding *b = NULL;
536 int nlen = strlen(ctx->name);
538 if (STREQLEN(ctx->name, name, nlen) && name[nlen] == '.')
541 b = bnd_lookup(ctx->local, name);
545 if (ctx->aug != NULL) {
547 r = lookup_internal(ctx->aug, ctx->name, name, &b);
550 char *modname = modname_of_qname(name);
551 syntax_error(info, "Could not load module %s for %s",
559 static struct value *ctx_lookup(struct info *info,
560 struct ctx *ctx, struct string *ident) {
561 struct binding *b = ctx_lookup_bnd(info, ctx, ident->str);
562 return b == NULL ? NULL : b->value;
565 static struct type *ctx_lookup_type(struct info *info,
566 struct ctx *ctx, struct string *ident) {
567 struct binding *b = ctx_lookup_bnd(info, ctx, ident->str);
568 return b == NULL ? NULL : b->type;
571 /* Takes ownership as needed */
572 static struct binding *bind_type(struct binding **bnds,
573 const char *name, struct type *type) {
574 struct binding *binding;
576 if (STREQ(name, anon_ident))
579 make_ref(binding->ident);
580 binding->ident->str = strdup(name);
581 binding->type = ref(type);
582 list_cons(*bnds, binding);
587 /* Takes ownership as needed */
588 static void bind_param(struct binding **bnds, struct param *param,
592 b->ident = ref(param->name);
593 b->type = ref(param->type);
599 static void unbind_param(struct binding **bnds, ATTRIBUTE_UNUSED struct param *param) {
600 struct binding *b = *bnds;
601 assert(b->ident == param->name);
602 assert(b->next != *bnds);
607 /* Takes ownership of VALUE */
608 static void bind(struct binding **bnds,
609 const char *name, struct type *type, struct value *value) {
610 struct binding *b = NULL;
612 if (STRNEQ(name, anon_ident)) {
613 b = bind_type(bnds, name, type);
614 b->value = ref(value);
619 * Some debug printing
622 static char *type_string(struct type *t);
624 static void dump_bindings(struct binding *bnds) {
625 list_for_each(b, bnds) {
626 char *st = type_string(b->type);
627 fprintf(stderr, " %s: %s", b->ident->str, st);
628 fprintf(stderr, " = ");
629 print_value(stderr, b->value);
635 static void dump_module(struct module *module) {
638 fprintf(stderr, "Module %s\n:", module->name);
639 dump_bindings(module->bindings);
640 dump_module(module->next);
644 static void dump_ctx(struct ctx *ctx) {
645 fprintf(stderr, "Context: %s\n", ctx->name);
646 dump_bindings(ctx->local);
647 if (ctx->aug != NULL) {
648 list_for_each(m, ctx->aug->modules)
656 void print_tree_braces(FILE *out, int indent, struct tree *tree) {
658 fprintf(out, "(null tree)\n");
661 list_for_each(t, tree) {
662 for (int i=0; i < indent; i++) fputc(' ', out);
664 if (t->label != NULL)
665 fprintf(out, "\"%s\"", t->label);
666 if (t->value != NULL)
667 fprintf(out, " = \"%s\"", t->value);
668 if (t->children != NULL) {
670 print_tree_braces(out, indent + 2, t->children);
671 for (int i=0; i < indent; i++) fputc(' ', out);
679 static void print_value(FILE *out, struct value *v) {
681 fprintf(out, "<null>");
687 fprintf(out, "\"%s\"", v->string->str);
690 fprintf(out, "/%s/", v->regexp->pattern->str);
693 fprintf(out, "<lens:");
694 print_info(out, v->lens->info);
698 print_tree_braces(out, 0, v->origin);
701 fprintf(out, "<filter:");
702 list_for_each(f, v->filter) {
703 fprintf(out, "%c%s%c", f->include ? '+' : '-', f->glob->str,
704 (f->next != NULL) ? ':' : '>');
708 fprintf(out, "<transform:");
709 print_info(out, v->transform->lens->info);
713 fprintf(out, "<native:");
714 print_info(out, v->info);
718 fprintf(out, "<closure:");
719 print_info(out, v->func->info);
723 if (! v->exn->seen) {
724 print_info(out, v->exn->info);
725 fprintf(out, "exception: %s\n", v->exn->message);
726 for (int i=0; i < v->exn->nlines; i++) {
727 fprintf(out, " %s\n", v->exn->lines[i]);
741 static int value_equal(struct value *v1, struct value *v2) {
742 if (v1 == NULL && v2 == NULL)
744 if (v1 == NULL || v2 == NULL)
746 if (v1->tag != v2->tag)
750 return STREQ(v1->string->str, v2->string->str);
753 // FIXME: Should probably build FA's and compare them
754 return STREQ(v1->regexp->pattern->str, v2->regexp->pattern->str);
757 return v1->lens == v2->lens;
760 return tree_equal(v1->origin->children, v2->origin->children);
763 return v1->filter == v2->filter;
766 return v1->transform == v2->transform;
769 return v1->native == v2->native;
772 return v1->func == v2->func && v1->bindings == v2->bindings;
784 struct type *make_arrow_type(struct type *dom, struct type *img) {
788 type->dom = ref(dom);
789 type->img = ref(img);
793 struct type *make_base_type(enum type_tag tag) {
795 return (struct type *) t_string;
796 else if (tag == T_REGEXP)
797 return (struct type *) t_regexp;
798 else if (tag == T_LENS)
799 return (struct type *) t_lens;
800 else if (tag == T_TREE)
801 return (struct type *) t_tree;
802 else if (tag == T_FILTER)
803 return (struct type *) t_filter;
804 else if (tag == T_TRANSFORM)
805 return (struct type *) t_transform;
806 else if (tag == T_UNIT)
807 return (struct type *) t_unit;
812 static const char *type_name(struct type *t) {
813 for (int i = 0; type_names[i] != NULL; i++)
815 return type_names[i];
820 static char *type_string(struct type *t) {
821 if (t->tag == T_ARROW) {
824 char *sd = type_string(t->dom);
825 char *si = type_string(t->img);
826 if (t->dom->tag == T_ARROW)
827 r = asprintf(&s, "(%s) -> %s", sd, si);
829 r = asprintf(&s, "%s -> %s", sd, si);
832 return (r == -1) ? NULL : s;
834 return strdup(type_name(t));
838 /* Decide whether T1 is a subtype of T2. The only subtype relations are
839 * T_STRING <: T_REGEXP and the usual subtyping of functions based on
840 * comparing domains/images
842 * Return 1 if T1 is a subtype of T2, 0 otherwise
844 static int subtype(struct type *t1, struct type *t2) {
847 /* We only promote T_STRING => T_REGEXP, no automatic conversion
848 of strings/regexps to lenses (yet) */
849 if (t1->tag == T_STRING)
850 return (t2->tag == T_STRING || t2->tag == T_REGEXP);
851 if (t1->tag == T_ARROW && t2->tag == T_ARROW) {
852 return subtype(t2->dom, t1->dom)
853 && subtype(t1->img, t2->img);
855 return t1->tag == t2->tag;
858 static int type_equal(struct type *t1, struct type *t2) {
859 return (t1 == t2) || (subtype(t1, t2) && subtype(t2, t1));
862 /* Return a type T with subtype(T, T1) && subtype(T, T2) */
863 static struct type *type_meet(struct type *t1, struct type *t2);
865 /* Return a type T with subtype(T1, T) && subtype(T2, T) */
866 static struct type *type_join(struct type *t1, struct type *t2) {
867 if (t1->tag == T_STRING) {
868 if (t2->tag == T_STRING)
870 else if (t2->tag == T_REGEXP)
872 } else if (t1->tag == T_REGEXP) {
873 if (t2->tag == T_STRING || t2->tag == T_REGEXP)
875 } else if (t1->tag == T_ARROW) {
876 if (t2->tag != T_ARROW)
878 struct type *dom = type_meet(t1->dom, t2->dom);
879 struct type *img = type_join(t1->img, t2->img);
880 if (dom == NULL || img == NULL) {
885 return make_arrow_type(dom, img);
886 } else if (type_equal(t1, t2)) {
892 /* Return a type T with subtype(T, T1) && subtype(T, T2) */
893 static struct type *type_meet(struct type *t1, struct type *t2) {
894 if (t1->tag == T_STRING) {
895 if (t2->tag == T_STRING || t2->tag == T_REGEXP)
897 } else if (t1->tag == T_REGEXP) {
898 if (t2->tag == T_STRING || t2->tag == T_REGEXP)
900 } else if (t1->tag == T_ARROW) {
901 if (t2->tag != T_ARROW)
903 struct type *dom = type_join(t1->dom, t2->dom);
904 struct type *img = type_meet(t1->img, t2->img);
905 if (dom == NULL || img == NULL) {
910 return make_arrow_type(dom, img);
911 } else if (type_equal(t1, t2)) {
917 static struct type *value_type(struct value *v) {
920 return make_base_type(T_STRING);
922 return make_base_type(T_REGEXP);
924 return make_base_type(T_LENS);
926 return make_base_type(T_TREE);
928 return make_base_type(T_FILTER);
930 return make_base_type(T_TRANSFORM);
932 return make_base_type(T_UNIT);
934 return ref(v->native->type);
936 return ref(v->func->type);
937 case V_EXN: /* Fail on exceptions */
944 /* Coerce V to the type T. Currently, only T_STRING can be coerced to
945 * T_REGEXP. Returns a value that is owned by the caller. Trying to perform
946 * an impossible coercion is a fatal error. Receives ownership of V.
948 static struct value *coerce(struct value *v, struct type *t) {
949 struct type *vt = value_type(v);
950 if (type_equal(vt, t)) {
954 if (vt->tag == T_STRING && t->tag == T_REGEXP) {
955 struct value *rxp = make_value(V_REGEXP, ref(v->info));
956 rxp->regexp = make_regexp_literal(v->info, v->string->str);
961 return make_exn_value(v->info, "Type %s can not be coerced to %s",
962 type_name(vt), type_name(t));
965 /* Return one of the expected types (passed as ...).
966 Does not give ownership of the returned type */
967 static struct type *expect_types_arr(struct info *info,
969 int ntypes, struct type *allowed[]) {
970 struct type *result = NULL;
972 for (int i=0; i < ntypes; i++) {
973 if (subtype(act, allowed[i])) {
978 if (result == NULL) {
980 for (int i=0; i < ntypes; i++) {
981 len += strlen(type_name(allowed[i]));
983 len += (ntypes - 1) * 4 + 1;
985 CALLOC(allowed_names, len);
986 for (int i=0; i < ntypes; i++) {
988 strcat(allowed_names, (i == ntypes - 1) ? ", or " : ", ");
989 strcat(allowed_names, type_name(allowed[i]));
991 char *act_str = type_string(act);
992 syntax_error(info, "type error: expected %s but found %s",
993 allowed_names, act_str);
1000 static struct type *expect_types(struct info *info,
1001 struct type *act, int ntypes, ...) {
1003 struct type *allowed[ntypes];
1005 va_start(ap, ntypes);
1006 for (int i=0; i < ntypes; i++)
1007 allowed[i] = va_arg(ap, struct type *);
1009 return expect_types_arr(info, act, ntypes, allowed);
1012 static struct value *apply(struct term *app, struct ctx *ctx);
1014 typedef struct value *(*impl0)(struct info *);
1015 typedef struct value *(*impl1)(struct info *, struct value *);
1016 typedef struct value *(*impl2)(struct info *, struct value *, struct value *);
1017 typedef struct value *(*impl3)(struct info *, struct value *, struct value *,
1019 typedef struct value *(*impl4)(struct info *, struct value *, struct value *,
1020 struct value *, struct value *);
1021 typedef struct value *(*impl5)(struct info *, struct value *, struct value *,
1022 struct value *, struct value *, struct value *);
1024 static struct value *native_call(struct info *info,
1025 struct native *func, struct ctx *ctx) {
1026 struct value *argv[func->argc];
1027 struct binding *b = ctx->local;
1028 struct value *result;
1030 for (int i = func->argc - 1; i >= 0; i--) {
1035 switch(func->argc) {
1037 result = ((impl0) *func->impl)(info);
1040 result = ((impl1) *func->impl)(info, argv[0]);
1043 result = ((impl2) *func->impl)(info, argv[0], argv[1]);
1046 result = ((impl3) *func->impl)(info, argv[0], argv[1], argv[2]);
1049 result = ((impl4) *func->impl)(info, argv[0], argv[1], argv[2], argv[3]);
1052 result = ((impl5) *func->impl)(info, argv[0], argv[1], argv[2], argv[3],
1064 static void type_error1(struct info *info, const char *msg, struct type *type) {
1065 char *s = type_string(type);
1066 syntax_error(info, "Type error: ");
1067 syntax_error(info, msg, s);
1071 static void type_error2(struct info *info, const char *msg,
1072 struct type *type1, struct type *type2) {
1073 char *s1 = type_string(type1);
1074 char *s2 = type_string(type2);
1075 syntax_error(info, "Type error: ");
1076 syntax_error(info, msg, s1, s2);
1081 static void type_error_binop(struct info *info, const char *opname,
1082 struct type *type1, struct type *type2) {
1083 char *s1 = type_string(type1);
1084 char *s2 = type_string(type2);
1085 syntax_error(info, "Type error: ");
1086 syntax_error(info, "%s of %s and %s is not possible", opname, s1, s2);
1091 static int check_exp(struct term *term, struct ctx *ctx);
1093 static struct type *require_exp_type(struct term *term, struct ctx *ctx,
1094 int ntypes, struct type *allowed[]) {
1097 if (term->type == NULL) {
1098 r = check_exp(term, ctx);
1103 return expect_types_arr(term->info, term->type, ntypes, allowed);
1106 static int check_compose(struct term *term, struct ctx *ctx) {
1107 struct type *tl = NULL, *tr = NULL;
1109 if (! check_exp(term->left, ctx))
1111 tl = term->left->type;
1113 if (tl->tag == T_ARROW) {
1114 /* Composition of functions f: a -> b and g: c -> d is defined as
1115 (f . g) x = g (f x) and is type correct if b <: c yielding a
1116 function with type a -> d */
1117 if (! check_exp(term->right, ctx))
1119 tr = term->right->type;
1120 if (tr->tag != T_ARROW)
1122 if (! subtype(tl->img, tr->dom))
1124 term->type = make_arrow_type(tl->dom, tr->img);
1125 } else if (tl->tag == T_UNIT) {
1126 if (! check_exp(term->right, ctx))
1128 term->type = ref(term->right->type);
1134 type_error_binop(term->info,
1135 "composition", term->left->type, term->right->type);
1139 static int check_binop(const char *opname, struct term *term,
1140 struct ctx *ctx, int ntypes, ...) {
1142 struct type *allowed[ntypes];
1143 struct type *tl = NULL, *tr = NULL;
1145 va_start(ap, ntypes);
1146 for (int i=0; i < ntypes; i++)
1147 allowed[i] = va_arg(ap, struct type *);
1150 tl = require_exp_type(term->left, ctx, ntypes, allowed);
1154 tr = require_exp_type(term->right, ctx, ntypes, allowed);
1158 term->type = type_join(tl, tr);
1159 if (term->type == NULL)
1163 type_error_binop(term->info, opname, term->left->type, term->right->type);
1167 static int check_value(struct term *term) {
1169 struct value *v = term->value;
1171 if (v->tag == V_REGEXP) {
1172 /* The only literal that needs checking are regular expressions,
1173 where we need to make sure the regexp is syntactically
1175 if (regexp_check(v->regexp, &msg) == -1) {
1176 syntax_error(v->info, "Invalid regular expression: %s", msg);
1179 term->type = make_base_type(T_REGEXP);
1180 } else if (v->tag == V_EXN) {
1181 /* Exceptions can't be typed */
1184 /* There are cases where we generate values internally, and
1185 those have their type already set; we don't want to
1187 if (term->type == NULL) {
1188 term->type = value_type(v);
1194 /* Return 1 if TERM passes, 0 otherwise */
1195 static int check_exp(struct term *term, struct ctx *ctx) {
1197 assert(term->type == NULL || term->tag == A_VALUE || term->ref > 1);
1198 if (term->type != NULL && term->tag != A_VALUE)
1201 switch (term->tag) {
1203 result = check_binop("union", term, ctx, 2, t_regexp, t_lens);
1206 result = check_binop("minus", term, ctx, 1, t_regexp);
1209 result = check_compose(term, ctx);
1212 result = check_binop("concatenation", term, ctx,
1213 4, t_string, t_regexp, t_lens, t_filter);
1217 result = check_exp(term->right, ctx);
1219 struct term *func = term->left;
1220 assert(func->tag == A_FUNC);
1221 assert(func->param->type == NULL);
1222 func->param->type = ref(term->right->type);
1224 result = check_exp(func, ctx);
1227 term->type = ref(func->type->img);
1233 result = check_exp(term->left, ctx) & check_exp(term->right, ctx);
1235 if (term->left->type->tag != T_ARROW) {
1236 type_error1(term->info,
1237 "expected function in application but found %s",
1243 result = expect_types(term->info,
1245 1, term->left->type->dom) != NULL;
1247 type_error_binop(term->info, "application",
1248 term->left->type, term->right->type);
1253 term->type = ref(term->left->type->img);
1256 result = check_value(term);
1260 struct type *t = ctx_lookup_type(term->info, ctx, term->ident);
1262 syntax_error(term->info, "Undefined variable %s",
1266 term->type = ref(t);
1271 result = check_exp(term->brexp, ctx);
1273 term->type = ref(expect_types(term->info, term->brexp->type,
1275 if (term->type == NULL) {
1276 type_error1(term->info,
1277 "[..] is only defined for lenses, not for %s",
1285 bind_param(&ctx->local, term->param, NULL);
1286 result = check_exp(term->body, ctx);
1289 make_arrow_type(term->param->type, term->body->type);
1291 unbind_param(&ctx->local, term->param);
1295 result = check_exp(term->exp, ctx);
1297 term->type = ref(expect_types(term->info, term->exp->type, 2,
1299 if (term->type == NULL) {
1300 type_error1(term->info,
1301 "Incompatible types: repetition is only defined"
1302 " for regexp and lens, not for %s",
1312 assert(!result || term->type != NULL);
1316 static int check_decl(struct term *term, struct ctx *ctx) {
1317 assert(term->tag == A_BIND || term->tag == A_TEST);
1319 if (term->tag == A_BIND) {
1320 if (!check_exp(term->exp, ctx))
1322 term->type = ref(term->exp->type);
1324 if (bnd_lookup(ctx->local, term->bname) != NULL) {
1325 syntax_error(term->info,
1326 "the name %s is already defined", term->bname);
1329 bind_type(&ctx->local, term->bname, term->type);
1330 } else if (term->tag == A_TEST) {
1331 if (!check_exp(term->test, ctx))
1333 if (term->result != NULL) {
1334 if (!check_exp(term->result, ctx))
1336 if (! type_equal(term->test->type, term->result->type)) {
1337 type_error2(term->info,
1338 "expected test result of type %s but got %s",
1339 term->result->type, term->test->type);
1343 if (expect_types(term->info, term->test->type, 2,
1344 t_string, t_tree) == NULL)
1347 term->type = ref(term->test->type);
1354 static int typecheck(struct term *term, struct augeas *aug) {
1358 const char *basenam;
1360 assert(term->tag == A_MODULE);
1362 /* Check that the module name is consistent with the filename */
1363 fname = module_basename(term->mname);
1365 basenam = strrchr(term->info->filename->str, SEP);
1366 if (basenam == NULL)
1367 basenam = term->info->filename->str;
1370 if (STRNEQ(fname, basenam)) {
1371 syntax_error(term->info,
1372 "The module %s must be in a file named %s",
1373 term->mname, fname);
1381 ctx.name = term->mname;
1382 list_for_each(dcl, term->decls) {
1383 ok &= check_decl(dcl, &ctx);
1385 unref(ctx.local, binding);
1389 static struct value *compile_exp(struct info *, struct term *, struct ctx *);
1391 static struct value *compile_union(struct term *exp, struct ctx *ctx) {
1392 struct value *v1 = compile_exp(exp->info, exp->left, ctx);
1395 struct value *v2 = compile_exp(exp->info, exp->right, ctx);
1401 struct type *t = exp->type;
1402 struct info *info = exp->info;
1403 struct value *v = NULL;
1414 if (t->tag == T_REGEXP) {
1415 v = make_value(V_REGEXP, ref(info));
1416 v->regexp = regexp_union(info, v1->regexp, v2->regexp);
1417 } else if (t->tag == T_LENS) {
1418 struct lens *l1 = v1->lens;
1419 struct lens *l2 = v2->lens;
1420 v = lns_make_union(ref(info), ref(l1), ref(l2), LNS_TYPE_CHECK(ctx));
1422 fatal_error(info, "Tried to union a %s and a %s to yield a %s",
1423 type_name(exp->left->type), type_name(exp->right->type),
1431 static struct value *compile_minus(struct term *exp, struct ctx *ctx) {
1432 struct value *v1 = compile_exp(exp->info, exp->left, ctx);
1435 struct value *v2 = compile_exp(exp->info, exp->right, ctx);
1441 struct type *t = exp->type;
1442 struct info *info = exp->info;
1447 if (t->tag == T_REGEXP) {
1448 struct regexp *re1 = v1->regexp;
1449 struct regexp *re2 = v2->regexp;
1450 struct regexp *re = regexp_minus(info, re1, re2);
1452 v = make_exn_value(ref(info),
1453 "Regular expression subtraction 'r1 - r2' failed");
1454 exn_printf_line(v, "r1: /%s/", re1->pattern->str);
1455 exn_printf_line(v, "r2: /%s/", re2->pattern->str);
1457 v = make_value(V_REGEXP, ref(info));
1462 fatal_error(info, "Tried to subtract a %s and a %s to yield a %s",
1463 type_name(exp->left->type), type_name(exp->right->type),
1471 static struct value *compile_compose(struct term *exp, struct ctx *ctx) {
1472 struct info *info = exp->info;
1475 if (exp->left->type->tag == T_ARROW) {
1476 // FIXME: This is really crufty, and should be desugared in the
1477 // parser so that we don't have to do all this manual type
1478 // computation. Should we write function compostion as
1479 // concatenation instead of using a separate syntax ?
1481 /* Build lambda x: exp->right (exp->left x) as a closure */
1482 char *var = strdup("@0");
1483 struct term *func = make_param(var, ref(exp->left->type->dom),
1485 func->type = make_arrow_type(exp->left->type->dom,
1486 exp->right->type->img);
1487 struct term *ident = make_term(A_IDENT, ref(info));
1488 ident->ident = ref(func->param->name);
1489 ident->type = ref(func->param->type);
1490 struct term *app = make_app_term(ref(exp->left), ident, ref(info));
1491 app->type = ref(app->left->type->img);
1492 app = make_app_term(ref(exp->right), app, ref(info));
1493 app->type = ref(app->right->type->img);
1495 build_func(func, app);
1497 if (!type_equal(func->type, exp->type)) {
1498 char *f = type_string(func->type);
1499 char *e = type_string(exp->type);
1501 "Composition has type %s but should have type %s", f, e);
1505 return info->error->exn;
1507 v = make_closure(func, ctx->local);
1510 v = compile_exp(exp->info, exp->left, ctx);
1512 v = compile_exp(exp->info, exp->right, ctx);
1517 static struct value *compile_concat(struct term *exp, struct ctx *ctx) {
1518 struct value *v1 = compile_exp(exp->info, exp->left, ctx);
1521 struct value *v2 = compile_exp(exp->info, exp->right, ctx);
1527 struct type *t = exp->type;
1528 struct info *info = exp->info;
1533 if (t->tag == T_STRING) {
1534 const char *s1 = v1->string->str;
1535 const char *s2 = v2->string->str;
1536 v = make_value(V_STRING, ref(info));
1537 make_ref(v->string);
1538 CALLOC(v->string->str, strlen(s1) + strlen(s2) + 1);
1539 char *s = v->string->str;
1542 } else if (t->tag == T_REGEXP) {
1543 v = make_value(V_REGEXP, ref(info));
1544 v->regexp = regexp_concat(info, v1->regexp, v2->regexp);
1545 } else if (t->tag == T_FILTER) {
1546 struct filter *f1 = v1->filter;
1547 struct filter *f2 = v2->filter;
1548 v = make_value(V_FILTER, ref(info));
1549 if (v2->ref == 1 && f2->ref == 1) {
1550 list_append(f2, ref(f1));
1551 v->filter = ref(f2);
1552 } else if (v1->ref == 1 && f1->ref == 1) {
1553 list_append(f1, ref(f2));
1554 v->filter = ref(f1);
1556 struct filter *cf1, *cf2;
1557 cf1 = make_filter(ref(f1->glob), f1->include);
1558 cf2 = make_filter(ref(f2->glob), f2->include);
1559 cf1->next = ref(f1->next);
1560 cf2->next = ref(f2->next);
1561 list_append(cf1, cf2);
1564 } else if (t->tag == T_LENS) {
1565 struct lens *l1 = v1->lens;
1566 struct lens *l2 = v2->lens;
1567 v = lns_make_concat(ref(info), ref(l1), ref(l2), LNS_TYPE_CHECK(ctx));
1570 fatal_error(info, "Tried to concat a %s and a %s to yield a %s",
1571 type_name(exp->left->type), type_name(exp->right->type),
1579 static struct value *apply(struct term *app, struct ctx *ctx) {
1580 struct value *f = compile_exp(app->info, app->left, ctx);
1581 struct value *result = NULL;
1587 struct value *arg = compile_exp(app->info, app->right, ctx);
1593 assert(f->tag == V_CLOS);
1595 lctx.aug = ctx->aug;
1596 lctx.local = ref(f->bindings);
1597 lctx.name = ctx->name;
1599 arg = coerce(arg, f->func->param->type);
1603 bind_param(&lctx.local, f->func->param, arg);
1604 result = compile_exp(app->info, f->func->body, &lctx);
1605 unref(result->info, info);
1606 result->info = ref(app->info);
1607 unbind_param(&lctx.local, f->func->param);
1610 unref(lctx.local, binding);
1616 static struct value *compile_bracket(struct term *exp, struct ctx *ctx) {
1617 struct value *arg = compile_exp(exp->info, exp->brexp, ctx);
1620 assert(arg->tag == V_LENS);
1622 struct value *v = lns_make_subtree(ref(exp->info), ref(arg->lens));
1628 static struct value *compile_rep(struct term *rep, struct ctx *ctx) {
1629 struct value *arg = compile_exp(rep->info, rep->rexp, ctx);
1630 struct value *v = NULL;
1635 arg = coerce(arg, rep->type);
1636 if (rep->type->tag == T_REGEXP) {
1638 if (rep->quant == Q_STAR) {
1640 } else if (rep->quant == Q_PLUS) {
1642 } else if (rep->quant == Q_MAYBE) {
1648 v = make_value(V_REGEXP, ref(rep->info));
1649 v->regexp = regexp_iter(rep->info, arg->regexp, min, max);
1650 } else if (rep->type->tag == T_LENS) {
1651 int c = LNS_TYPE_CHECK(ctx);
1652 if (rep->quant == Q_STAR) {
1653 v = lns_make_star(ref(rep->info), ref(arg->lens), c);
1654 } else if (rep->quant == Q_PLUS) {
1655 v = lns_make_plus(ref(rep->info), ref(arg->lens), c);
1656 } else if (rep->quant == Q_MAYBE) {
1657 v = lns_make_maybe(ref(rep->info), ref(arg->lens), c);
1662 fatal_error(rep->info, "Tried to repeat a %s to yield a %s",
1663 type_name(rep->rexp->type), type_name(rep->type));
1669 static struct value *compile_exp(struct info *info,
1670 struct term *exp, struct ctx *ctx) {
1671 struct value *v = NULL;
1675 v = compile_compose(exp, ctx);
1678 v = compile_union(exp, ctx);
1681 v = compile_minus(exp, ctx);
1684 v = compile_concat(exp, ctx);
1687 v = apply(exp, ctx);
1690 if (exp->value->tag == V_NATIVE) {
1691 v = native_call(info, exp->value->native, ctx);
1693 v = ref(exp->value);
1697 v = ref(ctx_lookup(exp->info, ctx, exp->ident));
1700 v = compile_bracket(exp, ctx);
1703 v = make_closure(exp, ctx->local);
1706 v = compile_rep(exp, ctx);
1716 static int compile_test(struct term *term, struct ctx *ctx) {
1717 struct value *actual = compile_exp(term->info, term->test, ctx);
1718 struct value *expect = NULL;
1721 if (term->tr_tag == TR_EXN) {
1723 print_info(stdout, term->info);
1724 printf("Test run should have produced exception, but produced\n");
1725 print_value(stdout, actual);
1731 print_info(stdout, term->info);
1732 printf("exception thrown in test\n");
1733 print_value(stdout, actual);
1736 } else if (term->tr_tag == TR_CHECK) {
1737 expect = compile_exp(term->info, term->result, ctx);
1740 if (! value_equal(actual, expect)) {
1741 printf("Test failure:");
1742 print_info(stdout, term->info);
1744 printf(" Expected:\n");
1745 print_value(stdout, expect);
1747 printf(" Actual:\n");
1748 print_value(stdout, actual);
1753 printf("Test result: ");
1754 print_info(stdout, term->info);
1756 if (actual->tag == V_TREE) {
1757 print_tree_braces(stdout, 2, actual->origin->children);
1759 print_value(stdout, actual);
1765 reset_error(term->info->error);
1766 unref(actual, value);
1767 unref(expect, value);
1771 static int compile_decl(struct term *term, struct ctx *ctx) {
1772 if (term->tag == A_BIND) {
1775 struct value *v = compile_exp(term->info, term->exp, ctx);
1776 bind(&ctx->local, term->bname, term->type, v);
1778 if (EXN(v) && !v->exn->seen) {
1779 struct error *error = term->info->error;
1780 struct memstream ms;
1782 init_memstream(&ms);
1784 syntax_error(term->info, "Failed to compile %s",
1786 fprintf(ms.stream, "%s\n", error->details);
1787 print_value(ms.stream, v);
1788 close_memstream(&ms);
1791 free(error->details);
1792 error->details = ms.buf;
1794 result = !(EXN(v) || HAS_ERR(ctx->aug));
1797 } else if (term->tag == A_TEST) {
1798 return compile_test(term, ctx);
1804 static struct module *compile(struct term *term, struct augeas *aug) {
1806 struct transform *autoload = NULL;
1807 assert(term->tag == A_MODULE);
1811 ctx.name = term->mname;
1812 list_for_each(dcl, term->decls) {
1813 if (!compile_decl(dcl, &ctx))
1817 if (term->autoload != NULL) {
1818 struct binding *bnd = bnd_lookup(ctx.local, term->autoload);
1820 syntax_error(term->info, "Undefined transform in autoload %s",
1824 if (expect_types(term->info, bnd->type, 1, t_transform) == NULL)
1826 autoload = bnd->value->transform;
1828 struct module *module = module_create(term->mname);
1829 module->bindings = ctx.local;
1830 module->autoload = ref(autoload);
1833 unref(ctx.local, binding);
1838 * Defining native functions
1840 static struct info *
1841 make_native_info(struct error *error, const char *fname, int line) {
1843 if (make_ref(info) < 0)
1845 info->first_line = info->last_line = line;
1846 info->first_column = info->last_column = 0;
1847 info->error = error;
1848 if (make_ref(info->filename) < 0)
1850 info->filename->str = strdup(fname);
1857 int define_native_intl(const char *file, int line,
1858 struct error *error,
1859 struct module *module, const char *name,
1860 int argc, void *impl, ...) {
1861 assert(argc > 0); /* We have no unit type */
1865 struct term *params = NULL, *body = NULL, *func = NULL;
1867 struct value *v = NULL;
1868 struct info *info = NULL;
1871 info = make_native_info(error, file, line);
1876 for (int i=0; i < argc; i++) {
1879 tag = va_arg(ap, enum type_tag);
1880 type = make_base_type(tag);
1881 snprintf(ident, 10, "@%d", i);
1882 pterm = make_param(strdup(ident), type, ref(info));
1883 list_append(params, pterm);
1885 tag = va_arg(ap, enum type_tag);
1888 type = make_base_type(tag);
1897 if (ALLOC(v->native) < 0)
1899 v->native->argc = argc;
1900 v->native->type = type;
1901 v->native->impl = impl;
1906 body->info = ref(info);
1907 body->type = ref(type);
1908 body->tag = A_VALUE;
1912 func = build_func(params, body);
1917 ctx.local = ref(module->bindings);
1918 ctx.name = module->name;
1919 if (! check_exp(func, &ctx)) {
1920 fatal_error(info, "Typechecking native %s failed",
1924 v = make_closure(func, ctx.local);
1926 unref(module->bindings, binding);
1929 bind(&ctx.local, name, func->type, v);
1932 unref(module->bindings, binding);
1934 module->bindings = ctx.local;
1937 list_for_each(p, params) {
1947 /* Defined in parser.y */
1948 int augl_parse_file(struct augeas *aug, const char *name, struct term **term);
1950 static char *module_basename(const char *modname) {
1953 if (asprintf(&fname, "%s" AUG_EXT, modname) == -1)
1955 for (int i=0; i < strlen(modname); i++)
1956 fname[i] = tolower(fname[i]);
1960 static char *module_filename(struct augeas *aug, const char *modname) {
1962 char *filename = NULL;
1963 char *name = module_basename(modname);
1965 while ((dir = argz_next(aug->modpathz, aug->nmodpath, dir)) != NULL) {
1966 int len = strlen(name) + strlen(dir) + 2;
1969 if (REALLOC_N(filename, len) == -1)
1971 sprintf(filename, "%s/%s", dir, name);
1972 if (stat(filename, &st) == 0)
1982 int load_module_file(struct augeas *aug, const char *filename,
1984 struct term *term = NULL;
1987 if (aug->flags & AUG_TRACE_MODULE_LOADING)
1988 printf("Module %s", filename);
1989 augl_parse_file(aug, filename, &term);
1990 if (aug->flags & AUG_TRACE_MODULE_LOADING)
1991 printf(HAS_ERR(aug) ? " failed\n" : " loaded\n");
1994 if (! typecheck(term, aug))
1997 struct module *module = compile(term, aug);
1998 bool bad_module = (module == NULL);
1999 if (bad_module && name != NULL) {
2000 /* Put an empty placeholder on the module list so that
2001 * we don't retry loading this module everytime its mentioned
2003 module = module_create(name);
2005 if (module != NULL) {
2006 list_append(aug->modules, module);
2007 list_for_each(bnd, module->bindings) {
2008 if (bnd->value->tag == V_LENS) {
2009 lens_release(bnd->value->lens);
2013 ERR_THROW(bad_module, aug, AUG_ESYNTAX, "Failed to load %s", filename);
2017 // FIXME: This leads to a bad free of a string used in a del lens
2018 // To reproduce run lenses/tests/test_yum.aug
2023 static int load_module(struct augeas *aug, const char *name) {
2024 char *filename = NULL;
2026 if (module_find(aug->modules, name) != NULL)
2029 if ((filename = module_filename(aug, name)) == NULL)
2032 if (load_module_file(aug, filename, name) == -1)
2043 int interpreter_init(struct augeas *aug) {
2046 r = init_fatal_exn(aug->error);
2050 aug->modules = builtin_init(aug->error);
2051 if (aug->flags & AUG_NO_MODL_AUTOLOAD)
2054 // For now, we just load every file on the search path
2055 const char *dir = NULL;
2057 int gl_flags = GLOB_NOSORT;
2059 MEMZERO(&globbuf, 1);
2061 while ((dir = argz_next(aug->modpathz, aug->nmodpath, dir)) != NULL) {
2063 r = asprintf(&globpat, "%s/*.aug", dir);
2064 ERR_NOMEM(r < 0, aug);
2066 r = glob(globpat, gl_flags, NULL, &globbuf);
2067 if (r != 0 && r != GLOB_NOMATCH) {
2068 /* This really has to be an allocation failure; glob is not
2069 * supposed to return GLOB_ABORTED here */
2070 aug_errcode_t code =
2071 r == GLOB_NOSPACE ? AUG_ENOMEM : AUG_EINTERNAL;
2072 ERR_REPORT(aug, code, "glob failure for %s", globpat);
2076 gl_flags |= GLOB_APPEND;
2080 for (int i=0; i < globbuf.gl_pathc; i++) {
2082 p = strrchr(globbuf.gl_pathv[i], SEP);
2084 p = globbuf.gl_pathv[i];
2088 name = strndup(p, q - p);
2089 name[0] = toupper(name[0]);
2090 if (load_module(aug, name) == -1)
2103 * indent-tabs-mode: nil