#include <ctype.h>
#include <unistd.h>
#include <getopt.h>
+#include <stdbool.h>
static struct ao_scheme_builtin *
ao_scheme_make_builtin(enum ao_scheme_builtin_id func, int args) {
}
struct builtin_func {
- char *name;
- int args;
+ const char *feature;
+ const char *name;
+ int args;
enum ao_scheme_builtin_id func;
};
+struct builtin_atom {
+ const char *feature;
+ const char *name;
+};
+
#define AO_SCHEME_BUILTIN_CONSTS
+#define AO_SCHEME_BUILTIN_ATOM_NAMES
+
#include "ao_scheme_builtin.h"
-#define N_FUNC (sizeof funcs / sizeof funcs[0])
+#define N_FUNC (sizeof funcs / sizeof funcs[0])
+
+#define N_ATOM (sizeof atoms / sizeof atoms[0])
struct ao_scheme_frame *globals;
return crc;
}
-uint16_t
+static uint16_t
ao_fec_crc(const uint8_t *bytes, uint8_t len)
{
uint16_t crc = AO_FEC_CRC_INIT;
struct ao_scheme_macro_stack *macro_stack;
-int
+static int
ao_scheme_macro_push(ao_poly p)
{
struct ao_scheme_macro_stack *m = macro_stack;
return 0;
}
-void
+static void
ao_scheme_macro_pop(void)
{
struct ao_scheme_macro_stack *m = macro_stack;
#define DBG_MACRO 0
#if DBG_MACRO
-int macro_scan_depth;
+static int macro_scan_depth;
-void indent(void)
+static void indent(void)
{
int i;
for (i = 0; i < macro_scan_depth; i++)
ao_poly
ao_has_macro(ao_poly p);
-ao_poly
+static ao_poly
ao_macro_test_get(ao_poly atom)
{
ao_poly *ref = ao_scheme_atom_ref(atom, NULL);
return AO_SCHEME_NIL;
}
-ao_poly
+static ao_poly
ao_is_macro(ao_poly p)
{
struct ao_scheme_builtin *builtin;
struct ao_scheme_lambda *lambda;
ao_poly ret;
- MACRO_DEBUG(indent(); printf ("is macro "); ao_scheme_poly_write(p); printf("\n"); ++macro_scan_depth);
+ MACRO_DEBUG(indent(); ao_scheme_printf ("is macro %v\n", p); ++macro_scan_depth);
switch (ao_scheme_poly_type(p)) {
case AO_SCHEME_ATOM:
if (ao_scheme_macro_push(p))
ret = AO_SCHEME_NIL;
break;
}
- MACRO_DEBUG(--macro_scan_depth; indent(); printf ("... "); ao_scheme_poly_write(ret); printf("\n"));
+ MACRO_DEBUG(--macro_scan_depth; indent(); ao_scheme_printf ("... %v\n", ret););
return ret;
}
if (p == AO_SCHEME_NIL)
return AO_SCHEME_NIL;
- MACRO_DEBUG(indent(); printf("has macro "); ao_scheme_poly_write(p); printf("\n"); ++macro_scan_depth);
+ MACRO_DEBUG(indent(); ao_scheme_printf("has macro %v\n", p); ++macro_scan_depth);
switch (ao_scheme_poly_type(p)) {
case AO_SCHEME_LAMBDA:
lambda = ao_scheme_poly_lambda(p);
- p = ao_has_macro(lambda->code);
+ p = ao_has_macro(ao_scheme_poly_cons(lambda->code)->cdr);
break;
case AO_SCHEME_CONS:
cons = ao_scheme_poly_cons(p);
list = cons->cdr;
p = AO_SCHEME_NIL;
- while (list != AO_SCHEME_NIL && ao_scheme_poly_type(list) == AO_SCHEME_CONS) {
+ while (ao_scheme_is_pair(list)) {
cons = ao_scheme_poly_cons(list);
m = ao_has_macro(cons->car);
if (m) {
p = AO_SCHEME_NIL;
break;
}
- MACRO_DEBUG(--macro_scan_depth; indent(); printf("... "); ao_scheme_poly_write(p); printf("\n"));
+ MACRO_DEBUG(--macro_scan_depth; indent(); ao_scheme_printf("... %v\n", p));
return p;
}
-int
-ao_scheme_read_eval_abort(void)
+static struct ao_scheme_builtin *
+ao_scheme_get_builtin(ao_poly p)
{
- ao_poly in, out = AO_SCHEME_NIL;
+ if (ao_scheme_poly_type(p) == AO_SCHEME_BUILTIN)
+ return ao_scheme_poly_builtin(p);
+ return NULL;
+}
+
+struct seen_builtin {
+ struct seen_builtin *next;
+ struct ao_scheme_builtin *builtin;
+};
+
+static struct seen_builtin *seen_builtins;
+
+static int
+ao_scheme_seen_builtin(struct ao_scheme_builtin *b)
+{
+ struct seen_builtin *s;
+
+ for (s = seen_builtins; s; s = s->next)
+ if (s->builtin == b)
+ return 1;
+ s = malloc (sizeof (struct seen_builtin));
+ s->builtin = b;
+ s->next = seen_builtins;
+ seen_builtins = s;
+ return 0;
+}
+
+static int
+ao_scheme_read_eval_abort(FILE *read_file)
+{
+ ao_poly in;
+
for(;;) {
- in = ao_scheme_read();
+ in = ao_scheme_read(read_file);
if (in == _ao_scheme_atom_eof)
break;
- out = ao_scheme_eval(in);
- if (ao_scheme_exception)
+ (void) ao_scheme_eval(in);
+ if (ao_scheme_exception) {
+ ao_scheme_fprintf(stderr, "make_const failed on %v\n", in);
return 0;
- ao_scheme_poly_write(out);
- putchar ('\n');
+ }
}
return 1;
}
static FILE *in;
static FILE *out;
+struct feature {
+ struct feature *next;
+ char name[];
+};
+
+static struct feature *enable;
+static struct feature *disable;
+
+static void
+ao_scheme_add_feature(struct feature **list, char *name)
+{
+ struct feature *feature = malloc (sizeof (struct feature) + strlen(name) + 1);
+ strcpy(feature->name, name);
+ feature->next = *list;
+ *list = feature;
+}
+
+static bool
+_ao_scheme_has_feature(struct feature *list, const char *name, bool skip_undef)
+{
+ if (skip_undef && !strcmp(name, "UNDEF"))
+ return false;
+
+ while (list) {
+ if (!strcmp(list->name, name))
+ return true;
+ list = list->next;
+ }
+ return false;
+}
+
+static bool
+ao_scheme_has_undef(struct feature *list)
+{
+ return _ao_scheme_has_feature(list, "UNDEF", false);
+}
+
+static bool
+ao_scheme_has_feature(struct feature *list, const char *name)
+{
+ return _ao_scheme_has_feature(list, name, true);
+}
+
+static void
+ao_scheme_add_features(struct feature **list, const char *names)
+{
+ char *saveptr = NULL;
+ char *name;
+ char *copy = strdup(names);
+ char *save = copy;
+
+ while ((name = strtok_r(copy, ",", &saveptr)) != NULL) {
+ copy = NULL;
+ if (!ao_scheme_has_feature(*list, name))
+ ao_scheme_add_feature(list, name);
+ }
+ free(save);
+}
+
int
ao_scheme_getc(void)
{
static const struct option options[] = {
{ .name = "out", .has_arg = 1, .val = 'o' },
+ { .name = "disable", .has_arg = 1, .val = 'd' },
+ { .name = "enable", .has_arg = 1, .val = 'e' },
{ 0, 0, 0, 0 }
};
static void usage(char *program)
{
- fprintf(stderr, "usage: %s [--out=<output>] [input]\n", program);
+ fprintf(stderr, "usage: %s [--out=<output>] [--disable={feature,...}] [--enable={feature,...} [input]\n", program);
exit(1);
}
int
main(int argc, char **argv)
{
- int f, o;
+ int f, o, an;
ao_poly val;
struct ao_scheme_atom *a;
struct ao_scheme_builtin *b;
+ struct feature *d;
int in_atom = 0;
char *out_name = NULL;
int c;
enum ao_scheme_builtin_id prev_func;
+ enum ao_scheme_builtin_id target_func;
+ enum ao_scheme_builtin_id func_map[_builtin_last];
in = stdin;
out = stdout;
- while ((c = getopt_long(argc, argv, "o:", options, NULL)) != -1) {
+ while ((c = getopt_long(argc, argv, "o:d:e:", options, NULL)) != -1) {
switch (c) {
case 'o':
out_name = optarg;
break;
+ case 'd':
+ ao_scheme_add_features(&disable, optarg);
+ break;
+ case 'e':
+ ao_scheme_add_features(&enable, optarg);
+ break;
default:
usage(argv[0]);
break;
ao_scheme_bool_get(1);
prev_func = _builtin_last;
+ target_func = 0;
+ b = NULL;
for (f = 0; f < (int) N_FUNC; f++) {
- if (funcs[f].func != prev_func)
- b = ao_scheme_make_builtin(funcs[f].func, funcs[f].args);
- a = ao_scheme_atom_intern(funcs[f].name);
- ao_scheme_atom_def(ao_scheme_atom_poly(a),
- ao_scheme_builtin_poly(b));
+ if (ao_scheme_has_feature(enable, funcs[f].feature) || !ao_scheme_has_feature(disable, funcs[f].feature)) {
+ if (funcs[f].func != prev_func) {
+ prev_func = funcs[f].func;
+ b = ao_scheme_make_builtin(prev_func, funcs[f].args);
+
+ /* Target may have only a subset of
+ * the enum values; record what those
+ * values will be here. This obviously
+ * depends on the functions in the
+ * array being in the same order as
+ * the enumeration; which
+ * ao_scheme_make_builtin ensures.
+ */
+ func_map[prev_func] = target_func++;
+ }
+ a = ao_scheme_atom_intern((char *) funcs[f].name);
+ ao_scheme_atom_def(ao_scheme_atom_poly(a),
+ ao_scheme_builtin_poly(b));
+ }
}
- /* end of file value */
- a = ao_scheme_atom_intern("eof");
- ao_scheme_atom_def(ao_scheme_atom_poly(a),
- ao_scheme_atom_poly(a));
-
- /* 'else' */
- a = ao_scheme_atom_intern("else");
+ /* atoms */
+ for (an = 0; an < (int) N_ATOM; an++) {
+ if (ao_scheme_has_feature(enable, atoms[an].feature) || !ao_scheme_has_feature(disable, atoms[an].feature))
+ a = ao_scheme_atom_intern((char *) atoms[an].name);
+ }
- if (argv[optind]){
+ while (argv[optind]) {
in = fopen(argv[optind], "r");
if (!in) {
perror(argv[optind]);
exit(1);
}
+ if (!ao_scheme_read_eval_abort(in)) {
+ fprintf(stderr, "eval failed\n");
+ exit(1);
+ }
+ fclose(in);
+ optind++;
}
- if (!ao_scheme_read_eval_abort()) {
- fprintf(stderr, "eval failed\n");
- exit(1);
+
+ if (!ao_scheme_has_undef(enable) && ao_scheme_has_undef(disable)) {
+ struct ao_scheme_cons cons;
+
+ cons.car = _ao_scheme_atom_undef;
+ cons.cdr = AO_SCHEME_NIL;
+ ao_scheme_do_undef(&cons);
}
/* Reduce to referenced values */
for (f = 0; f < ao_scheme_frame_global->num; f++) {
struct ao_scheme_frame_vals *vals = ao_scheme_poly_frame_vals(ao_scheme_frame_global->vals);
+
val = ao_has_macro(vals->vals[f].val);
if (val != AO_SCHEME_NIL) {
- printf("error: function %s contains unresolved macro: ",
- ao_scheme_poly_atom(vals->vals[f].atom)->name);
- ao_scheme_poly_write(val);
- printf("\n");
+ fprintf(stderr, "error: function %s contains unresolved macro: ",
+ ao_scheme_poly_atom(vals->vals[f].atom)->name);
+ ao_scheme_poly_write(stderr, val, true);
+ fprintf(stderr, "\n");
exit(1);
}
+
+ /* Remap builtin enum values to match target set */
+ b = ao_scheme_get_builtin(vals->vals[f].val);
+ if (b != NULL) {
+ if (!ao_scheme_seen_builtin(b))
+ b->func = func_map[b->func];
+ }
}
if (out_name) {
fprintf(out, "/* Generated file, do not edit */\n\n");
+ for (d = disable; d; d = d->next)
+ fprintf(out, "#undef AO_SCHEME_FEATURE_%s\n", d->name);
+
fprintf(out, "#define AO_SCHEME_POOL_CONST %d\n", ao_scheme_top);
fprintf(out, "extern const uint8_t ao_scheme_const[AO_SCHEME_POOL_CONST] __attribute__((aligned(4)));\n");
fprintf(out, "#define ao_builtin_atoms 0x%04x\n", ao_scheme_atom_poly(ao_scheme_atoms));
fprintf(out, "#define _ao_scheme_bool_true 0x%04x\n", ao_scheme_bool_poly(ao_scheme_true));
for (a = ao_scheme_atoms; a; a = ao_scheme_poly_atom(a->next)) {
- char *n = a->name, c;
+ const char *n = a->name;
+ char ch;
fprintf(out, "#define _ao_scheme_atom_");
- while ((c = *n++)) {
- if (isalnum(c))
- fprintf(out, "%c", c);
+ while ((ch = *n++)) {
+ if (isalnum(ch))
+ fprintf(out, "%c", ch);
else
- fprintf(out, "%02x", c);
+ fprintf(out, "%02x", ch);
}
fprintf(out, " 0x%04x\n", ao_scheme_atom_poly(a));
}
fprintf(out, "#ifdef AO_SCHEME_CONST_BITS\n");
fprintf(out, "const uint8_t ao_scheme_const[AO_SCHEME_POOL_CONST] __attribute((aligned(4))) = {");
for (o = 0; o < ao_scheme_top; o++) {
- uint8_t c;
+ uint8_t ch;
if ((o & 0xf) == 0)
fprintf(out, "\n\t");
else
fprintf(out, " ");
- c = ao_scheme_const[o];
+ ch = ao_scheme_const[o];
if (!in_atom)
in_atom = is_atom(o);
if (in_atom) {
- fprintf(out, " '%c',", c);
+ fprintf(out, " '%c',", ch);
in_atom--;
} else {
- fprintf(out, "0x%02x,", c);
+ fprintf(out, "0x%02x,", ch);
}
}
fprintf(out, "\n};\n");