Ejemplo n.º 1
0
Archivo: lambda.c Proyecto: 74AC153/lam
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;
}
Ejemplo n.º 2
0
Archivo: eval.c Proyecto: ingramj/bs
static inline object *let_to_application(object *exp)
{
    return make_application(
            make_lambda(let_variables(exp),
                let_body(exp)),
            let_values(exp));
}
Ejemplo n.º 3
0
//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;
}
Ejemplo n.º 4
0
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)));
}
Ejemplo n.º 5
0
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));
	}
}
Ejemplo n.º 6
0
Archivo: value.cpp Proyecto: iwag/lsch
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;
	}
}
Ejemplo n.º 7
0
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;
}
Ejemplo n.º 8
0
//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;
}
Ejemplo n.º 9
0
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;
    }
}
Ejemplo n.º 10
0
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);
}
Ejemplo n.º 11
0
/*
  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;
}
Ejemplo n.º 12
0
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;
}
Ejemplo n.º 13
0
object *definition_value(object *exp) {
    return is_symbol(cadr(exp)) ? caddr(exp) : make_lambda(cdadr(exp), cddr(exp));
}
Ejemplo n.º 14
0
object *let_to_application(object *exp) {
    return make_application(make_lambda(let_parameters(exp), let_body(exp)), let_arguments(exp));
}
Ejemplo n.º 15
0
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));
}
Ejemplo n.º 16
0
Archivo: eval.c Proyecto: ingramj/bs
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)));
}
Ejemplo n.º 17
0
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));
}
Ejemplo n.º 18
0
Archivo: lam.c Proyecto: 74AC153/lam
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;
}
Ejemplo n.º 19
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));
}