int main() {
char buf[80];
printf("Enter the password.\n");
readuntil(STDIN_FILENO, buf, 80, '\n');
// meh.
if (strlen(buf) != 30) { puts("Wrong! :("); return; }
thunk *t = make_thunk(verify);
thunk *a = make_thunk(id);
a->value = buf;
a->computed = 1;
t->arguments = make_args(a);
if (t->compute(t)) {
puts("Congratulations! :)");
} else {
puts("Wrong! :(");
}
}
int verify(thunk *t) {
thunk *bw = make_thunk(burrows_wheeler);
bw->arguments = malloc(sizeof(thunk *));
bw->arguments[0] = t->arguments[0];
char *secret = "\x04\x19\x19\x68\x43\x41\x5b\x04\xc8\x44\x43\x43\x43\x40\x45\x47\x68\x68\x06\x5a\x52\x56\x03\x56\x44\x03\x5e\x06\x68\x19";
thunk *bwc = bw->compute(bw);
char *bwr = bwc->compute(bwc);
if (memcmp(secret, bwr, 31) == 0)
return 1;
return 0;
}
thunk *burrows_wheeler(thunk *t) {
if (t->computed) return t->value;
thunk *a = make_thunk(string_length);
a->arguments = make_args(t->arguments[0]);
thunk *b = make_thunk(rotate_by_all);
b->arguments = malloc(sizeof(thunk *) * 2);
b->arguments[0] = a->arguments[0];
b->arguments[1] = a;
thunk *c = make_thunk(sorted);
c->arguments = malloc(sizeof(thunk *) * 2);
c->arguments[0] = b;
c->arguments[1] = a;
thunk *d = make_thunk(get_last);
d->arguments = malloc(sizeof(thunk *) * 2);
d->arguments[0] = c;
d->arguments[1] = a;
t->computed = 1;
t->value = d;
return d;
}
static lisp_obj *eval_condition(lisp_expr_condition *expr, lisp_env *env, lisp_err *err)
{
lisp_obj *cond = FORCE_VALUE(expr->condition, env, err);
if (cond == NULL){
return NULL;
}
lisp_expr *next = (cond != NIL && cond != FALSE) ? expr->consequence : expr->alternative;
lisp_obj *res = make_thunk(next, env);
release(cond);
return res;
}
static lisp_obj *apply(lisp_expr_application *app, lisp_env *env, lisp_err *err)
{
lisp_obj *callable = FORCE_VALUE(app->proc, env, err);
if (! callable){
return NULL;
}
lisp_obj *res = NIL;
/* Internal procedure */
if (callable->type == PROC){
/* Eval args */
lisp_obj **args = calloc(app->nparams, sizeof(lisp_obj*));
for (size_t i=0; i<app->nparams; i++){
lisp_obj *arg = FORCE_VALUE(app->params[i], env, err);
if (! arg){
for (size_t j=0; j<i; j++){
release(args[j]);
}
free(args);
return NULL;
}
args[i] = arg;
}
/* Eval internal */
res = callable->value.p(app->nparams, args);
/* Free args */
for (size_t i=0; i<app->nparams; i++){
release(args[i]);
}
free(args);
}
/* Lisp func */
else if (callable->type == LAMBDA){
lisp_lambda *lambda = &(callable->value.l);
lisp_expr_lambda *lambda_expr = &(lambda->declaration->value.mklambda);
/* Check arity */
if (app->nparams != lambda_expr->nparams){
raise_error(err, WRONG_ARITY, "Arity error ! Expected %d params, got %d",
lambda_expr->nparams, app->nparams);
return NULL;
}
/* Extend env */
lisp_env *locals = create_env(lambda->context);
for (size_t i=0; i<lambda_expr->nparams; i++){
lisp_obj *param = eval_expression(app->params[i], env, err);
if (! param){
release_env(locals);
return NULL;
}
DEBUG("Extend env with %s", lambda_expr->param_names[i]);
release(set_env(locals, lambda_expr->param_names[i], param));
}
if (enable_debug){
printf("\033[1mCALL\033[0m ");
dump_expr(lambda_expr->body);
printf(" with env\n");
dump_env(locals);
}
/* Wrap in thunk for trampoline */
res = make_thunk(lambda_expr->body, locals);
release_env(locals);
}
else {
lisp_print(callable);
raise_error(err, NOT_CALLABLE, "CANNOT CALL obj %p", callable);
return NULL;
}
release(callable);
return res;
}
