Add a hacky Erlang VM printer

include/fsm/print.h

@@ -41,6 +41,7 @@ fsm_print fsm_print_irjson;
 fsm_print fsm_print_json;
 fsm_print fsm_print_vmc;
 fsm_print fsm_print_sh;
+fsm_print fsm_print_erl;
 
 #endif
 

src/libfsm/libfsm.syms

@@ -36,6 +36,7 @@ fsm_print_irjson
 fsm_print_json
 fsm_print_vmc
 fsm_print_sh
+fsm_print_erl
 
 # <fsm/fsm.h>
 fsm_clone

src/libfsm/print/Makefile

@@ -10,8 +10,9 @@ SRC += src/libfsm/print/irjson.c
 SRC += src/libfsm/print/json.c
 SRC += src/libfsm/print/vmc.c
 SRC += src/libfsm/print/sh.c
+SRC += src/libfsm/print/erl.c
 
-.for src in ${SRC:Msrc/libfsm/print/vmc.c} ${SRC:Msrc/libfsm/print/sh.c}
+.for src in ${SRC:Msrc/libfsm/print/vmc.c} ${SRC:Msrc/libfsm/print/sh.c} ${SRC:Msrc/libfsm/print/erl.c}
 CFLAGS.${src} += -std=c99 # XXX: for ir.h
 DFLAGS.${src} += -std=c99 # XXX: for ir.h
 .endfor

src/libfsm/print/erl.c

@@ -0,0 +1,291 @@
+/*
+ * Copyright 2008-2020 Katherine Flavel
+ *
+ * See LICENCE for the full copyright terms.
+ */
+
+#include <assert.h>
+#include <string.h>
+#include <stdint.h>
+#include <stdbool.h>
+#include <errno.h>
+#include <stdio.h>
+
+#include <print/esc.h>
+
+#include <adt/set.h>
+
+#include <fsm/fsm.h>
+#include <fsm/pred.h>
+#include <fsm/walk.h>
+#include <fsm/print.h>
+#include <fsm/options.h>
+#include <fsm/vm.h>
+
+#include "libfsm/internal.h"
+
+#include "libfsm/vm/vm.h"
+
+#include "ir.h"
+
+  static const char *
+cmp_operator(int cmp)
+{
+  switch (cmp) {
+    case VM_CMP_LT: return "<";
+    case VM_CMP_LE: return "=<";
+    case VM_CMP_EQ: return "==";
+    case VM_CMP_GE: return ">=";
+    case VM_CMP_GT: return ">";
+    case VM_CMP_NE: return "/=";
+
+    case VM_CMP_ALWAYS:
+    default:
+                    assert("unreached");
+                    return NULL;
+  }
+}
+
+  static void
+print_label(FILE *f, uint8_t fetches, const struct dfavm_op_ir *op, const struct fsm_options *opt)
+{
+  fprintf(f, "fsm(%lu=_State, <<", (unsigned long) op->index);
+  for (int i = 0; i <= fetches; i++) {
+    fprintf(f, "_%c,", 65+i);
+  }
+  fprintf(f, "_Rest/binary>>) ->");
+
+  if (op->ir_state->example != NULL) {
+    fprintf(f, " %% e.g. \"");
+    escputs(f, opt, c_escputc_str, op->ir_state->example);
+    fprintf(f, "\"\n");
+  }
+  fprintf(f, "\t if");
+}
+
+  static void
+print_cond(FILE *f, uint8_t fetches, const struct dfavm_op_ir *op, const struct fsm_options *opt)
+{
+  (void) opt;
+
+  if (op->cmp == VM_CMP_ALWAYS) {
+    fprintf(f, "true -> ");
+    return;
+  }
+
+  fprintf(f, "_%c %s ", 65+fetches, cmp_operator(op->cmp));
+  fprintf(f, "%hu", (unsigned char) op->cmp_arg);
+  fprintf(f, " -> ");
+}
+
+  static void
+print_end(FILE *f, const struct dfavm_op_ir *op, const struct fsm_options *opt,
+    enum dfavm_op_end end_bits, const struct ir *ir)
+{
+  if (end_bits == VM_END_FAIL) {
+    fprintf(f, "throw(fail)");
+    return;
+  }
+
+  if (opt->endleaf != NULL) {
+    opt->endleaf(f, op->ir_state->opaque, opt->endleaf_opaque);
+  } else {
+    fprintf(f, "fsm(%lu, <<>>) ->", (unsigned long) op->index);
+    if (op->ir_state->example != NULL) {
+      fprintf(f, " %% e.g. \"");
+      escputs(f, opt, c_escputc_str, op->ir_state->example);
+      fprintf(f, "\"\n");
+    }
+    fprintf(f, "\tthrow({matched,%lu});\n", (unsigned long) (op->ir_state - ir->states));
+  }
+}
+
+  static void
+print_branch(FILE *f, const struct dfavm_op_ir *op)
+{
+  fprintf(f, "fsm(%lu, _Rest)", (unsigned long) op->u.br.dest_arg->index);
+}
+
+  static void
+print_fetch(FILE *f, const struct fsm_options *opt)
+{
+  (void) opt;
+
+  fprintf(f, "true -> ok\n");
+  fprintf(f, "\tend,\n");
+}
+
+  static int
+fsm_print_shfrag(FILE *f, const struct ir *ir, const struct fsm_options *opt)
+{
+  static const struct dfavm_assembler_ir zero;
+  struct dfavm_assembler_ir a;
+  struct dfavm_op_ir *op, *op2;
+
+  static const struct fsm_vm_compile_opts vm_opts = { FSM_VM_COMPILE_DEFAULT_FLAGS, FSM_VM_COMPILE_VM_V1, NULL };
+
+  assert(f != NULL);
+  assert(ir != NULL);
+  assert(opt != NULL);
+
+  a = zero;
+
+  if (!dfavm_compile_ir(&a, ir, vm_opts)) {
+    return -1;
+  }
+
+  /*
+   * We only output labels for ops which are branched to. This gives
+   * gaps in the sequence for ops which don't need a label.
+   * So here we renumber just the ones we use.
+   */
+  {
+    uint32_t l;
+
+    l = 0;
+
+    for (op = a.linked; op != NULL; op = op->next) {
+      if (op->num_incoming > 0) {
+        op->index = l++;
+      }
+    }
+  }
+
+  fprintf(f, "-module(fsm).\n");
+  fprintf(f, "-export([main/1]).\n");
+  fprintf(f, "main([String]) ->\n");
+  fprintf(f, "\ttry fsm(start, list_to_binary(String))\n");
+  fprintf(f, "\tcatch throw:fail ->\n");
+  fprintf(f, "\t\tio:format(\"failed~n\"),\n");
+  fprintf(f, "\t\thalt(1);\n");
+  fprintf(f, "\tthrow:{matched, N} ->\n");
+  fprintf(f, "\t\tio:format(\"matched ~b~n\", [N]),\n");
+  fprintf(f, "\t\thalt(0)\n");
+  fprintf(f, "\tend.\n\n");
+
+  bool saw_always = false, first=true;
+  uint8_t fetched = 0;
+  uint8_t fetches = -1;
+  uint8_t stanza = 0;
+  for (op = a.linked; op != NULL; op = op->next) {
+    if (first) {
+      for (op2 = op; op2 != NULL; op2 = op2->next) {
+        if (op2->instr == VM_OP_FETCH) {
+          fetches++;
+        }
+        if (op2->num_incoming > 0) {
+          break;
+        }
+      }
+      if (fetches == 0) {
+        fetches = 1;
+      }
+      //fprintf(f, "fetches %d\n", fetches);
+      first=false;
+    }
+    if (op == a.linked) {
+      fprintf(f, "fsm(start, <<");
+      for (int i = 0; i < fetches; i++) {
+        fprintf(f, "_%c,", 65+i);
+      }
+      fprintf(f, " _Rest/binary>>) ->\n");
+      fprintf(f, "\tif\n");
+    }
+
+    //fprintf(f, "%% incoming %d\n", op->num_incoming);
+    if (op->num_incoming > 0) {
+      if (!saw_always && op->u.stop.end_bits != VM_END_FAIL && stanza > 0) {
+        fprintf(f, "\t\ttrue -> fsm(_State, _Rest)\n");
+      }
+      if (op != a.linked) {
+        saw_always = false;
+        fetched = 0;
+        fetches = 0;
+        stanza++;
+        first = true;
+        fprintf(f, "\tend;\n");
+
+        print_end(f, op, opt, op->u.stop.end_bits, ir);
+      }
+
+      print_label(f, fetches, op, opt);
+    }
+
+    fprintf(f, "\t\t");
+
+    switch (op->instr) {
+      case VM_OP_STOP:
+        print_cond(f, fetched - 1, op, opt);
+        if (op->cmp == VM_CMP_ALWAYS) {
+          saw_always = true;
+        }
+        fprintf(f, "throw(fail)");
+        if ( op->next != NULL && op->next->num_incoming == 0 && op->cmp != VM_CMP_ALWAYS) {
+          fprintf(f, ";");
+        }
+        if ( op->next != NULL && op->next->num_incoming > 0 && op->u.stop.end_bits == VM_END_FAIL && op->cmp != VM_CMP_ALWAYS) {
+          fprintf(f, ";");
+        }
+
+        break;
+
+      case VM_OP_FETCH:
+        //print_end(f, op, opt, op->u.fetch.end_bits, ir);
+        fetched++;
+        if (fetched > 1) {
+          print_fetch(f, opt);
+          fprintf(f, "\tif\n");
+        }
+        fprintf(f, "\n");
+        continue;
+
+      case VM_OP_BRANCH:
+        print_cond(f, fetched - 1, op, opt);
+        print_branch(f, op);
+        if (op->cmp == VM_CMP_ALWAYS) {
+          saw_always = true;
+        } else if (stanza > 0 || op->next != NULL && op->next->num_incoming == 0) {
+          fprintf(f, ";");
+        }
+        break;
+
+      default:
+        assert(!"unreached");
+        break;
+    }
+
+    fprintf(f, "\n");
+  }
+
+  fprintf(f, "\tend;\nfsm(_, _) -> throw(fail).\n");
+
+  dfavm_opasm_finalize_op(&a);
+
+  return 0;
+}
+
+  void
+fsm_print_erl(FILE *f, const struct fsm *fsm)
+{
+  struct ir *ir;
+
+  assert(f != NULL);
+  assert(fsm != NULL);
+  assert(fsm->opt != NULL);
+
+  ir = make_ir(fsm);
+  if (ir == NULL) {
+    return;
+  }
+
+  if (fsm->opt->io != FSM_IO_STR) {
+    fprintf(stderr, "unsupported IO API\n");
+    exit(EXIT_FAILURE);
+  }
+
+  (void) fsm_print_shfrag(f, ir, fsm->opt);
+
+  free_ir(fsm, ir);
+}
+
+

src/re/main.c

@@ -113,6 +113,7 @@ print_name(const char *name,
 		{ "json",   fsm_print_json,   NULL  },
 		{ "vmc",    fsm_print_vmc,    NULL  },
 		{ "sh",     fsm_print_sh,     NULL  },
+		{ "erl",    fsm_print_erl,    NULL  },
 
 		{ "tree",   NULL, ast_print_tree },
 		{ "abnf",   NULL, ast_print_abnf },