~jack/misc

e96a4e120a45ae298c8de01ec093765dc665e38d — Jack Kelly 6 months ago fc18319
lambda-c: Capture-avoiding substitution
11 files changed, 167 insertions(+), 294 deletions(-)

M lambda-c/.gitignore
M lambda-c/configure.ac
M lambda-c/src/Makefile.am
M lambda-c/src/eval.c
M lambda-c/src/eval.h
M lambda-c/src/lambda.c
D lambda-c/src/macros.h
M lambda-c/src/term.c
M lambda-c/src/term.h
D lambda-c/src/xmalloc.c
D lambda-c/src/xmalloc.h
M lambda-c/.gitignore => lambda-c/.gitignore +1 -0
@@ 9,5 9,6 @@ config.h.in
config.log
config.status
configure
m4/*.m4
src/lambda
stamp-h1

M lambda-c/configure.ac => lambda-c/configure.ac +1 -0
@@ 14,6 14,7 @@ AM_SILENT_RULES([yes])
AC_PROG_CC

# Checks for libraries.
PKG_CHECK_MODULES([GLib], [glib-2.0])

# Checks for header files.


M lambda-c/src/Makefile.am => lambda-c/src/Makefile.am +4 -3
@@ 1,8 1,9 @@
## Process this file with automake to generate Makefile.in
AM_CFLAGS = $(GLib_CFLAGS)
LDADD = $(GLib_LIBS)

bin_PROGRAMS = lambda

lambda_SOURCES = lambda.c \
	eval.c eval.h \
	macros.h \
	term.c term.h \
	xmalloc.c xmalloc.h
	term.c term.h

M lambda-c/src/eval.c => lambda-c/src/eval.c +73 -61
@@ 19,83 19,95 @@
#include "config.h"
#include "eval.h"

#include "macros.h"
#include "term.h"
#include "xmalloc.h"

#include <glib.h>
#include <stdlib.h>
#include <string.h>

struct apply_args {
  const char *v;
  const struct term *t;
};

struct term* apply(const struct term *t, struct apply_args *args);

void* apply_var(const char *v, void *data) {
  struct apply_args *args = data;
  if (strcmp(v, args->v) == 0) return term_dup(args->t);
  return term_var(xstrdup(v));
}

void* apply_app(const struct term *t1, const struct term *t2, void *data) {
  struct apply_args *args = data;
  return term_app(apply(t1, args), apply(t2, args));
}

void* apply_lam(const char *v, const struct term *t, void *data) {
  struct apply_args *args = data;
  /* If the lambda's var matches ours, go no further - it's
     scoping our var in the body. */
  if (strcmp(v, args->v) == 0) return term_lam(xstrdup(v), term_dup(t));
  return term_lam(xstrdup(v), apply(t, args));
}

struct term* apply(const struct term *t, struct apply_args *args) {
  const struct term_const_match m = {
    .var = apply_var,
    .app = apply_app,
    .lam = apply_lam
  };
  return term_const_match(&m, t, args);
static GHashTable* /* gchar* (not owned) -> gchar* (not owned) */
free_vars(const Term *t) {
  switch (t->tag) {
  case TERM_VAR: {
    GHashTable *r = g_hash_table_new(g_str_hash, g_str_equal);
    g_hash_table_add(r, t->var.v);
    return r;
  }
  case TERM_APP: {
    GHashTable *fv1 = free_vars(t->app.t1);
    g_autoptr(GHashTable) fv2 = free_vars(t->app.t2);
    GHashTableIter it;
    gpointer v;
    g_hash_table_iter_init(&it, fv2);
    while (g_hash_table_iter_next(&it, &v, NULL)) g_hash_table_add(fv1, v);
    return fv1;
  }
  case TERM_LAM: {
    GHashTable *r = free_vars(t->lam.t);
    g_hash_table_remove(r, t->lam.v);
    return r;
  }
  default: g_assert_not_reached();
  }
}

void* eval_var(const char *v, UNUSED void *data) {
  return term_var(xstrdup(v));
static Term*
sub(Term *t, const gchar *from, Term *to, gint *gensym_count) {
  switch (t->tag) {
  case TERM_VAR:
    return term_ref(strcmp(t->var.v, from) == 0 ? to : t);
  case TERM_APP:
    return term_app(sub(t->app.t1, from, to, gensym_count),
                    sub(t->app.t2, from, to, gensym_count));
  case TERM_LAM:
    if (strcmp(t->lam.v, from) == 0) {
      return term_ref(t);
    } else {
      g_autoptr(GHashTable) fvs = free_vars(to);
      if (g_hash_table_contains(fvs, t->lam.v)) {
        g_autofree gchar* gensym = g_strdup_printf("_g%d", (*gensym_count)++);
        g_autoptr(Term) new_var = term_var(gensym);
        g_autoptr(Term) renamed_body =
          sub(t->lam.t, t->lam.v, new_var, gensym_count);
        return term_lam(gensym, sub(renamed_body, from, to, gensym_count));
      } else {
        return term_lam(t->lam.v, sub(t->lam.t, from, to, gensym_count));
      }
    }
  default: g_assert_not_reached();
  }
}

void* eval_app(const struct term *t1, const struct term *t2, UNUSED void *data) {
  struct term *t1e = eval(t1);
  struct term *t2e = eval(t2);
  struct apply_args args;
  struct term *r;
  switch (t1e->tag) {
static Term*
apply(Term *t1, Term *t2, gint *gensym_count) {
  switch (t1->tag) {
  case TERM_VAR:
  case TERM_APP:
    return term_app(t1e, t2e);
    return term_app(term_ref(t1), term_ref(t2));
  case TERM_LAM:
    args.v = t1e->data.lam.v;
    args.t = t2e;
    r = apply(t1e->data.lam.t, &args);
    term_free(t2e);
    term_free(t1e);
    return r;
    return sub(t1->lam.t, t1->lam.v, t2, gensym_count);
  default:
    fprintf(stderr, "eval_app: unexpected tag %d\n", t1e->tag);
    abort();
    g_assert_not_reached();
  }
}

void* eval_lam(const char *v, const struct term *t, UNUSED void *data) {
  return term_lam(xstrdup(v), term_dup(t));
static Term*
eval_rec(Term *t, gint *gensym_count) {
  switch (t->tag) {
  case TERM_VAR:
  case TERM_LAM:
    return term_ref(t);
  case TERM_APP: {
    g_autoptr(Term) t1e = eval_rec(t->app.t1, gensym_count);
    g_autoptr(Term) t2e = eval_rec(t->app.t2, gensym_count);
    return apply(t1e, t2e, gensym_count);
  }
  default: g_assert_not_reached();
  }
}

struct term* eval(const struct term *t) {
  struct term_const_match m = {
    .var = eval_var,
    .app = eval_app,
    .lam = eval_lam
  };
  return term_const_match(&m, t, NULL);
Term*
eval(Term *t) {
  gint gensym_count = 0;
  return eval_rec(t, &gensym_count);
}

M lambda-c/src/eval.h => lambda-c/src/eval.h +3 -1
@@ 19,6 19,8 @@
#ifndef EVAL_H
#define EVAL_H

struct term* eval(const struct term *t);
#include "term.h"

Term* eval(Term *t);

#endif

M lambda-c/src/lambda.c => lambda-c/src/lambda.c +12 -5
@@ 20,19 20,26 @@

#include "eval.h"
#include "term.h"
#include "xmalloc.h"

#include <glib.h>
#include <stdio.h>

int main(int argc, char *argv[]) {
  struct term *t = term_app(term_lam(xstrdup("x"), term_lam(xstrdup("y"), term_var(xstrdup("x")))), term_var(xstrdup("p")));
  g_autoptr(Term) t =
    term_app(term_app(term_lam("w",
                               term_lam("x",
                                        term_lam("y",
                                                 term_lam("z",
                                                          term_app(term_var("x"),
                                                                   term_var("w")))))),
                      term_var("y")),
             term_var("z"));
  term_fput(t, stdout);
  puts("");
  struct term *e = eval(t);
  g_autoptr(Term) e = eval(t);
  printf("=> ");
  term_fput(e, stdout);
  puts("");
  term_free(e);
  term_free(t);

  return 0;
}

D lambda-c/src/macros.h => lambda-c/src/macros.h +0 -28
@@ 1,28 0,0 @@
/*
 * lambda-c: minimal lambda calculus interpreter
 * Copyright (C) 2021  Jack Kelly
 *
 * This program is free software: you can redistribute it and/or modify
 * it under the terms of the GNU Affero General Public License as published by
 * the Free Software Foundation, either version 3 of the License, or
 * (at your option) any later version.
 *
 * This program 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 Affero General Public License for more details.
 *
 * You should have received a copy of the GNU Affero General Public License
 * along with this program.  If not, see <https://www.gnu.org/licenses/>.
 */

#ifndef MACROS_H
#define MACROS_H

#ifdef __GNUC__
#define UNUSED __attribute__((unused))
#else
#define UNUSED
#endif

#endif

M lambda-c/src/term.c => lambda-c/src/term.c +58 -106
@@ 19,136 19,88 @@
#include "config.h"
#include "term.h"

#include "macros.h"
#include "xmalloc.h"

#include <stdlib.h>
Term*
term_new(void) {
  struct term *r = g_new(struct term, 1);
  g_ref_count_init(&r->rc);
  return r;
}

struct term* term_var(char *v) {
  struct term *r = xmalloc(sizeof(struct term));
Term*
term_var(const gchar *v) {
  struct term *r = term_new();
  r->tag = TERM_VAR;
  r->data.var.v = v;
  r->var.v = g_strdup(v);
  return r;
}

struct term* term_app(struct term *t1, struct term *t2) {
  struct term *r = xmalloc(sizeof(struct term));
Term*
term_app(Term *t1, Term *t2) {
  struct term *r = term_new();
  r->tag = TERM_APP;
  r->data.app.t1 = t1;
  r->data.app.t2 = t2;
  r->app.t1 = t1;
  r->app.t2 = t2;
  return r;
}

struct term* term_lam(char *v, struct term *t) {
  struct term *r = xmalloc(sizeof(struct term));
Term*
term_lam(const gchar *v, Term *t) {
  struct term *r = term_new();
  r->tag = TERM_LAM;
  r->data.lam.v = v;
  r->data.lam.t = t;
  r->lam.v = g_strdup(v);
  r->lam.t = t;
  return r;
}

void* term_free_var(char *v, UNUSED void *data) {
  free(v);
  return NULL;
Term*
term_ref(Term *t) {
  g_ref_count_inc(&t->rc);
  return t;
}

void* term_free_app(struct term *t1, struct term *t2, UNUSED void *data) {
  term_free(t1);
  term_free(t2);
  return NULL;
}
void
term_unref(Term *t) {
  if (!g_ref_count_dec(&t->rc)) return;

void* term_free_lam(char *v, struct term *t, UNUSED void *data) {
  free(v);
  term_free(t);
  return NULL;
}

void term_free(struct term *t) {
  struct term_match m = {
    .var = term_free_var,
    .app = term_free_app,
    .lam = term_free_lam
  };
  term_match(&m, t, NULL);
  free(t);
}

void* term_dup_var(const char *v, UNUSED void *data) {
  return term_var(xstrdup(v));
}

void* term_dup_app(const struct term *t1,
                   const struct term *t2,
                   UNUSED void *data) {
  return term_app(term_dup(t1), term_dup(t2));
}

void* term_dup_lam(const char *v, const struct term *t, UNUSED void *data) {
  return term_lam(xstrdup(v), term_dup(t));
}

struct term* term_dup(const struct term *t) {
  struct term_const_match m = {
    .var = term_dup_var,
    .app = term_dup_app,
    .lam = term_dup_lam
  };
  return term_const_match(&m, t, NULL);
}

void* term_fput_var(const char *v, void *data) {
  FILE *fp = data;
  fprintf(fp, "%s", v);
  return NULL;
}

void* term_fput_app(const struct term *t1, const struct term *t2, void *data) {
  FILE *fp = data;
  fprintf(fp, "(");
  term_fput(t1, fp);
  fprintf(fp, ")(");
  term_fput(t2, fp);
  fprintf(fp, ")");
  return NULL;
}

void* term_fput_lam(const char *v, const struct term *t, void *data) {
  FILE *fp = data;
  fprintf(fp, "\\%s.", v);
  term_fput(t, fp);
  return NULL;
}

void term_fput(const struct term *t, FILE *fp) {
  struct term_const_match m = {
    .var = term_fput_var,
    .app = term_fput_app,
    .lam = term_fput_lam
  };
  term_const_match(&m, t, fp);
}

void* term_match(const struct term_match *m, struct term *t, void *data) {
  switch (t->tag) {
  case TERM_VAR: return m->var(t->data.var.v, data);
  case TERM_APP: return m->app(t->data.app.t1, t->data.app.t2, data);
  case TERM_LAM: return m->lam(t->data.lam.v, t->data.lam.t, data);
  case TERM_VAR:
    g_free(t->var.v);
    break;
  case TERM_APP:
    term_unref(t->app.t1);
    term_unref(t->app.t2);
    break;
  case TERM_LAM:
    g_free(t->lam.v);
    term_unref(t->lam.t);
    break;
  default:
    fprintf(stderr, "term_match: unexpected tag %d\n", t->tag);
    fprintf(stderr, "term_unref: unexpected tag %d\n", t->tag);
    abort();
  }

  g_free(t);
}

void* term_const_match(const struct term_const_match *m,
                       const struct term *t,
                       void *data) {
void
term_fput(Term *t, FILE *fp) {
  switch (t->tag) {
  case TERM_VAR: return m->var(t->data.var.v, data);
  case TERM_APP: return m->app(t->data.app.t1, t->data.app.t2, data);
  case TERM_LAM: return m->lam(t->data.lam.v, t->data.lam.t, data);
  case TERM_VAR:
    fprintf(fp, "%s", t->var.v);
    break;
  case TERM_APP:
    fprintf(fp, "(");
    term_fput(t->app.t1, fp);
    fprintf(fp, ")(");
    term_fput(t->app.t2, fp);
    fprintf(fp, ")");
    break;
  case TERM_LAM:
    fprintf(fp, "\\%s.", t->lam.v);
    term_fput(t->lam.t, fp);
    break;
  default:
    fprintf(stderr, "term_const_match: unexpected tag %d\n", t->tag);
    fprintf(stderr, "term_fput: unexpected tag %d\n", t->tag);
    abort();
  }
}

M lambda-c/src/term.h => lambda-c/src/term.h +15 -28
@@ 19,6 19,7 @@
#ifndef TERM_H
#define TERM_H

#include <glib.h>
#include <stdio.h>

enum term_tag {


@@ 27,40 28,26 @@ enum term_tag {
  TERM_LAM
};

struct term {
typedef struct term {
  grefcount rc;
  enum term_tag tag;
  union {
    struct { char *v; } var;
    struct { gchar *v; } var;
    struct { struct term *t1; struct term *t2; } app;
    struct { char *v; struct term *t; } lam;
  } data;
};

/* Takes ownership of pointers */
struct term* term_var(char *v);
struct term* term_app(struct term *t1, struct term *t2);
struct term* term_lam(char *v, struct term *t);
void term_free(struct term *t);
    struct { gchar *v; struct term *t; } lam;
  };
} Term;

struct term* term_dup(const struct term *t);
void term_fput(const struct term *t, FILE *fp);
/* Copies the const ghcar* arguments but does not incref the Term* arguments. */
Term* term_var(const gchar *v);
Term* term_app(Term *t1, Term *t2);
Term* term_lam(const gchar *v, Term *t);

struct term_match {
  void* (*var)(char *v, void *data);
  void* (*app)(struct term *t1, struct term *t2, void *data);
  void* (*lam)(char *v, struct term *t, void *data);
};
Term* term_ref(Term *t);
void term_unref(Term *t);

void* term_match(const struct term_match *m, struct term *t, void *data);

struct term_const_match {
  void* (*var)(const char *v, void *data);
  void* (*app)(const struct term *t1, const struct term *t2, void *data);
  void* (*lam)(const char *v, const struct term *t, void *data);
};
G_DEFINE_AUTOPTR_CLEANUP_FUNC(Term, term_unref);

void* term_const_match(const struct term_const_match *m,
                       const struct term *t,
                       void *data);
void term_fput(struct term *t, FILE *fp);

#endif

D lambda-c/src/xmalloc.c => lambda-c/src/xmalloc.c +0 -35
@@ 1,35 0,0 @@
/*
 * lambda-c: minimal lambda calculus interpreter
 * Copyright (C) 2021  Jack Kelly
 *
 * This program is free software: you can redistribute it and/or modify
 * it under the terms of the GNU Affero General Public License as published by
 * the Free Software Foundation, either version 3 of the License, or
 * (at your option) any later version.
 *
 * This program 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 Affero General Public License for more details.
 *
 * You should have received a copy of the GNU Affero General Public License
 * along with this program.  If not, see <https://www.gnu.org/licenses/>.
 */

#include "config.h"
#include "xmalloc.h"

#include <stdio.h>
#include <stdlib.h>
#include <string.h>

void* xmalloc(size_t size) {
  void *r = malloc(size);
  if (r) return r;
  fprintf(stderr, "xmalloc: failed to allocate %zd bytes\n", size);
  abort();
}

char* xstrdup(const char *s) {
  return strcpy(xmalloc(strlen(s) + 1), s);
}

D lambda-c/src/xmalloc.h => lambda-c/src/xmalloc.h +0 -27
@@ 1,27 0,0 @@
/*
 * lambda-c: minimal lambda calculus interpreter
 * Copyright (C) 2021  Jack Kelly
 *
 * This program is free software: you can redistribute it and/or modify
 * it under the terms of the GNU Affero General Public License as published by
 * the Free Software Foundation, either version 3 of the License, or
 * (at your option) any later version.
 *
 * This program 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 Affero General Public License for more details.
 *
 * You should have received a copy of the GNU Affero General Public License
 * along with this program.  If not, see <https://www.gnu.org/licenses/>.
 */

#ifndef XMALLOC_H
#define XMALLOC_H

#include <stddef.h>

void* xmalloc(size_t size);
char* xstrdup(const char *s);

#endif