Пример #1
0
/* compose -- evaluate a sequential composition or piping */
PRIVATE env compose(tree t, env e, tok ldec, tok rdec, char *kind)
{
     env e1 = tc_sexp(t->x_arg1, e);
     env e2 = tc_sexp(t->x_arg2, e);
     env ee = new_env(e);
     def q;

     /* Get vars from left arg that don't match */
     for (;;) {
	  def d = pop_def(e1);
	  if (d == NULL) 
	       break;
	  else if (d->d_name->s_decor != ldec)
	       push_def(d, ee);
	  else {
	       sym rname = mk_symbol(d->d_name->s_basename, rdec);
	       type rtype = del_var(rname, e2);
	       if (rtype == NULL)
		    push_def(d, ee);
	       else if (! unify(d->d_type, rtype)) {
		    tc_error(t->x_loc, "Type mismatch in %s", kind);
		    tc_e_etc("Expression: %z", t);
		    tc_e_etc("Type of %n in LHS: %t", d->d_name, d->d_type);
		    tc_e_etc("Type of %n in RHS: %t", rname, rtype);
		    tc_e_end();
	       }
	  }
     }

     /* Now merge the unmatched vars from the right */
     for (q = e2->e_defs; q != NULL; q = q->d_next)
	  merge_def(VAR, q->d_name, q->d_type, ee, t, t->x_loc);

     return ee;
}
Пример #2
0
/* theta_type -- compute type of a theta-exp or theta-select */
PRIVATE type theta_type(tree t, env e, type a, tree cxt)
{
     def d = get_schema((tok) t->x_the_name, t->x_loc);
     schema s;
     env e1 = new_env(e);
     type b;
     int i;

     if (d == NULL)
	  return err_type;

     s = d->d_schema;
     check_rename(s, (tok) t->x_the_decor, t->x_the_rename, t);

     for (i = 0; i < s->z_ncomps; i++) {
	  sym x = s->z_comp[i].z_name;
	  sym xp = get_rename(x, (tok) t->x_the_decor, t->x_the_rename);
	  type tt = (a == NULL
		     ? ref_type(xp, nil, e, t)
		     : comp_type(a, xp, cxt, t->x_loc));
	  add_def(VAR, x, tt, e1);
     }

     b = mk_sproduct(mk_schema(e1));
     if (! aflag && d->d_abbrev && d->d_nparams == 0
	 && type_equal(b, arid, mk_sproduct(s), arid))
	  return mk_abbrev(d, arid);
     else
	  return b;
}
Пример #3
0
int			main(int argc, char **argv)
{
	t_env		*e;
	int			i;

	e = NULL;
	i = -1;
	if (argc != 2)
	{
		ft_putendl("Usage : ./fillit <filename>");
		return (0);
	}
	e = new_env(e);
	e->file = argv[1];
	read_file(e);
	c_pieces(e);
	while (++i < e->nb_piece && i < 26)
		e->t[i] = scan(e->buf, i);
	if (verif(e) == 1)
		return (0);
	new_square(e);
	resolve(e);
	display_grid(e);
	free(e);
	return (0);
}
Пример #4
0
/* binary_sexp -- compute a binary schema exp */
PRIVATE env binary_sexp(mergeop f, tree t, env e)
{
     env e1 = sort_env(tc_sexp(t->x_arg1, e));
     env e2 = sort_env(tc_sexp(t->x_arg2, e));
     env ee = new_env(e);
     def d1, d2;

     d1 = pop_def(e1);
     d2 = pop_def(e2);
     while (d1 != NULL || d2 != NULL) {
	  int c = (d1 == NULL ? 1 : d2 == NULL ? -1 
		   : my_compare(&d1, &d2));
	  if (c < 0) {
	       (*f)(d1, (def) NULL, ee, t);
	       d1 = pop_def(e1);
	  }
	  else if (c > 0) {
	       (*f)((def) NULL, d2, ee, t);
	       d2 = pop_def(e2);
	  }
	  else {
	       (*f)(d1, d2, ee, t);
	       d1 = pop_def(e1);
	       d2 = pop_def(e2);
	  }
     }
     return ee;
}
Пример #5
0
entry sum_35() {
new_env(1, 0);
ildc(0);
load();
null();
oequal();
jz(label2);
ildc(0);
ret();
jmp(label3);
label2:
ildc(0);
load();
call(get_element_29);
ildc(0);
load();
ildc(1);
getfield();
call(sum_35);
iadd();
ret();
label3:
null();
ret();
}
Пример #6
0
int BoolTest::run(Env &env, LocalDefs &ienv)
{
  //cout << "---------------------------------\n";
  //term1.print(cout);
  //cout << "\n";
  //term2.print(cout);
  //cout << "\n\n";

  //Term et1 = prg.evaluate(term1);
  //Term et2 = prg.evaluate(term2);

  //cout << "\n\n";
  //et1.print(cout);
  //cout << "\n";
  //et2.print(cout);
  //cout << "\n";

  //string es = expr.to_string();

  Env new_env(env);

  Term et = expr.evaluate(new_env, ienv);

  string ts = et.to_string();

  if (et.is_true())
  {
    cout << "Test OK" << endl;
    return 0;
  }

  cout << "Test Failed" << endl;

  //string rs_str = t.top_symbol().to_string();

  //if (t.top_symbol() == Symbol::eq())
  //{
  //  assert(t.arity() == 2);

  //  Term st1 = t.subterm(0);
  //  Term st2 = t.subterm(1);

  //  Term et1 = prg.evaluate(st1);
  //  Term et2 = prg.evaluate(st2);

  //  if (et1 != et2)
  //  {
  //    cout << "-------------" << endl;
  //    cout << st1.to_string() << endl << st2.to_string() << endl;
  //    cout << "- - - - - - -" << endl;
  //    cout << et1.to_string() << endl << et2.to_string() << endl;
  //    cout << "-------------" << endl;
  //  }
  //}

  //getchar();

  return 1;
}
Пример #7
0
int				ft_unsetenv(char **args, char **env)
{
	if (!args[1])
		ft_putendl("unsetenv: No assignment");
	else
		return (new_env(args, env));
	return (1);
}
Пример #8
0
t_env			*get_env(void)
{
	static t_env	*env = NULL;

	if (env == NULL)
		env = new_env();
	return (env);
}
Пример #9
0
int PrintStmt::run(Env &env, LocalDefs &ienv)
{
  Env new_env(env);
  Term rt = expr.evaluate(new_env, ienv);
  rt.print_indented(cout);
  cout << endl;
  return 0;
}
Пример #10
0
int AsgnTest::run(Env &env, LocalDefs &ienv)
{
  Env new_env(env);
  Term et = expr.evaluate(new_env, ienv);
  
  env.set(var, et);
  
  return 0;
}
Пример #11
0
entry get_element_29() {
new_env(1, 0);
ildc(0);
load();
ildc(0);
getfield();
ret();
null();
ret();
}
Пример #12
0
entry pop_front_33() {
new_env(1, 0);
ildc(0);
load();
ildc(1);
getfield();
ret();
null();
ret();
}
Пример #13
0
/* tc_sexp -- check a schema expression */
PUBLIC env tc_sexp(tree t, env e)
{
     env e1, e2;
     tree u;
     def d;

     switch (t->x_kind) {
     case TEXT:
	  return tc_schema(t->x_text, e);
	  
     case SREF:
	  e1 = new_env(e);
	  do_sref(t, e, e1);
	  return e1;

     case SNOT:
	  e1 = tc_sexp(t->x_arg, e);
	  for (d = e1->e_defs; d != NULL; d = d->d_next)
	       d->d_type = super_expand(d->d_type, arid);
	  return e1;
	  
     case SAND:	    return binary_sexp(and_fun, t, e);
     case SOR:	    return binary_sexp(or_fun, t, e);
     case SIMPLIES: case SEQUIV:
		    return binary_sexp(implies_fun, t, e);
     case PROJECT:  return binary_sexp(project_fun, t, e);

     case FATSEMI:
	  return compose(t, e, prime, empty, "sequential composition");

     case PIPE:
	  return compose(t, e, pling, query, "piping");

     case HIDE:
	  e1 = tc_sexp(t->x_arg1, e);
	  for (u = t->x_arg2; u != nil; u = cdr(u))
	       hide_var((sym) car(u), (type) NULL, e1, t, t->x_loc);
	  return e1;

     case SFORALL: case SEXISTS: case SEXISTS1:
	  e2 = tc_schema(t->x_bvar, e);
	  e1 = tc_sexp(t->x_body, e);
	  for (d = e2->e_defs; d != NULL; d = d->d_next)
	       hide_var(d->d_name, d->d_type, e1, t, t->x_loc);
	  return e1;

     case PRE:
	  return precond(t, e);

     default:
	  bad_tag("get_sexp", t->x_kind);
	  return NULL;
     }
}
Пример #14
0
int test_begin()
{
   integer *i10 = new_integer(10);
   integer *i20 = new_integer(20);
   integer *i30 = new_integer(30);

   list *val10 = cons(i10, cons(i20, cons(i30, NULL)));
   environment *env = new_env();
   assert(generic_equal(syntax_begin(val10, env), i30));

   return 1;
}
Пример #15
0
entry println_19() {
new_env(1, 0);
ildc(0);
load();
call(print_11);
pop();
ildc(2);
call(print_13);
pop();
null();
ret();
}
Пример #16
0
int establish_root_environment(void) {
    spawn_env(NULL, Primordial_Grid(GC_SKIPREG));
    rootEnvironment=Car(env);
    rootBacros=Grid();
    unknownSymbolError=Err(Cons(String("Unknown symbol"), NULL));
    Set(rootEnvironment, "nil", NULL);
    Set(rootEnvironment, "true", Atom("true"));
    Set(rootEnvironment, "add", Routine(&dirty_sum));
    Set(rootEnvironment, "+", Get(rootEnvironment, "add"));
    Set(rootEnvironment, "subtract", Routine(&dirty_sub));
    Set(rootEnvironment, "-", Get(rootEnvironment, "subtract"));
    Set(rootEnvironment, "if", Method(&funky_if));
    Set(rootEnvironment, "&ver", String("Funky Lisp Draft 3"));
    Set(rootEnvironment, "set!", Routine(&funky_set));
    Set(rootEnvironment, "print_", Routine(&funky_print));
    Set(rootEnvironment, "list", Routine(&funky_list));
    Set(rootEnvironment, "pair", Routine(&funky_pair));
    Set(rootEnvironment, "grid", Routine(&funky_grid));
    Set(rootEnvironment, "get", Routine(&funky_grid_get));
    Set(rootEnvironment, "quote", Method(&funky_quote));
    Set(rootEnvironment, "apply", Routine(&apply));
    Set(rootEnvironment, "mac", Method(&funky_macro));
    Set(rootEnvironment, "def", Method(&funky_def));
    Set(rootEnvironment, "head", Routine(&funky_head));
    Set(rootEnvironment, "rest_", Routine(&funky_rest));
    Set(rootEnvironment, "last", Routine(&funky_last));
    Set(rootEnvironment, "err", Routine(&funky_err));
    Set(rootEnvironment, "dump", Routine(&funky_dump));
    Set(rootEnvironment, "&bacros", rootBacros);
    Set(rootEnvironment, ">", Routine(&funky_greater_than));
    Set(rootEnvironment, "<", Routine(&funky_less_than));
    Set(rootEnvironment, "=", Routine(&funky_equivalent));
    Set(rootEnvironment, "not", Routine(&funky_not_operator));
    Set(rootEnvironment, "eval", Method(&funky_evaluator));
    Set(rootEnvironment, "true?", Routine(&funky_truthy));
    Set(rootEnvironment, "false?", Routine(&funky_nilly));
    Set(rootEnvironment, "lambda?", Routine(&funky_callable));
    Set(rootEnvironment, "atom?", Routine(&funky_is_atom));
    Set(rootEnvironment, "gen?", Routine(&funky_is_gen));
    Set(rootEnvironment, "len", Routine(&funky_length));
    Set(rootEnvironment, "gen", Routine(&funky_gen));
    Set(rootEnvironment, "cons", Routine(&funky_cons));
    Set(rootEnvironment, "append", Routine(&funky_append));
    Set(rootEnvironment, "error?", Routine(&funky_is_error));
    Set(rootEnvironment, "grid?", Routine(&funky_is_grid));
    Set(rootEnvironment, "txt-concatenate_", Routine(&funky_make_txt));
    Set(rootEnvironment, "type", Routine(&funky_type_symbol));
    Set(rootEnvironment, UNKNOWN_HANDLER, Atom(UNKNOWN_LIT));
    establish_bacros(rootBacros);
    return new_env();
}
Пример #17
0
int main(void) {
    GC_INIT();
    
    struct env* env = new_env();
    
    insert(env, "define", SCMPRIM(scm_define));    
    insert(env, "quote", SCMPRIM(scm_quote));
    insert(env, "eval", SCMPRIM(scm_eval));
    insert(env, "lambda", SCMPRIM(scm_lambda));
    insert(env, "cons", SCMPRIM(scm_cons));
    insert(env, "car", SCMPRIM(scm_car));
    insert(env, "cdr", SCMPRIM(scm_cdr));

    // A read-eval loop!
    char* buff;
    size_t bufflen = 0;

    while (true) {
        printf("> ");
        fflush(stdout);
        if (getline(&buff, &bufflen, stdin) == -1)
            break;
        
        /*
        int len;
        fdisplay(stdout, eval(parse(buff, &len)[0], &env));
        printf("\n");
        */
        
        struct parse_error parse_err;

        struct value* vals;
        int len;
        if (PARSED(parse_err = parse(buff, &vals, &len))) {
            struct value ret;
            struct error err = eval(vals[0], &env, &ret);
            if (!SUCCEEDED(err)) {
                display_error(err);
            } else {
                fdisplay(stdout, ret);
                printf("\n");
            }
        } else {
            display_parse_error(parse_err);
            printf("\n");
        }
    }

    return 0;
}
Пример #18
0
int TestBlock::run(Env &env, LocalDefs &ienv)
{
	extern bool run_all_testcases;

	if (!enabled && !run_all_testcases)
		return 0;

  int errors = 0;
  
  Env new_env(env);
  
  for (unsigned int i=0 ; i < instrs.size() ; i++)
    errors += instrs[i]->run(new_env, ienv);

  return errors;
}
Пример #19
0
/* precond -- pre operator */
PRIVATE env precond(tree t, env e)
{
     env e1 = tc_sexp(t->x_arg, e);
     env e2 = new_env(e);
     def d;
     tok dec;

     for (;;) {
	  d = pop_def(e1);
	  if (d == NULL) break;
	  dec = d->d_name->s_decor;
	  if (dec != prime && dec != pling)
	       push_def(d, e2);
     }
     return e2;
}
Пример #20
0
int test_quote()
{
   symbol *sa = new_symbol("a");
   symbol *sb = new_symbol("b");
   symbol *sc = new_symbol("c");
   list *va = cons(sa, cons(sb, cons(sc, NULL)));
   environment *env = new_env();

   list *ql = syntax_quote(va, env);

   assert(generic_equal(car(ql), sa));
   assert(generic_equal(car(cdr(ql)), sb));
   assert(generic_equal(car(cdr(cdr(ql))), sc));

   return 1;
}
Пример #21
0
bool test_macro()
{
   list *l;
   environment *env = new_env();
   macro *m;
   list *arg;
   list *body;

   l = read_tokens(expand_readmacro(
         tokenize("(defmacro m (x) `(,x ,x))")));
   m = eval(eval(l, env), env);
   
   arg = car(m);
   body = cdr(m);
   assert(equal_symbol(car(arg), new_symbol("x")));
   assert(equal_symbol(car(body), new_symbol("quasiquote")));
   return true;
}
Пример #22
0
void uiloop(data_t a, data_t b, int nsteps, char *s)
{
	int done = 0;
	struct input inp;
	struct parse_options po;
	struct expr_environ *env = new_env();
	struct expr_var ans;
	data_t ans_data = 45;
	
	Genv = env;
	
	/* setup global vars */
	ans.name = "ans";
	ans.location = &ans_data;
	var_load(env, &ans);
	
	/*setup C funcions & constants*/
	load_builtins(env);
	func_multiload(env, local_funcs, ARSIZE(local_funcs));

	/*Parser options*/
	po.auto_clear = 0;
	po.n_args = (nsteps != 0);
	po.n_rets = CALC_N_RETS;
	
	if (s == NULL) {
		mk_lineinput(&inp, stdin);
		
		while(!done && !linput_done(inp) && !Gdone) {
			fputs("> ", stderr);
			if (linput_prefetch(inp)) {
				eval_print(a, b, nsteps, po, env, inp, &ans_data);
			}
		}
		
		destroy_lineinput(&inp);
	} else {
		mk_strinput(&inp, s, STRINP_NOCOPY);
		eval_print(a, b, nsteps, po, env, inp, &ans_data);
		destroy_strinput(&inp);
	}
	
	destroy_env(env);
}
Пример #23
0
bool test_cond()
{
   list *l;
   environment *env = new_env();
   macro *m;
   
   l = read_tokens(expand_readmacro(
         tokenize("(cond ((+ 1 2) (+ 2 3)) (else 0))")));
   m = eval(eval(l, env), env);
   
   assert(integer_to_int(m) == 5);

   l = read_tokens(expand_readmacro(
         tokenize("(cond (#f (+ 2 3)) (#f (+ 2 3))(else 0))")));
   m = eval(eval(l, env), env);
   assert(integer_to_int(m) == 0);

   return true;
}
Пример #24
0
entry List_28() {
new_env(2, 0);
ildc(0);
load();
ildc(0);
ildc(1);
load();
putfield();
pop();
ildc(0);
load();
ildc(1);
null();
putfield();
pop();
ildc(0);
load();
ret();
}
Пример #25
0
t_env	*global_singleton(void)
{
	static t_env	e;
	static t_bool	inited = false;

	if (!inited)
	{
		inited = true;
		ft_bzero(&e, sizeof(e));
		e.zoom = 1;
		e.width = 600;
		e.height = 400;
		e.run = true;
		e.wanted_iter = 10;
		e.set = 1;
		set1();
		new_env(e.width, e.height, "Fract'Ol", &e);
		pthread_mutex_init(&e.m, NULL);
		init_hooks(&e);
	}
	return (&e);
}
Пример #26
0
entry push_front_30() {
new_env(2, 1);
ildc(2);
newobj(2);
ildc(1);
load();
call(List_28);
store();
pop();
ildc(2);
load();
ildc(1);
ildc(0);
load();
putfield();
pop();
ildc(2);
load();
ret();
null();
ret();
}
Пример #27
0
entry length_34() {
new_env(1, 0);
ildc(0);
load();
null();
oequal();
jz(label0);
ildc(0);
ret();
jmp(label1);
label0:
ildc(1);
ildc(0);
load();
ildc(1);
getfield();
call(length_34);
iadd();
ret();
label1:
null();
ret();
}
Пример #28
0
int ForStmtTest::run(Env &env, LocalDefs &ienv)
{
  //cout << "Number of tests to perform: " << instrs.size() << endl;
  Env src_env(env);

  Term src_seq = src_expr.evaluate(src_env, ienv);
  
  assert(src_seq.is_seq());
  
  int len = src_seq.size();

  int errors = 0;
  for (int i=0 ; i < len ; i++)
  {
    Env new_env(env);
    new_env.set(var, src_seq.item(i));

    for (unsigned int j=0 ; j < instrs.size() ; j++)
      errors += instrs[j]->run(new_env, ienv);
  }

  return errors;
}
Пример #29
0
entry print_36() {
new_env(1, 1);
ildc(1);
ildc(0);
load();
store();
pop();
label4:
ildc(1);
load();
null();
onotequal();
jz(label5);
ildc(1);
load();
call(get_element_29);
call(print_7);
pop();
ildc(4);
call(print_13);
pop();
ildc(1);
ildc(1);
load();
ildc(1);
getfield();
store();
pop();
jmp(label4);
label5:
ildc(5);
call(println_21);
pop();
null();
ret();
}
Пример #30
0
void define_internal_attribute(const char *name,
			       void (*handle_ndecl)(nesc_attribute attr,
						    nesc_declaration ndecl),
			       void (*handle_decl)(nesc_attribute attr,
						   data_declaration ddecl),
			       void (*handle_tag)(nesc_attribute attr,
						  tag_declaration tdecl),
			       void (*handle_field)(nesc_attribute attr,
						    field_declaration fdecl),
			       void (*handle_type)(nesc_attribute attr,
						   type *t),
			       ...)
{
  va_list args;
  field_declaration *next_field;
  word attr_word;
  type_element attr_tag;
  tag_declaration attr_decl;
  struct internal_attribute *iattr;

  /* Build and declare the attribute */
  current.env = global_env;
  attr_word = build_word(parse_region, name);
  attr_tag = start_struct(dummy_location, kind_attribute_ref, attr_word);
  attr_decl = CAST(tag_ref, attr_tag)->tdecl;
  attr_decl->fields = new_env(parse_region, NULL);
  next_field = &attr_decl->fieldlist;

  /* Fields. A fieldname, fieldtype argument list, terminated with a
     null fieldname. We build a semi-fake struct for these.
  */
  va_start(args, handle_type);
  for (;;)
    {
      const char *field_name = va_arg(args, const char *);
      field_declaration field;

      if (!field_name)
	break;
      field = ralloc(parse_region, struct field_declaration);
      field->containing_tag = attr_decl;
      *next_field = field;
      next_field = &field->next;
      field->name = field_name;
      field->type = va_arg(args, type);
      field->bitwidth = field->offset = cval_unknown_number;

      env_add(attr_decl->fields, field_name, field);
    }
  va_end(args);

  /* Add to internal attributes table */
  iattr = ralloc(permanent, struct internal_attribute);
  iattr->name = name;
  iattr->handle_ndecl = handle_ndecl;
  iattr->handle_decl = handle_decl;
  iattr->handle_tag = handle_tag;
  iattr->handle_field = handle_field;
  iattr->handle_type = handle_type;
  env_add(internal_attributes, name, iattr);
}