static Node *assign(Simp *s, Node *lhs, Node *rhs)
{
Node *t, *u, *v, *r;
if (exprop(lhs) == Otup) {
r = destructure(s, lhs, rhs);
} else {
t = lval(s, lhs);
u = rval(s, rhs, t);
/* if we stored the result into t, rval() should return that,
* so we know our work is done. */
if (u == t) {
r = t;
} else if (stacknode(lhs)) {
t = addr(s, t, exprtype(lhs));
u = addr(s, u, exprtype(lhs));
v = disp(lhs->line, size(lhs));
r = mkexpr(lhs->line, Oblit, t, u, v, NULL);
} else {
r = set(t, u);
}
}
return r;
}
static void normalize(struct Orb_priv_each_s* es) {
while(es->ptr == es->end && es->stack) {
list_t tmp = es->stack;
es->stack = tmp->next;
destructure(es, tmp->value);
}
}
int
destructure(Value *pattern, Value *match)
{
switch (VTAG(pattern)) {
case any:
return 1;
break;
case nil:
CHECK_TAG(match, nil);
return 1;
break;
case cons:
CHECK_TAG(match, cons);
return (destructure(VCAR(pattern), VCAR(match)) &&
destructure(VCDR(pattern), VCDR(match)));
break;
case string:
CHECK_TAG(match, string);
return (VSLENGTH(pattern) == VSLENGTH(match) &&
0 == bcmp(VSDATA(pattern), VSDATA(match), VSLENGTH(pattern)));
break;
case symbol:
CHECK_TAG(match, symbol);
return (VSLENGTH(pattern) == VSLENGTH(match) &&
0 == bcmp(VSDATA(pattern), VSDATA(match), VSLENGTH(pattern)));
break;
case integer:
CHECK_TAG(match, integer);
return (VINTEGER(pattern) == VINTEGER(match));
break;
case var:
if (VVTAG(pattern) != any)
CHECK_TAG(match, VVTAG(pattern));
if (VVDATA(pattern) != NULL)
*VVDATA(pattern) = (void *) match;
return 1;
break;
default:
/* ??? error */
break;
}
}
struct Orb_priv_each_s* Orb_priv_each_init(Orb_t s) {
s = Orb_ensure_seq(s);
struct Orb_priv_each_s* rv =
Orb_gc_malloc(sizeof(struct Orb_priv_each_s))
;
rv->stack = 0;
destructure(rv, s);
normalize(rv);
return rv;
}
read_and_parse()
{
#define BUFLEN 512
char buf[BUFLEN]; /* this will have to be dynamically expanded */
int bufpos = 0;
int ret;
Value *v = NULL;
Value *match_data;
Value *pattern = vmake_cons(vmake_symbol_c("integer"),
vmake_var(integer, (void **) &match_data));
while (1) {
ret = read(0, buf + bufpos, BUFLEN - bufpos);
if (ret < 0) {
perror("read");
exit(1);
}
else {
bufpos += ret;
do {
if (v != NULL) {
free_value(v);
v = NULL;
}
ret = parse(bufpos, buf, &v);
if (ret > 0) {
bcopy(buf + ret, buf, bufpos - ret);
bufpos -= ret;
printf("parsed: ");
prin(stdout, v);
fputc('\n', stdout);
if (destructure(pattern, v)) {
printf("match_data = ");
prin(stdout, match_data);
fputc('\n', stdout);
}
else {
printf("destructure failed\n");
}
free_value(v);
}
else
printf("EOF\n");
} while (ret > 0);
}
}
}
static Node *
destructure(Flattenctx *s, Node *lhs, Node *rhs)
{
Node *lv, *rv, *idx;
Node **args;
size_t i;
args = lhs->expr.args;
rhs = rval(s, rhs);
for (i = 0; i < lhs->expr.nargs; i++) {
idx = mkintlit(rhs->loc, i);
idx->expr.type = mktype(rhs->loc, Tyuint64);
rv = mkexpr(rhs->loc, Otupget, rhs, idx, NULL);
rv->expr.type = lhs->expr.type;
if (exprop(args[i]) == Otup) {
destructure(s, args[i], rv);
} else {
lv = lval(s, args[i]);
append(s, assign(s, lv, rv));
}
}
return rhs;
}