/* modify the environment to make a new binding in the first frame */
void env_bind(Cell *env, Cell *name, Cell *val) {
Cell *frame, *names, *vals;
EnvTrace fprintf(stderr, "env_bind(%s, %s, %s)\n",
cell_asprint(env), cell_asprint(val), cell_asprint(name));
if (cell_atomp(name)) {
name = cell_cons(name, cell_nil);
EnvTrace fprintf(stderr, "env_bind(): name enlisted to %s\n",
cell_asprint(name));
}
val = cell_cons(val, cell_nil);
frame = cell_car_cell(env);
EnvTrace fprintf(stderr, "env_bind(): frame is %s\n", cell_asprint(frame));
names = frame ? cell_car_cell(frame) : cell_nil;
vals = frame ? cell_cdr(frame) : cell_nil;
EnvTrace fprintf(stderr, "env_bind(): old-names is %s\n",
cell_asprint(names));
list_appendM(name, names);
EnvTrace fprintf(stderr, "env_bind(): out-names is %s\n",
cell_asprint(name));
list_appendM(val, vals);
EnvTrace fprintf(stderr, "env_bind(): out-vals is %s\n",
cell_asprint(val));
cell_car_set(frame, name);
cell_cdr_set(frame, val);
//EnvTrace fprint(stderr, "env_bind(): frame is %O\n", frame);
EnvTrace fprintf(stderr, "env_bind(): out-env is %s\n", cell_asprint(env));
}
/* attach a new frame to an environment */
Cell *env_frame(Cell *env, Cell *names, Cell *values) {
Cell *frame = cell_cons(names, values);
assert(cell_nullp(names) || cell_pairp(names));
assert(cell_nullp(values) || cell_pairp(values));
EnvTrace fprintf(stderr, "env_frame(): env is %s\n",
cell_asprint(env));
EnvTrace fprintf(stderr, "env_frame(): names is %s\n",
cell_asprint(names));
EnvTrace fprintf(stderr, "env_frame(): values is %s\n",
cell_asprint(values));
env = cell_cons(frame, env);
return env;
}
void *sexpression_from_json_token(jsmntok_t t[1024], const char* json_string, int *json_element_size) {
jsmntok_t token = t[0];
if (token.type != JSMN_ARRAY) {
printf("ERROR in parsing!");
return NULL;
}
if (token.type == JSMN_ARRAY) {
*json_element_size = token.size;
// char * valueBuff = malloc(token.end - token.start+1);
// strlcpy(valueBuff, json_string + token.start, token.end - token.start+1);
// printf("PROCESSING array %s \n", valueBuff);
int j = 1;
int child_elements_size =0;
cell *c = NULL;
while (j<=token.size) {
int child_json_element_size;
jsmntok_t *next_tokens = t+j+child_elements_size;
if (next_tokens[0].type == JSMN_ARRAY) {
cell *child = sexpression_from_json_token(next_tokens, json_string, &child_json_element_size);
child_elements_size += child_json_element_size;
cellValue cellv;
cellv.cellValue = child;
c = cell_cons(cellv, typeCell, c);
} else {
cellType type = typeNil;
cellValue a = atom_from_json_token(next_tokens[0], json_string, &type);
c = cell_cons(a, type, c);
}
j ++;
}
*json_element_size += child_elements_size;
cell* curr = c;
cell* reversed_cell = NULL;
do {
reversed_cell = cell_cons(cell_car_value(curr), cell_car_type(curr), reversed_cell);
} while (((curr = cell_cdr(curr))));
return reversed_cell;
}
return NULL;
}
/* Lookup a name in an environment. The value is returned as a singleton
* list: this allows the caller to distinguish between an unbound name:
* lookup returns (); and a name bound to the empty list: lookup returns
* (()).
*/
Cell *env_lookup(Cell *env, Cell *name) {
char *tgt = cell_car_string(name);
Cell *e;
EnvTrace fprintf(stderr, "env_lookup(%s, %s)\n", cell_asprint(env), tgt);
for (e = env; e; e = cell_cdr(e)) {
Cell *f, *ns, *vs;
f = cell_car_cell(e);
assert(f);
ns = cell_car_cell(f);
vs = cell_cdr(f);
EnvTrace fprintf(stderr, "env_lookup(): ns is %s\n",
cell_asprint(ns));
EnvTrace fprintf(stderr, "env_lookup(): vs is %s\n",
cell_asprint(vs));
Cell *n, *v;
for (n = ns, v = vs; n; n = cell_cdr(n), v = cell_cdr(v))
if (streq(cell_car_string(n), tgt)) {
EnvTrace fprintf(stderr, "env_lookup(): returning %s\n",
cell_asprint(cell_car(v)));
return cell_cons(cell_car(v), cell_nil);
}
}
EnvTrace fprintf(stderr, "env_lookup(): no binding found for %s\n", tgt);
return cell_nil;
}
void test_flatten(void) {
Cell *c, *t;
char *s;
c = cell_nil;
check(cell_nullp(tree_flatten(c)));
c = cell_cons_string("one", cell_nil);
t = tree_flatten(c);
s = cell_asprint(t);
fprintf(stderr, "tree_flatten %s ==> %s\n", cell_asprint(c), s);
check(streq(s, "(one)"));
c = cell_cons_string("two", c);
t = tree_flatten(c);
s = cell_asprint(t);
fprintf(stderr, "tree_flatten %s ==> %s\n", cell_asprint(c), s);
check(streq(s, "(two one)"));
c = cell_cons(c, cell_nil);
t = tree_flatten(c);
s = cell_asprint(t);
fprintf(stderr, "tree_flatten %s ==> %s\n", cell_asprint(c), s);
check(streq(s, "(two one)"));
c = cell_cons_string("three", c);
t = tree_flatten(c);
s = cell_asprint(t);
fprintf(stderr, "tree_flatten %s ==> %s\n", cell_asprint(c), s);
check(streq(s, "(three two one)"));
c = cell_cons(c, c);
t = tree_flatten(c);
s = cell_asprint(t);
fprintf(stderr, "tree_flatten %s ==> %s\n", cell_asprint(c), s);
check(streq(s, "(three two one three two one)"));
c = fbbq();
c = cell_cons(cell_nil, c);
t = tree_flatten(c);
s = cell_asprint(t);
fprintf(stderr, "tree_flatten %s ==> %s\n", cell_asprint(c), s);
check(streq(s, "(foo bar baz qux)"));
}
