eval.cpp

Go to the documentation of this file.

/************************************************************************
 ************************************************************************
    FAUST compiler
    Copyright (C) 2003-2004 GRAME, Centre National de Creation Musicale
    ---------------------------------------------------------------------
    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 ************************************************************************
 ************************************************************************/
 #define TRACE

#include "eval.hh"
#include <stdio.h>
#include "errormsg.hh"
#include "ppbox.hh"
#include "simplify.hh"
#include "propagate.hh"
#include "patternmatcher.hh"
#include "signals.hh"
#include "xtended.hh"
#include "loopDetector.hh"
#include "property.hh"
#include "names.hh"
#include "compatibility.hh"


#include <assert.h>
extern SourceReader gReader;
extern int  gMaxNameSize;
extern bool gSimpleNames;
extern bool gSimplifyDiagrams;
// History
// 23/05/2005 : New environment management


//-------------- prototypes ---------------------------------------------------------
static Tree     a2sb(Tree exp);
static Tree     eval (Tree exp, Tree visited, Tree localValEnv);
static Tree     realeval (Tree exp, Tree visited, Tree localValEnv);
static Tree     revEvalList (Tree lexp, Tree visited, Tree localValEnv);
static Tree     applyList (Tree fun, Tree larg);
static Tree     iteratePar (Tree var, int num, Tree body, Tree visited, Tree localValEnv);
static Tree     iterateSeq (Tree id, int num, Tree body, Tree visited, Tree localValEnv);
static Tree     iterateSum (Tree id, int num, Tree body, Tree visited, Tree localValEnv);
static Tree     iterateProd (Tree id, int num, Tree body, Tree visited, Tree localValEnv);
static Tree     larg2par (Tree larg);
static int      eval2int (Tree exp, Tree visited, Tree localValEnv);
static double   eval2double (Tree exp, Tree visited, Tree localValEnv);
static const char * evalLabel (const char* l, Tree visited, Tree localValEnv);

static Tree     evalIdDef(Tree id, Tree visited, Tree env);



static Tree     evalCase(Tree rules, Tree env);
static Tree     evalRuleList(Tree rules, Tree env);
static Tree     evalRule(Tree rule, Tree env);
static Tree     evalPatternList(Tree patterns, Tree env);
static Tree     evalPattern(Tree pattern, Tree env);

static Tree     patternSimplification (Tree pattern);
static bool     isBoxNumeric (Tree in, Tree& out);

static Tree     vec2list(const vector<Tree>& v);
static void     list2vec(Tree l, vector<Tree>& v);
static Tree     listn (int n, Tree e);

static Tree     boxSimplification(Tree box);

// Public Interface
//----------------------


Tree evalprocess (Tree eqlist)
{
    Tree b = a2sb(eval(boxIdent("process"), nil, pushMultiClosureDefs(eqlist, nil, nil)));

    if (gSimplifyDiagrams) {
        b = boxSimplification(b);
    }

    return b;
}


/* Eval a documentation expression. */

Tree evaldocexpr (Tree docexpr, Tree eqlist)
{
    return a2sb(eval(docexpr, nil, pushMultiClosureDefs(eqlist, nil, nil)));
}



// Private Implementation
//------------------------

property<Tree> gSymbolicBoxProperty;

static Tree real_a2sb(Tree exp);

static Tree a2sb(Tree exp)
{
    Tree    result;
    Tree    id;

    if (gSymbolicBoxProperty.get(exp, result)) {
        return result;
    }

    result = real_a2sb(exp);
    if (result != exp && getDefNameProperty(exp, id)) {
        setDefNameProperty(result, id);     // propagate definition name property when needed
    }
    gSymbolicBoxProperty.set(exp, result);
    return result;
}

static int  gBoxSlotNumber = 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(++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);
            exit(1);
        }
        
    } 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(++gBoxSlotNumber);          
        stringstream s; s << "PM" << 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,nil))));

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

    } 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;
    }
}

static bool autoName(Tree exp , Tree& id)
{
    stringstream s; s << boxpp(exp);
    id = tree(s.str().c_str());
    return true;
}

bool getArgName(Tree t, Tree& id)
{
    //return getDefNameProperty(t, id) || autoName(t, id) ;
    return autoName(t, id) ;
}



static loopDetector LD(1024, 1);


static Node EVALPROPERTY(symbol("EvalProperty"));

void setEvalProperty(Tree box, Tree env, Tree value)
{
    setProperty(box, tree(EVALPROPERTY,env), value);
}


bool getEvalProperty(Tree box, Tree env, Tree& value)
{
    return getProperty(box, tree(EVALPROPERTY,env), value);
}


static Tree eval (Tree exp, Tree visited, Tree localValEnv)
{
    Tree    id;
    Tree    result;
    
    LD.detect(cons(exp,localValEnv));
    
    if (!getEvalProperty(exp, localValEnv, result)) {
        //cerr << "ENTER eval("<< *exp << ") with env " << *localValEnv << endl;
        result = realeval(exp, visited, localValEnv);
        setEvalProperty(exp, localValEnv, result);
        //cerr << "EXIT eval(" << *exp << ") IS " << *result << " with env " << *localValEnv << endl;
        if (getDefNameProperty(exp, id)) {
            setDefNameProperty(result, id);     // propagate definition name property 
        }
    }
    return result;
}

static Tree realeval (Tree exp, Tree visited, Tree localValEnv)
{
    //Tree  def;
    Tree    fun;
    Tree    arg;
    Tree    var, num, body, ldef;
    Tree    label;
    Tree    cur, lo, hi, step;
    Tree    e1, e2, exp2, notused, visited2, lenv2;
    Tree    rules;
    Tree    id;

    //cerr << "EVAL " << *exp << " (visited : " << *visited << ")" << endl;
    //cerr << "REALEVAL of " << *exp << endl;
    
    xtended* xt = (xtended*) getUserData(exp);


    // constants
    //-----------
    
    if (    xt || 
            isBoxInt(exp) || isBoxReal(exp) || 
            isBoxWire(exp) || isBoxCut(exp) ||
            isBoxPrim0(exp) || isBoxPrim1(exp) || 
            isBoxPrim2(exp) || isBoxPrim3(exp) || 
            isBoxPrim4(exp) || isBoxPrim5(exp) ||
            isBoxFFun(exp) || isBoxFConst(exp) || isBoxFVar(exp) ) {
        return exp;

    // block-diagram constructors
    //---------------------------
    
    } else if ( isBoxSeq(exp, e1, e2) ) {
        return boxSeq(eval(e1, visited, localValEnv), eval(e2, visited, localValEnv));

    } else if ( isBoxPar(exp, e1, e2) ) {
        return boxPar(eval(e1, visited, localValEnv), eval(e2, visited, localValEnv));

    } else if ( isBoxRec(exp, e1, e2) ) {
        return boxRec(eval(e1, visited, localValEnv), eval(e2, visited, localValEnv));

    } else if ( isBoxSplit(exp, e1, e2) ) {
        return boxSplit(eval(e1, visited, localValEnv), eval(e2, visited, localValEnv));

    } else if ( isBoxMerge(exp, e1, e2) ) {
        return boxMerge(eval(e1, visited, localValEnv), eval(e2, visited, localValEnv));
        
    // Modules
    //--------

    } else if (isBoxAccess(exp, body, var)) {
        Tree val = eval(body, visited, localValEnv);
        if (isClosure(val, exp2, notused, visited2, lenv2)) {
            // it is a closure, we have an environment to access
            return eval(closure(var,notused,visited2,lenv2), visited, localValEnv);
        } else {
            evalerror(getDefFileProp(exp), getDefLineProp(exp), "No environment to access ", exp);
            exit(1);
        }


    } else if (isBoxModifLocalDef(exp, body, ldef)) {
        Tree val = eval(body, visited, localValEnv);
        if (isClosure(val, exp2, notused, visited2, lenv2)) {
            // we rebuild the closure using a copy of the original environment
            // modified with some new definitions
            Tree lenv3 = copyEnvReplaceDefs(lenv2, ldef, visited2, localValEnv);
            return eval(closure(exp2,notused,visited2,lenv3), visited, localValEnv);
        } else {

            evalerror(getDefFileProp(exp), getDefLineProp(exp), "not a closure ", val);
            evalerror(getDefFileProp(exp), getDefLineProp(exp), "No environment to access ", exp);
            exit(1);
        }


    } else if (isBoxComponent(exp, label)) {
        string  fname   = tree2str(label);
        Tree    eqlst   = gReader.expandlist(gReader.getlist(fname));
        Tree    res     = closure(boxIdent("process"), nil, nil, pushMultiClosureDefs(eqlst, nil, nil));
        setDefNameProperty(res, label);
        //cerr << "component is " << boxpp(res) << endl;
        return res;

    } else if (isBoxLibrary(exp, label)) {
        string  fname   = tree2str(label);
        Tree    eqlst   = gReader.expandlist(gReader.getlist(fname));
        Tree    res     = closure(boxEnvironment(), nil, nil, pushMultiClosureDefs(eqlst, nil, nil));
        setDefNameProperty(res, label);
        //cerr << "component is " << boxpp(res) << endl;
        return res;


    // user interface elements
    //------------------------
    
    } else if (isBoxButton(exp, label)) {
        const char* l1 = tree2str(label);
        const char* l2= evalLabel(l1, visited, localValEnv);
        //cout << "button label : " << l1 << " become " << l2 << endl;
        return ((l1 == l2) ? exp : boxButton(tree(l2)));

    } else if (isBoxCheckbox(exp, label)) {
        const char* l1 = tree2str(label);
        const char* l2= evalLabel(l1, visited, localValEnv);
        //cout << "check box label : " << l1 << " become " << l2 << endl;
        return ((l1 == l2) ? exp : boxCheckbox(tree(l2)));

    } else if (isBoxVSlider(exp, label, cur, lo, hi, step)) {
        const char* l1 = tree2str(label);
        const char* l2= evalLabel(l1, visited, localValEnv);
        return ( boxVSlider(tree(l2),
                    tree(eval2double(cur, visited, localValEnv)),
                    tree(eval2double(lo, visited, localValEnv)),
                    tree(eval2double(hi, visited, localValEnv)),
                    tree(eval2double(step, visited, localValEnv))));

    } else if (isBoxHSlider(exp, label, cur, lo, hi, step)) {
        const char* l1 = tree2str(label);
        const char* l2= evalLabel(l1, visited, localValEnv);
        return ( boxHSlider(tree(l2),
                    tree(eval2double(cur, visited, localValEnv)),
                    tree(eval2double(lo, visited, localValEnv)),
                    tree(eval2double(hi, visited, localValEnv)),
                    tree(eval2double(step, visited, localValEnv))));

    } else if (isBoxNumEntry(exp, label, cur, lo, hi, step)) {
        const char* l1 = tree2str(label);
        const char* l2= evalLabel(l1, visited, localValEnv);
        return (boxNumEntry(tree(l2),
                    tree(eval2double(cur, visited, localValEnv)),
                    tree(eval2double(lo, visited, localValEnv)),
                    tree(eval2double(hi, visited, localValEnv)),
                    tree(eval2double(step, visited, localValEnv))));

    } else if (isBoxVGroup(exp, label, arg)) {
        const char* l1 = tree2str(label);
        const char* l2= evalLabel(l1, visited, localValEnv);
        return boxVGroup(tree(l2),  eval(arg, visited, localValEnv) );

    } else if (isBoxHGroup(exp, label, arg)) {
        const char* l1 = tree2str(label);
        const char* l2= evalLabel(l1, visited, localValEnv);
        return boxHGroup(tree(l2),  eval(arg, visited, localValEnv) );

    } else if (isBoxTGroup(exp, label, arg)) {
        const char* l1 = tree2str(label);
        const char* l2= evalLabel(l1, visited, localValEnv);
        return boxTGroup(tree(l2),  eval(arg, visited, localValEnv) );

    } else if (isBoxHBargraph(exp, label, lo, hi)) {
        const char* l1 = tree2str(label);
        const char* l2= evalLabel(l1, visited, localValEnv);
        return boxHBargraph(tree(l2),
                    tree(eval2double(lo, visited, localValEnv)),
                    tree(eval2double(hi, visited, localValEnv)));

    } else if (isBoxVBargraph(exp, label, lo, hi)) {
        const char* l1 = tree2str(label);
        const char* l2= evalLabel(l1, visited, localValEnv);
        return boxVBargraph(tree(l2),
                    tree(eval2double(lo, visited, localValEnv)),
                    tree(eval2double(hi, visited, localValEnv)));

    // lambda calculus
    //----------------
        
    } else if (isBoxIdent(exp)) {
        return evalIdDef(exp, visited, localValEnv);

    } else if (isBoxWithLocalDef(exp, body, ldef)) {
        return eval(body, visited, pushMultiClosureDefs(ldef, visited, localValEnv));
    
    } else if (isBoxAppl(exp, fun, arg)) {
        return applyList( eval(fun, visited, localValEnv),
                          revEvalList(arg, visited, localValEnv) );

    } else if (isBoxAbstr(exp)) {
        // it is an abstraction : return a closure
        return closure(exp, nil, visited, localValEnv);

    } else if (isBoxEnvironment(exp)) {
        // environment : return also a closure
        return closure(exp, nil, visited, localValEnv);

    } else if (isClosure(exp, exp2, notused, visited2, lenv2)) {

        if (isBoxAbstr(exp2)) {
            // a 'real' closure
            return closure(exp2, nil, setUnion(visited,visited2), lenv2);
        } else if (isBoxEnvironment(exp2)) {
            // a 'real' closure
            return closure(exp2, nil, setUnion(visited,visited2), lenv2);
        } else {
            // it was a suspended evaluation
            return eval(exp2, setUnion(visited,visited2), lenv2);
        }

    // Algorithmic constructions
    //--------------------------
    
    } else if (isBoxIPar(exp, var, num, body)) {
        int n = eval2int(num, visited, localValEnv);
        return iteratePar(var, n, body, visited, localValEnv);

    } else if (isBoxISeq(exp, var, num, body)) {
        int n = eval2int(num, visited, localValEnv);
        return iterateSeq(var, n, body, visited, localValEnv);

    } else if (isBoxISum(exp, var, num, body)) {
        int n = eval2int(num, visited, localValEnv);
        return iterateSum(var, n, body, visited, localValEnv);

    } else if (isBoxIProd(exp, var, num, body)) {
        int n = eval2int(num, visited, localValEnv);
        return iterateProd(var, n, body, visited, localValEnv);
        
    } else if (isBoxSlot(exp))      { 
        return exp; 
    
    } else if (isBoxSymbolic(exp))  {
     
        return exp;
    

    // Pattern matching extension
    //---------------------------
    
    } else if (isBoxCase(exp, rules)) {
        return evalCase(rules, localValEnv);

    } else if (isBoxPatternVar(exp, id)) {
        return exp;
        //return evalIdDef(id, visited, localValEnv);

    } else if (isBoxPatternMatcher(exp)) {
        return exp;

    } else {
        cerr << "ERROR : EVAL don't intercept : " << *exp << endl;
        assert(false);
    }
}

/* Deconstruct a (BDA) op pattern (YO). */

static inline bool isBoxPatternOp(Tree box, Node& n, Tree& t1, Tree& t2)
{
    if (    isBoxPar(box, t1, t2) ||
            isBoxSeq(box, t1, t2) ||
            isBoxSplit(box, t1, t2) ||
            isBoxMerge(box, t1, t2) ||
            isBoxRec(box, t1, t2)    )
    {
        n = box->node();
        return true;
    } else {
        return false;
    }
}


Tree NUMERICPROPERTY = tree(symbol("NUMERICPROPERTY"));

void setNumericProperty(Tree t, Tree num)
{
    setProperty(t, NUMERICPROPERTY, num);
}

bool getNumericProperty(Tree t, Tree& num)
{
    return getProperty(t, NUMERICPROPERTY, num);
}

/* uncomment for debugging output */
//#define DEBUG
Tree simplifyPattern (Tree value)
{
    Tree num;
    if (!getNumericProperty(value,num)) {
        if (!isBoxNumeric(value,num)) {
            num = value;
        }
        setNumericProperty(value,num);
    }
    return num;
}


static bool isBoxNumeric (Tree in, Tree& out)
{
    int     numInputs, numOutputs;
    double  x;
    int     i;
    Tree    v;

    if (isBoxInt(in, &i) || isBoxReal(in, &x)) {
        out = in;
        return true;
    } else {
        v = a2sb(in);
        if ( getBoxType(v, &numInputs, &numOutputs) && (numInputs == 0) && (numOutputs == 1) ) {
            // potential numerical expression
            Tree lsignals = boxPropagateSig(nil, v , makeSigInputList(numInputs) );
            Tree res = simplify(hd(lsignals));
            if (isSigReal(res, &x))     {
            out = boxReal(x);
            return true;
            }
            if (isSigInt(res, &i))      {
            out = boxInt(i);
            return true;
            }
        }
        return false;
    }
}

static Tree patternSimplification (Tree pattern)
{   
    
    Node    n(0);
    Tree    v, t1, t2;
    
    if (isBoxNumeric(pattern, v)) {
        return v;
    } else if (isBoxPatternOp(pattern, n, t1, t2)) {
        return tree(n, patternSimplification(t1), patternSimplification(t2));
    } else {
        return pattern;
    }
}



static double eval2double (Tree exp, Tree visited, Tree localValEnv)
{
    Tree diagram = a2sb(eval(exp, visited, localValEnv)); // pour getBoxType
    int numInputs, numOutputs;
    getBoxType(diagram, &numInputs, &numOutputs);
    if ( (numInputs > 0) || (numOutputs != 1) ) {
        evalerror (yyfilename, yylineno, "not a constant expression of type : (0->1)", exp);
        return 1;
    } else {
        Tree lsignals = boxPropagateSig(nil, diagram , makeSigInputList(numInputs) );
        Tree val = simplify(hd(lsignals));
        return tree2float(val);
    }
}


static int eval2int (Tree exp, Tree visited, Tree localValEnv)
{
    Tree diagram = a2sb(eval(exp, visited, localValEnv));   // pour getBoxType()
    int numInputs, numOutputs;
    getBoxType(diagram, &numInputs, &numOutputs);
    if ( (numInputs > 0) || (numOutputs != 1) ) {
        evalerror (yyfilename, yylineno, "not a constant expression of type : (0->1)", exp);
        return 1;
    } else {
        Tree lsignals = boxPropagateSig(nil, diagram , makeSigInputList(numInputs) );
        Tree val = simplify(hd(lsignals));
        return tree2int(val);
    }
}

static bool isDigitChar(char c)
{
    return (c >= '0') & (c <= '9');
}

static bool isIdentChar(char c)
{
    return ((c >= 'a') & (c <= 'z')) || ((c >= 'A') & (c <= 'Z')) || ((c >= '0') & (c <= '9')) || (c == '_');
}

const char* Formats [] = {"%d", "%1d", "%2d", "%3d", "%4d"};

static char* writeIdentValue(char* dst, int format, const char* ident, Tree visited, Tree localValEnv)
{
    int n = eval2int(boxIdent(ident), visited, localValEnv);
    int i = min(4,max(format,0));
    
    return dst + sprintf(dst, Formats[i], n);
}

static const char * evalLabel (const char* label, Tree visited, Tree localValEnv)
{
    char        res[2000];
    char        ident[64];

    const char* src = &label[0];
    char*       dst = &res[0];
    char*       id  = &ident[0];

    bool        parametric = false;
    int         state = 0; int format = 0;
    char        c;

    while ((c=*src++)) {
        if (state == 0) {
            // outside ident mode
            if (c == '%') {
                // look ahead for next char
                if (*src == '%') {
                    *dst++ = *src++;        // copy escape char and skip one char
                } else {
                    state = 1;              // prepare ident mode
                    format = 0;
                    parametric = true;
                    id  = &ident[0];
                }
            } else {
                *dst++ = c;                 // copy char
            }
        } else if (state == 1) {
            // read the format 
            if (isDigitChar(c)) {
                format = format*10 + (c-'0');
            } else {
                state = 2;
                --src; // unread !!!
            }

        } else {
            
            // within ident mode
            if (isIdentChar(c)) {
                *id++ = c;
            } else {
                *id = 0;
                dst = writeIdentValue(dst, format, ident, visited, localValEnv);
                state = 0;
                src -= 1;
            }
        }
    }

    if (state == 2) {
        *id = 0;
        dst = writeIdentValue(dst, format, ident, visited, localValEnv);
    }
    *dst = 0;
    return (parametric) ? strdup(res) : label;
}



static Tree iteratePar (Tree id, int num, Tree body, Tree visited, Tree localValEnv)
{
    assert (num>0);

    Tree res = eval(body, visited, pushValueDef(id, tree(num-1), localValEnv));
    for (int i = num-2; i >= 0; i--) {
        res = boxPar(eval(body, visited, pushValueDef(id, tree(i), localValEnv)), res);
    }

    return res;
}



static Tree iterateSeq (Tree id, int num, Tree body, Tree visited, Tree localValEnv)
{
    assert (num>0);

    Tree res = eval(body, visited, pushValueDef(id, tree(num-1), localValEnv));
    for (int i = num-2; i >= 0; i--) {
        res = boxSeq(eval(body, visited, pushValueDef(id, tree(i), localValEnv)), res);
    }

    return res;
}



static Tree iterateSum (Tree id, int num, Tree body, Tree visited, Tree localValEnv)
{
    assert (num>0);

    Tree res = eval(body, visited, pushValueDef(id, tree(0), localValEnv));

    for (int i = 1; i < num; i++) {
        res = boxSeq(boxPar(res, eval(body, visited, pushValueDef(id, tree(i), localValEnv))),boxPrim2(sigAdd)) ;
    }

    return res;
}



static Tree iterateProd (Tree id, int num, Tree body, Tree visited, Tree localValEnv)
{
    assert (num>0);

    Tree res = eval(body, visited, pushValueDef(id, tree(0), localValEnv));

    for (int i = 1; i < num; i++) {
        res = boxSeq(boxPar(res, eval(body, visited, pushValueDef(id, tree(i), localValEnv))),boxPrim2(sigMul)) ;
    }

    return res;
}

 #if 1
static bool boxlistOutputs(Tree boxlist, int* outputs)
{
    int ins, outs;

    *outputs = 0;
    while (!isNil(boxlist))
    {
        Tree b = a2sb(hd(boxlist)); // for getBoxType, suppose list of evaluated boxes
        if (getBoxType(b, &ins, &outs)) {
            *outputs += outs;
        } else {
            // arbitrary output arity set to 1
            // when can't be determined
            *outputs += 1;
        }
        boxlist = tl(boxlist);
    }
    return isNil(boxlist);
}
#else
static bool boxlistOutputs(Tree boxlist, int* outputs)
{
    int ins, outs;

    *outputs = 0;
    while (!isNil(boxlist) && getBoxType(hd(boxlist), &ins, &outs)) {
            *outputs += outs;
            boxlist = tl(boxlist);
    }
    return isNil(boxlist);
}
#endif

static Tree nwires(int n)
{
    Tree l = nil;
    while (n--) { l = cons(boxWire(), l); }
    return l;
}


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) {
            cerr << "ERROR : pattern matching failed, no rule of " << boxpp(boxCase(originalRules)) 
                 << " matches argument list " << boxpp(reverse(cons(hd(larg), revParamList))) << endl;
            exit(1);
        } 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, 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) {
            cerr << "too much arguments : " << outs << ", instead of : " << ins << endl;
            cerr << "when applying : " << boxpp(fun) << endl
                 << "           to : " << boxpp(larg) << endl;
            assert(false);
        }
        
        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);
        exit(1);
    }

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

    // 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 (!gSimpleNames) s << "(" << boxpp(arg) << ")";
            setDefNameProperty(f, s.str());
        }
        return applyList(f, tl(larg));
    }
}



static Tree revEvalList (Tree lexp, Tree visited, Tree localValEnv)
{
    Tree result = nil;
    //Tree lexp_orig = lexp;
    //cerr << "ENTER revEvalList(" << *lexp_orig << ", env:" << *localValEnv << ")" << endl;
    while (!isNil(lexp)) {
        result = cons(eval(hd(lexp), visited, localValEnv), result);
        lexp = tl(lexp);
    }

    //cerr << "EXIT revEvalList(" << *lexp_orig << ", env:" << *localValEnv << ") -> " << *result << endl;
    return result;
}



static Tree larg2par (Tree larg)
{
    if (isNil(larg)) {
        evalerror(yyfilename, -1, "empty list of arguments", larg);
        exit(1);
    }
    if (isNil(tl(larg))) {
        return hd(larg);
    }
    return boxPar(hd(larg), larg2par(tl(larg)));
}




static Tree evalIdDef(Tree id, Tree visited, Tree lenv)
{
    Tree def, name;

    // search the environment env for a definition of symbol id
    while (!isNil(lenv) && !getProperty(lenv, id, def)) {
        lenv = lenv->branch(0);
    }

    // check that the definition exists
    if (isNil(lenv)) {
        cerr << "undefined symbol " << *id << endl;
        evalerror(getDefFileProp(id), getDefLineProp(id), "undefined symbol ", id);
        exit(1);
    }

    //cerr << "Id definition is " << *def << endl;
    // check that it is not a recursive definition
    Tree p = cons(id,lenv);
    // set the definition name property
    if (!getDefNameProperty(def, name)) {
        // if the definition has no name use the identifier
        stringstream s; s << boxpp(id);
        //XXXXXX setDefNameProperty(def, s.str());
    }

    // return the evaluated definition
    return eval(def, addElement(p,visited), nil);
}


static Tree listn (int n, Tree e)
{
    return (n<= 0) ? nil : cons(e, listn(n-1,e));
}

static Node PMPROPERTYNODE(symbol("PMPROPERTY"));

static void setPMProperty(Tree t, Tree env, Tree pm)
{
    setProperty(t, tree(PMPROPERTYNODE, env), pm);
}

static bool getPMProperty(Tree t, Tree env, Tree& pm)
{
    return getProperty(t, tree(PMPROPERTYNODE, env), pm);
}

static Tree evalCase(Tree rules, Tree env)
{
    Tree pm;
    if (!getPMProperty(rules, env, pm)) {
        Automaton*  a = make_pattern_matcher(evalRuleList(rules, env));
        pm = boxPatternMatcher(a, 0, listn(len(rules), pushEnvBarrier(env)), rules, nil);
        setPMProperty(rules, env, pm);
    }
    return pm;
}       


static Tree evalRuleList(Tree rules, Tree env)
{
    //cerr << "evalRuleList "<< *rules << " in " << *env << endl;
    if (isNil(rules)) return nil;
    else return cons(evalRule(hd(rules), env), evalRuleList(tl(rules), env));
}


static Tree evalRule(Tree rule, Tree env)
{
    //cerr << "evalRule "<< *rule << " in " << *env << endl;
    return cons(evalPatternList(left(rule), env), right(rule));
}


static Tree evalPatternList(Tree patterns, Tree env)
{
    if (isNil(patterns)) {
        return nil;
    } else {
        return cons(    evalPattern(hd(patterns), env), 
                        evalPatternList(tl(patterns), env)  );
    }
}


static Tree evalPattern(Tree pattern, Tree env)
{
    Tree p = eval(pattern, nil, env);
    return patternSimplification(p);
}


static void list2vec(Tree l, vector<Tree>& v)
{
    while (!isNil(l)) {
        v.push_back(hd(l));
        l = tl(l);
    }
}


static Tree vec2list(const vector<Tree>& v)
{
    Tree l = nil;
    int  n = v.size();
    while (n--) { l = cons(v[n],l); }
    return l;
}




// further simplification : replace bloc-diagrams that denote constant number by this number

static property<Tree> SimplifiedBoxProperty;
static Tree numericBoxSimplification(Tree box);
static Tree insideBoxSimplification (Tree box);

Tree boxSimplification (Tree box)
{
    Tree    simplified;

    if (SimplifiedBoxProperty.get(box,simplified)) {

        return simplified;

    } else {

        simplified = numericBoxSimplification(box);

        // transferts name property if any
        Tree name; if (getDefNameProperty(box, name)) setDefNameProperty(simplified, name);

        // attach simplified expression as a property of original box
        SimplifiedBoxProperty.set(box,simplified);

        return simplified;
    }
}

Tree numericBoxSimplification(Tree box)
{
    int     ins, outs;
    Tree    result;
    int     i;
    double  x;

    if ( ! getBoxType(box, &ins, &outs)) {
        cout << "ERROR in file " << __FILE__ << ':' << __LINE__ << ", Can't compute the box type of : " << *box << endl;
        exit(1);
    }

    if (ins==0 && outs==1) {
        // this box can potentially denote a number
        if (isBoxInt(box, &i) || isBoxReal(box, &x)) {
           result = box;
        } else {
            // propagate signals to discover if it simplifies to a number
            int     i;
            double  x;
            Tree    lsignals = boxPropagateSig(nil, box , makeSigInputList(0));
            Tree    s = simplify(hd(lsignals));

            if (isSigReal(s, &x))   {
                result = boxReal(x);
            } else if (isSigInt(s, &i))     {
                result = boxInt(i);
            } else {
                result = insideBoxSimplification(box);
            }
        }
    } else {
        // this box can't denote a number
        result = insideBoxSimplification(box);
    }
    return result;
}

Tree insideBoxSimplification (Tree box)
{
    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;


    xtended* xt = (xtended*)getUserData(box);

    // Extended Primitives

    if (xt) {
        return box;
    }

    // Numbers and Constants

    else if (isBoxInt(box, &i))     {
        return box;
    }
    else if (isBoxReal(box, &r))    {
        return box;
    }

    else if (isBoxFConst(box, type, name, file))    {
        return box;
    }

    else if (isBoxFVar(box, type, name, file))    {
        return box;
    }

    // Wire and Cut

    else if (isBoxCut(box))                 {
        return box;
    }

    else if (isBoxWire(box))                {
        return box;
    }

    // Primitives

    else if (isBoxPrim0(box, &p0))          {
        return box;
    }

    else if (isBoxPrim1(box, &p1))          {
        return box;
    }

    else if (isBoxPrim2(box, &p2))              {
        return box;
    }

    else if (isBoxPrim3(box, &p3))              {
        return box;
    }

    else if (isBoxPrim4(box, &p4))              {
        return box;
    }

    else if (isBoxPrim5(box, &p5))              {
        return box;
    }

    else if (isBoxFFun(box, ff))                {
        return box;
    }

    // User Interface Widgets

    else if (isBoxButton(box, label))   {
        return box;
    }

    else if (isBoxCheckbox(box, label))     {
        return box;
    }

    else if (isBoxVSlider(box, label, cur, min, max, step))     {
        return box;
    }

    else if (isBoxHSlider(box, label, cur, min, max, step))     {
        return box;
    }

    else if (isBoxNumEntry(box, label, cur, min, max, step))    {
        return box;
    }

    else if (isBoxVBargraph(box, label, min, max))  {
        return box;
    }

    else if (isBoxHBargraph(box, label, min, max))  {
        return box;
    }

    // User Interface Groups

    else if (isBoxVGroup(box, label, t1))   {
        return boxVGroup(label, boxSimplification(t1));
    }

    else if (isBoxHGroup(box, label, t1))   {
        return boxHGroup(label, boxSimplification(t1));
    }

    else if (isBoxTGroup(box, label, t1))   {
        return boxTGroup(label, boxSimplification(t1));
    }

    // Slots and Symbolic Boxes

    else if (isBoxSlot(box))                {
        return box;;
    }

    else if (isBoxSymbolic(box, slot, body)){

        Tree b = boxSimplification(body);
        return boxSymbolic(slot,b);
    }

    // Block Diagram Composition Algebra

    else if (isBoxSeq(box, t1, t2))     {
        Tree s1 = boxSimplification(t1);
        Tree s2 = boxSimplification(t2);
        return boxSeq(s1,s2);
    }

    else if (isBoxPar(box, t1, t2))     {
        Tree s1 = boxSimplification(t1);
        Tree s2 = boxSimplification(t2);
        return boxPar(s1,s2);
    }

    else if (isBoxSplit(box, t1, t2))   {
        Tree s1 = boxSimplification(t1);
        Tree s2 = boxSimplification(t2);
        return boxSplit(s1,s2);
    }

    else if (isBoxMerge(box, t1, t2))   {
        Tree s1 = boxSimplification(t1);
        Tree s2 = boxSimplification(t2);
        return boxMerge(s1,s2);
    }
    else if (isBoxRec(box, t1, t2))     {
        Tree s1 = boxSimplification(t1);
        Tree s2 = boxSimplification(t2);
        return boxRec(s1,s2);
    }

    cout << "ERROR in file " << __FILE__ << ':' << __LINE__ << ", unrecognised box expression : " << *box << endl;
    exit(1);
    return 0;
}