/src/augeas/src/syntax.c

Source (jump to first uncovered line)
/*
 * syntax.c:
 *
 * 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 <assert.h>
#include <stdarg.h>
#include <limits.h>
#include <ctype.h>
#include <glob.h>
#include <argz.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <unistd.h>

#include "memory.h"
#include "syntax.h"
#include "augeas.h"
#include "transform.h"
#include "errcode.h"

/* Extension of source files */
#define AUG_EXT ".aug"

#define LNS_TYPE_CHECK(ctx) ((ctx)->aug->flags & AUG_TYPE_CHECK)

static const char *const builtin_module = "Builtin";

static const struct type string_type    = { .ref = UINT_MAX, .tag = T_STRING };
static const struct type regexp_type    = { .ref = UINT_MAX, .tag = T_REGEXP };
static const struct type lens_type      = { .ref = UINT_MAX, .tag = T_LENS };
static const struct type tree_type      = { .ref = UINT_MAX, .tag = T_TREE };
static const struct type filter_type    = { .ref = UINT_MAX, .tag = T_FILTER };
static const struct type transform_type =
                                       { .ref = UINT_MAX, .tag = T_TRANSFORM };
static const struct type unit_type      = { .ref = UINT_MAX, .tag = T_UNIT };

const struct type *const t_string    = &string_type;
const struct type *const t_regexp    = &regexp_type;
const struct type *const t_lens      = &lens_type;
const struct type *const t_tree      = &tree_type;
const struct type *const t_filter    = &filter_type;
const struct type *const t_transform = &transform_type;
const struct type *const t_unit      = &unit_type;

static const char *const type_names[] = {
    "string", "regexp", "lens", "tree", "filter",
    "transform", "function", "unit", NULL
};

/* The anonymous identifier which we will never bind */
static const char anon_ident[] = "_";

static void print_value(FILE *out, struct value *v);

/* The evaluation context with all loaded modules and the bindings for the
 * module we are working on in LOCAL
 */
struct ctx {
    const char     *name;     /* The module we are working on */
    struct augeas  *aug;
    struct binding *local;
};

static int init_fatal_exn(struct error *error) {
    if (error->exn != NULL)
        return 0;
    error->exn = make_exn_value(ref(error->info), "Error during evaluation");
    if (error->exn == NULL)
        return -1;
    error->exn->exn->seen = 1;
    error->exn->exn->error = 1;
    error->exn->exn->lines = NULL;
    error->exn->exn->nlines = 0;
    error->exn->ref = REF_MAX;
    return 0;
}

static void format_error(struct info *info, aug_errcode_t code,
                         const char *format, va_list ap) {
    struct error *error = info->error;
    char *si = NULL, *sf = NULL, *sd = NULL;
    int r;

    error->code = code;
    /* Only syntax errors are cumulative */
    if (code != AUG_ESYNTAX)
        FREE(error->details);

    si = format_info(info);
    r = vasprintf(&sf, format, ap);
    if (r < 0)
        sf = NULL;
    if (error->details != NULL) {
        r = xasprintf(&sd, "%s\n%s%s", error->details,
                      (si == NULL) ? "(no location)" : si,
                      (sf == NULL) ? "(no details)" : sf);
    } else {
        r = xasprintf(&sd, "%s%s",
                      (si == NULL) ? "(no location)" : si,
                      (sf == NULL) ? "(no details)" : sf);
    }
    if (r >= 0) {
        free(error->details);
        error->details = sd;
    }
    free(si);
    free(sf);
}

void syntax_error(struct info *info, const char *format, ...) {
    struct error *error = info->error;
    va_list ap;

    if (error->code != AUG_NOERROR && error->code != AUG_ESYNTAX)
        return;

    va_start(ap, format);
    format_error(info, AUG_ESYNTAX, format, ap);
    va_end(ap);
}

void fatal_error(struct info *info, const char *format, ...) {
    struct error *error = info->error;
    va_list ap;

    if (error->code == AUG_EINTERNAL)
        return;

    va_start(ap, format);
    format_error(info, AUG_EINTERNAL, format, ap);
    va_end(ap);
}

static void free_param(struct param *param) {
    if (param == NULL)
        return;
    assert(param->ref == 0);
    unref(param->info, info);
    unref(param->name, string);
    unref(param->type, type);
    free(param);
}

void free_term(struct term *term) {
    if (term == NULL)
        return;
    assert(term->ref == 0);
    switch(term->tag) {
    case A_MODULE:
        free(term->mname);
        free(term->autoload);
        unref(term->decls, term);
        break;
    case A_BIND:
        free(term->bname);
        unref(term->exp, term);
        break;
    case A_COMPOSE:
    case A_UNION:
    case A_MINUS:
    case A_CONCAT:
    case A_APP:
    case A_LET:
        unref(term->left, term);
        unref(term->right, term);
        break;
    case A_VALUE:
        unref(term->value, value);
        break;
    case A_IDENT:
        unref(term->ident, string);
        break;
    case A_BRACKET:
        unref(term->brexp, term);
        break;
    case A_FUNC:
        unref(term->param, param);
        unref(term->body, term);
        break;
    case A_REP:
        unref(term->rexp, term);
        break;
    case A_TEST:
        unref(term->test, term);
        unref(term->result, term);
        break;
    default:
        assert(0);
        break;
    }
    unref(term->next, term);
    unref(term->info, info);
    unref(term->type, type);
    free(term);
}

static void free_binding(struct binding *binding) {
    if (binding == NULL)
        return;
    assert(binding->ref == 0);
    unref(binding->next, binding);
    unref(binding->ident, string);
    unref(binding->type, type);
    unref(binding->value, value);
    free(binding);
}

void free_module(struct module *module) {
    if (module == NULL)
        return;
    assert(module->ref == 0);
    free(module->name);
    unref(module->next, module);
    unref(module->bindings, binding);
    unref(module->autoload, transform);
    free(module);
}

void free_type(struct type *type) {
    if (type == NULL)
        return;
    assert(type->ref == 0);

    if (type->tag == T_ARROW) {
        unref(type->dom, type);
        unref(type->img, type);
    }
    free(type);
}

static void free_exn(struct exn *exn) {
    if (exn == NULL)
        return;

    unref(exn->info, info);
    free(exn->message);
    for (int i=0; i < exn->nlines; i++) {
        free(exn->lines[i]);
    }
    free(exn->lines);
    free(exn);
}

void free_value(struct value *v) {
    if (v == NULL)
        return;
    assert(v->ref == 0);

    switch(v->tag) {
    case V_STRING:
        unref(v->string, string);
        break;
    case V_REGEXP:
        unref(v->regexp, regexp);
        break;
    case V_LENS:
        unref(v->lens, lens);
        break;
    case V_TREE:
        free_tree(v->origin);
        break;
    case V_FILTER:
        unref(v->filter, filter);
        break;
    case V_TRANSFORM:
        unref(v->transform, transform);
        break;
    case V_NATIVE:
        if (v->native)
            unref(v->native->type, type);
        free(v->native);
        break;
    case V_CLOS:
        unref(v->func, term);
        unref(v->bindings, binding);
        break;
    case V_EXN:
        free_exn(v->exn);
        break;
    case V_UNIT:
        break;
    default:
        assert(0);
    }
    unref(v->info, info);
    free(v);
}

/*
 * Creation of (some) terms. Others are in parser.y
 * Reference counted arguments are now owned by the returned object, i.e.
 * the make_* functions do not increment the count.
 * Returned objects have a referece count of 1.
 */
struct term *make_term(enum term_tag tag, struct info *info) {
  struct term *term;
  if (make_ref(term) < 0) {
      unref(info, info);
  } else {
      term->tag = tag;
      term->info = info;
  }
  return term;
}

struct term *make_param(char *name, struct type *type, struct info *info) {
  struct term *term = make_term(A_FUNC, info);
  if (term == NULL)
      goto error;
  make_ref_err(term->param);
  term->param->info = ref(term->info);
  make_ref_err(term->param->name);
  term->param->name->str = name;
  term->param->type = type;
  return term;
 error:
  unref(term, term);
  return NULL;
}

struct value *make_value(enum value_tag tag, struct info *info) {
    struct value *value = NULL;
    if (make_ref(value) < 0) {
        unref(info, info);
    } else {
        value->tag = tag;
        value->info = info;
    }
    return value;
}

struct value *make_unit(struct info *info) {
    return make_value(V_UNIT, info);
}

struct term *make_app_term(struct term *lambda, struct term *arg,
                           struct info *info) {
  struct term *app = make_term(A_APP, info);
  if (app == NULL) {
      unref(lambda, term);
      unref(arg, term);
  } else {
      app->left = lambda;
      app->right = arg;
  }
  return app;
}

struct term *make_app_ident(char *id, struct term *arg, struct info *info) {
    struct term *ident = make_term(A_IDENT, ref(info));
    ident->ident = make_string(id);
    if (ident->ident == NULL) {
        unref(arg, term);
        unref(info, info);
        unref(ident, term);
        return NULL;
    }
    return make_app_term(ident, arg, info);
}

struct term *build_func(struct term *params, struct term *exp) {
  assert(params->tag == A_FUNC);
  if (params->next != NULL)
    exp = build_func(params->next, exp);

  params->body = exp;
  params->next = NULL;
  return params;
}

/* Ownership is taken as needed */
static struct value *make_closure(struct term *func, struct binding *bnds) {
    struct value *v = NULL;
    if (make_ref(v) == 0) {
        v->tag  = V_CLOS;
        v->info = ref(func->info);
        v->func = ref(func);
        v->bindings = ref(bnds);
    }
    return v;
}

struct value *make_exn_value(struct info *info,
                             const char *format, ...) {
    va_list ap;
    int r;
    struct value *v;
    char *message;

    va_start(ap, format);
    r = vasprintf(&message, format, ap);
    va_end(ap);
    if (r == -1)
        return NULL;

    v = make_value(V_EXN, ref(info));
    if (ALLOC(v->exn) < 0)
        return info->error->exn;
    v->exn->info = info;
    v->exn->message = message;

    return v;
}

void exn_add_lines(struct value *v, int nlines, ...) {
    assert(v->tag == V_EXN);

    va_list ap;
    if (REALLOC_N(v->exn->lines, v->exn->nlines + nlines) == -1)
        return;
    va_start(ap, nlines);
    for (int i=0; i < nlines; i++) {
        char *line = va_arg(ap, char *);
        v->exn->lines[v->exn->nlines + i] = line;
    }
    va_end(ap);
    v->exn->nlines += nlines;
}

void exn_printf_line(struct value *exn, const char *format, ...) {
    va_list ap;
    int r;
    char *line;

    va_start(ap, format);
    r = vasprintf(&line, format, ap);
    va_end(ap);
    if (r >= 0)
        exn_add_lines(exn, 1, line);
}

/*
 * Modules
 */
static int load_module(struct augeas *aug, const char *name);
static char *module_basename(const char *modname);

struct module *module_create(const char *name) {
    struct module *module;
    make_ref(module);
    module->name = strdup(name);
    return module;
}

static struct module *module_find(struct module *module, const char *name) {
    list_for_each(e, module) {
        if (STRCASEEQ(e->name, name))
            return e;
    }
    return NULL;
}

static struct binding *bnd_lookup(struct binding *bindings, const char *name) {
    list_for_each(b, bindings) {
        if (STREQ(b->ident->str, name))
            return b;
    }
    return NULL;
}

static char *modname_of_qname(const char *qname) {
    char *dot = strchr(qname, '.');
    if (dot == NULL)
        return NULL;

    return strndup(qname, dot - qname);
}

static int lookup_internal(struct augeas *aug, const char *ctx_modname,
                           const char *name, struct binding **bnd) {
    char *modname = modname_of_qname(name);

    *bnd = NULL;

    if (modname == NULL) {
        struct module *builtin =
            module_find(aug->modules, builtin_module);
        assert(builtin != NULL);
        *bnd = bnd_lookup(builtin->bindings, name);
        return 0;
    }

 qual_lookup:
    list_for_each(module, aug->modules) {
        if (STRCASEEQ(module->name, modname)) {
            *bnd = bnd_lookup(module->bindings, name + strlen(modname) + 1);
            free(modname);
            return 0;
        }
    }
    /* Try to load the module */
    if (streqv(modname, ctx_modname)) {
        free(modname);
        return 0;
    }
    int loaded = load_module(aug, modname) == 0;
    if (loaded)
        goto qual_lookup;

    free(modname);
    return -1;
}

struct lens *lens_lookup(struct augeas *aug, const char *qname) {
    struct binding *bnd = NULL;

    if (lookup_internal(aug, NULL, qname, &bnd) < 0)
        return NULL;
    if (bnd == NULL || bnd->value->tag != V_LENS)
        return NULL;
    return bnd->value->lens;
}

static struct binding *ctx_lookup_bnd(struct info *info,
                                      struct ctx *ctx, const char *name) {
    struct binding *b = NULL;
    int nlen = strlen(ctx->name);

    if (STREQLEN(ctx->name, name, nlen) && name[nlen] == '.')
        name += nlen + 1;

    b = bnd_lookup(ctx->local, name);
    if (b != NULL)
        return b;

    if (ctx->aug != NULL) {
        int r;
        r = lookup_internal(ctx->aug, ctx->name, name, &b);
        if (r == 0)
            return b;
        char *modname = modname_of_qname(name);
        syntax_error(info, "Could not load module %s for %s",
                     modname, name);
        free(modname);
        return NULL;
    }
    return NULL;
}

static struct value *ctx_lookup(struct info *info,
                                struct ctx *ctx, struct string *ident) {
    struct binding *b = ctx_lookup_bnd(info, ctx, ident->str);
    return b == NULL ? NULL : b->value;
}

static struct type *ctx_lookup_type(struct info *info,
                                    struct ctx *ctx, struct string *ident) {
    struct binding *b = ctx_lookup_bnd(info, ctx, ident->str);
    return b == NULL ? NULL : b->type;
}

/* Takes ownership as needed */
static struct binding *bind_type(struct binding **bnds,
                                 const char *name, struct type *type) {
    struct binding *binding;

    if (STREQ(name, anon_ident))
        return NULL;
    make_ref(binding);
    make_ref(binding->ident);
    binding->ident->str = strdup(name);
    binding->type = ref(type);
    list_cons(*bnds, binding);

    return binding;
}

/* Takes ownership as needed */
static void bind_param(struct binding **bnds, struct param *param,
                       struct value *v) {
    struct binding *b;
    make_ref(b);
    b->ident = ref(param->name);
    b->type  = ref(param->type);
    b->value = ref(v);
    ref(*bnds);
    list_cons(*bnds, b);
}

static void unbind_param(struct binding **bnds, ATTRIBUTE_UNUSED struct param *param) {
    struct binding *b = *bnds;
    assert(b->ident == param->name);
    assert(b->next != *bnds);
    *bnds = b->next;
    unref(b, binding);
}

/* Takes ownership of VALUE */
static void bind(struct binding **bnds,
                 const char *name, struct type *type, struct value *value) {
    struct binding *b = NULL;

    if (STRNEQ(name, anon_ident)) {
        b = bind_type(bnds, name, type);
        b->value = ref(value);
    }
}

/*
 * Some debug printing
 */

static char *type_string(struct type *t);

static void dump_bindings(struct binding *bnds) {
    list_for_each(b, bnds) {
        char *st = type_string(b->type);
        fprintf(stderr, "    %s: %s", b->ident->str, st);
        fprintf(stderr, " = ");
        print_value(stderr, b->value);
        fputc('\n', stderr);
        free(st);
    }
}

static void dump_module(struct module *module) {
    if (module == NULL)
        return;
    fprintf(stderr, "Module %s\n:", module->name);
    dump_bindings(module->bindings);
    dump_module(module->next);
}

ATTRIBUTE_UNUSED
static void dump_ctx(struct ctx *ctx) {
    fprintf(stderr, "Context: %s\n", ctx->name);
    dump_bindings(ctx->local);
    if (ctx->aug != NULL) {
        list_for_each(m, ctx->aug->modules)
            dump_module(m);
    }
}

/*
 * Values
 */
void print_tree_braces(FILE *out, int indent, struct tree *tree) {
    if (tree == NULL) {
        fprintf(out, "(null tree)\n");
        return;
    }
    list_for_each(t, tree) {
        for (int i=0; i < indent; i++) fputc(' ', out);
        fprintf(out, "{ ");
        if (t->label != NULL)
            fprintf(out, "\"%s\"", t->label);
        if (t->value != NULL)
            fprintf(out, " = \"%s\"", t->value);
        if (t->children != NULL) {
            fputc('\n', out);
            print_tree_braces(out, indent + 2, t->children);
            for (int i=0; i < indent; i++) fputc(' ', out);
        } else {
            fputc(' ', out);
        }
        fprintf(out, "}\n");
    }
}

static void print_value(FILE *out, struct value *v) {
    if (v == NULL) {
        fprintf(out, "<null>");
        return;
    }

    switch(v->tag) {
    case V_STRING:
        fprintf(out, "\"%s\"", v->string->str);
        break;
    case V_REGEXP:
        fprintf(out, "/%s/", v->regexp->pattern->str);
        break;
    case V_LENS:
        fprintf(out, "<lens:");
        print_info(out, v->lens->info);
        fprintf(out, ">");
        break;
    case V_TREE:
        print_tree_braces(out, 0, v->origin);
        break;
    case V_FILTER:
        fprintf(out, "<filter:");
        list_for_each(f, v->filter) {
            fprintf(out, "%c%s%c", f->include ? '+' : '-', f->glob->str,
                   (f->next != NULL) ? ':' : '>');
        }
        break;
    case V_TRANSFORM:
        fprintf(out, "<transform:");
        print_info(out, v->transform->lens->info);
        fprintf(out, ">");
        break;
    case V_NATIVE:
        fprintf(out, "<native:");
        print_info(out, v->info);
        fprintf(out, ">");
        break;
    case V_CLOS:
        fprintf(out, "<closure:");
        print_info(out, v->func->info);
        fprintf(out, ">");
        break;
    case V_EXN:
        if (! v->exn->seen) {
            print_info(out, v->exn->info);
            fprintf(out, "exception: %s\n", v->exn->message);
            for (int i=0; i < v->exn->nlines; i++) {
                fprintf(out, "    %s\n", v->exn->lines[i]);
            }
            v->exn->seen = 1;
        }
        break;
    case V_UNIT:
        fprintf(out, "()");
        break;
    default:
        assert(0);
        break;
    }
}

static int value_equal(struct value *v1, struct value *v2) {
    if (v1 == NULL && v2 == NULL)
        return 1;
    if (v1 == NULL || v2 == NULL)
        return 0;
    if (v1->tag != v2->tag)
        return 0;
    switch (v1->tag) {
    case V_STRING:
        return STREQ(v1->string->str, v2->string->str);
        break;
    case V_REGEXP:
        // FIXME: Should probably build FA's and compare them
        return STREQ(v1->regexp->pattern->str, v2->regexp->pattern->str);
        break;
    case V_LENS:
        return v1->lens == v2->lens;
        break;
    case V_TREE:
        return tree_equal(v1->origin->children, v2->origin->children);
        break;
    case V_FILTER:
        return v1->filter == v2->filter;
        break;
    case V_TRANSFORM:
        return v1->transform == v2->transform;
        break;
    case V_NATIVE:
        return v1->native == v2->native;
        break;
    case V_CLOS:
        return v1->func == v2->func && v1->bindings == v2->bindings;
        break;
    default:
        assert(0);
        abort();
        break;
    }
}

/*
 * Types
 */
struct type *make_arrow_type(struct type *dom, struct type *img) {
  struct type *type;
  make_ref(type);
  type->tag = T_ARROW;
  type->dom = ref(dom);
  type->img = ref(img);
  return type;
}

struct type *make_base_type(enum type_tag tag) {
    if (tag == T_STRING)
        return (struct type *) t_string;
    else if (tag == T_REGEXP)
        return (struct type *) t_regexp;
    else if (tag == T_LENS)
        return (struct type *) t_lens;
    else if (tag == T_TREE)
        return (struct type *) t_tree;
    else if (tag == T_FILTER)
        return (struct type *) t_filter;
    else if (tag == T_TRANSFORM)
        return (struct type *) t_transform;
    else if (tag == T_UNIT)
        return (struct type *) t_unit;
    assert(0);
    abort();
}

static const char *type_name(struct type *t) {
    for (int i = 0; type_names[i] != NULL; i++)
        if (i == t->tag)
            return type_names[i];
    assert(0);
    abort();
}

static char *type_string(struct type *t) {
    if (t->tag == T_ARROW) {
        char *s = NULL;
        int r;
        char *sd = type_string(t->dom);
        char *si = type_string(t->img);
        if (t->dom->tag == T_ARROW)
            r = asprintf(&s, "(%s) -> %s", sd, si);
        else
            r = asprintf(&s, "%s -> %s", sd, si);
        free(sd);
        free(si);
        return (r == -1) ? NULL : s;
    } else {
        return strdup(type_name(t));
    }
}

/* Decide whether T1 is a subtype of T2. The only subtype relations are
 * T_STRING <: T_REGEXP and the usual subtyping of functions based on
 * comparing domains/images
 *
 * Return 1 if T1 is a subtype of T2, 0 otherwise
 */
static int subtype(struct type *t1, struct type *t2) {
    if (t1 == t2)
        return 1;
    /* We only promote T_STRING => T_REGEXP, no automatic conversion
       of strings/regexps to lenses (yet) */
    if (t1->tag == T_STRING)
        return (t2->tag == T_STRING || t2->tag == T_REGEXP);
    if (t1->tag == T_ARROW && t2->tag == T_ARROW) {
        return subtype(t2->dom, t1->dom)
            && subtype(t1->img, t2->img);
    }
    return t1->tag == t2->tag;
}

static int type_equal(struct type *t1, struct type *t2) {
    return (t1 == t2) || (subtype(t1, t2) && subtype(t2, t1));
}

/* Return a type T with subtype(T, T1) && subtype(T, T2) */
static struct type *type_meet(struct type *t1, struct type *t2);

/* Return a type T with subtype(T1, T) && subtype(T2, T) */
static struct type *type_join(struct type *t1, struct type *t2) {
    if (t1->tag == T_STRING) {
        if (t2->tag == T_STRING)
            return ref(t1);
        else if (t2->tag == T_REGEXP)
            return ref(t2);
    } else if (t1->tag == T_REGEXP) {
        if (t2->tag == T_STRING || t2->tag == T_REGEXP)
            return ref(t1);
    } else if (t1->tag == T_ARROW) {
        if (t2->tag != T_ARROW)
            return NULL;
        struct type *dom = type_meet(t1->dom, t2->dom);
        struct type *img = type_join(t1->img, t2->img);
        if (dom == NULL || img == NULL) {
            unref(dom, type);
            unref(img, type);
            return NULL;
        }
        return make_arrow_type(dom, img);
    } else if (type_equal(t1, t2)) {
        return ref(t1);
    }
    return NULL;
}

/* Return a type T with subtype(T, T1) && subtype(T, T2) */
static struct type *type_meet(struct type *t1, struct type *t2) {
    if (t1->tag == T_STRING) {
        if (t2->tag == T_STRING || t2->tag == T_REGEXP)
            return ref(t1);
    } else if (t1->tag == T_REGEXP) {
        if (t2->tag == T_STRING || t2->tag == T_REGEXP)
            return ref(t2);
    } else if (t1->tag == T_ARROW) {
        if (t2->tag != T_ARROW)
            return NULL;
        struct type *dom = type_join(t1->dom, t2->dom);
        struct type *img = type_meet(t1->img, t2->img);
        if (dom == NULL || img == NULL) {
            unref(dom, type);
            unref(img, type);
            return NULL;
        }
        return make_arrow_type(dom, img);
    } else if (type_equal(t1, t2)) {
        return ref(t1);
    }
    return NULL;
}

static struct type *value_type(struct value *v) {
    switch(v->tag) {
    case V_STRING:
        return make_base_type(T_STRING);
    case V_REGEXP:
        return make_base_type(T_REGEXP);
    case V_LENS:
        return make_base_type(T_LENS);
    case V_TREE:
        return make_base_type(T_TREE);
    case V_FILTER:
        return make_base_type(T_FILTER);
    case V_TRANSFORM:
        return make_base_type(T_TRANSFORM);
    case V_UNIT:
        return make_base_type(T_UNIT);
    case V_NATIVE:
        return ref(v->native->type);
    case V_CLOS:
        return ref(v->func->type);
    case V_EXN:   /* Fail on exceptions */
    default:
        assert(0);
        abort();
    }
}

/* Coerce V to the type T. Currently, only T_STRING can be coerced to
 * T_REGEXP. Returns a value that is owned by the caller. Trying to perform
 * an impossible coercion is a fatal error. Receives ownership of V.
 */
static struct value *coerce(struct value *v, struct type *t) {
    struct type *vt = value_type(v);
    if (type_equal(vt, t)) {
        unref(vt, type);
        return v;
    }
    if (vt->tag == T_STRING && t->tag == T_REGEXP) {
        struct value *rxp = make_value(V_REGEXP, ref(v->info));
        rxp->regexp = make_regexp_literal(v->info, v->string->str);
        if (rxp->regexp == NULL) {
            report_error(v->info->error, AUG_ENOMEM, NULL);
        };
        unref(v, value);
        unref(vt, type);
        return rxp;
    }
    return make_exn_value(v->info, "Type %s can not be coerced to %s",
                          type_name(vt), type_name(t));
}

/* Return one of the expected types (passed as ...).
   Does not give ownership of the returned type */
static struct type *expect_types_arr(struct info *info,
                                     struct type *act,
                                     int ntypes, struct type *allowed[]) {
    struct type *result = NULL;

    for (int i=0; i < ntypes; i++) {
        if (subtype(act, allowed[i])) {
            result = allowed[i];
            break;
        }
    }
    if (result == NULL) {
        int len = 0;
        for (int i=0; i < ntypes; i++) {
            len += strlen(type_name(allowed[i]));
        }
        len += (ntypes - 1) * 4 + 1;
        char *allowed_names;
        if (ALLOC_N(allowed_names, len) < 0)
            return NULL;
        for (int i=0; i < ntypes; i++) {
            if (i > 0)
                strcat(allowed_names, (i == ntypes - 1) ? ", or " : ", ");
            strcat(allowed_names, type_name(allowed[i]));
        }
        char *act_str = type_string(act);
        syntax_error(info, "type error: expected %s but found %s",
                     allowed_names, act_str);
        free(act_str);
        free(allowed_names);
    }
    return result;
}

static struct type *expect_types(struct info *info,
                                 struct type *act, int ntypes, ...) {
    va_list ap;
    struct type *allowed[ntypes];

    va_start(ap, ntypes);
    for (int i=0; i < ntypes; i++)
        allowed[i] = va_arg(ap, struct type *);
    va_end(ap);
    return expect_types_arr(info, act, ntypes, allowed);
}

static struct value *apply(struct term *app, struct ctx *ctx);

typedef struct value *(*impl0)(struct info *);
typedef struct value *(*impl1)(struct info *, struct value *);
typedef struct value *(*impl2)(struct info *, struct value *, struct value *);
typedef struct value *(*impl3)(struct info *, struct value *, struct value *,
                               struct value *);
typedef struct value *(*impl4)(struct info *, struct value *, struct value *,
                               struct value *, struct value *);
typedef struct value *(*impl5)(struct info *, struct value *, struct value *,
                               struct value *, struct value *, struct value *);

static struct value *native_call(struct info *info,
                                 struct native *func, struct ctx *ctx) {
    struct value *argv[func->argc + 1];
    struct binding *b = ctx->local;

    for (int i = func->argc - 1; i >= 0; i--) {
        argv[i] = b->value;
        b = b->next;
    }
    argv[func->argc] = NULL;

    return func->impl(info, argv);
}

static void type_error1(struct info *info, const char *msg, struct type *type) {
    char *s = type_string(type);
    syntax_error(info, "Type error: ");
    syntax_error(info, msg, s);
    free(s);
}

static void type_error2(struct info *info, const char *msg,
                        struct type *type1, struct type *type2) {
    char *s1 = type_string(type1);
    char *s2 = type_string(type2);
    syntax_error(info, "Type error: ");
    syntax_error(info, msg, s1, s2);
    free(s1);
    free(s2);
}

static void type_error_binop(struct info *info, const char *opname,
                             struct type *type1, struct type *type2) {
    char *s1 = type_string(type1);
    char *s2 = type_string(type2);
    syntax_error(info, "Type error: ");
    syntax_error(info, "%s of %s and %s is not possible", opname, s1, s2);
    free(s1);
    free(s2);
}

static int check_exp(struct term *term, struct ctx *ctx);

static struct type *require_exp_type(struct term *term, struct ctx *ctx,
                                     int ntypes, struct type *allowed[]) {
    int r = 1;

    if (term->type == NULL) {
        r = check_exp(term, ctx);
        if (! r)
            return NULL;
    }

    return expect_types_arr(term->info, term->type, ntypes, allowed);
}

static int check_compose(struct term *term, struct ctx *ctx) {
    struct type *tl = NULL, *tr = NULL;

    if (! check_exp(term->left, ctx))
        return 0;
    tl = term->left->type;

    if (tl->tag == T_ARROW) {
        /* Composition of functions f: a -> b and g: c -> d is defined as
           (f . g) x = g (f x) and is type correct if b <: c yielding a
           function with type a -> d */
        if (! check_exp(term->right, ctx))
            return 0;
        tr = term->right->type;
        if (tr->tag != T_ARROW)
            goto print_error;
        if (! subtype(tl->img, tr->dom))
            goto print_error;
        term->type = make_arrow_type(tl->dom, tr->img);
    } else if (tl->tag == T_UNIT) {
        if (! check_exp(term->right, ctx))
            return 0;
        term->type = ref(term->right->type);
    } else {
        goto print_error;
    }
    return 1;
 print_error:
    type_error_binop(term->info,
                     "composition", term->left->type, term->right->type);
    return 0;
}

static int check_binop(const char *opname, struct term *term,
                       struct ctx *ctx, int ntypes, ...) {
    va_list ap;
    struct type *allowed[ntypes];
    struct type *tl = NULL, *tr = NULL;

    va_start(ap, ntypes);
    for (int i=0; i < ntypes; i++)
        allowed[i] = va_arg(ap, struct type *);
    va_end(ap);

    tl = require_exp_type(term->left, ctx, ntypes, allowed);
    if (tl == NULL)
        return 0;

    tr = require_exp_type(term->right, ctx, ntypes, allowed);
    if (tr == NULL)
        return 0;

    term->type = type_join(tl, tr);
    if (term->type == NULL)
        goto print_error;
    return 1;
 print_error:
    type_error_binop(term->info, opname, term->left->type, term->right->type);
    return 0;
}

static int check_value(struct term *term) {
    const char *msg;
    struct value *v = term->value;

    if (v->tag == V_REGEXP) {
        /* The only literal that needs checking are regular expressions,
           where we need to make sure the regexp is syntactically
           correct */
        if (regexp_check(v->regexp, &msg) == -1) {
            syntax_error(v->info, "Invalid regular expression: %s", msg);
            return 0;
        }
        term->type = make_base_type(T_REGEXP);
    } else if (v->tag == V_EXN) {
        /* Exceptions can't be typed */
        return 0;
    } else {
        /* There are cases where we generate values internally, and
           those have their type already set; we don't want to
           overwrite that */
        if (term->type == NULL) {
            term->type = value_type(v);
        }
    }
    return 1;
}

/* Return 1 if TERM passes, 0 otherwise */
static int check_exp(struct term *term, struct ctx *ctx) {
    int result = 1;
    assert(term->type == NULL || term->tag == A_VALUE || term->ref > 1);
    if (term->type != NULL && term->tag != A_VALUE)
        return 1;

    switch (term->tag) {
    case A_UNION:
        result = check_binop("union", term, ctx, 2, t_regexp, t_lens);
        break;
    case A_MINUS:
        result = check_binop("minus", term, ctx, 1, t_regexp);
        break;
    case A_COMPOSE:
        result = check_compose(term, ctx);
        break;
    case A_CONCAT:
        result = check_binop("concatenation", term, ctx,
                             4, t_string, t_regexp, t_lens, t_filter);
        break;
    case A_LET:
        {
            result = check_exp(term->right, ctx);
            if (result) {
                struct term *func = term->left;
                assert(func->tag == A_FUNC);
                assert(func->param->type == NULL);
                func->param->type = ref(term->right->type);

                result = check_exp(func, ctx);
                if (result) {
                    term->tag = A_APP;
                    term->type = ref(func->type->img);
                }
            }
        }
        break;
    case A_APP:
        result = check_exp(term->left, ctx) & check_exp(term->right, ctx);
        if (result) {
            if (term->left->type->tag != T_ARROW) {
                type_error1(term->info,
                            "expected function in application but found %s",
                            term->left->type);
                result = 0;
            };
        }
        if (result) {
            result = expect_types(term->info,
                                  term->right->type,
                                  1, term->left->type->dom) != NULL;
            if (! result) {
                type_error_binop(term->info, "application",
                                 term->left->type, term->right->type);
                result = 0;
            }
        }
        if (result)
            term->type = ref(term->left->type->img);
        break;
    case A_VALUE:
        result = check_value(term);
        break;
    case A_IDENT:
        {
            struct type *t = ctx_lookup_type(term->info, ctx, term->ident);
            if (t == NULL) {
                syntax_error(term->info, "Undefined variable %s",
                             term->ident->str);
                result = 0;
            } else {
                term->type = ref(t);
            }
        }
        break;
    case A_BRACKET:
        result = check_exp(term->brexp, ctx);
        if (result) {
            term->type = ref(expect_types(term->info, term->brexp->type,
                                          1, t_lens));
            if (term->type == NULL) {
                type_error1(term->info,
                             "[..] is only defined for lenses, not for %s",
                            term->brexp->type);
                result = 0;
            }
        }
        break;
    case A_FUNC:
        {
            bind_param(&ctx->local, term->param, NULL);
            result = check_exp(term->body, ctx);
            if (result) {
                term->type =
                    make_arrow_type(term->param->type, term->body->type);
            }
            unbind_param(&ctx->local, term->param);
        }
        break;
    case A_REP:
        result = check_exp(term->exp, ctx);
        if (result) {
            term->type = ref(expect_types(term->info, term->exp->type, 2,
                                          t_regexp, t_lens));
            if (term->type == NULL) {
                type_error1(term->info,
                            "Incompatible types: repetition is only defined"
                            " for regexp and lens, not for %s",
                            term->exp->type);
                result = 0;
            }
        }
        break;
    default:
        assert(0);
        break;
    }
    assert(!result || term->type != NULL);
    return result;
}

static int check_decl(struct term *term, struct ctx *ctx) {
    assert(term->tag == A_BIND || term->tag == A_TEST);

    if (term->tag == A_BIND) {
        if (!check_exp(term->exp, ctx))
            return 0;
        term->type = ref(term->exp->type);

        if (bnd_lookup(ctx->local, term->bname) != NULL) {
            syntax_error(term->info,
                         "the name %s is already defined", term->bname);
            return 0;
        }
        bind_type(&ctx->local, term->bname, term->type);
    } else if (term->tag == A_TEST) {
        if (!check_exp(term->test, ctx))
            return 0;
        if (term->result != NULL) {
            if (!check_exp(term->result, ctx))
                return 0;
            if (! type_equal(term->test->type, term->result->type)) {
                type_error2(term->info,
                            "expected test result of type %s but got %s",
                            term->result->type, term->test->type);
                return 0;
            }
        } else {
            if (expect_types(term->info, term->test->type, 2,
                             t_string, t_tree) == NULL)
                return 0;
        }
        term->type = ref(term->test->type);
    } else {
        assert(0);
    }
    return 1;
}

static int typecheck(struct term *term, struct augeas *aug) {
    int ok = 1;
    struct ctx ctx;
    char *fname;
    const char *basenam;

    assert(term->tag == A_MODULE);

    /* Check that the module name is consistent with the filename */
    fname = module_basename(term->mname);

    basenam = strrchr(term->info->filename->str, SEP);
    if (basenam == NULL)
        basenam = term->info->filename->str;
    else
        basenam += 1;
    if (STRNEQ(fname, basenam)) {
        syntax_error(term->info,
                     "The module %s must be in a file named %s",
                     term->mname, fname);
        free(fname);
        return 0;
    }
    free(fname);

    ctx.aug = aug;
    ctx.local = NULL;
    ctx.name = term->mname;
    list_for_each(dcl, term->decls) {
        ok &= check_decl(dcl, &ctx);
    }
    unref(ctx.local, binding);
    return ok;
}

static struct value *compile_exp(struct info *, struct term *, struct ctx *);

static struct value *compile_union(struct term *exp, struct ctx *ctx) {
    struct value *v1 = compile_exp(exp->info, exp->left, ctx);
    if (EXN(v1))
        return v1;
    struct value *v2 = compile_exp(exp->info, exp->right, ctx);
    if (EXN(v2)) {
        unref(v1, value);
        return v2;
    }

    struct type *t = exp->type;
    struct info *info = exp->info;
    struct value *v = NULL;

    v1 = coerce(v1, t);
    if (EXN(v1))
        return v1;
    v2 = coerce(v2, t);
    if (EXN(v2)) {
        unref(v1, value);
        return v2;
    }

    if (t->tag == T_REGEXP) {
        v = make_value(V_REGEXP, ref(info));
        v->regexp = regexp_union(info, v1->regexp, v2->regexp);
    } else if (t->tag == T_LENS) {
        struct lens *l1 = v1->lens;
        struct lens *l2 = v2->lens;
        v = lns_make_union(ref(info), ref(l1), ref(l2), LNS_TYPE_CHECK(ctx));
    } else {
        fatal_error(info, "Tried to union a %s and a %s to yield a %s",
                    type_name(exp->left->type), type_name(exp->right->type),
                    type_name(t));
    }
    unref(v1, value);
    unref(v2, value);
    return v;
}

static struct value *compile_minus(struct term *exp, struct ctx *ctx) {
    struct value *v1 = compile_exp(exp->info, exp->left, ctx);
    if (EXN(v1))
        return v1;
    struct value *v2 = compile_exp(exp->info, exp->right, ctx);
    if (EXN(v2)) {
        unref(v1, value);
        return v2;
    }

    struct type *t = exp->type;
    struct info *info = exp->info;
    struct value *v;

    v1 = coerce(v1, t);
    v2 = coerce(v2, t);
    if (t->tag == T_REGEXP) {
        struct regexp *re1 = v1->regexp;
        struct regexp *re2 = v2->regexp;
        struct regexp *re = regexp_minus(info, re1, re2);
        if (re == NULL) {
            v = make_exn_value(ref(info),
                   "Regular expression subtraction 'r1 - r2' failed");
            exn_printf_line(v, "r1: /%s/", re1->pattern->str);
            exn_printf_line(v, "r2: /%s/", re2->pattern->str);
        } else {
            v = make_value(V_REGEXP, ref(info));
            v->regexp = re;
        }
    } else {
        v = NULL;
        fatal_error(info, "Tried to subtract a %s and a %s to yield a %s",
                    type_name(exp->left->type), type_name(exp->right->type),
                    type_name(t));
    }
    unref(v1, value);
    unref(v2, value);
    return v;
}

static struct value *compile_compose(struct term *exp, struct ctx *ctx) {
    struct info *info = exp->info;
    struct value *v;

    if (exp->left->type->tag == T_ARROW) {
        // FIXME: This is really crufty, and should be desugared in the
        // parser so that we don't have to do all this manual type
        // computation. Should we write function compostion as
        // concatenation instead of using a separate syntax ?

        /* Build lambda x: exp->right (exp->left x) as a closure */
        char *var = strdup("@0");
        struct term *func = make_param(var, ref(exp->left->type->dom),
                                       ref(info));
        func->type = make_arrow_type(exp->left->type->dom,
                                     exp->right->type->img);
        struct term *ident = make_term(A_IDENT, ref(info));
        ident->ident = ref(func->param->name);
        ident->type = ref(func->param->type);
        struct term *app = make_app_term(ref(exp->left), ident, ref(info));
        app->type = ref(app->left->type->img);
        app = make_app_term(ref(exp->right), app, ref(info));
        app->type = ref(app->right->type->img);

        build_func(func, app);

        if (!type_equal(func->type, exp->type)) {
            char *f = type_string(func->type);
            char *e = type_string(exp->type);
            fatal_error(info,
              "Composition has type %s but should have type %s", f, e);
            free(f);
            free(e);
            unref(func, term);
            return info->error->exn;
        }
        v = make_closure(func, ctx->local);
        unref(func, term);
    } else {
        v = compile_exp(exp->info, exp->left, ctx);
        unref(v, value);
        v = compile_exp(exp->info, exp->right, ctx);
    }
    return v;
}

static struct value *compile_concat(struct term *exp, struct ctx *ctx) {
    struct value *v1 = compile_exp(exp->info, exp->left, ctx);
    if (EXN(v1))
        return v1;
    struct value *v2 = compile_exp(exp->info, exp->right, ctx);
    if (EXN(v2)) {
        unref(v1, value);
        return v2;
    }

    struct type *t = exp->type;
    struct info *info = exp->info;
    struct value *v;

    v1 = coerce(v1, t);
    v2 = coerce(v2, t);
    if (t->tag == T_STRING) {
        const char *s1 = v1->string->str;
        const char *s2 = v2->string->str;
        v = make_value(V_STRING, ref(info));
        make_ref(v->string);
        if (ALLOC_N(v->string->str, strlen(s1) + strlen(s2) + 1) < 0)
            goto error;
        char *s = v->string->str;
        strcpy(s, s1);
        strcat(s, s2);
    } else if (t->tag == T_REGEXP) {
        v = make_value(V_REGEXP, ref(info));
        v->regexp = regexp_concat(info, v1->regexp, v2->regexp);
    } else if (t->tag == T_FILTER) {
        struct filter *f1 = v1->filter;
        struct filter *f2 = v2->filter;
        v = make_value(V_FILTER, ref(info));
        if (v2->ref == 1 && f2->ref == 1) {
            list_append(f2, ref(f1));
            v->filter = ref(f2);
        } else if (v1->ref == 1 && f1->ref == 1) {
            list_append(f1, ref(f2));
            v->filter = ref(f1);
        } else {
            struct filter *cf1, *cf2;
            cf1 = make_filter(ref(f1->glob), f1->include);
            cf2 = make_filter(ref(f2->glob), f2->include);
            cf1->next = ref(f1->next);
            cf2->next = ref(f2->next);
            list_append(cf1, cf2);
            v->filter = cf1;
        }
    } else if (t->tag == T_LENS) {
        struct lens *l1 = v1->lens;
        struct lens *l2 = v2->lens;
        v = lns_make_concat(ref(info), ref(l1), ref(l2), LNS_TYPE_CHECK(ctx));
    } else {
        v = NULL;
        fatal_error(info, "Tried to concat a %s and a %s to yield a %s",
                    type_name(exp->left->type), type_name(exp->right->type),
                    type_name(t));
    }
    unref(v1, value);
    unref(v2, value);
    return v;
 error:
    return exp->info->error->exn;
}

static struct value *apply(struct term *app, struct ctx *ctx) {
    struct value *f = compile_exp(app->info, app->left, ctx);
    struct value *result = NULL;
    struct ctx lctx;

    if (EXN(f))
        return f;

    struct value *arg = compile_exp(app->info, app->right, ctx);
    if (EXN(arg)) {
        unref(f, value);
        return arg;
    }

    assert(f->tag == V_CLOS);

    lctx.aug = ctx->aug;
    lctx.local = ref(f->bindings);
    lctx.name = ctx->name;

    arg = coerce(arg, f->func->param->type);
    if (arg == NULL)
        goto done;

    bind_param(&lctx.local, f->func->param, arg);
    result = compile_exp(app->info, f->func->body, &lctx);
    unref(result->info, info);
    result->info = ref(app->info);
    unbind_param(&lctx.local, f->func->param);

 done:
    unref(lctx.local, binding);
    unref(arg, value);
    unref(f, value);
    return result;
}

static struct value *compile_bracket(struct term *exp, struct ctx *ctx) {
    struct value *arg = compile_exp(exp->info, exp->brexp, ctx);
    if (EXN(arg))
        return arg;
    assert(arg->tag == V_LENS);

    struct value *v = lns_make_subtree(ref(exp->info), ref(arg->lens));
    unref(arg, value);

    return v;
}

static struct value *compile_rep(struct term *rep, struct ctx *ctx) {
    struct value *arg = compile_exp(rep->info, rep->rexp, ctx);
    struct value *v = NULL;

    if (EXN(arg))
        return arg;

    arg = coerce(arg, rep->type);
    if (rep->type->tag == T_REGEXP) {
        int min, max;
        if (rep->quant == Q_STAR) {
            min = 0; max = -1;
        } else if (rep->quant == Q_PLUS) {
            min = 1; max = -1;
        } else if (rep->quant == Q_MAYBE) {
            min = 0; max = 1;
        } else {
            assert(0);
            abort();
        }
        v = make_value(V_REGEXP, ref(rep->info));
        v->regexp = regexp_iter(rep->info, arg->regexp, min, max);
    } else if (rep->type->tag == T_LENS) {
        int c = LNS_TYPE_CHECK(ctx);
        if (rep->quant == Q_STAR) {
            v = lns_make_star(ref(rep->info), ref(arg->lens), c);
        } else if (rep->quant == Q_PLUS) {
            v = lns_make_plus(ref(rep->info), ref(arg->lens), c);
        } else if (rep->quant == Q_MAYBE) {
            v = lns_make_maybe(ref(rep->info), ref(arg->lens), c);
        } else {
            assert(0);
        }
    } else {
        fatal_error(rep->info, "Tried to repeat a %s to yield a %s",
                    type_name(rep->rexp->type), type_name(rep->type));
    }
    unref(arg, value);
    return v;
}

static struct value *compile_exp(struct info *info,
                                 struct term *exp, struct ctx *ctx) {
    struct value *v = NULL;

    switch (exp->tag) {
    case A_COMPOSE:
        v = compile_compose(exp, ctx);
        break;
    case A_UNION:
        v = compile_union(exp, ctx);
        break;
    case A_MINUS:
        v = compile_minus(exp, ctx);
        break;
    case A_CONCAT:
        v = compile_concat(exp, ctx);
        break;
    case A_APP:
        v = apply(exp, ctx);
        break;
    case A_VALUE:
        if (exp->value->tag == V_NATIVE) {
            v = native_call(info, exp->value->native, ctx);
        } else {
            v = ref(exp->value);
        }
        break;
    case A_IDENT:
        v = ref(ctx_lookup(exp->info, ctx, exp->ident));
        break;
    case A_BRACKET:
        v = compile_bracket(exp, ctx);
        break;
    case A_FUNC:
        v = make_closure(exp, ctx->local);
        break;
    case A_REP:
        v = compile_rep(exp, ctx);
        break;
    default:
        assert(0);
        break;
    }

    return v;
}

static int compile_test(struct term *term, struct ctx *ctx) {
    struct value *actual = compile_exp(term->info, term->test, ctx);
    struct value *expect = NULL;
    int ret = 1;

    if (term->tr_tag == TR_EXN) {
        if (!EXN(actual)) {
            print_info(stdout, term->info);
            printf("Test run should have produced exception, but produced\n");
            print_value(stdout, actual);
            printf("\n");
            ret = 0;
        }
    } else {
        if (EXN(actual)) {
            print_info(stdout, term->info);
            printf("exception thrown in test\n");
            print_value(stdout, actual);
            printf("\n");
            ret = 0;
        } else if (term->tr_tag == TR_CHECK) {
            expect = compile_exp(term->info, term->result, ctx);
            if (EXN(expect))
                goto done;
            if (! value_equal(actual, expect)) {
                printf("Test failure:");
                print_info(stdout, term->info);
                printf("\n");
                printf(" Expected:\n");
                print_value(stdout, expect);
                printf("\n");
                printf(" Actual:\n");
                print_value(stdout, actual);
                printf("\n");
                ret = 0;
            }
        } else {
            printf("Test result: ");
            print_info(stdout, term->info);
            printf("\n");
            if (actual->tag == V_TREE) {
                print_tree_braces(stdout, 2, actual->origin->children);
            } else {
                print_value(stdout, actual);
            }
            printf("\n");
        }
    }
 done:
    reset_error(term->info->error);
    unref(actual, value);
    unref(expect, value);
    return ret;
}

static int compile_decl(struct term *term, struct ctx *ctx) {
    if (term->tag == A_BIND) {
        int result;

        struct value *v = compile_exp(term->info, term->exp, ctx);
        bind(&ctx->local, term->bname, term->type, v);

        if (EXN(v) && !v->exn->seen) {
            struct error *error = term->info->error;
            struct memstream ms;

            init_memstream(&ms);

            syntax_error(term->info, "Failed to compile %s",
                         term->bname);
            fprintf(ms.stream, "%s\n", error->details);
            print_value(ms.stream, v);
            close_memstream(&ms);

            v->exn->seen = 1;
            free(error->details);
            error->details = ms.buf;
        }
        result = !(EXN(v) || HAS_ERR(ctx->aug));
        unref(v, value);
        return result;
    } else if (term->tag == A_TEST) {
        return compile_test(term, ctx);
    }
    assert(0);
    abort();
}

static struct module *compile(struct term *term, struct augeas *aug) {
    struct ctx ctx;
    struct transform *autoload = NULL;
    assert(term->tag == A_MODULE);

    ctx.aug = aug;
    ctx.local = NULL;
    ctx.name = term->mname;
    list_for_each(dcl, term->decls) {
        if (!compile_decl(dcl, &ctx))
            goto error;
    }

    if (term->autoload != NULL) {
        struct binding *bnd = bnd_lookup(ctx.local, term->autoload);
        if (bnd == NULL) {
            syntax_error(term->info, "Undefined transform in autoload %s",
                         term->autoload);
            goto error;
        }
        if (expect_types(term->info, bnd->type, 1, t_transform) == NULL)
            goto error;
        autoload = bnd->value->transform;
    }
    struct module *module = module_create(term->mname);
    module->bindings = ctx.local;
    module->autoload = ref(autoload);
    return module;
 error:
    unref(ctx.local, binding);
    return NULL;
}

/*
 * Defining native functions
 */
static struct info *
make_native_info(struct error *error, const char *fname, int line) {
    struct info *info;
    if (make_ref(info) < 0)
        goto error;
    info->first_line = info->last_line = line;
    info->first_column = info->last_column = 0;
    info->error = error;
    if (make_ref(info->filename) < 0)
        goto error;
    info->filename->str = strdup(fname);
    return info;
 error:
    unref(info, info);
    return NULL;
}

int define_native_intl(const char *file, int line,
                       struct error *error,
                       struct module *module, const char *name,
                       int argc, func_impl impl, ...) {
    assert(argc > 0);  /* We have no unit type */
    assert(argc <= 5);
    va_list ap;
    enum type_tag tag;
    struct term *params = NULL, *body = NULL, *func = NULL;
    struct type *type;
    struct value *v = NULL;
    struct info *info = NULL;
    struct ctx ctx;

    info = make_native_info(error, file, line);
    if (info == NULL)
        goto error;

    va_start(ap, impl);
    for (int i=0; i < argc; i++) {
        struct term *pterm;
        char ident[10];
        tag = va_arg(ap, enum type_tag);
        type = make_base_type(tag);
        snprintf(ident, 10, "@%d", i);
        pterm = make_param(strdup(ident), type, ref(info));
        list_append(params, pterm);
    }
    tag = va_arg(ap, enum type_tag);
    va_end(ap);

    type = make_base_type(tag);

    make_ref(v);
    if (v == NULL)
        goto error;
    v->tag = V_NATIVE;
    v->info = info;
    info = NULL;

    if (ALLOC(v->native) < 0)
        goto error;
    v->native->argc = argc;
    v->native->type = type;
    v->native->impl = impl;

    make_ref(body);
    if (body == NULL)
        goto error;
    body->info = ref(info);
    body->type = ref(type);
    body->tag = A_VALUE;
    body->value = v;
    v = NULL;

    func = build_func(params, body);
    params = NULL;
    body = NULL;

    ctx.aug = NULL;
    ctx.local = ref(module->bindings);
    ctx.name = module->name;
    if (! check_exp(func, &ctx)) {
        fatal_error(info, "Typechecking native %s failed",
                    name);
        abort();
    }
    v = make_closure(func, ctx.local);
    if (v == NULL) {
        unref(module->bindings, binding);
        goto error;
    }
    bind(&ctx.local, name, func->type, v);
    unref(v, value);
    unref(func, term);
    unref(module->bindings, binding);

    module->bindings = ctx.local;
    return 0;
 error:
    list_for_each(p, params) {
        unref(p, term);
    }
    unref(v, value);
    unref(body, term);
    unref(func, term);
    return -1;
}


/* Defined in parser.y */
int augl_parse_file(struct augeas *aug, const char *name, struct term **term);

static char *module_basename(const char *modname) {
    char *fname;

    if (asprintf(&fname, "%s" AUG_EXT, modname) == -1)
        return NULL;
    for (int i=0; i < strlen(modname); i++)
        fname[i] = tolower(fname[i]);
    return fname;
}

static char *module_filename(struct augeas *aug, const char *modname) {
    char *dir = NULL;
    char *filename = NULL;
    char *name = module_basename(modname);

    /* Module names that contain slashes can fool us into finding and
     * loading a module in another directory, but once loaded we won't find
     * it under MODNAME so that we will later try and load it over and
     * over */
    if (index(modname, '/') != NULL)
        goto error;

    while ((dir = argz_next(aug->modpathz, aug->nmodpath, dir)) != NULL) {
        int len = strlen(name) + strlen(dir) + 2;
        struct stat st;

        if (REALLOC_N(filename, len) == -1)
            goto error;
        sprintf(filename, "%s/%s", dir, name);
        if (stat(filename, &st) == 0)
            goto done;
    }
 error:
    FREE(filename);
 done:
    free(name);
    return filename;
}

int load_module_file(struct augeas *aug, const char *filename,
                     const char *name) {
    struct term *term = NULL;
    int result = -1;

    if (aug->flags & AUG_TRACE_MODULE_LOADING)
        printf("Module %s", filename);
    augl_parse_file(aug, filename, &term);
    if (aug->flags & AUG_TRACE_MODULE_LOADING)
        printf(HAS_ERR(aug) ? " failed\n" : " loaded\n");
    ERR_BAIL(aug);

    if (! typecheck(term, aug))
        goto error;

    struct module *module = compile(term, aug);
    bool bad_module = (module == NULL);
    if (bad_module && name != NULL) {
        /* Put an empty placeholder on the module list so that
         * we don't retry loading this module everytime its mentioned
         */
        module = module_create(name);
    }
    if (module != NULL) {
        list_append(aug->modules, module);
        list_for_each(bnd, module->bindings) {
            if (bnd->value->tag == V_LENS) {
                lens_release(bnd->value->lens);
            }
        }
    }
    ERR_THROW(bad_module, aug, AUG_ESYNTAX, "Failed to load %s", filename);

    result = 0;
 error:
    // FIXME: This leads to a bad free of a string used in a del lens
    // To reproduce run lenses/tests/test_yum.aug
    unref(term, term);
    return result;
}

static int load_module(struct augeas *aug, const char *name) {
    char *filename = NULL;

    if (module_find(aug->modules, name) != NULL)
        return 0;

    if ((filename = module_filename(aug, name)) == NULL)
        return -1;

    if (load_module_file(aug, filename, name) == -1)
        goto error;

    free(filename);
    return 0;

 error:
    free(filename);
    return -1;
}

int interpreter_init(struct augeas *aug) {
    int r;

    r = init_fatal_exn(aug->error);
    if (r < 0)
        return -1;

    aug->modules = builtin_init(aug->error);
    if (aug->flags & AUG_NO_MODL_AUTOLOAD)
        return 0;

    // For now, we just load every file on the search path
    const char *dir = NULL;
    glob_t globbuf;
    int gl_flags = GLOB_NOSORT;

    MEMZERO(&globbuf, 1);

    while ((dir = argz_next(aug->modpathz, aug->nmodpath, dir)) != NULL) {
        char *globpat;
        r = asprintf(&globpat, "%s/*.aug", dir);
        ERR_NOMEM(r < 0, aug);

        r = glob(globpat, gl_flags, NULL, &globbuf);
        if (r != 0 && r != GLOB_NOMATCH) {
            /* This really has to be an allocation failure; glob is not
             * supposed to return GLOB_ABORTED here */
            aug_errcode_t code =
                r == GLOB_NOSPACE ? AUG_ENOMEM : AUG_EINTERNAL;
            ERR_REPORT(aug, code, "glob failure for %s", globpat);
            free(globpat);
            goto error;
        }
        gl_flags |= GLOB_APPEND;
        free(globpat);
    }

    for (int i=0; i < globbuf.gl_pathc; i++) {
        char *name, *p, *q;
        int res;
        p = strrchr(globbuf.gl_pathv[i], SEP);
        if (p == NULL)
            p = globbuf.gl_pathv[i];
        else
            p += 1;
        q = strchr(p, '.');
        name = strndup(p, q - p);
        name[0] = toupper(name[0]);
        res = load_module(aug, name);
        free(name);
        if (res == -1)
            goto error;
    }
    globfree(&globbuf);
    return 0;
 error:
    globfree(&globbuf);
    return -1;
}

/*
 * Local variables:
 *  indent-tabs-mode: nil
 *  c-indent-level: 4
 *  c-basic-offset: 4
 *  tab-width: 4
 * End:
 */

Coverage Report

Created: 2023-09-23 07:04