static struct term *_lambda_parse(struct lexer *lex, enum term_parse_res *res) { struct term *body = NULL; struct term *ret = NULL; if(lex->type != TOK_SYM) { *res = PARSE_EXPECTED_SYM; goto done; } else { char var[VAR_LEN]; strncpy(var, lex->sym, VAR_LEN); lexer_advance(lex); if(lex->type != TOK_DOT) { *res = PARSE_EXPECTED_DOT; goto done; } lexer_advance(lex); body = _term_parse(lex, res); if(! body) { goto done; } ret = make_lambda(var, body); } done: destroy_term(body); return ret; }
static inline object *let_to_application(object *exp) { return make_application( make_lambda(let_variables(exp), let_body(exp)), let_values(exp)); }
//one arg: exp static cellpoint definition_value(void) { if (is_true(is_null(cdr(cdr(args_ref(1)))))){ printf("define: bad syntax in: "); write(args_ref(1)); newline(); error_handler(); } reg = car(cdr(args_ref(1))); if (is_true(is_symbol(reg))){ reg = car(cdr(cdr(args_ref(1)))); }else { //get formal arguments list reg = cdr(reg); stack_push(&vars_stack, reg); //get body reg = cdr(cdr(args_ref(1))); //make a lambda expression args_push(reg); args_push(stack_pop(&vars_stack)); reg = make_lambda(); } args_pop(1); return reg; }
item definition_value(item exp){ if (car(cdr(exp)).type == t_symbol){ return car(cdr(cdr(exp))); } else return make_lambda(cdr(car(cdr(exp))), cdr(cdr(exp))); }
static pSlipObject definition_value(pSlip gd, pSlipObject exp, pSlipEnvironment env) { if (sIsObject_Symbol(cadr(exp)) == S_TRUE) { return caddr(exp); } else { return make_lambda(gd, cdadr(exp), cddr(exp)); } }
Value Value::definition_value(void) const{ const auto second=vlist.begin()+1; if ( second->type == SYMBOL ) { return *(second+1); } else if ( second->type == LIST ) { const auto second_second = second->vlist.begin()+1; Vlist params = Vlist(second_second,second->vlist.end()); Vlist body = Vlist(second+1,vlist.end()); return make_lambda( params, body ); } else { return *second; } }
term* normalize_fuel_lambda(context *Sigma, typing_context* Delta, term* t, int fuel) { term* b = NULL; term* A = normalize_fuel(Sigma, Delta, t->left, fuel-1); context* extend = context_add(variable_dup(t->var), NULL, Sigma); b = normalize_fuel(extend, Delta, t->right, fuel-1); context_pop(extend); if (!b) goto error; return make_lambda(variable_dup(t->var), A, b); error: free_term(A); free_term(b); return NULL; }
//one arg: exp static cellpoint let_2_combination(void) { //get the binding vals of let expression args_push(args_ref(1)); reg = let_vals(); stack_push(&vars_stack, reg); //make a lambda expression args_push(args_ref(1)); reg = let_vars(); stack_push(&vars_stack, reg); args_push(args_ref(1)); reg = let_body(); args_push(reg); args_push(stack_pop(&vars_stack)); reg = make_lambda(); //make a combination reg = cons(reg, stack_pop(&vars_stack)); args_pop(1); return reg; }
lisp_obj *eval_expression(lisp_expr *expr, lisp_env *env, lisp_err *err) { lisp_obj *value = NULL; assert(expr != NULL); switch (expr->type){ case MKLAMBDA: return make_lambda(expr, env); case SELFEVAL: value = expr->value.selfeval.value; if (! value){ return NULL; } return retain(value); case LOOKUP: value = lookup(env, expr->value.lookup.name); if (! value){ raise_error(err, UNKNOW_IDENTIFIER, "Unknow identifier \"%s\"", expr->value.lookup.name); return NULL; } return retain(value); case APPLICATION: return apply(&(expr->value.application), env, err); case CONDITION: return eval_condition(&(expr->value.condition), env, err); case DEFINE: value = FORCE_VALUE(expr->value.define.expr, env, err); if (! value){ return NULL; } release(set_env(env, expr->value.define.name, value)); default: return NIL; } }
void graph_pylambda_evaluator::init(const std::string& lambda, size_t num_partitions, const std::vector<std::string>& vertex_fields, const std::vector<std::string>& edge_fields, size_t src_column_id, size_t dst_column_id) { clear(); // initialize members size_t new_lambda_id = make_lambda(lambda); // If it has changed, release the old one. if(m_lambda_id != size_t(-1) && new_lambda_id != m_lambda_id) { release_lambda(m_lambda_id); } m_lambda_id = new_lambda_id; m_vertex_keys = vertex_fields; m_edge_keys = edge_fields; m_srcid_column = src_column_id; m_dstid_column = dst_column_id; m_graph_sync.init(num_partitions, vertex_fields); }
/* invariant: no sharing between returned term and *any* arguments. the caller must free the result. */ term* substitute(variable* from, term* to, term* haystack) { if (haystack == NULL) return NULL; check(from != NULL && to != NULL, "substitute requires non-NULL arguments"); check(term_locally_well_formed(to), "substitute requires %W to be locally well-formed", to, print_term); check(term_locally_well_formed(haystack),"substitute requires %W to be locally well-formed", haystack, print_term); switch(haystack->tag) { case VAR: if (variable_equal(from, haystack->var)) { return term_dup(to); } else { return term_dup(haystack); } case HOLE: return term_dup(haystack); case LAM: if (variable_equal(from, haystack->var)) { return make_lambda(variable_dup(haystack->var), substitute(from, to, haystack->left), term_dup(haystack->right)); } else { if (is_free(haystack->var, to)) { variable *g = gensym(haystack->var->name); term *tg = make_var(g); term* new_haystack = make_lambda(variable_dup(g), term_dup(haystack->left), substitute(haystack->var, tg, haystack->right)); free_term(tg); term* ans = substitute(from, to, new_haystack); free_term(new_haystack); return ans; } return make_lambda(variable_dup(haystack->var), substitute(from, to, haystack->left), substitute(from, to, haystack->right)); } case PI: if (variable_equal(from, haystack->var)) { return make_pi(variable_dup(haystack->var), substitute(from, to, haystack->left), term_dup(haystack->right)); } else { if (is_free(haystack->var, to)) { variable *g = gensym(haystack->var->name); term *tg = make_var(g); term* new_haystack = make_pi(variable_dup(g), term_dup(haystack->left), substitute(haystack->var, tg, haystack->right)); free_term(tg); term* ans = substitute(from, to, new_haystack); free_term(new_haystack); return ans; } return make_pi(variable_dup(haystack->var), substitute(from, to, haystack->left), substitute(from, to, haystack->right)); } case APP: return make_app(substitute(from, to, haystack->left), substitute(from, to, haystack->right)); case TYPE: return term_dup(haystack); case DATATYPE: { term* ans = make_datatype_term(variable_dup(haystack->var), haystack->num_params, haystack->num_indices); #define SUB_VEC(dst, src, n) do { \ int __i; \ for (__i = 0; __i < n; __i++) { \ dst[__i] = substitute(from, to, src[__i]); \ } \ } while(0) SUB_VEC(ans->params, haystack->params, haystack->num_params); SUB_VEC(ans->indices, haystack->indices, haystack->num_indices); return ans; } case INTRO: { term* ans = make_intro(variable_dup(haystack->var), substitute(from, to, haystack->left), haystack->num_args, haystack->num_params, haystack->num_indices); SUB_VEC(ans->args, haystack->args, haystack->num_args); SUB_VEC(ans->params, haystack->params, haystack->num_params); SUB_VEC(ans->indices, haystack->indices, haystack->num_indices); return ans; } case ELIM: { term* ans = make_elim(variable_dup(haystack->var), haystack->num_args, haystack->num_params, haystack->num_indices); SUB_VEC(ans->args, haystack->args, haystack->num_args); SUB_VEC(ans->params, haystack->params, haystack->num_params); SUB_VEC(ans->indices, haystack->indices, haystack->num_indices); return ans; } case IMPLICIT: return term_dup(haystack); default: sentinel("malformed term with tag %d", haystack->tag); } error: return NULL; }
int syntactically_identical(term* a, term* b) { if (a == NULL || b == NULL) return a == b; check(term_locally_well_formed(a) && term_locally_well_formed(b), "alpha equiv requires well-formed arguments"); if (a->tag == HOLE) { log_info("Hole should unify with %W", b, print_term); return 1; } if (b->tag == HOLE) { log_info("Hole should unify with %W", a, print_term); return 1; } if (a->tag != b-> tag) return 0; switch (a->tag) { case VAR: return variable_equal(a->var, b->var); case LAM: { if (a->left != NULL && b->left != NULL && !syntactically_identical(a->left, b->left)) return 0; if (variable_equal(a->var, b->var)) return syntactically_identical(a->right, b->right); term* va = make_var(variable_dup(a->var)); term* bsubs = substitute(b->var, va, b->right); free_term(va); term* c = make_lambda(variable_dup(a->var), term_dup(b->left), bsubs); int ans = syntactically_identical(a, c); free_term(c); return ans; } case PI: { if (!syntactically_identical(a->left, b->left)) return 0; if (variable_equal(a->var, b->var)) return syntactically_identical(a->right, b->right); term* va = make_var(variable_dup(a->var)); term* bsubs = substitute(b->var, va, b->right); free_term(va); term* c = make_pi(variable_dup(a->var), term_dup(b->left), bsubs); int ans = syntactically_identical(a, c); free_term(c); return ans; } case APP: return syntactically_identical(a->left, b->left) && syntactically_identical(a->right, b->right); case DATATYPE: { if (!variable_equal(a->var, b->var)) { return 0; } #define EQ_VEC(a, an, b, bn) do { \ if (an != bn) return 0; \ int __i; \ for (__i = 0; __i < an; __i++) { \ if (!syntactically_identical(a[__i], b[__i])) return 0; \ } \ } while(0) EQ_VEC(a->params, a->num_params, b->params, b->num_params); EQ_VEC(a->indices, a->num_indices, b->indices, b->num_indices); return 1; } case INTRO: case ELIM: { if (!variable_equal(a->var, b->var)) { return 0; } EQ_VEC(a->args, a->num_args, b->args, b->num_args); EQ_VEC(a->params, a->num_params, b->params, b->num_params); EQ_VEC(a->indices, a->num_indices, b->indices, b->num_indices); return 1; } case TYPE: return 1; case IMPLICIT: return syntactically_identical(a->right, b->right); default: sentinel("malformed term"); } error: return 0; }
object *definition_value(object *exp) { return is_symbol(cadr(exp)) ? caddr(exp) : make_lambda(cdadr(exp), cddr(exp)); }
object *let_to_application(object *exp) { return make_application(make_lambda(let_parameters(exp), let_body(exp)), let_arguments(exp)); }
static data_t *get_definition_value(const data_t *exp) { if(is_symbol(cadr(exp))) return caddr(exp); return make_lambda(cdadr(exp), cddr(exp)); }
static inline object *definition_value(object *exp) { return is_symbol(car(cdr(exp))) ? car(cdr(cdr(exp))) : make_lambda(cdr(car(cdr(exp))), cdr(cdr(exp))); }
static data_t *transform_let(const data_t *assignment, const data_t *body) { return cons(make_lambda(get_let_var(assignment), body), get_let_exp(assignment)); }
int main(int argc, char *argv[]) { if(argc == 1) { printf("usage: %s <cmds> ...\n", argv[0]); printf("<cmds> is one of:\n"); printf("<expr> -- push <expr> onto stack\n"); printf("<expr> <name> -alpha -- push alpha rename of <expr> using <name>\n"); printf("<expr> -beta -- push beta reduce of <expr>\n"); printf("<expr> -eta -- push eta convert of <expr>\n"); printf("<body> <var> -lambda -- push lambda binding free <var> in <body>\n"); printf("<fun> <arg> -apply -- push apply of <fun> and <arg>\n"); printf("<expr1> <expr2> -alpheq -- push \\x.\\y.x (true) or \\x.\\y.y (false) if <expr1> and <expr2> are alpha equivalent\n"); printf("-body -- move cursor into body of lambda\n"); printf("-fun -- move cursor into func of apply\n"); printf("-arg -- move cursor into arg of apply\n"); printf("-up -- move cursor up one level\n"); printf("-top -- move cursor to top level\n"); printf("<expr1> <expr2> -swap -- swap <expr1> and <expr2>\n"); printf("<expr> -dup -- duplicate <expr>\n"); printf("<expr1> <expr2> -repl -- replace <expr1> with <expr2> and remove <expr2>\n"); printf("-print -- print expression stack\n"); return 0; } struct termnode *term_top = NULL; struct term *church_true, *church_false; { enum term_parse_res res; char *expr = "\\a.\\b.a"; FILE *stream = fmemopen(expr, strlen(expr), "r"); church_true = term_parse(stream, &res); fclose(stream); expr = "\\a.\\b.b"; stream = fmemopen(expr, strlen(expr), "r"); church_false = term_parse(stream, &res); fclose(stream); } for(int i = 1; i < argc; i++) { if(strcmp(argv[i], "-alpha") == 0) { if(! termstack_get(term_top, 1)) { fprintf(stderr, "stack underflow\n"); break; } struct term *var = termstack_get(term_top, 0); if(var->type != TYPE_VAR) { fprintf(stderr, "alpha requires second arg VAR, got "); term_print(stderr, var); fputc('\n', stderr); break; } struct term *expr = termstack_get(term_top, 1); struct term *renamed = alpha_rename(expr, var->var); if(renamed) { termstack_push(&term_top, renamed); } else { fprintf(stderr, "alpha rename failed\n"); break; } } else if(strcmp(argv[i], "-beta") == 0) { if(! termstack_get(term_top, 0)) { fprintf(stderr, "stack underflow\n"); break; } struct term *term = termstack_get(term_top, 0); struct term *reduced = beta_reduce(term); if(reduced) { termstack_push(&term_top, reduced); } else { fprintf(stderr, "beta reduction failed\n"); break; } } else if(strcmp(argv[i], "-eta") == 0) { if(! termstack_get(term_top, 0)) { fprintf(stderr, "stack underflow\n"); break; } struct term *converted = eta_convert(term_top->t); if(converted) { termstack_push(&term_top, converted); } else { fprintf(stderr, "eta conversion failed\n"); break; } } else if(strcmp(argv[i], "-lambda") == 0) { if(! termstack_get(term_top, 1)) { fprintf(stderr, "stack underflow\n"); break; } struct term *var = termstack_get(term_top, 0); struct term *body = termstack_get(term_top, 1); if(var->type != TYPE_VAR) { fprintf(stderr, "lambda requires VAR, got "); term_print(stderr, var); fputc('\n', stderr); break; } struct term *lambda = make_lambda(var->var, body); if(lambda) { termstack_push(&term_top, lambda); } else { fprintf(stderr, "create lambda failed\n"); break; } } else if(strcmp(argv[i], "-apply") == 0) { if(! termstack_get(term_top, 1)) { fprintf(stderr, "stack underflow\n"); break; } struct term *arg = termstack_get(term_top, 0); struct term *fun = termstack_get(term_top, 1); struct term *appl = make_appl(fun, arg); if(appl) { termstack_push(&term_top, appl); } else { fprintf(stderr, "create apply failed\n"); break; } } else if(strcmp(argv[i], "-alpheq") == 0) { if(! termstack_get(term_top, 1)) { fprintf(stderr, "stack underflow\n"); break; } struct term *t1_term = termstack_get(term_top, 0); struct term *t2_term = termstack_get(term_top, 1); if(alpha_eq(t1_term, t2_term)) { termstack_push(&term_top, term_duplicate(church_true)); } else { termstack_push(&term_top, term_duplicate(church_false)); } } else if(strcmp(argv[i], "-print") == 0) { for(struct termnode *n = term_top; n; n = n->next) { term_print(stdout, termtrace_current(n->trace)); fprintf(stdout, "\n"); } } else if(strcmp(argv[i], "-body") == 0) { if(! termstack_get(term_top, 0)) { fprintf(stderr, "stack underflow\n"); break; } if(termtrace_current(term_top->trace)->type != TYPE_LAMBDA) { fprintf(stderr, "not a lambda\n"); break; } termtrace_go_body(&term_top->trace); } else if(strcmp(argv[i], "-fun") == 0) { if(! termstack_get(term_top, 0)) { fprintf(stderr, "stack underflow\n"); break; } if(termtrace_current(term_top->trace)->type != TYPE_APPL) { fprintf(stderr, "not an apply\n"); break; } termtrace_go_fun(&term_top->trace); } else if(strcmp(argv[i], "-arg") == 0) { if(! termstack_get(term_top, 0)) { fprintf(stderr, "stack underflow\n"); break; } if(termtrace_current(term_top->trace)->type != TYPE_APPL) { fprintf(stderr, "not an apply\n"); break; } termtrace_go_arg(&term_top->trace); } else if(strcmp(argv[i], "-up") == 0) { if(term_top->trace->prev) termtrace_go_prev(&term_top->trace); } else if(strcmp(argv[i], "-top") == 0) { while(term_top->trace->prev) termtrace_go_prev(&term_top->trace); } else if(strcmp(argv[i], "-swap") == 0) { if(! termstack_get(term_top, 1)) { fprintf(stderr, "stack underflow\n"); break; } struct termnode *next = term_top->next; term_top->next = next->next; next->next = term_top; term_top = next; } else if(strcmp(argv[i], "-dup") == 0) { if(! termstack_get(term_top, 0)) { fprintf(stderr, "stack underflow\n"); break; } termstack_push(&term_top, term_duplicate(termtrace_current(term_top->trace))); } else if(strcmp(argv[i], "-repl") == 0) { if(! termstack_get(term_top, 1)) { fprintf(stderr, "stack underflow\n"); break; } struct term *newterm = term_duplicate(termtrace_current(term_top->trace)); destroy_term(termstack_pop(&term_top)); destroy_term(termtrace_replace(term_top->trace, newterm)); } else { FILE *stream = fmemopen(argv[i], strlen(argv[i]), "r"); if(! stream) continue; enum term_parse_res res; struct term *term = term_parse(stream, &res); fclose(stream); if(term == NULL) { long loc = ftell(stream); if(! feof(stream)) loc--; printf("parse error: %s at char %lu\n", term_parse_str(res), loc+1); printf("%s\n", argv[i]); for(long i = 0; i < loc; i++) printf(" "); printf("^\n"); break; } termstack_push(&term_top, term); } } struct term *t; while(NULL != (t = termstack_get(term_top, 0))) { destroy_term(termstack_pop(&term_top)); } destroy_term(church_true); destroy_term(church_false); return 0; }
static pSlipObject let_to_application(pSlip gd, pSlipObject exp) { return make_application(gd, make_lambda(gd, let_parameters(gd, exp), let_body(exp)), let_arguments(gd, exp)); }