Example #1
0
void eval(BOOLEAN do_gc)
{
  static unsigned int count = 0;

  OBJECT_PTR exp = car(reg_next_expression);

  OBJECT_PTR opcode = car(exp);

  pin_globals();

  if(do_gc)
  {
    count++;

    if(count == GC_FREQUENCY)
    {
      gc(false, true);
      count = 0;
    }
  }

  if(opcode == APPLY && profiling_in_progress)
  {
    last_operator = reg_accumulator;

    if(prev_operator != NIL)
    {
      OBJECT_PTR operator_to_be_used;

      hashtable_entry_t *e;

      unsigned int count;
      unsigned int mem_alloc;
      double elapsed_wall_time;
      double elapsed_cpu_time;

      double temp1 = get_wall_time();
      clock_t temp2 = clock();
      unsigned int temp3 = memory_allocated();

      profiling_datum_t *pd = (profiling_datum_t *)malloc(sizeof(profiling_datum_t));

      if(IS_SYMBOL_OBJECT(prev_operator))
         operator_to_be_used = prev_operator;
      else
      {
        OBJECT_PTR res = get_symbol_from_value(prev_operator, reg_current_env);
        if(car(res) != NIL)
          operator_to_be_used = cdr(res);
        else
          operator_to_be_used = cons(LAMBDA,
                                     cons(get_params_object(prev_operator),
                                          cons(car(get_source_object(prev_operator)), NIL)));
      }

      e = hashtable_get(profiling_tab, (void *)operator_to_be_used);

      if(e)
      {
        profiling_datum_t *pd = (profiling_datum_t *)e->value;

        count = pd->count + 1;

        elapsed_wall_time = pd->elapsed_wall_time + temp1 - wall_time_var;
        elapsed_cpu_time = pd->elapsed_cpu_time + (temp2 - cpu_time_var) * 1.0 / CLOCKS_PER_SEC;
      
        mem_alloc = pd->mem_allocated + temp3 - mem_alloc_var;

        hashtable_remove(profiling_tab, (void *)operator_to_be_used);
        free(pd);
      }
      else
      {
        count = 1;
        elapsed_wall_time = temp1 - wall_time_var;
        elapsed_cpu_time = (temp2 - cpu_time_var) * 1.0 / CLOCKS_PER_SEC;
        mem_alloc = temp3 - mem_alloc_var;
      }

      pd->count = count;
      pd->elapsed_wall_time = elapsed_wall_time;
      pd->elapsed_cpu_time = elapsed_cpu_time;
      pd->mem_allocated = mem_alloc;

      hashtable_put(profiling_tab, (void *)operator_to_be_used, (void *)pd);
    }

    wall_time_var = get_wall_time();
    cpu_time_var = clock();
    mem_alloc_var = memory_allocated();

    prev_operator = reg_accumulator;
  }

  if(opcode == HALT)
  {
    halt_op();
  }
  else if(opcode == REFER)
  {
    if(refer(CADR(exp)))
       return;
    reg_next_expression = CADDR(exp);
  }
  else if(opcode == CONSTANT)
  {
    if(constant(CADR(exp)))
      return;
    reg_next_expression = CADDR(exp);
  }
  else if(opcode == CLOSE)
  {
    if(closure(exp))
      return;
    reg_next_expression = fifth(exp);
  }
  else if(opcode == MACRO)
  {
    if(macro(exp))
      return;
    reg_next_expression = CADDDDR(exp);
  }
  else if(opcode == TEST)
  {
    if(reg_accumulator != NIL)
      reg_next_expression = CADR(exp);
    else
      reg_next_expression = CADDR(exp);
  }
  //Not using this WHILE; reverting 
  //to macro definition, as this
  //version doesn't handle (BREAK)
  else if(opcode == WHILE)
  {
    OBJECT_PTR cond = CADR(exp);
    OBJECT_PTR body  = CADDR(exp);

    OBJECT_PTR ret = NIL;

    while(1)
    {
      OBJECT_PTR temp = reg_current_stack;

      reg_next_expression = cond;

      while(car(reg_next_expression) != NIL)
      {
        eval(false);
        if(in_error)
          return;
      }

      if(reg_accumulator == NIL)
        break;

      reg_next_expression = body;

      while(car(reg_next_expression) != NIL)
      {
        eval(false);
        if(in_error)
          return;
      }

      //to handle premature exits
      //via RETURN-FROM
      if(reg_current_stack != temp)
        return;

      ret = reg_accumulator;
    }

    reg_accumulator = ret;
    reg_next_expression = CADDDR(exp);
  }
  else if(opcode == ASSIGN)
  {
    if(assign(CADR(exp)))
      return;
    reg_next_expression = CADDR(exp);
  }
  else if(opcode == DEFINE)
  {
    if(define(CADR(exp)))
      return;
    reg_next_expression = CADDR(exp);
  }
  else if(opcode == CONTI)
  {
    if(conti())
      return;
    reg_next_expression = CADR(exp);
  }
  else if(opcode == NUATE) //this never gets called
  {
    reg_current_stack = CADR(exp);
    reg_accumulator = CADDR(exp);
    reg_current_value_rib = NIL;
    reg_next_expression =  cons(CONS_RETURN_NIL, cdr(reg_next_expression));
  }
  else if(opcode == FRAME)
  {
    if(frame(exp))
      return;
    reg_next_expression = CADDR(exp);
  }
  else if(opcode == ARGUMENT)
  {
    if(argument())
      return;
    reg_next_expression = CADR(exp);
  }
  else if(opcode == APPLY)
  {
    apply_compiled();
  }
  else if(opcode == RETURN)
  {
    return_op();
  }
}
Example #2
0
int
main(int argc)
{


	IloEnv   env;
	try {
		IloModel model(env);

		NumVarMatrix varOutput(env, J + current);
		NumVar3Matrix varHelp(env, J + current);
		Range3Matrix cons(env, J + current);
		for (int j = 0; j <J + current; j++){
			varOutput[j] = IloNumVarArray(env, K);
			varHelp[j] = NumVarMatrix(env, K);
			cons[j] = RangeMatrix(env, K);
			for (int k = 0; k < K; k++){
				varOutput[j][k] = IloNumVar(env, 0.0, IloInfinity);
				varHelp[j][k] = IloNumVarArray(env, L);
				cons[j][k] = IloRangeArray(env, C);
				for (int l = 0; l < L; l++){
					varHelp[j][k][l] = IloNumVar(env, 0.0, IloInfinity);
				}
				if (j > current){
					cons[j][k][0] = IloRange(env, 0.0, 0.0);//will be used to express equality of varOutput, constraint (0)
					cons[j][k][1] = IloRange(env, 0.0, IloInfinity);// constraint (1)
					cons[j][k][2] = IloRange(env, -IloInfinity, T[j] - Tdc - Tblow[j] - Tslack);// constraint (2)
					cons[j][k][3] = IloRange(env, Tfd[k], Tfd[k]);// constraint (3)
					cons[j][k][4] = IloRange(env, 0.0, IloInfinity);// constraint (4)
					cons[j][k][5] = IloRange(env, Tdf[k], IloInfinity);// constraint (5)
					cons[j][k][6] = IloRange(env, T[j - a[k]] + Tcd, T[j - a[k]] + Tcd);// constraint (6)
					cons[j][k][7] = IloRange(env, TlossD[k], IloInfinity);// constraint (7)
					cons[j][k][8] = IloRange(env, TlossF[k], IloInfinity);// constraint (8)
				}
			}
		}

		populatebynonzero(model, varOutput, varHelp, cons);

		IloCplex cplex(model);

		// Optimize the problem and obtain solution.
		if (!cplex.solve()) {
			env.error() << "Failed to optimize LP" << endl;
			throw(-1);
		}

		IloNumArray vals(env);
		IloNumVar val(env);

		//vars to save output
		double TimeAvailable[J][K];
		double TimeInstances[J][K][L];
		double LK103[J][2];


		env.out() << "Solution status = " << cplex.getStatus() << endl;
		env.out() << "Solution value  = " << cplex.getObjValue() << endl;
		for (int j = current; j < current + J; ++j)
		{
			cplex.getValues(vals, varOutput[j]);
			env.out() << "Seconds for load "<<j<<"       = " << vals << endl;
			/*for (int k = 0; k < K; k++){
				TimeAvailable[j][k] = cplex.getValue(varOutput[j][k]);
			}*/
		}
		for (int j = current; j < current + J; j++){
			for (int k = 0; k < K; k++){
				cplex.getValues(vals, varHelp[j][k]);
				env.out() << "Time instances for spoon "<<k<<" in load "<<j<<" = " << vals << endl;
				/*for (int l = 0; l < L; l++){
					TimeInstances[j][k][l] = cplex.getValue(varHelp[j][k][l]);
				}*/
			}
		}

		for (int j = current + 2; j < J + current; j++){
			LK103[j][0] = TimeInstances[j - 2][0][0];
			LK103[j][1] = TimeInstances[j][0][5];
			env.out() << "LK103, load " << j << " : " << LK103[j][1]-LK103[j][0] << endl;
		}
		/*cplex.getSlacks(vals, cons);
		env.out() << "Slacks        = " << vals << endl;
		cplex.getDuals(vals, cons);
		env.out() << "Duals         = " << vals << endl;
		cplex.getReducedCosts(vals, varOutput);
		env.out() << "Reduced Costs = " << vals << endl;*/

		cplex.exportModel("lpex1.lp");
	}
	catch (IloException& e) {
		cerr << "Concert exception caught: " << e << endl;
	}
	catch (...) {
		cerr << "Unknown exception caught" << endl;
	}

	env.end();
	cin.get();
	return 0;
}  // END main
 public: Val AddOpt(Val ty)
     { ASSERT(nil != ty); m_opts = cons(ty, m_opts); return ty; }
Example #4
0
liste liste_test1 ()
{
  return cons (1, cons (2, cons (3, cons (4, l_vide ())))) ;
}
Example #5
0
/* Evaluate object 
 * NULL return value means Nothing
 */
object *eval(object *obj, env_hashtable *env)
{
    object *cur, *eobj, 
        *last_pair, *t,
        *ecar, *ecdr;
    
    if (!obj)
        return NULL;
    
    /* Detect syntatic construction */
    if (TYPE(obj) == OBJ_PAIR &&
        TYPE(CAR(obj)) == OBJ_SYMBOL) {
        t = CAR(obj);
        if (strcmp("lambda", STR(t)) == 0) {
            t = CDDR(obj);
            t = cons(symbol("begin"), t);
            eobj = compound_procedure(CADR(obj), t, env);
            return eobj;
        } else if (strcmp("define", STR(t)) == 0) {
            eobj = eval(CADDR(obj), env);
            env_hashtable_insert(env, STR(CADR(obj)), eobj);
            return NULL; /* Not error, just nothing */
        } else if (strcmp("begin", STR(t)) == 0) {
            obj = CDR(obj);
            eobj = NULL; /* Not error, just nothing */
            while (obj != null_object) {
                eobj = eval(CAR(obj), env);
                obj = CDR(obj);
            }
            return eobj;
        } else if (strcmp("apply", STR(t)) == 0) {
            eobj = eval(CADR(obj), env);
            t = eval(CADDR(obj), env);
            return apply(eobj, t);
        } else if (strcmp("quote", STR(t)) == 0) {
            return CADR(obj);
        }
    }
    
    /* Object evaluation */
    switch (TYPE(obj)) {
        case OBJ_NUMBER:
        case OBJ_BOOLEAN:
            return obj;
        case OBJ_SYMBOL:
            return env_hashtable_find(env, STR(obj));
        case OBJ_PAIR:
            cur = obj;
            eobj = null_object;
            last_pair = NULL;
            
            while (cur != null_object && 
                   TYPE(cur) == OBJ_PAIR) {
                t = cons(eval(CAR(cur), env), null_object);
                if (!last_pair)
                    eobj = t;
                else
                    CDR(last_pair) = t;
                last_pair = t;
                
                cur = CDR(cur);
            }
            
            ecar = CAR(eobj);
            ecdr = CDR(eobj);
            
            return apply(ecar, ecdr);
        default:
            return NULL;
    }
}
Example #6
0
File: parse.cpp Project: shaurz/amp
Value
Parser::quoted(Symbol *quote)
{
	return cons(quote, cons(parse(), NIL));
}
Example #7
0
static Tree prepareRule(Tree rule)
{
  return cons(lmap(preparePattern, hd(rule)), tl(rule));
}
/* An explicit control evaluator, taken almost directly from SICP, section
 * 5.2.  list is a flat list of expressions to evaluate.  where is a label to
 * begin at.  Return value depends on where.
 */ 
NODE *evaluator(NODE *list, enum labels where) {

    /* registers */
    NODE    *exp    = NIL,  /* the current expression */
	    *val    = NIL,  /* the value of the last expression */
	    *proc   = NIL,  /* the procedure definition */
	    *argl   = NIL,  /* evaluated argument list */
	    *unev   = NIL,  /* list of unevaluated expressions */
	    *stack  = NIL,  /* register stack */
	    *parm   = NIL,  /* the current formal */
	    *catch_tag = NIL,
	    *arg    = NIL;  /* the current actual */

/* registers that don't get reference counted, so we pretend they're ints */
FIXNUM	    vsp    = 0,		/* temp ptr into var_stack */
	    cont   = 0,		/* where to go next */
	    formals = (FIXNUM)NIL; /* list of formal parameters */

    int i, nargs;
    BOOLEAN tracing;	    /* are we tracing the current procedure? */
    FIXNUM oldtailcall;	    /* in case of reentrant use of evaluator */
    FIXNUM repcount;	    /* count for repeat */
    FIXNUM old_ift_iff;

    oldtailcall = tailcall;
    old_ift_iff = ift_iff_flag;
    save2(var,this_line);
    assign(var, var_stack);
    save2(fun,ufun);
    cont = (FIXNUM)all_done;
    numsave((FIXNUM)cont);
    newcont(where);
    goto fetch_cont;
    
begin_line:
    ref(list);
    assign(this_line, list);
    newcont(end_line);
begin_seq:
    make_tree(list);
    if (!is_tree(list)) {
	assign(val, UNBOUND);
	goto fetch_cont;
    }
    assign(unev, tree__tree(list));
    assign(val, UNBOUND);
    goto eval_sequence;

end_line:
    if (val != UNBOUND) {
	if (NOT_THROWING) err_logo(DK_WHAT, val);
	deref(val);
    }
    val = NIL;
    deref(list);
    goto fetch_cont;


/* ----------------- EVAL ---------------------------------- */

tail_eval_dispatch:
    tailcall = 1;
eval_dispatch:
    switch (nodetype(exp)) {
	case QUOTE:			/* quoted literal */
	    assign(val, node__quote(exp));
	    goto fetch_cont;
	case COLON:			/* variable */
	    assign(val, valnode__colon(exp));
	    while (val == UNBOUND && NOT_THROWING)
		assign(val, err_logo(NO_VALUE, node__colon(exp)));
	    goto fetch_cont;
	case CONS:			/* procedure application */
	    if (tailcall == 1 && is_macro(car(exp)) &&
				 is_list(procnode__caseobj(car(exp)))) {
		/* tail call to user-defined macro must be treated as non-tail
		 * because the expression returned by the macro
		 * remains to be evaluated in the caller's context */
		assign(unev, NIL);
		goto non_tail_eval;
	    }
	    assign(fun, car(exp));
	    if (cdr(exp) != NIL)
		goto ev_application;
	    else
		goto ev_no_args;
	default:
	    assign(val, exp);		/* self-evaluating */
	    goto fetch_cont;
    }

ev_no_args:
    /* Evaluate an application of a procedure with no arguments. */
    assign(argl, NIL);
    goto apply_dispatch;    /* apply the procedure */

ev_application:
    /* Evaluate an application of a procedure with arguments. */
    assign(unev, cdr(exp));
    assign(argl, NIL);
    mixsave(tailcall,var);
    num2save(val_status,ift_iff_flag);
    save2(didnt_get_output,didnt_output_name);
eval_arg_loop:
    if (unev == NIL) goto eval_args_done;
    assign(exp, car(unev));
    if (exp == Not_Enough_Node) {
	if (NOT_THROWING)
	    err_logo(NOT_ENOUGH, NIL);
	goto eval_args_done;
    }
    save(argl);
    save2(unev,fun);
    save2(ufun,last_ufun);
    save2(this_line,last_line);
    assign(var, var_stack);
    tailcall = -1;
    val_status = 1;
    assign(didnt_get_output,
	   cons_list(0,fun,ufun,this_line,END_OF_LIST));
    assign(didnt_output_name, NIL);
    newcont(accumulate_arg);
    goto eval_dispatch;	    /* evaluate the current argument */

accumulate_arg:
    /* Put the evaluated argument into the argl list. */
    reset_args(var);
    restore2(this_line,last_line);
    restore2(ufun,last_ufun);
    assign(last_call, fun);
    restore2(unev,fun);
    restore(argl);
    while (NOT_THROWING && val == UNBOUND) {
	assign(val, err_logo(DIDNT_OUTPUT, NIL));
    }
    push(val, argl);
    pop(unev);
    goto eval_arg_loop;

eval_args_done:
    restore2(didnt_get_output,didnt_output_name);
    num2restore(val_status,ift_iff_flag);
    mixrestore(tailcall,var);
    if (stopping_flag == THROWING) {
	assign(val, UNBOUND);
	goto fetch_cont;
    }
    assign(argl, reverse(argl));
/* --------------------- APPLY ---------------------------- */
apply_dispatch:
    /* Load in the procedure's definition and decide whether it's a compound
     * procedure or a primitive procedure.
     */
    proc = procnode__caseobj(fun);
    if (is_macro(fun)) {
	num2save(val_status,tailcall);
	val_status = 1;
	newcont(macro_return);
    }
    if (proc == UNDEFINED) {
	if (ufun != NIL) {
	    untreeify_proc(ufun);
	}
	if (NOT_THROWING)
	    assign(val, err_logo(DK_HOW, fun));
	else
	    assign(val, UNBOUND);
	goto fetch_cont;
    }
    if (is_list(proc)) goto compound_apply;
    /* primitive_apply */
    if (NOT_THROWING)
	assign(val, (*getprimfun(proc))(argl));
    else
	assign(val, UNBOUND);
#define do_case(x) case x: goto x;
fetch_cont:
    {
	enum labels x = (enum labels)cont;
	cont = (FIXNUM)car(stack);
	numpop(&stack);
	switch (x) {
	    do_list(do_case)
	    default: abort();
	}
    }

compound_apply:
#ifdef mac
    check_mac_stop();
#endif
#ifdef ibm
    check_ibm_stop();
#endif
    if (tracing = flag__caseobj(fun, PROC_TRACED)) {
	for (i = 0; i < trace_level; i++) print_space(writestream);
	trace_level++;
	ndprintf(writestream, "( %s ", fun);
    }
/* Bind the actuals to the formals */
    vsp = (FIXNUM)var_stack;	/* remember where we came in */
    for (formals = (FIXNUM)formals__procnode(proc);
    	 formals != (FIXNUM)NIL;
	 formals = (FIXNUM)cdr((NODE *)formals)) {
	    parm = car((NODE *)formals);
	    if (nodetype(parm) == INT) break;	/* default # args */
	    if (argl != NIL) {
		arg = car(argl);
		if (tracing) {
		    print_node(writestream, maybe_quote(arg));
		    print_space(writestream);
		}
	    } else
		arg = UNBOUND;
	    if (nodetype(parm) == CASEOBJ) {
		if (not_local(parm,(NODE *)vsp)) {
		    push(parm, var_stack);
		    setobject(var_stack, valnode__caseobj(parm));
		}
		tell_shadow(parm);
		setvalnode__caseobj(parm, arg);
	    } else if (nodetype(parm) == CONS) {
		/* parm is optional or rest */
		if (not_local(car(parm),(NODE *)vsp)) {
		    push(car(parm), var_stack);
		    setobject(var_stack, valnode__caseobj(car(parm)));
		}
		tell_shadow(car(parm));
		if (cdr(parm) == NIL) {		    /* parm is rest */
		    setvalnode__caseobj(car(parm), argl);
		    break;
		}
		if (arg == UNBOUND) {		    /* use default */
		    save2(fun,var);
		    save2(ufun,last_ufun);
		    save2(this_line,last_line);
		    save2(didnt_output_name,didnt_get_output);
		    num2save(ift_iff_flag,val_status);
		    assign(var, var_stack);
		    tailcall = -1;
		    val_status = 1;
		    mixsave(formals,argl);
		    numsave(vsp);
		    assign(list, cdr(parm));
		    if (NOT_THROWING)
			make_tree(list);
		    else
			assign(list, NIL);
		    if (!is_tree(list)) {
			assign(val, UNBOUND);
			goto set_args_continue;
		    }
		    assign(unev, tree__tree(list));
		    assign(val, UNBOUND);
		    newcont(set_args_continue);
		    goto eval_sequence;

set_args_continue:
		    numrestore(vsp);
		    mixrestore(formals,argl);
		    parm = car((NODE *)formals);
		    reset_args(var);
		    num2restore(ift_iff_flag,val_status);
		    restore2(didnt_output_name,didnt_get_output);
		    restore2(this_line,last_line);
		    restore2(ufun,last_ufun);
		    restore2(fun,var);
		    arg = val;
		}
		setvalnode__caseobj(car(parm), arg);
	    }
	    if (argl != NIL) pop(argl);
    }
    if (check_throwing) {
	assign(val, UNBOUND);
	goto fetch_cont;
    }
    vsp = 0;
    if (tracing = flag__caseobj(fun, PROC_TRACED)) {
	if (NOT_THROWING) print_char(writestream, ')');
	new_line(writestream);
	save(fun);
	newcont(compound_apply_continue);
    }
    assign(val, UNBOUND);
    assign(last_ufun, ufun);
    assign(ufun, fun);
    assign(last_line, this_line);
    assign(this_line, NIL);
    proc = procnode__caseobj(fun);
    assign(list, bodylist__procnode(proc));	/* get the body ... */
    make_tree_from_body(list);
    if (!is_tree(list)) {
	goto fetch_cont;
    }
    assign(unev, tree__tree(list));
    if (NOT_THROWING) stopping_flag = RUN;
    assign(output_node, UNBOUND);
    if (val_status == 1) val_status = 2;
    else if (val_status == 5) val_status = 3;
    else val_status = 0;
eval_sequence:
    /* Evaluate each expression in the sequence.  Stop as soon as
     * val != UNBOUND.
     */
    if (!RUNNING || val != UNBOUND) {
	goto fetch_cont;
    }
    if (nodetype(unev) == LINE) {
	assign(this_line, unparsed__line(unev));
	if (flag__caseobj(ufun, PROC_STEPPED)) {
	    char junk[20];

	    if (tracing) {
		int i = 1;
		while (i++ < trace_level) print_space(stdout);
	    }
	    print_node(stdout, this_line);
	    ndprintf(stdout, " >>> ");
	    input_blocking++;
#ifndef TIOCSTI
	    if (!setjmp(iblk_buf))
#endif
#ifdef __ZTC__
		ztc_getcr();
#else
		fgets(junk, 19, stdin);
#endif
	    input_blocking = 0;
	    update_coords('\n');
	}
    }
    assign(exp, car(unev));
    pop(unev);
    if (is_list(exp) && (is_tailform(procnode__caseobj(car(exp))))) {
      if (nameis(car(exp),Output) || nameis(car(exp),Op)) {
	assign(didnt_get_output,
	       cons_list(0,car(exp),ufun,this_line,END_OF_LIST));
	assign(didnt_output_name, NIL);
	if (val_status == 2 || val_status == 3) {
	    val_status = 1;
	    assign(exp, cadr(exp));
	    goto tail_eval_dispatch;
	} else if (ufun == NIL) {
	    err_logo(AT_TOPLEVEL,car(exp));
	    assign(val, UNBOUND);
	    goto fetch_cont;
	} else if (val_status < 4) {
	    val_status = 1;
	    assign(exp, cadr(exp));
	    assign(unev, NIL);
	    goto non_tail_eval;	    /* compute value then give error */
	}
      } else if (nameis(car(exp),Stop)) {
	if (ufun == NIL) {
	    err_logo(AT_TOPLEVEL,car(exp));
	    assign(val, UNBOUND);
	    goto fetch_cont;
	} else if (val_status == 0 || val_status == 3) {
	    assign(val, UNBOUND);
	    goto fetch_cont;
	} else if (val_status < 4) {
	    assign(didnt_output_name, fun);
	    assign(val, UNBOUND);
	    goto fetch_cont;
	}
      } else { /* maybeoutput */
	assign(exp, cadr(exp));
	val_status = 5;
	goto tail_eval_dispatch;
      }
    }
    if (unev == NIL) {
	if (val_status == 2 || val_status == 4) {
	    assign(didnt_output_name, fun);
	    assign(unev, UNBOUND);
	    goto non_tail_eval;
	} else {
	    goto tail_eval_dispatch;
	}
    }
    if (is_list(car(unev)) && nameis(car(car(unev)),Stop)) {
	if ((val_status == 0 || val_status == 3) && ufun != NIL) {
	    goto tail_eval_dispatch;
	} else if (val_status < 4) {
	    assign(didnt_output_name, fun);
	    goto tail_eval_dispatch;
	}
    }
non_tail_eval:
    save2(unev,fun);
    num2save(ift_iff_flag,val_status);
    save2(ufun,last_ufun);
    save2(this_line,last_line);
    save(var);
    assign(var, var_stack);
    tailcall = 0;
    newcont(eval_sequence_continue);
    goto eval_dispatch;

eval_sequence_continue:
    reset_args(var);
    restore(var);
    restore2(this_line,last_line);
    restore2(ufun,last_ufun);
    if (dont_fix_ift) {
	num2restore(dont_fix_ift,val_status);
	dont_fix_ift = 0;
    } else
	num2restore(ift_iff_flag,val_status);
    restore2(unev,fun);
    if (stopping_flag == MACRO_RETURN) {
	if (unev == UNBOUND) assign(unev, NIL);
	assign(unev, append(val, unev));
	assign(val, UNBOUND);
	stopping_flag = RUN;
	if (unev == NIL) goto fetch_cont;
    } else if (val_status < 4) {
	if (STOPPING || RUNNING) assign(output_node, UNBOUND);
	if (stopping_flag == OUTPUT || STOPPING) {
	    stopping_flag = RUN;
	    assign(val, output_node);
	    if (val != UNBOUND && val_status < 2 && NOT_THROWING) {
		assign(didnt_output_name,Output);
		err_logo(DIDNT_OUTPUT,Output);
	    }
	    if (val == UNBOUND && val_status == 1 && NOT_THROWING) {
		assign(didnt_output_name,Stop);
		err_logo(DIDNT_OUTPUT,Output);
	    }
	    goto fetch_cont;
	}
    }
    if (val != UNBOUND) {
	err_logo((unev == NIL ? DK_WHAT_UP : DK_WHAT), val);
	assign(val, UNBOUND);
    }
    if (NOT_THROWING && (unev == NIL || unev == UNBOUND)) {
	if (val_status != 4)  err_logo(DIDNT_OUTPUT,NIL);
	goto fetch_cont;
    }
    goto eval_sequence;

compound_apply_continue:
    /* Only get here if tracing */
    restore(fun);
    --trace_level;
    if (NOT_THROWING) {
	for (i = 0; i < trace_level; i++) print_space(writestream);
	print_node(writestream, fun);
	if (val == UNBOUND)
	    ndprintf(writestream, " stops\n");
	else {
	    ref(val);
	    ndprintf(writestream, " outputs %s\n", maybe_quote(val));
	    deref(val);
	}
    }
    goto fetch_cont;

/* --------------------- MACROS ---------------------------- */

macro_return:
    num2restore(val_status,tailcall);
    while (!is_list(val) && NOT_THROWING) {
	assign(val,err_logo(ERR_MACRO,val));
    }
    if (NOT_THROWING) {
	if (is_cont(val)) {
	    newcont(cont__cont(val));
	    val->n_car = NIL;
	    assign(val, val__cont(val));
	    goto fetch_cont;
	}
macro_reval:
	if (tailcall == 0) {
	    make_tree(val);
	    stopping_flag = MACRO_RETURN;
	    if (!is_tree(val)) assign(val, NIL);
	    else assign(val, tree__tree(val));
	    goto fetch_cont;
	}
	assign(list,val);
	goto begin_seq;
    }
    assign(val, UNBOUND);
    goto fetch_cont;

runresult_continuation:
    assign(list, val);
    newcont(runresult_followup);
    val_status = 5;
    goto begin_seq;

runresult_followup:
    if (val == UNBOUND) {
	assign(val, NIL);
    } else {
	assign(val, cons(val, NIL));
    }
    goto fetch_cont;

repeat_continuation:
    assign(list, cdr(val));
    repcount = getint(car(val));
repeat_again:
    assign(val, UNBOUND);
    if (repcount == 0) goto fetch_cont;
    mixsave(repcount,list);
    num2save(val_status,tailcall);
    val_status = 4;
    newcont(repeat_followup);
    goto begin_seq;

repeat_followup:
    if (val != UNBOUND && NOT_THROWING) {
	ref(val);
	err_logo(DK_WHAT, val);
	unref(val);
    }
    num2restore(val_status,tailcall);
    mixrestore(repcount,list);
    if (val_status < 4 && tailcall != 0) {
	if (STOPPING || RUNNING) assign(output_node, UNBOUND);
	if (stopping_flag == OUTPUT || STOPPING) {
	    stopping_flag = RUN;
	    assign(val, output_node);
	    if (val != UNBOUND && val_status < 2) {
		err_logo(DK_WHAT_UP,val);
	    }
	    goto fetch_cont;
	}
    }
    if (repcount > 0)    /* negative means forever */
	--repcount;
#ifdef mac
    check_mac_stop();
#endif
#ifdef ibm
    check_ibm_stop();
#endif
    if (RUNNING) goto repeat_again;
    assign(val, UNBOUND);
    goto fetch_cont;

catch_continuation:
    assign(list, cdr(val));
    assign(catch_tag, car(val));
    if (compare_node(catch_tag,Error,TRUE) == 0) {
	push(Erract, var_stack);
	setobject(var_stack, valnode__caseobj(Erract));
	setvalnode__caseobj(Erract, UNBOUND);
    }
    save(catch_tag);
    save2(didnt_output_name,didnt_get_output);
    num2save(val_status,tailcall);
    newcont(catch_followup);
    val_status = 5;
    goto begin_seq;

catch_followup:
    num2restore(val_status,tailcall);
    restore2(didnt_output_name,didnt_get_output);
    restore(catch_tag);
    if (val_status < 4 && tailcall != 0) {
	if (STOPPING || RUNNING) assign(output_node, UNBOUND);
	if (stopping_flag == OUTPUT || STOPPING) {
	    stopping_flag = RUN;
	    assign(val, output_node);
	    if (val != UNBOUND && val_status < 2) {
		err_logo(DK_WHAT_UP,val);
	    }
	}
    }
    if (stopping_flag == THROWING &&
	compare_node(throw_node, catch_tag, TRUE) == 0) {
	    throw_node = reref(throw_node, UNBOUND);
	    stopping_flag = RUN;
	    assign(val, output_node);
    }
    goto fetch_cont;

begin_apply:
    /* This is for lapply. */
    assign(fun, car(val));
    while (nodetype(fun) == ARRAY && NOT_THROWING)
	assign(fun, err_logo(APPLY_BAD_DATA, fun));
    assign(argl, cadr(val));
    assign(val, UNBOUND);
    while (!is_list(argl) && NOT_THROWING)
	assign(argl, err_logo(APPLY_BAD_DATA, argl));
    if (NOT_THROWING && fun != NIL) {
	if (is_list(fun)) {		    /* template */
	    if (is_list(car(fun)) && cdr(fun) != NIL) {
		/* lambda form */
		formals = (FIXNUM)car(fun);
		numsave(tailcall);
		tailcall = 0;
		llocal((NODE *)formals);    /* bind the formals locally */
		numrestore(tailcall);
		for ( ;
		     formals && argl && NOT_THROWING;
		     formals = (FIXNUM)cdr((NODE *)formals),
		     assign(argl, cdr(argl)))
			setvalnode__caseobj(car((NODE *)formals), car(argl));
		assign(val, cdr(fun));
		goto macro_reval;
	    } else {		/* question-mark form */
		save(qm_list);
		assign(qm_list, argl);
		assign(list, fun);
		make_tree(list);
		if (list == NIL || !is_tree(list)) {
		    goto qm_failed;
		}
		assign(unev, tree__tree(list));
		save2(didnt_output_name,didnt_get_output);
		num2save(val_status,tailcall);
		newcont(qm_continue);
		val_status = 5;
		goto eval_sequence;

qm_continue:
		num2restore(val_status,tailcall);
		restore2(didnt_output_name,didnt_get_output);
		if (val_status < 4 && tailcall != 0) {
		    if (STOPPING || RUNNING) assign(output_node, UNBOUND);
		    if (stopping_flag == OUTPUT || STOPPING) {
			stopping_flag = RUN;
			assign(val, output_node);
			if (val != UNBOUND && val_status < 2) {
			    err_logo(DK_WHAT_UP,val);
			}
		    }
		}
qm_failed:
		restore(qm_list);
		goto fetch_cont;
	    }
	} else {    /* name of procedure to apply */
	    int min, max, n;
	    NODE *arg;
	    assign(fun, intern(fun));
	    if (procnode__caseobj(fun) == UNDEFINED && NOT_THROWING &&
		fun != Null_Word)
		    silent_load(fun, NULL);    /* try ./<fun>.lg */
	    if (procnode__caseobj(fun) == UNDEFINED && NOT_THROWING &&
		fun != Null_Word)
		    silent_load(fun, logolib); /* try <logolib>/<fun> */
	    proc = procnode__caseobj(fun);
	    while (proc == UNDEFINED && NOT_THROWING) {
		assign(val, err_logo(DK_HOW_UNREC, fun));
	    }
	    if (NOT_THROWING) {
		if (nodetype(proc) == CONS) {
		    min = getint(minargs__procnode(proc));
		    max = getint(maxargs__procnode(proc));
		} else {
		    if (getprimdflt(proc) < 0) {	    /* special form */
			err_logo(DK_HOW_UNREC, fun);    /* can't apply */
			goto fetch_cont;
		    } else {
			min = getprimmin(proc);
			max = getprimmax(proc);
		    }
		}
		for (n = 0, arg = argl; arg != NIL; n++, arg = cdr(arg));
		if (n < min) {
		    err_logo(NOT_ENOUGH, NIL);
		} else if (n > max && max >= 0) {
		    err_logo(TOO_MUCH, NIL);
		} else {
		    goto apply_dispatch;
		}
	    }
	}
    }
    goto fetch_cont;

all_done:
    tailcall = oldtailcall;
    ift_iff_flag = old_ift_iff;
    restore2(fun,ufun);
    reset_args(var);
    restore2(var,this_line);
    deref(argl);deref(unev);deref(stack);deref(catch_tag);deref(exp);
    return(val);
}
Example #9
0
File: utils.c Project: aburry/trol
/*! \brief Concatenate two lists.
 *
 * Create a list by joining two lists together.
 *
 * \param list_a A list to become the head of new list.
 * \param list_b A list to become the tail of new list.
 * \return A list with the elements of \a list_a followed by the
 * elements of \a list_b.
 */
sexp append(sexp list_a, sexp list_b) {
    if (c_bool(null(list_a))) { return list_b; }
    return cons(car(list_a), append(cdr(list_a), list_b));
}
 bool Porter_Stemmer::cvc(int i) {
   if (i < k0+2 || !cons(i) || cons(i-1) || !cons(i-2)) return false;
   int ch = b[i];
   if (ch == 'w' || ch == 'x' || ch == 'y') return false;
   return true;
 }
Example #11
0
/* nondestructive append */
NODE *append(NODE *a, NODE *b) {
    NODE *result;

    if (a == NIL) return b;
    return cons(car(a), append(cdr(a), b));
}
 bool Porter_Stemmer::doublec(int j) {
   if (j < k0+1) return false;
   if (b[j] != b[j-1]) return false;
   return cons(j);
 }
 bool Porter_Stemmer::vowelinstem() {
   int i; 
   for (i = k0; i <= j; i++) if (! cons(i)) return true;
   return false;
 }
Example #14
0
OBJECT_PTR eval_backquote(OBJECT_PTR form)
{
  OBJECT_PTR car_obj;

  assert(is_valid_object(form));

  if(is_atom(form))
    return form;

  car_obj = car(form);

  assert(is_valid_object(car_obj));

  if(IS_SYMBOL_OBJECT(car_obj))
  {
    char buf[SYMBOL_STRING_SIZE];
    print_symbol(car_obj, buf);

    if(car_obj == COMMA)
    {
      OBJECT_PTR temp = compile(CADR(form), NIL);

#ifdef WIN32
      if(temp == ERROR1)
#else
      if(temp == ERROR)
#endif
      {
        throw_generic_exception("Backquote evaluation(1): compile failed");
        return NIL;
      }

      reg_next_expression = cons(cons(FRAME, cons(cons(CONS_HALT_NIL, CADR(form)),
                                                  cons(temp, CADR(form)))),
                                 CADR(form));

      reg_current_value_rib = NIL;

      while(car(reg_next_expression) != NIL)
      {
	//print_object(car(reg_next_expression));printf("\n");getchar();
        eval(false);
        if(in_error)
        {
          throw_generic_exception("Evaluation of backquote failed(1)");
          return NIL;
        }
      }

      reg_next_expression = cons(CONS_RETURN_NIL, cdr(reg_next_expression));
      reg_current_value_rib = NIL;

      return reg_accumulator;
    }
  }

  if(form_contains_comma_at(form))
  {
    //1. loop through elements in form
    //2. if element is not comma-at, call eval_backquote on
    //   it and append it to the result list without splicing
    //3. if it is comma-at, get its symbol value and
    //   splice the value to the result list
    //4. return the result list

    OBJECT_PTR result = NIL;

    OBJECT_PTR rest = form;

    while(rest != NIL)
    {
      OBJECT_PTR ret;
      OBJECT_PTR obj;

      if(IS_CONS_OBJECT(car(rest)) &&
	 IS_SYMBOL_OBJECT(CAAR(rest)))
      {
	char buf[SYMBOL_STRING_SIZE];
	print_symbol(CAAR(rest), buf);

	if(CAAR(rest) == COMMA_AT)
        {
          OBJECT_PTR temp = compile(CADAR(rest), NIL);
#ifdef WIN32
          if(temp == ERROR1)
#else
          if(temp == ERROR)
#endif
          {
            throw_generic_exception("Backquote evaluation(2): compile failed");
            return NIL;
          }

          reg_next_expression = cons(cons(FRAME, cons(cons(CONS_HALT_NIL, CADAR(rest)),
                                                      cons(temp, CADAR(rest)))),
                                     CADAR(rest));

          reg_current_value_rib = NIL;

          while(car(reg_next_expression) != NIL)
          {
            eval(false);
            if(in_error)
            {
              throw_generic_exception("Evaluation of backquote failed(2)");
              return NIL;
            }
          }

          reg_next_expression = cons(CONS_RETURN_NIL, cdr(reg_next_expression));
          reg_current_value_rib = NIL;

	  obj = reg_accumulator;

	  if(result == NIL)
	    result = obj;
	  else
	    set_heap(last_cell(result) & POINTER_MASK, 1, obj);
	}
	else
	{
	  obj = eval_backquote(car(rest));
	  
	  if(result == NIL)
	    result = cons(obj, NIL);
	  else
	    set_heap(last_cell(result) & POINTER_MASK, 1, cons(obj, NIL));
	}
      }
      else
      {
	obj = eval_backquote(car(rest));

	if(result == NIL)
	  result = cons(obj, NIL);
	else
	  set_heap(last_cell(result) & POINTER_MASK, 1, cons(obj, NIL));
      }
      rest = cdr(rest);
    }

    return result;
  }

  return cons(eval_backquote(car(form)),
	      eval_backquote(cdr(form)));

}
Example #15
0
static at *
four_integers(int i1, int i2, int i3, int i4)
{
  return cons(NEW_NUMBER(i1), cons(NEW_NUMBER(i2), two_integers(i3, i4)));
} 
Example #16
0
static Tree listn (int n, Tree e)
{
	return (n<= 0) ? gGlobal->nil : cons(e, listn(n-1,e));
}
Example #17
0
static at * 
event_to_list(int event, int xd, int yd, int xu, int yu, int *pmods)
{
  *pmods = -1;
  /* events that do not update evshift and evcontrol */
  if (event == EVENT_MOUSE_UP) 
    return cons(named("mouse-up"), four_integers(xd,yd,xu,yu));
  if (event == EVENT_MOUSE_DRAG) 
    return cons(named("mouse-drag"), four_integers(xd,yd,xu,yu));
  if (event == EVENT_RESIZE)
    return cons(named("resize"), two_integers(xd,yd));
  if (event == EVENT_DELETE) 
    return cons(named("delete"),NIL);
  if (event == EVENT_SENDEVENT)
    return cons(named("sendevent"), two_integers(xd,yd));
  if (event == EVENT_EXPOSE)
    return cons(named("expose"), two_integers(xd,yd));
  if (event == EVENT_GLEXPOSE)
    return cons(named("glexpose"), two_integers(xd,yd));
  if (event >= EVENT_ASCII_MIN && event <= EVENT_ASCII_MAX) 
    {
      char keyevent[2];
      keyevent[0] = EVENT_TO_ASCII(event);
      keyevent[1] = 0;
      return cons(new_string(keyevent), two_integers(xd,yd));
    }
  /* events that update evshift and evcontrol */
  *pmods = 0;
  if (xu) 
    *pmods |= 1;  /* shift */
  if (yu) 
    *pmods |= 2;  /* ctrl  */
  if (event == EVENT_MOUSE_DOWN)
    return cons(named("mouse-down"), two_integers(xd,yd)); 
  if (event == EVENT_HELP)
    return cons(named("help"), two_integers(xd,yd)); 
  if (event == EVENT_ARROW_UP)
    return cons(named("arrow-up"), two_integers(xd,yd)); 
  if (event == EVENT_ARROW_RIGHT)
    return cons(named("arrow-right"), two_integers(xd,yd)); 
  if (event == EVENT_ARROW_DOWN)
    return cons(named("arrow-down"), two_integers(xd,yd)); 
  if (event == EVENT_ARROW_LEFT)
    return cons(named("arrow-left"), two_integers(xd,yd)); 
  if (event == EVENT_FKEY)
    return cons(named("fkey"), two_integers(xd,yd)); 
  /* default */
  return NIL;
}
Example #18
0
/**
 * Evaluates each rule of the list
 */
static Tree	evalRuleList(Tree rules, Tree env)
{
    //cerr << "evalRuleList "<< *rules << " in " << *env << endl;
	if (isNil(rules)) return gGlobal->nil;
	else return cons(evalRule(hd(rules), env), evalRuleList(tl(rules), env));
}
Example #19
0
/*
 * No BNF for numeric aggregates - that's defined by the caller.  What
 * this function does is to parse a sequence of numbers separated by the
 * token specified in separator.  If max is zero, any number of numbers
 * will be parsed; otherwise, exactly max numbers are expected.  Base
 * and size tell us how to internalize the numbers once they've been
 * tokenized.
 */
unsigned char *
parse_numeric_aggregate(FILE *cfile, unsigned char *buf, int *max,
    int separator, int base, int size)
{
	unsigned char *bufp = buf, *s = NULL;
	int token, count = 0;
	char *val, *t;
	size_t valsize;
	pair c = NULL;

	if (!bufp && *max) {
		bufp = malloc(*max * size / 8);
		if (!bufp)
			error("can't allocate space for numeric aggregate");
	} else
		s = bufp;

	do {
		if (count) {
			token = peek_token(&val, cfile);
			if (token != separator) {
				if (!*max)
					break;
				if (token != RBRACE && token != LBRACE)
					token = next_token(&val, cfile);
				parse_warn("too few numbers.");
				if (token != SEMI)
					skip_to_semi(cfile);
				return (NULL);
			}
			token = next_token(&val, cfile);
		}
		token = next_token(&val, cfile);

		if (token == EOF) {
			parse_warn("unexpected end of file");
			break;
		}

		/* Allow NUMBER_OR_NAME if base is 16. */
		if (token != NUMBER &&
		    (base != 16 || token != NUMBER_OR_NAME)) {
			parse_warn("expecting numeric value.");
			skip_to_semi(cfile);
			return (NULL);
		}
		/*
		 * If we can, convert the number now; otherwise, build a
		 * linked list of all the numbers.
		 */
		if (s) {
			convert_num(s, val, base, size);
			s += size / 8;
		} else {
			valsize = strlen(val) + 1;
			t = malloc(valsize);
			if (!t)
				error("no temp space for number.");
			memcpy(t, val, valsize);
			c = cons(t, c);
		}
	} while (++count != *max);

	/* If we had to cons up a list, convert it now. */
	if (c) {
		bufp = malloc(count * size / 8);
		if (!bufp)
			error("can't allocate space for numeric aggregate.");
		s = bufp + count - size / 8;
		*max = count;
	}
	while (c) {
		pair cdr = c->cdr;
		convert_num(s, (char *)c->car, base, size);
		s -= size / 8;
		/* Free up temp space. */
		free(c->car);
		free(c);
		c = cdr;
	}
	return (bufp);
}
Example #20
0
/**
 * Evaluates the list of patterns and closure the rhs
 */
static Tree	evalRule(Tree rule, Tree env)
{
    //cerr << "evalRule "<< *rule << " in " << *env << endl;
	return cons(evalPatternList(left(rule), env), right(rule));
}
Example #21
0
void SceneObjectCartPole::synchronousUpdate(float dt) {
	if (_ticks >= _ticksPerAction || !getRenderScene()->_renderingEnabled) {
		_ticks = 0;

		std::array<char, _maxBatchSize> buffer;

		std::array<char, 1 + 4 + 4> msg;

		size_t received = 0;
		size_t totalReceived = 0;

		while (totalReceived < msg.size()) {
			_socket->receive(buffer.data(), msg.size() - totalReceived, received);

			for (int i = 0; i < received; i++)
				msg[totalReceived + i] = buffer[i];

			totalReceived += received;
		}

		if (msg[0] == 'A') { // Action
			_action = pge::Vec2f(*reinterpret_cast<float*>(&msg[1]), *reinterpret_cast<float*>(&msg[5]));
		}
		else if (msg[0] == 'R') { // Reset
			_action = pge::Vec2f(*reinterpret_cast<float*>(&msg[1]), *reinterpret_cast<float*>(&msg[5]));

			reset();
		}
		else if (msg[0] == 'C') { // Capture + action
			_action = pge::Vec2f(*reinterpret_cast<float*>(&msg[1]), *reinterpret_cast<float*>(&msg[5]));

			_capture = true;

			if (!getRenderScene()->_renderingEnabled) {
				getRenderScene()->getRenderWindow()->setFramerateLimit(60);
				getRenderScene()->getRenderWindow()->setVerticalSyncEnabled(true);
			}

			getRenderScene()->_renderingEnabled = true;
		}
		else if (msg[0] == 'S') { // Stop capture + action
			_action = pge::Vec2f(*reinterpret_cast<float*>(&msg[1]), *reinterpret_cast<float*>(&msg[5]));

			_capture = false;

			if (!_show) {
				if (getRenderScene()->_renderingEnabled) {
					getRenderScene()->getRenderWindow()->setFramerateLimit(0);
					getRenderScene()->getRenderWindow()->setVerticalSyncEnabled(false);
				}

				getRenderScene()->_renderingEnabled = false;
			}
		}
		else if (msg[0] == 'X') { // Exit
			getRenderScene()->_close = true;
		}

		_action.x = std::min(1.0f, std::max(-1.0f, _action.x));
		_action.y = std::min(1.0f, std::max(-1.0f, _action.y));
		
		act();

		// Give state and reward (+ capture if is on)

		// Observation (8 values)
		std::vector<float> obs(8);

		btVector3 pos = _pRigidBodyCart->getWorldTransform().getOrigin();
		btVector3 vel = _pRigidBodyCart->getLinearVelocity();
		btQuaternion rot = _pRigidBodyPole->getWorldTransform().getRotation();
		btVector3 angleVel = _pRigidBodyPole->getAngularVelocity();

		pge::Quaternion rotC = cons(rot);
		pge::Vec3f rotE = rotC.getEulerAngles();

		obs[0] = pos.getX();
		obs[1] = pos.getZ();
		obs[2] = vel.getX();
		obs[3] = vel.getZ();
		obs[4] = rotE.x;
		obs[5] = rotE.z;
		obs[6] = angleVel.getX();
		obs[7] = angleVel.getZ();

		// First add reward
		int index = 0;

		*reinterpret_cast<float*>(&buffer[index]) = _reward;

		index += sizeof(float);

		for (int i = 0; i < obs.size(); i++) {
			*reinterpret_cast<float*>(&buffer[index]) = obs[i];

			index += sizeof(float);
		}

		// Reset flag
		*reinterpret_cast<int*>(&buffer[index]) = static_cast<int>(_doneLastFrame);

		_doneLastFrame = false;

		index += sizeof(int);

		// Submit number of batches of _maxBatchSize
		int numBatches = _capBytes->size() / _maxBatchSize + ((_capBytes->size() % _maxBatchSize) == 0 ? 0 : 1);

		// No batches if not capturing
		if (!_capture)
			numBatches = 0;

		*reinterpret_cast<int*>(&buffer[index]) = numBatches;

		index += sizeof(int);

		_socket->send(buffer.data(), index);

		if (_capture) {
			std::vector<char> reorganized(_capBytes->size());

			int reorgIndex = 0;

			for (int y = 0; y < getRenderScene()->_gBuffer.getHeight(); y++)
				for (int x = 0; x < getRenderScene()->_gBuffer.getWidth(); x++) {
					int start = 3 * (x + (getRenderScene()->_gBuffer.getHeight() - 1 - y) * getRenderScene()->_gBuffer.getWidth());

					reorganized[reorgIndex++] = (*_capBytes)[start + 0];
					reorganized[reorgIndex++] = (*_capBytes)[start + 1];
					reorganized[reorgIndex++] = (*_capBytes)[start + 2];
				}

			int total = 0;

			for (int i = 0; i < numBatches; i++) {
				// Submit batch
				size_t count = 0;

				for (int j = 0; j < _maxBatchSize && total < _capBytes->size(); j++) {
					buffer[j] = reorganized[total++];

					count++;
				}

				_socket->send(buffer.data(), count);
			}
		}
	}
	else
		_ticks++;
}
Example #22
0
static Tree real_a2sb(Tree exp)
{
	Tree abstr, visited, unusedEnv, localValEnv, var, name, body;

	if (isClosure(exp, abstr, unusedEnv, visited, localValEnv)) {

		if (isBoxIdent(abstr)) {
			// special case introduced with access and components
			Tree result = a2sb(eval(abstr, visited, localValEnv));

			// propagate definition name property when needed
			if (getDefNameProperty(exp, name))	setDefNameProperty(result, name);
			return result;

		} else if (isBoxAbstr(abstr, var, body)) {
			// Here we have remaining abstraction that we will try to 
			// transform in a symbolic box by applying it to a slot

			Tree slot = boxSlot(++gGlobal->gBoxSlotNumber); 
			stringstream s; s << boxpp(var);
			setDefNameProperty(slot, s.str() ); // ajout YO
			
			// Apply the abstraction to the slot
			Tree result = boxSymbolic(slot, a2sb(eval(body, visited, pushValueDef(var, slot, localValEnv))));

			// propagate definition name property when needed
			if (getDefNameProperty(exp, name)) setDefNameProperty(result, name);
			return result;

        } else if (isBoxEnvironment(abstr)) {
            return abstr;
	
		} else {
            evalerror(yyfilename, -1, "a2sb : internal error : not an abstraction inside closure", exp);
            // Never reached...
            return 0;
        }
		
	} else if (isBoxPatternMatcher(exp)) {
		// Here we have remaining PM rules that we will try to 
		// transform in a symbolic box by applying it to a slot
		
		Tree slot = boxSlot(++gGlobal->gBoxSlotNumber); 			
		stringstream s; s << "PM" << gGlobal->gBoxSlotNumber;
		setDefNameProperty(slot, s.str() ); 
		
		// apply the PM rules to the slot and transfoms the result in a symbolic box
		Tree result = boxSymbolic(slot, a2sb(applyList(exp, cons(slot,gGlobal->nil))));

		// propagate definition name property when needed
		if (getDefNameProperty(exp, name)) setDefNameProperty(result, name);
		return result;

    } else if (isBoxWaveform(exp)) {
        // A waveform is always in Normal Form, nothing to evaluate
        return exp;

	} else {
		// it is a constructor : transform each branches
        unsigned int    ar = exp->arity();
		tvec            B(ar);
        bool            modified = false;
		for (unsigned int i = 0; i < ar; i++) {
            Tree b = exp->branch(i);
            Tree m = a2sb(b);
            B[i] = m;
            if (b != m) modified=true;
		}
        Tree r = (modified) ? CTree::make(exp->node(), B) : exp;
        return r;
	}
}
Example #23
0
File: test.c Project: kstephens/tl
  tl expr, val;

  expr = cons(tl_s_quote, cons(a, tl_nil));
  val = tl_eval_print(TL expr, env);

  expr = cons(tl_s_quote, cons(cons(a, b), tl_nil));
  val = tl_eval_print(TL expr, env);

  expr = tl_s_cons;
  val = tl_eval_print(TL expr, env);

  expr = cons(tl_s_car, cons(cons(tl_s_quote, cons(expr, tl_nil)), tl_nil));
  val = tl_eval_print(TL expr, env);

  expr = cons(tl_s_cons, 
              cons(
                   cons(tl_s_quote, cons(a, tl_nil)),
                   cons(
                        cons(tl_s_quote, cons(b, tl_nil)),
                        tl_nil)));
  val = tl_eval_print(TL expr, env);

  expr = cons(cons(tl_s_lambda, 
                   cons(cons(a, cons(b, tl_nil)),
                        cons(cons(tl_s_cons, cons(a, cons(b, tl_nil))),
                             tl_nil))),
              cons(tl_i(1),
                   cons(tl_i(2),
                        tl_nil)));
  val = tl_eval_print(TL expr, env);
  
Example #24
0
/**
 * repeat n times a wire
 */
static Tree nwires(int n)
{
	Tree l = gGlobal->nil;
	while (n--) { l = cons(boxWire(), l); }
	return l;
}
Example #25
0
OBJ vm(char *bytecode)
{
	OBJ stack[1000];
	int top = 0;
	long fp = 0;
	char *ip;
	OBJ tmp;
	int i;

	ip = bytecode;
	while(ip)
	{
		switch(*ip++)
		{
		case CONS:
			stack[top-2] = cons(stack[top-1],stack[top-2]);
			top--;
			break;
		case CAR:
			stack[top-1] = car(stack[top-1]);
			break;
		case CDR:
			stack[top-1] = cdr(stack[top-1]);
			break;
		case PUSH:
			stack[top] = *((OBJ*)ip);
			top++;
			ip += sizeof(OBJ);
			break;
		case POP:
			top--;
			break;
		case SET_CDR:
			cdr(stack[top-1]) = stack[top-2];
			stack[top - 2] = OBJ_VOID;
			top--;
			break;
		case SET_CAR:
			car(stack[top-1]) = stack[top-2];
			stack[top - 2] = OBJ_VOID;
			top--;
			break;
		case REF:
			stack[top -1] = cdr(stack[top -1]);
			break;
		case UNINIT_REF:
			if(cdr(stack[top-1]) == OBJ_VOID)
			{
				fprintf(stderr,"can't uninitialized variable %s.",obj_symbol_data(car(stack[top-1])));
				return OBJ_NULL; /* fixme:should return a runtime error */
			}
			stack[top-1] = cdr(stack[top-1]);
			break;
		case BIND:
			tmp = obj_procedure_formals(stack[top-1]);
			i = top-2;
			while(!nullp(tmp))
			{
				cdr(car(tmp)) = stack[i];
				i--;
				tmp = cdr(tmp);
			}
			stack[i+1] = stack[top-1];
			top = i+2;
			break;
		case EQ:
			if(eq(stack[top-1],stack[top-2]))
				stack[top-2] = OBJ_TRUE;
			else
				stack[top-2] = OBJ_FALSE;
			top--;
			break;
		case ADD:
			stack[top-2] = add(stack[top-1],stack[top-2]);
			top--;
			break;
		case MUL:
			stack[top-2] = mul(stack[top-1],stack[top-2]);
			top--;
			break;
		case SUB:
			stack[top-2] = sub(stack[top-1],stack[top-2]);
			top--;
			break;
			/* case DIV: */
			/* 	stack[top-2] = div(stack[top-1],stack[top-2]); */
			/* 	top--; */
			/* 	break; */
		case TYPE:
			switch(*ip)
			{
			case OBJ_BOOLEAN:
				stack[top-1] = obj_make_boolean(obj_booleanp(stack[top-1]));
				break;
			case OBJ_SYMBOL:
				stack[top-1] = obj_make_boolean(obj_symbolp(stack[top-1]));
				break;
			case OBJ_CHAR:
				stack[top-1] = obj_make_boolean(obj_charp(stack[top-1]));
				break;
			case OBJ_VECTOR:
				stack[top-1] = obj_make_boolean(obj_vectorp(stack[top-1]));
				break;
			case OBJ_PROCEDURE:
				stack[top-1] = obj_make_boolean(obj_primitivep(stack[top-1]) || obj_procedurep(stack[top-1]));
				break;
			case OBJ_PAIR:
				stack[top-1] = obj_make_boolean(obj_pairp(stack[top-1]));
				break;
			case OBJ_NUMBER:
				stack[top-1] = obj_make_boolean(obj_numberp(stack[top-1]));
				break;
			case OBJ_STRING:
 				stack[top-1] = obj_make_boolean(obj_stringp(stack[top-1]));
				break;
//			case OBJ_PORT:
			}
			ip += sizeof(OBJ);
			break;
		case JUMP:
			ip = *((char**)ip);
			break;
		case JUMP_UNLESS:
			if(stack[top-1] == OBJ_FALSE)
				ip = *((char**)ip);
			else
				ip += sizeof(char*);
			break;
		case CALL:
			stack[top] = ip;
			top++;
			stack[top] = fp;
			top++;
			fp = top-3;
			ip = obj_string_data(obj_procedure_code(stack[fp]));
			break;
		case TAIL_CALL:
			ip = obj_string_data(obj_procedure_code(stack[top-1]));
			top = fp+3;
			break;
		case RET:
			ip = (char*)(stack[fp+1]);
			stack[fp] = stack[top-1];
			top = fp+1;
			fp = (long)stack[fp+2];
			break;
		case GT:
			if(obj_numberp(stack[top-1]) && obj_numberp(stack[top-2]))
			{
				stack[top-2] = obj_make_boolean(obj_number_data(stack[top-1]) > obj_number_data(stack[top-2]));
			}
			top--;
			break;
		case FC1:
			stack[top-1] = (*((fn1_t*)ip))(stack[top-1]);
			ip += sizeof(OBJ);
			break;
		case FC2:
			stack[top-2] = (*((fn2_t*)ip))(stack[top-1],stack[top-2]);
			top--;
			ip += sizeof(OBJ);
			break;
		case DONE:
			goto out;
		default:
			printf("error instruction!\n");
			goto error;
		}
	}
error:
	printf("error instruction!\n");
	return OBJ_NULL;
out:
	return stack[top-1];
}
Example #26
0
/**
 * Apply a function to a list of arguments. 
 * Apply a function F to a list of arguments (a,b,c,...).
 * F can be either a closure over an abstraction, or a 
 * pattern matcher. If it is not the case then we have :
 * F(a,b,c,...) ==> (a,b,c,...):F
 *
 * @param fun the function to apply
 * @param larg the list of arguments
 * @return the resulting expression in normal form
 */
static Tree applyList (Tree fun, Tree larg)
{
	Tree abstr;
	Tree globalDefEnv;
	Tree visited;
	Tree localValEnv;
	Tree envList;
	Tree originalRules;
	Tree revParamList;

	Tree id;
	Tree body;
	
	Automaton*	automat;
	int			state;

	prim2	p2;

    //cerr << "applyList (" << *fun << ", " << *larg << ")" << endl;

	if (isNil(larg)) return fun;

	if (isBoxError(fun) || isBoxError(larg)) {
		return boxError();
	}

	if (isBoxPatternMatcher(fun, automat, state, envList, originalRules, revParamList)) {
		Tree 			result;
		int 			state2;
		vector<Tree>	envVect;
		
		list2vec(envList, envVect);
        //cerr << "applyList/apply_pattern_matcher(" << automat << "," << state << "," << *hd(larg) << ")" << endl;
		state2 = apply_pattern_matcher(automat, state, hd(larg), result, envVect);
        //cerr << "state2 = " << state2 << "; result = " << *result << endl;
		if (state2 >= 0 && isNil(result)) {
			// we need to continue the pattern matching
			return applyList(
						boxPatternMatcher(automat, state2, vec2list(envVect), originalRules, cons(hd(larg),revParamList)),
						tl(larg) );
		} else if (state2 < 0) {
		    stringstream error;
            error << "ERROR : pattern matching failed, no rule of " << boxpp(boxCase(originalRules)) 
				 << " matches argument list " << boxpp(reverse(cons(hd(larg), revParamList))) << endl;
            throw faustexception(error.str());
		} else {
			// Pattern Matching was succesful
			// the result is a closure that we need to evaluate.
			if (isClosure(result, body, globalDefEnv, visited, localValEnv)) {
				// why ??? return simplifyPattern(eval(body, nil, localValEnv));
				//return eval(body, nil, localValEnv);
				return applyList(eval(body, gGlobal->nil, localValEnv), tl(larg));
			} else {
				cerr << "wrong result from pattern matching (not a closure) : " << boxpp(result) << endl;
				return boxError();
			}
		}			
	}
	if (!isClosure(fun, abstr, globalDefEnv, visited, localValEnv)) {
		// principle : f(a,b,c,...) ==> (a,b,c,...):f
         int ins, outs;
         
         // check arity of function
         Tree efun = a2sb(fun);
         //cerr << "TRACEPOINT 1 : " << boxpp(efun) << endl;
         if (!getBoxType(efun, &ins, &outs)) { // on laisse comme ca pour le moment
         	// we can't determine the input arity of the expression
         	// hope for the best
         	return boxSeq(larg2par(larg), fun);
         }
 
         // check arity of arg list
         if (!boxlistOutputs(larg, &outs)) {
         	// we don't know yet the output arity of larg. Therefore we can't
         	// do any arity checking nor add _ to reach the required number of arguments
            // cerr << "warning : can't infere the type of : " << boxpp(larg) << endl;
         	return boxSeq(larg2par(larg), fun);
         }
		
		if (outs > ins) {
            stringstream error;
			error << "too much arguments : " << outs << ", instead of : " << ins << endl;
            error << "when applying : " << boxpp(fun) << endl
            << "to : " << boxpp(larg) << endl;
            throw faustexception(error.str());
		}
		
        if ((outs == 1)
            && (( isBoxPrim2(fun, &p2) && (p2 != sigPrefix))
            || (getUserData(fun) && ((xtended*)getUserData(fun))->isSpecialInfix()))) {
            // special case : /(3) ==> _,3 : /
            Tree larg2 = concat(nwires(ins-outs), larg);
            return boxSeq(larg2par(larg2), fun);

        } else {

			Tree larg2 = concat(larg, nwires(ins-outs));
            return boxSeq(larg2par(larg2), fun);
        }
	}

    if (isBoxEnvironment(abstr)) {
        evalerrorbox(yyfilename, -1, "an environment can't be used as a function", fun);
    }

    if (!isBoxAbstr(abstr, id, body)) {
        evalerror(yyfilename, -1, "(internal) not an abstraction inside closure", fun);
    }

	// try to synthetise a  name from the function name and the argument name
	{
		Tree arg = eval(hd(larg), visited, localValEnv);
		Tree narg; if ( isBoxNumeric(arg,narg) ) { arg =  narg; } 
		Tree f = eval(body, visited, pushValueDef(id, arg, localValEnv));

		Tree fname;
		if (getDefNameProperty(fun, fname)) {
			stringstream s; s << tree2str(fname); if (!gGlobal->gSimpleNames) s << "(" << boxpp(arg) << ")";
			setDefNameProperty(f, s.str());
		}
		return applyList(f, tl(larg));
	}
}
 public: Val AddReq(Val ty)
     { ASSERT(nil != ty); m_reqs = cons(ty, m_reqs); return ty; }
Example #28
0
static at *
two_integers(int i1, int i2)
{
  return cons(NEW_NUMBER(i1), cons(NEW_NUMBER(i2), NIL));
}
Example #29
0
int rscheme_std_main( int argc, const char **argv, 
		      struct module_descr **modules,
		      const char *default_image )
{
  obj start, args, rc;
  const char *system_file = NULL;
  int i = 1;
  rs_bool verbose = YES;
  rs_bool is_script = NO;

  init_dynamic_link( argv[0] ); /* some systems need this */

  for (i=1; i<argc && argv[i][0] == (char)'-'; i++)
    {
      if (strcmp(argv[i],"-image") == 0)
	{
	  if (i+1 >= argc)
	    goto miss_arg;
	  system_file = argv[++i];
	}
      else if (strcmp(argv[i],"--version") == 0)
	{
	  puts( RSCHEME_VERSION );
	  return 0;
	}
      else if (strcmp(argv[i],"--install") == 0)
	{
	  puts( rs_install_dir );
	  return 0;
	}
      else if (strcmp(argv[i],"-qimage") == 0)
	{
	  if (i+1 >= argc)
	    goto miss_arg;
	  system_file = argv[++i];
	  verbose = NO;
	}
      else if (strcmp(argv[i],"-bcitrace") == 0)
	{
	  if (bci_trace_flag >= 0)
	    bci_trace_flag = 1;
	  else
	    goto not_comp;
	}
      else if (strcmp(argv[i],"-stepdump") == 0)
	{
#ifdef STEP_DUMP
	  do_step_dump = 1;
#else
	  goto not_comp;
#endif
	}
      else if (strcmp(argv[i],"-q") == 0)
	{
	  verbose = NO;
	}
      else if (strcmp(argv[i],"-script") == 0)
	{
	  verbose = NO;
	  is_script = YES;
	}
#ifdef RECORD_CALL_CHAIN
      else if (strcmp(argv[i],"-abt") == 0)
	{
	  extern rs_bool do_record_call_chain;

	  do_record_call_chain = YES;
	}
#endif
      else
	break;
    }
  if (!system_file)
    system_file = find_system_image( argv[0], default_image );

  if (!system_file)
    {
      fprintf( stderr, "%s: could not find system image\n", argv[0] );
      return 1;			/* boot failed */
    }

  start = init_scheme( argc, argv, system_file, 
		      verbose,
		      modules );
  if (EQ(start,FALSE_OBJ))
    {
      fprintf( stderr, "%s: initialization from %s failed\n", 
	      argv[0], system_file );
      return 1;
    }

  args = NIL_OBJ;
  while (argc > i)
    args = cons( make_string( argv[--argc] ), args );

  rc = call_scheme( start, 3, 
		    args, 
		    rb_to_bo(verbose),
		    rb_to_bo(is_script) );

  if (truish(rc))
    return 0;
  return 1;

 miss_arg:
  fprintf( stderr, "missing arg to `%s'\n", argv[i] );
  return 2;
 not_comp:
  fprintf( stderr, "system not compiled to support `%s'\n", argv[i] );
  return 2;
}
Example #30
0
siglist realPropagate (Tree slotenv, Tree path, Tree box, const siglist&  lsig)
{
	int		i;
	double	r;
	prim0	p0;
	prim1	p1;
	prim2	p2;
	prim3	p3;
	prim4	p4;
	prim5	p5;
	
    Tree	t1, t2, ff, label, cur, min, max, step, type, name, file, slot, body, chan;
    tvec    wf;
	
	
	xtended* xt = (xtended*)getUserData(box);
	
	// Extended Primitives
	
	if (xt)	{
		faustassert(lsig.size() == xt->arity());
		return makeList(xt->computeSigOutput(lsig));
	}
		
	// Numbers and Constants
	
	else if (isBoxInt(box, &i)) 	{ 
		faustassert(lsig.size()==0); 
		return makeList(sigInt(i)); 
	}
	else if (isBoxReal(box, &r)) 	{ 
		faustassert(lsig.size()==0); 
		return makeList(sigReal(r)); 
	}

    // A Waveform has two outputs it size and a period signal representing its content

    else if (isBoxWaveform(box)) 	{
        faustassert(lsig.size()==0);
        const tvec br = box->branches();
        return listConcat(makeList(sigInt(int(br.size()))), makeList(sigWaveform(br)));
    }

    else if (isBoxFConst(box, type, name, file))    { 
        faustassert(lsig.size()==0); 
        return makeList(sigFConst(type, name, file)); 
    }
    
    else if (isBoxFVar(box, type, name, file))    { 
        faustassert(lsig.size()==0); 
        return makeList(sigFVar(type, name, file)); 
    }
	
	// Wire and Cut
	
	else if (isBoxCut(box)) 				{ 
		faustassert(lsig.size()==1); 
		return siglist(); 
	}
	
	else if (isBoxWire(box)) 				{ 
		faustassert(lsig.size()==1); 
		return lsig;  
	}
	
	// Slots and Symbolic Boxes
	
	else if (isBoxSlot(box)) 				{ 
		Tree sig;
		faustassert(lsig.size()==0); 
		if (!searchEnv(box,sig,slotenv)) {
			// test YO simplification des diagrames
			//fprintf(stderr, "propagate : internal error (slot undefined)\n");
			sig = sigInput(++gGlobal->gDummyInput);
		}
		return makeList(sig);
	}
	
	else if (isBoxSymbolic(box, slot, body)) 				{ 
		faustassert(lsig.size()>0); 
		return propagate(pushEnv(slot,lsig[0],slotenv), path, body, listRange(lsig, 1, (int)lsig.size()));
	}
	
	// Primitives
	
	else if (isBoxPrim0(box, &p0)) 			{ 
		faustassert(lsig.size()==0); 
		return makeList(p0());
	}
	
	else if (isBoxPrim1(box, &p1)) 				{ 
		faustassert(lsig.size()==1); 
		return makeList(p1(lsig[0]));
	}
	
	else if (isBoxPrim2(box, &p2)) 				{ 
//		printf("prim2 recoit : "); print(lsig); printf("\n");
		faustassert(lsig.size()==2);
        if (p2 == &sigEnable) {
            if (gGlobal->gEnableFlag) {
                // special case for sigEnable that requires a transformation
                // enable(X,Y) -> sigEnable(X*Y, Y>0)
                return makeList(sigEnable( sigMul(lsig[0],lsig[1]), sigGT(lsig[1],sigReal(0.0))));
            } else {
                // We gEnableFlag is false we replace enable by a simple multiplication
                return makeList(sigMul(lsig[0],lsig[1]));
            }
        } else if (p2 == &sigControl) {
            if (gGlobal->gEnableFlag) {
                // special case for sigEnable that requires a transformation
                // enable(X,Y) -> sigEnable(X*Y, Y>0)
                return makeList(sigEnable( lsig[0], lsig[1]));
            } else {
                // We gEnableFlag is false we replace control by identity function
                return makeList(lsig[0]);
            }
        }
        return makeList( p2(lsig[0],lsig[1]) );
	}
	
	else if (isBoxPrim3(box, &p3)) 				{ 
		faustassert(lsig.size()==3); 
		return makeList(p3(lsig[0],lsig[1],lsig[2]));
	}
	
	else if (isBoxPrim4(box, &p4)) 				{ 
		faustassert(lsig.size()==4); 
		return makeList(p4(lsig[0],lsig[1],lsig[2],lsig[3]));
	}
	
	else if (isBoxPrim5(box, &p5)) 				{ 
		faustassert(lsig.size()==5); 
		return makeList(p5(lsig[0],lsig[1],lsig[2],lsig[3],lsig[4]));
	}
	
	else if (isBoxFFun(box, ff)) 				{ 
		//cerr << "propagate en boxFFun of arity " << ffarity(ff) << endl;
		faustassert(int(lsig.size())==ffarity(ff)); 
		return makeList(sigFFun(ff, listConvert(lsig)));  
	}
	
	// User Interface Widgets
	
	else if (isBoxButton(box, label)) 	{ 
		faustassert(lsig.size()==0); 
		return makeList(sigButton(normalizePath(cons(label, path)))); 
	}
	
	else if (isBoxCheckbox(box, label)) 	{ 
		faustassert(lsig.size()==0); 
		return makeList(sigCheckbox(normalizePath(cons(label, path)))); 
	}
	
	else if (isBoxVSlider(box, label, cur, min, max, step)) 	{ 
		faustassert(lsig.size()==0); 
		return makeList(sigVSlider(normalizePath(cons(label, path)), cur, min, max, step)); 
	}
	
	else if (isBoxHSlider(box, label, cur, min, max, step)) 	{ 
		faustassert(lsig.size()==0); 
		return makeList(sigHSlider(normalizePath(cons(label, path)), cur, min, max, step)); 
	}

	else if (isBoxNumEntry(box, label, cur, min, max, step)) 	{ 
		faustassert(lsig.size()==0); 
		return makeList(sigNumEntry(normalizePath(cons(label, path)), cur, min, max, step)); 
	}
	
	else if (isBoxVBargraph(box, label, min, max)) 	{ 
		faustassert(lsig.size()==1); 
		return makeList(sigVBargraph(normalizePath(cons(label, path)), min, max, lsig[0])); 
	}
	
	else if (isBoxHBargraph(box, label, min, max)) 	{ 
		faustassert(lsig.size()==1); 
		return makeList(sigHBargraph(normalizePath(cons(label, path)), min, max, lsig[0])); 
	}
	
	else if (isBoxSoundfile(box, label, chan)) 	{ 
		faustassert(lsig.size()==1);
        Tree fullpath = normalizePath(cons(label, path));
        Tree soundfile = sigSoundfile(fullpath);
        int c = tree2int(chan);
        siglist lsig2(c+3);
        lsig2[0] = sigSoundfileLength(soundfile);
        lsig2[1] = sigSoundfileRate(soundfile);
        lsig2[2] = sigSoundfileChannels(soundfile);

		// compute bound limited read index : int(max(0, min(ridx,length-1)))
		Tree ridx = sigIntCast(tree(gGlobal->gMaxPrim->symbol(), sigInt(0), tree(gGlobal->gMinPrim->symbol(), lsig[0], sigAdd(lsig2[0],sigInt(-1)))));
		for (int i = 0; i<c; i++) {
			lsig2[i+3] = sigSoundfileBuffer(soundfile, sigInt(i), ridx);
		}
		return lsig2; 
	}
	
	// User Interface Groups
	
	else if (isBoxVGroup(box, label, t1)) 	{ 
		return propagate(slotenv,cons(cons(tree(0),label), path), t1, lsig); 
	}
	
	else if (isBoxHGroup(box, label, t1)) 	{ 
		return propagate(slotenv, cons(cons(tree(1),label), path), t1, lsig); 
	}
	
	else if (isBoxTGroup(box, label, t1)) 	{ 
		return propagate(slotenv, cons(cons(tree(2),label), path), t1, lsig); 
	}
	
	// Block Diagram Composition Algebra
	
	else if (isBoxSeq(box, t1, t2)) 	{ 
		int in1, out1, in2, out2;
		getBoxType(t1, &in1, &out1);
		getBoxType(t2, &in2, &out2);

        faustassert(out1==in2);

		if (out1 == in2) {
			return propagate(slotenv, path, t2, propagate(slotenv, path,t1,lsig));
		} else if (out1 > in2) {
			siglist lr = propagate(slotenv, path, t1,lsig);
			return listConcat(propagate(slotenv, path, t2, listRange(lr, 0, in2)), listRange(lr, in2, out1));
		} else {
			return propagate(slotenv, path, t2, listConcat( propagate(slotenv, path, t1, listRange(lsig,0,in1)), listRange(lsig,in1,in1+in2-out1)));
		}
	}
	
	else if (isBoxPar(box, t1, t2)) 	{ 
		int in1, out1, in2, out2;
		getBoxType(t1, &in1, &out1);
		getBoxType(t2, &in2, &out2);
			
		return listConcat(propagate(slotenv, path, t1, listRange(lsig, 0,  in1)),
                          propagate(slotenv, path, t2, listRange(lsig, in1, in1+in2)));
	}
	
	else if (isBoxSplit(box, t1, t2)) 	{ 
		int in1, out1, in2, out2;
		getBoxType(t1, &in1, &out1);
		getBoxType(t2, &in2, &out2);
		
		siglist l1 = propagate(slotenv, path, t1, lsig);
		siglist l2 = split(l1, in2);
		return propagate(slotenv, path, t2, l2);
	}
	
	else if (isBoxMerge(box, t1, t2)) 	{ 
		int in1, out1, in2, out2;
		getBoxType(t1, &in1, &out1);
		getBoxType(t2, &in2, &out2);
		
		siglist l1 = propagate(slotenv, path, t1, lsig);
		siglist l2 = mix(l1, in2);
		return propagate(slotenv, path, t2, l2);
	}

    else if (isBoxRec(box, t1, t2)) 	{
        // Bug Corrected
        int in1, out1, in2, out2;
        getBoxType(t1, &in1, &out1);
        getBoxType(t2, &in2, &out2);

        Tree slotenv2 = lift(slotenv); // the environment must also be lifted

        siglist l0 = makeMemSigProjList(ref(1), in2);
        siglist l1 = propagate(slotenv2, path, t2, l0);
        siglist l2 = propagate(slotenv2, path, t1, listConcat(l1,listLift(lsig)));
		siglist l3 = (gGlobal->gFTZMode > 0) ? wrapWithFTZ(l2) : l2;
        Tree g = rec(listConvert(l3));
        return makeSigProjList(g, out1);
    }

    stringstream error;
    error << "ERROR in file " << __FILE__ << ':' << __LINE__ << ", unrecognised box expression : " << boxpp(box) << endl;
    throw faustexception(error.str());

	return siglist();
}