00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021 #define TRACE
00022
00032 #include "eval.hh"
00033 #include <stdio.h>
00034 #include "errormsg.hh"
00035 #include "ppbox.hh"
00036 #include "simplify.hh"
00037 #include "propagate.hh"
00038 #include "patternmatcher.hh"
00039 #include "signals.hh"
00040 #include "xtended.hh"
00041 #include "loopDetector.hh"
00042 #include "property.hh"
00043 #include "names.hh"
00044 #include "compatibility.hh"
00045
00046
00047 #include <assert.h>
00048 extern SourceReader gReader;
00049 extern int gMaxNameSize;
00050 extern bool gPatternEvalMode;
00051 extern bool gSimpleNames;
00052 extern bool gSimplifyDiagrams;
00053
00054
00055
00056
00057
00058 static Tree a2sb(Tree exp);
00059 static Tree eval (Tree exp, Tree visited, Tree localValEnv);
00060 static Tree realeval (Tree exp, Tree visited, Tree localValEnv);
00061 static Tree revEvalList (Tree lexp, Tree visited, Tree localValEnv);
00062 static Tree applyList (Tree fun, Tree larg);
00063 static Tree iteratePar (Tree var, int num, Tree body, Tree visited, Tree localValEnv);
00064 static Tree iterateSeq (Tree id, int num, Tree body, Tree visited, Tree localValEnv);
00065 static Tree iterateSum (Tree id, int num, Tree body, Tree visited, Tree localValEnv);
00066 static Tree iterateProd (Tree id, int num, Tree body, Tree visited, Tree localValEnv);
00067 static Tree larg2par (Tree larg);
00068 static int eval2int (Tree exp, Tree visited, Tree localValEnv);
00069 static double eval2double (Tree exp, Tree visited, Tree localValEnv);
00070 static const char * evalLabel (const char* l, Tree visited, Tree localValEnv);
00071
00072 static Tree evalIdDef(Tree id, Tree visited, Tree env);
00073
00074
00075
00076 static Tree evalCase(Tree rules, Tree env);
00077 static Tree evalRuleList(Tree rules, Tree env);
00078 static Tree evalRule(Tree rule, Tree env);
00079 static Tree evalPatternList(Tree patterns, Tree env);
00080 static Tree evalPattern(Tree pattern, Tree env);
00081
00082 static Tree patternSimplification (Tree pattern);
00083 static bool isBoxNumeric (Tree in, Tree& out);
00084 static Tree replaceBoxNumeric (Tree exp);
00085
00086
00087 static Tree vec2list(const vector<Tree>& v);
00088 static void list2vec(Tree l, vector<Tree>& v);
00089 static Tree listn (int n, Tree e);
00090
00091
00092
00093
00094
00102 Tree evalprocess (Tree eqlist)
00103 {
00104 return a2sb(eval(boxIdent("process"), nil, pushMultiClosureDefs(eqlist, nil, nil)));
00105 }
00106
00107
00108
00109
00110 Tree evaldocexpr (Tree docexpr, Tree eqlist)
00111 {
00112 return a2sb(eval(docexpr, nil, pushMultiClosureDefs(eqlist, nil, nil)));
00113 }
00114
00115
00116
00117
00118
00119
00127 property<Tree> gSymbolicBoxProperty;
00128
00129 static Tree real_a2sb(Tree exp);
00130
00131 static Tree a2sb(Tree exp)
00132 {
00133 Tree result;
00134 Tree id;
00135
00136 if (gSymbolicBoxProperty.get(exp, result)) {
00137 return result;
00138 }
00139
00140 result = real_a2sb(exp);
00141 if (result != exp && getDefNameProperty(exp, id)) {
00142 setDefNameProperty(result, id);
00143 }
00144 gSymbolicBoxProperty.set(exp, result);
00145 return result;
00146 }
00147
00148 static int gBoxSlotNumber = 0;
00149
00150 static Tree real_a2sb(Tree exp)
00151 {
00152 Tree abstr, visited, unusedEnv, localValEnv, var, name, body;
00153
00154 if (isClosure(exp, abstr, unusedEnv, visited, localValEnv)) {
00155
00156 if (isBoxIdent(abstr)) {
00157
00158 Tree result = a2sb(eval(abstr, visited, localValEnv));
00159
00160
00161 if (getDefNameProperty(exp, name)) setDefNameProperty(result, name);
00162 return result;
00163
00164 } else if (isBoxAbstr(abstr, var, body)) {
00165
00166
00167
00168 Tree slot = boxSlot(++gBoxSlotNumber);
00169 stringstream s; s << boxpp(var);
00170 setDefNameProperty(slot, s.str() );
00171
00172
00173 Tree result = boxSymbolic(slot, a2sb(eval(body, visited, pushValueDef(var, slot, localValEnv))));
00174
00175
00176 if (getDefNameProperty(exp, name)) setDefNameProperty(result, name);
00177 return result;
00178
00179 } else if (isBoxEnvironment(abstr)) {
00180 return abstr;
00181
00182 } else {
00183 evalerror(yyfilename, -1, " a2sb : internal error : not an abstraction inside closure ", exp);
00184 exit(1);
00185 }
00186
00187 } else if (isBoxPatternMatcher(exp)) {
00188
00189
00190
00191 Tree slot = boxSlot(++gBoxSlotNumber);
00192 stringstream s; s << "PM" << gBoxSlotNumber;
00193 setDefNameProperty(slot, s.str() );
00194
00195
00196 Tree result = boxSymbolic(slot, a2sb(applyList(exp, cons(slot,nil))));
00197
00198
00199 if (getDefNameProperty(exp, name)) setDefNameProperty(result, name);
00200 return result;
00201
00202 } else {
00203
00204 unsigned int ar = exp->arity();
00205 tvec B(ar);
00206 bool modified = false;
00207 for (unsigned int i = 0; i < ar; i++) {
00208 Tree b = exp->branch(i);
00209 Tree m = a2sb(b);
00210 B[i] = m;
00211 if (b != m) modified=true;
00212 }
00213 Tree r = (modified) ? CTree::make(exp->node(), B) : exp;
00214 if (gSimplifyDiagrams) {
00215 return replaceBoxNumeric(r);
00216 } else {
00217 return r;
00218 }
00219
00220
00221
00222 }
00223 }
00224
00225 static bool autoName(Tree exp , Tree& id)
00226 {
00227 stringstream s; s << boxpp(exp);
00228 id = tree(s.str().c_str());
00229 return true;
00230 }
00231
00232 bool getArgName(Tree t, Tree& id)
00233 {
00234
00235 return autoName(t, id) ;
00236 }
00237
00238
00239
00249 static loopDetector LD(1024, 1);
00250
00251
00252 static Node EVALPROPERTY(symbol("EvalProperty"));
00253
00259 void setEvalProperty(Tree box, Tree env, Tree value)
00260 {
00261
00262 setProperty(box, tree(EVALPROPERTY,env), value);
00263 }
00264
00265
00273 bool getEvalProperty(Tree box, Tree env, Tree& value)
00274 {
00275 return getProperty(box, tree(EVALPROPERTY,env), value);
00276 }
00277
00278
00279 static Tree eval (Tree exp, Tree visited, Tree localValEnv)
00280 {
00281 Tree id;
00282 Tree result;
00283
00284 LD.detect(cons(exp,localValEnv));
00285
00286 if (!getEvalProperty(exp, localValEnv, result)) {
00287 result = realeval(exp, visited, localValEnv);
00288 setEvalProperty(exp, localValEnv, result);
00289
00290
00291
00292 if (getDefNameProperty(exp, id)) {
00293 setDefNameProperty(result, id);
00294 }
00295 }
00296 return result;
00297 }
00298
00309 static Tree realeval (Tree exp, Tree visited, Tree localValEnv)
00310 {
00311
00312 Tree fun;
00313 Tree arg;
00314 Tree var, num, body, ldef;
00315 Tree label;
00316 Tree cur, lo, hi, step;
00317 Tree e1, e2, exp2, notused, visited2, lenv2;
00318 Tree rules;
00319 Tree id;
00320
00321
00322
00323
00324 xtended* xt = (xtended*) getUserData(exp);
00325
00326
00327
00328
00329
00330 if ( xt ||
00331 isBoxInt(exp) || isBoxReal(exp) ||
00332 isBoxWire(exp) || isBoxCut(exp) ||
00333 isBoxPrim0(exp) || isBoxPrim1(exp) ||
00334 isBoxPrim2(exp) || isBoxPrim3(exp) ||
00335 isBoxPrim4(exp) || isBoxPrim5(exp) ||
00336 isBoxFFun(exp) || isBoxFConst(exp) || isBoxFVar(exp) ) {
00337 return exp;
00338
00339
00340
00341
00342 } else if ( isBoxSeq(exp, e1, e2) ) {
00343 return boxSeq(eval(e1, visited, localValEnv), eval(e2, visited, localValEnv));
00344
00345 } else if ( isBoxPar(exp, e1, e2) ) {
00346 return boxPar(eval(e1, visited, localValEnv), eval(e2, visited, localValEnv));
00347
00348 } else if ( isBoxRec(exp, e1, e2) ) {
00349 return boxRec(eval(e1, visited, localValEnv), eval(e2, visited, localValEnv));
00350
00351 } else if ( isBoxSplit(exp, e1, e2) ) {
00352 return boxSplit(eval(e1, visited, localValEnv), eval(e2, visited, localValEnv));
00353
00354 } else if ( isBoxMerge(exp, e1, e2) ) {
00355 return boxMerge(eval(e1, visited, localValEnv), eval(e2, visited, localValEnv));
00356
00357
00358
00359
00360 } else if (isBoxAccess(exp, body, var)) {
00361 Tree val = eval(body, visited, localValEnv);
00362 if (isClosure(val, exp2, notused, visited2, lenv2)) {
00363
00364 return eval(closure(var,notused,visited2,lenv2), visited, localValEnv);
00365 } else {
00366 evalerror(getDefFileProp(exp), getDefLineProp(exp), "No environment to access ", exp);
00367 exit(1);
00368 }
00369
00371
00372 } else if (isBoxModifLocalDef(exp, body, ldef)) {
00373 Tree val = eval(body, visited, localValEnv);
00374 if (isClosure(val, exp2, notused, visited2, lenv2)) {
00375
00376
00377 Tree lenv3 = copyEnvReplaceDefs(lenv2, ldef, visited2, localValEnv);
00378 return eval(closure(exp2,notused,visited2,lenv3), visited, localValEnv);
00379 } else {
00380
00381 evalerror(getDefFileProp(exp), getDefLineProp(exp), "not a closure ", val);
00382 evalerror(getDefFileProp(exp), getDefLineProp(exp), "No environment to access ", exp);
00383 exit(1);
00384 }
00385
00387
00388 } else if (isBoxComponent(exp, label)) {
00389 string fname = tree2str(label);
00390 Tree eqlst = gReader.expandlist(gReader.getlist(fname));
00391 Tree res = closure(boxIdent("process"), nil, nil, pushMultiClosureDefs(eqlst, nil, nil));
00392 setDefNameProperty(res, label);
00393
00394 return res;
00395
00396 } else if (isBoxLibrary(exp, label)) {
00397 string fname = tree2str(label);
00398 Tree eqlst = gReader.expandlist(gReader.getlist(fname));
00399 Tree res = closure(boxEnvironment(), nil, nil, pushMultiClosureDefs(eqlst, nil, nil));
00400 setDefNameProperty(res, label);
00401
00402 return res;
00403
00404
00405
00406
00407
00408 } else if (isBoxButton(exp, label)) {
00409 const char* l1 = tree2str(label);
00410 const char* l2= evalLabel(l1, visited, localValEnv);
00411
00412 return ((l1 == l2) ? exp : boxButton(tree(l2)));
00413
00414 } else if (isBoxCheckbox(exp, label)) {
00415 const char* l1 = tree2str(label);
00416 const char* l2= evalLabel(l1, visited, localValEnv);
00417
00418 return ((l1 == l2) ? exp : boxCheckbox(tree(l2)));
00419
00420 } else if (isBoxVSlider(exp, label, cur, lo, hi, step)) {
00421 const char* l1 = tree2str(label);
00422 const char* l2= evalLabel(l1, visited, localValEnv);
00423 return ( boxVSlider(tree(l2),
00424 tree(eval2double(cur, visited, localValEnv)),
00425 tree(eval2double(lo, visited, localValEnv)),
00426 tree(eval2double(hi, visited, localValEnv)),
00427 tree(eval2double(step, visited, localValEnv))));
00428
00429 } else if (isBoxHSlider(exp, label, cur, lo, hi, step)) {
00430 const char* l1 = tree2str(label);
00431 const char* l2= evalLabel(l1, visited, localValEnv);
00432 return ( boxHSlider(tree(l2),
00433 tree(eval2double(cur, visited, localValEnv)),
00434 tree(eval2double(lo, visited, localValEnv)),
00435 tree(eval2double(hi, visited, localValEnv)),
00436 tree(eval2double(step, visited, localValEnv))));
00437
00438 } else if (isBoxNumEntry(exp, label, cur, lo, hi, step)) {
00439 const char* l1 = tree2str(label);
00440 const char* l2= evalLabel(l1, visited, localValEnv);
00441 return (boxNumEntry(tree(l2),
00442 tree(eval2double(cur, visited, localValEnv)),
00443 tree(eval2double(lo, visited, localValEnv)),
00444 tree(eval2double(hi, visited, localValEnv)),
00445 tree(eval2double(step, visited, localValEnv))));
00446
00447 } else if (isBoxVGroup(exp, label, arg)) {
00448 const char* l1 = tree2str(label);
00449 const char* l2= evalLabel(l1, visited, localValEnv);
00450 return boxVGroup(tree(l2), eval(arg, visited, localValEnv) );
00451
00452 } else if (isBoxHGroup(exp, label, arg)) {
00453 const char* l1 = tree2str(label);
00454 const char* l2= evalLabel(l1, visited, localValEnv);
00455 return boxHGroup(tree(l2), eval(arg, visited, localValEnv) );
00456
00457 } else if (isBoxTGroup(exp, label, arg)) {
00458 const char* l1 = tree2str(label);
00459 const char* l2= evalLabel(l1, visited, localValEnv);
00460 return boxTGroup(tree(l2), eval(arg, visited, localValEnv) );
00461
00462 } else if (isBoxHBargraph(exp, label, lo, hi)) {
00463 const char* l1 = tree2str(label);
00464 const char* l2= evalLabel(l1, visited, localValEnv);
00465 return boxHBargraph(tree(l2),
00466 tree(eval2double(lo, visited, localValEnv)),
00467 tree(eval2double(hi, visited, localValEnv)));
00468
00469 } else if (isBoxVBargraph(exp, label, lo, hi)) {
00470 const char* l1 = tree2str(label);
00471 const char* l2= evalLabel(l1, visited, localValEnv);
00472 return boxVBargraph(tree(l2),
00473 tree(eval2double(lo, visited, localValEnv)),
00474 tree(eval2double(hi, visited, localValEnv)));
00475
00476
00477
00478
00479 } else if (isBoxIdent(exp)) {
00480 return evalIdDef(exp, visited, localValEnv);
00481
00482 } else if (isBoxWithLocalDef(exp, body, ldef)) {
00483 return eval(body, visited, pushMultiClosureDefs(ldef, visited, localValEnv));
00484
00485 } else if (isBoxAppl(exp, fun, arg)) {
00486 return applyList( eval(fun, visited, localValEnv),
00487 revEvalList(arg, visited, localValEnv) );
00488
00489 } else if (isBoxAbstr(exp)) {
00490
00491 return closure(exp, nil, visited, localValEnv);
00492
00493 } else if (isBoxEnvironment(exp)) {
00494
00495 return closure(exp, nil, visited, localValEnv);
00496
00497 } else if (isClosure(exp, exp2, notused, visited2, lenv2)) {
00498
00499 if (isBoxAbstr(exp2)) {
00500
00501 return closure(exp2, nil, setUnion(visited,visited2), lenv2);
00502 } else if (isBoxEnvironment(exp2)) {
00503
00504 return closure(exp2, nil, setUnion(visited,visited2), lenv2);
00505 } else {
00506
00507 return eval(exp2, setUnion(visited,visited2), lenv2);
00508 }
00509
00510
00511
00512
00513 } else if (isBoxIPar(exp, var, num, body)) {
00514 int n = eval2int(num, visited, localValEnv);
00515 return iteratePar(var, n, body, visited, localValEnv);
00516
00517 } else if (isBoxISeq(exp, var, num, body)) {
00518 int n = eval2int(num, visited, localValEnv);
00519 return iterateSeq(var, n, body, visited, localValEnv);
00520
00521 } else if (isBoxISum(exp, var, num, body)) {
00522 int n = eval2int(num, visited, localValEnv);
00523 return iterateSum(var, n, body, visited, localValEnv);
00524
00525 } else if (isBoxIProd(exp, var, num, body)) {
00526 int n = eval2int(num, visited, localValEnv);
00527 return iterateProd(var, n, body, visited, localValEnv);
00528
00529 } else if (isBoxSlot(exp)) {
00530 return exp;
00531
00532 } else if (isBoxSymbolic(exp)) {
00533
00534 return exp;
00535
00536
00537
00538
00539
00540 } else if (isBoxCase(exp, rules)) {
00541 return evalCase(rules, localValEnv);
00542
00543 } else if (isBoxPatternVar(exp, id)) {
00544 return exp;
00545
00546
00547 } else if (isBoxPatternMatcher(exp)) {
00548 return exp;
00549
00550 } else {
00551 cerr << "ERROR : EVAL don't intercept : " << *exp << endl;
00552 assert(false);
00553 }
00554 }
00555
00556
00557
00558 static inline bool isBoxPatternOp(Tree box, Node& n, Tree& t1, Tree& t2)
00559 {
00560 if ( isBoxPar(box, t1, t2) ||
00561 isBoxSeq(box, t1, t2) ||
00562 isBoxSplit(box, t1, t2) ||
00563 isBoxMerge(box, t1, t2) ||
00564 isBoxRec(box, t1, t2) )
00565 {
00566 n = box->node();
00567 return true;
00568 } else {
00569 return false;
00570 }
00571 }
00572
00573
00574 Tree NUMERICPROPERTY = tree(symbol("NUMERICPROPERTY"));
00575
00576 void setNumericProperty(Tree t, Tree num)
00577 {
00578 setProperty(t, NUMERICPROPERTY, num);
00579 }
00580
00581 bool getNumericProperty(Tree t, Tree& num)
00582 {
00583 return getProperty(t, NUMERICPROPERTY, num);
00584 }
00585
00586
00587 static Tree replaceBoxNumeric (Tree exp)
00588 {
00589 int numInputs, numOutputs;
00590 double x;
00591 int i;
00592 Tree out;
00593
00594 if (isBoxInt(exp, &i) || isBoxReal(exp, &x)) {
00595 return exp;
00596 } else if (getNumericProperty(exp, out)) {
00597 return out;
00598 } else {
00599 if ( getBoxType(exp, &numInputs, &numOutputs) && (numInputs == 0) && (numOutputs == 1) ) {
00600
00601 Tree lsignals = boxPropagateSig(nil, exp , makeSigInputList(numInputs) );
00602 assert(isList(lsignals));
00603 Tree res = simplify(hd(lsignals));
00604 if (isSigReal(res, &x)) out = boxReal(x);
00605 else if (isSigInt(res, &i)) out = boxInt(i);
00606 else out = exp;
00607 } else {
00608 out = exp;
00609 }
00610 setNumericProperty(exp,out);
00611 return out;
00612 }
00613 }
00614
00621
00622
00623 Tree simplifyPattern (Tree value)
00624 {
00625 Tree num;
00626 if (!getNumericProperty(value,num)) {
00627 if (!isBoxNumeric(value,num)) {
00628 num = value;
00629 }
00630 setNumericProperty(value,num);
00631 }
00632 return num;
00633 }
00634
00635
00636 static bool isBoxNumeric (Tree in, Tree& out)
00637 {
00638 int numInputs, numOutputs;
00639 double x;
00640 int i;
00641 Tree v;
00642
00643 if (isBoxInt(in, &i) || isBoxReal(in, &x)) {
00644 out = in;
00645 return true;
00646 } else {
00647 v = a2sb(in);
00648 if ( getBoxType(v, &numInputs, &numOutputs) && (numInputs == 0) && (numOutputs == 1) ) {
00649
00650 Tree lsignals = boxPropagateSig(nil, v , makeSigInputList(numInputs) );
00651 Tree res = simplify(hd(lsignals));
00652 if (isSigReal(res, &x)) {
00653 out = boxReal(x);
00654 return true;
00655 }
00656 if (isSigInt(res, &i)) {
00657 out = boxInt(i);
00658 return true;
00659 }
00660 }
00661 return false;
00662 }
00663 }
00664
00665 static Tree patternSimplification (Tree pattern)
00666 {
00667
00668 Node n(0);
00669 Tree v, t1, t2;
00670
00671 if (isBoxNumeric(pattern, v)) {
00672 return v;
00673 } else if (isBoxPatternOp(pattern, n, t1, t2)) {
00674 return tree(n, patternSimplification(t1), patternSimplification(t2));
00675 } else {
00676 return pattern;
00677 }
00678 }
00679
00680
00681
00695 static double eval2double (Tree exp, Tree visited, Tree localValEnv)
00696 {
00697 Tree diagram = eval(exp, visited, localValEnv);
00698 int numInputs, numOutputs;
00699 getBoxType(diagram, &numInputs, &numOutputs);
00700 if ( (numInputs > 0) || (numOutputs != 1) ) {
00701 evalerror (yyfilename, yylineno, "not a constant expression of type : (0->1)", exp);
00702 return 1;
00703 } else {
00704 Tree lsignals = boxPropagateSig(nil, diagram , makeSigInputList(numInputs) );
00705 Tree val = simplify(hd(lsignals));
00706 return tree2float(val);
00707 }
00708 }
00709
00710
00724 static int eval2int (Tree exp, Tree visited, Tree localValEnv)
00725 {
00726 Tree diagram = eval(exp, visited, localValEnv);
00727 int numInputs, numOutputs;
00728 getBoxType(diagram, &numInputs, &numOutputs);
00729 if ( (numInputs > 0) || (numOutputs != 1) ) {
00730 evalerror (yyfilename, yylineno, "not a constant expression of type : (0->1)", exp);
00731 return 1;
00732 } else {
00733 Tree lsignals = boxPropagateSig(nil, diagram , makeSigInputList(numInputs) );
00734 Tree val = simplify(hd(lsignals));
00735 return tree2int(val);
00736 }
00737 }
00738
00739 static bool isDigitChar(char c)
00740 {
00741 return (c >= '0') & (c <= '9');
00742 }
00743
00744 static bool isIdentChar(char c)
00745 {
00746 return ((c >= 'a') & (c <= 'z')) || ((c >= 'A') & (c <= 'Z')) || ((c >= '0') & (c <= '9')) || (c == '_');
00747 }
00748
00749 const char* Formats [] = {"%d", "%1d", "%2d", "%3d", "%4d"};
00750
00751 static char* writeIdentValue(char* dst, int format, const char* ident, Tree visited, Tree localValEnv)
00752 {
00753 int n = eval2int(boxIdent(ident), visited, localValEnv);
00754 int i = min(4,max(format,0));
00755
00756 return dst + sprintf(dst, Formats[i], n);
00757 }
00758
00759 static const char * evalLabel (const char* label, Tree visited, Tree localValEnv)
00760 {
00761 char res[2000];
00762 char ident[64];
00763
00764 const char* src = &label[0];
00765 char* dst = &res[0];
00766 char* id = &ident[0];
00767
00768 bool parametric = false;
00769 int state = 0; int format = 0;
00770 char c;
00771
00772 while ((c=*src++)) {
00773 if (state == 0) {
00774
00775 if (c == '%') {
00776
00777 if (*src == '%') {
00778 *dst++ = *src++;
00779 } else {
00780 state = 1;
00781 format = 0;
00782 parametric = true;
00783 id = &ident[0];
00784 }
00785 } else {
00786 *dst++ = c;
00787 }
00788 } else if (state == 1) {
00789
00790 if (isDigitChar(c)) {
00791 format = format*10 + (c-'0');
00792 } else {
00793 state = 2;
00794 --src;
00795 }
00796
00797 } else {
00798
00799
00800 if (isIdentChar(c)) {
00801 *id++ = c;
00802 } else {
00803 *id = 0;
00804 dst = writeIdentValue(dst, format, ident, visited, localValEnv);
00805 state = 0;
00806 src -= 1;
00807 }
00808 }
00809 }
00810
00811 if (state == 2) {
00812 *id = 0;
00813 dst = writeIdentValue(dst, format, ident, visited, localValEnv);
00814 }
00815 *dst = 0;
00816 return (parametric) ? strdup(res) : label;
00817 }
00818
00819
00820
00834 static Tree iteratePar (Tree id, int num, Tree body, Tree visited, Tree localValEnv)
00835 {
00836 assert (num>0);
00837
00838 Tree res = eval(body, visited, pushValueDef(id, tree(0), localValEnv));
00839 for (int i = 1; i < num; i++) {
00840 res = boxPar(res, eval(body, visited, pushValueDef(id, tree(i), localValEnv)));
00841 }
00842
00843 return res;
00844 }
00845
00846
00847
00860 static Tree iterateSeq (Tree id, int num, Tree body, Tree visited, Tree localValEnv)
00861 {
00862 assert (num>0);
00863
00864 Tree res = eval(body, visited, pushValueDef(id, tree(0), localValEnv));
00865
00866 for (int i = 1; i < num; i++) {
00867 res = boxSeq(res, eval(body, visited, pushValueDef(id, tree(i), localValEnv)));
00868 }
00869
00870 return res;
00871 }
00872
00873
00874
00888 static Tree iterateSum (Tree id, int num, Tree body, Tree visited, Tree localValEnv)
00889 {
00890 assert (num>0);
00891
00892 Tree res = eval(body, visited, pushValueDef(id, tree(0), localValEnv));
00893
00894 for (int i = 1; i < num; i++) {
00895 res = boxSeq(boxPar(res, eval(body, visited, pushValueDef(id, tree(i), localValEnv))),boxPrim2(sigAdd)) ;
00896 }
00897
00898 return res;
00899 }
00900
00901
00902
00916 static Tree iterateProd (Tree id, int num, Tree body, Tree visited, Tree localValEnv)
00917 {
00918 assert (num>0);
00919
00920 Tree res = eval(body, visited, pushValueDef(id, tree(0), localValEnv));
00921
00922 for (int i = 1; i < num; i++) {
00923 res = boxSeq(boxPar(res, eval(body, visited, pushValueDef(id, tree(i), localValEnv))),boxPrim2(sigMul)) ;
00924 }
00925
00926 return res;
00927 }
00928
00937 #if 1
00938 static bool boxlistOutputs(Tree boxlist, int* outputs)
00939 {
00940 int ins, outs;
00941
00942 *outputs = 0;
00943 while (!isNil(boxlist))
00944 {
00945 if (getBoxType(hd(boxlist), &ins, &outs)) {
00946 *outputs += outs;
00947 } else {
00948
00949
00950 *outputs += 1;
00951 }
00952 boxlist = tl(boxlist);
00953 }
00954 return isNil(boxlist);
00955 }
00956 #else
00957 static bool boxlistOutputs(Tree boxlist, int* outputs)
00958 {
00959 int ins, outs;
00960
00961 *outputs = 0;
00962 while (!isNil(boxlist) && getBoxType(hd(boxlist), &ins, &outs)) {
00963 *outputs += outs;
00964 boxlist = tl(boxlist);
00965 }
00966 return isNil(boxlist);
00967 }
00968 #endif
00969
00973 static Tree nwires(int n)
00974 {
00975 Tree l = nil;
00976 while (n--) { l = cons(boxWire(), l); }
00977 return l;
00978 }
00979
00980
00992 static Tree applyList (Tree fun, Tree larg)
00993 {
00994 Tree abstr;
00995 Tree globalDefEnv;
00996 Tree visited;
00997 Tree localValEnv;
00998 Tree envList;
00999 Tree originalRules;
01000 Tree revParamList;
01001
01002 Tree id;
01003 Tree body;
01004
01005 Automaton* automat;
01006 int state;
01007
01008 prim2 p2;
01009
01010 if (isNil(larg)) return fun;
01011
01012 if (isBoxError(fun) || isBoxError(larg)) {
01013 return boxError();
01014 }
01015
01016 if (isBoxPatternMatcher(fun, automat, state, envList, originalRules, revParamList)) {
01017 Tree result;
01018 int state2;
01019 vector<Tree> envVect;
01020
01021 list2vec(envList, envVect);
01022 state2 = apply_pattern_matcher(automat, state, hd(larg), result, envVect);
01023 if (state2 >= 0 && isNil(result)) {
01024
01025 return applyList(
01026 boxPatternMatcher(automat, state2, vec2list(envVect), originalRules, cons(hd(larg),revParamList)),
01027 tl(larg) );
01028 } else if (state2 < 0) {
01029 cerr << "ERROR : pattern matching failed, no rule of " << boxpp(boxCase(originalRules))
01030 << " matches argument list " << boxpp(reverse(cons(hd(larg), revParamList))) << endl;
01031 exit(1);
01032 } else {
01033
01034
01035 if (isClosure(result, body, globalDefEnv, visited, localValEnv)) {
01036
01037
01038 return applyList(eval(body, nil, localValEnv), tl(larg));
01039 } else {
01040 cerr << "wrong result from pattern matching (not a closure) : " << boxpp(result) << endl;
01041 return boxError();
01042 }
01043 }
01044 }
01045 if (!isClosure(fun, abstr, globalDefEnv, visited, localValEnv)) {
01046
01047 int ins, outs;
01048
01049
01050 if (!getBoxType(fun, &ins, &outs)) {
01051
01052
01053 return boxSeq(larg2par(larg), fun);
01054 }
01055
01056
01057 if (!boxlistOutputs(larg,&outs)) {
01058
01059
01060
01061 return boxSeq(larg2par(larg), fun);
01062 }
01063
01064 if (outs > ins) {
01065 cerr << "too much arguments : " << outs << ", instead of : " << ins << endl;
01066 cerr << "when applying : " << boxpp(fun) << endl
01067 << " to : " << boxpp(larg) << endl;
01068 assert(false);
01069 }
01070
01071 if ( (outs == 1)
01072 &&
01073 ( ( isBoxPrim2(fun, &p2) && (p2 != sigPrefix) )
01074 || ( getUserData(fun) && ((xtended*)getUserData(fun))->isSpecialInfix() ) ) ) {
01075
01076 Tree larg2 = concat(nwires(ins-outs), larg);
01077 return boxSeq(larg2par(larg2), fun);
01078
01079 } else {
01080
01081 Tree larg2 = concat(larg, nwires(ins-outs));
01082 return boxSeq(larg2par(larg2), fun);
01083 }
01084 }
01085
01086 if (isBoxEnvironment(abstr)) {
01087 evalerrorbox(yyfilename, -1, "an environment can't be used as a function", fun);
01088 exit(1);
01089 }
01090
01091 if (!isBoxAbstr(abstr, id, body)) {
01092 evalerror(yyfilename, -1, "(internal) not an abstraction inside closure", fun);
01093 exit(1);
01094 }
01095
01096
01097 {
01098 Tree arg = eval(hd(larg), visited, localValEnv);
01099 Tree narg; if ( isBoxNumeric(arg,narg) ) { arg = narg; }
01100 Tree f = eval(body, visited, pushValueDef(id, arg, localValEnv));
01101
01102 Tree fname;
01103 if (getDefNameProperty(fun, fname)) {
01104 stringstream s; s << tree2str(fname); if (!gSimpleNames) s << "(" << boxpp(arg) << ")";
01105 setDefNameProperty(f, s.str());
01106 }
01107 return applyList(f, tl(larg));
01108 }
01109 }
01110
01111
01112
01124 static Tree revEvalList (Tree lexp, Tree visited, Tree localValEnv)
01125 {
01126 Tree result = nil;
01127 while (!isNil(lexp)) {
01128 result = cons(eval(hd(lexp), visited, localValEnv), result);
01129 lexp = tl(lexp);
01130 }
01131 return result;
01132 }
01133
01134
01135
01142 static Tree larg2par (Tree larg)
01143 {
01144 if (isNil(larg)) {
01145 evalerror(yyfilename, -1, "empty list of arguments", larg);
01146 exit(1);
01147 }
01148 if (isNil(tl(larg))) {
01149 return hd(larg);
01150 }
01151 return boxPar(hd(larg), larg2par(tl(larg)));
01152 }
01153
01154
01155
01156
01167 static Tree evalIdDef(Tree id, Tree visited, Tree lenv)
01168 {
01169 Tree def, name;
01170
01171
01172 while (!isNil(lenv) && !getProperty(lenv, id, def)) {
01173 lenv = lenv->branch(0);
01174 }
01175
01176
01177 if (isNil(lenv)) {
01178 if (gPatternEvalMode) return boxPatternVar(id);
01179 cerr << "undefined symbol " << *id << endl;
01180 evalerror(getDefFileProp(id), getDefLineProp(id), "undefined symbol ", id);
01181 exit(1);
01182
01183 }
01184
01185
01186 Tree p = cons(id,lenv);
01187
01188 if (!getDefNameProperty(def, name)) {
01189
01190 stringstream s; s << boxpp(id);
01191
01192 }
01193
01194
01195 return eval(def, addElement(p,visited), nil);
01196 }
01197
01198
01206 static Tree listn (int n, Tree e)
01207 {
01208 return (n<= 0) ? nil : cons(e, listn(n-1,e));
01209 }
01210
01216 static Node PMPROPERTYNODE(symbol("PMPROPERTY"));
01217
01218 static void setPMProperty(Tree t, Tree env, Tree pm)
01219 {
01220 setProperty(t, tree(PMPROPERTYNODE, env), pm);
01221 }
01222
01223 static bool getPMProperty(Tree t, Tree env, Tree& pm)
01224 {
01225 return getProperty(t, tree(PMPROPERTYNODE, env), pm);
01226 }
01227
01237 static Tree evalCase(Tree rules, Tree env)
01238 {
01239 Tree pm;
01240 if (!getPMProperty(rules, env, pm)) {
01241 Automaton* a = make_pattern_matcher(evalRuleList(rules, env));
01242 pm = boxPatternMatcher(a, 0, listn(len(rules), env), rules, nil);
01243 setPMProperty(rules, env, pm);
01244 }
01245 return pm;
01246 }
01247
01248
01252 static Tree evalRuleList(Tree rules, Tree env)
01253 {
01254 if (isNil(rules)) return nil;
01255 else return cons(evalRule(hd(rules), env), evalRuleList(tl(rules), env));
01256 }
01257
01258
01262 static Tree evalRule(Tree rule, Tree env)
01263 {
01264 return cons(evalPatternList(left(rule), env), right(rule));
01265 }
01266
01267
01271 static Tree evalPatternList(Tree patterns, Tree env)
01272 {
01273 if (isNil(patterns)) {
01274 return nil;
01275 } else {
01276 return cons( evalPattern(hd(patterns), env),
01277 evalPatternList(tl(patterns), env) );
01278 }
01279 }
01280
01281
01286 static Tree evalPattern(Tree pattern, Tree env)
01287 {
01288 bool saveMode = gPatternEvalMode;
01289 gPatternEvalMode = true;
01290 Tree p = eval(pattern, nil, env);
01291 gPatternEvalMode = saveMode;
01292 return patternSimplification(p);
01293 }
01294
01295
01296 static void list2vec(Tree l, vector<Tree>& v)
01297 {
01298 while (!isNil(l)) {
01299 v.push_back(hd(l));
01300 l = tl(l);
01301 }
01302 }
01303
01304
01305 static Tree vec2list(const vector<Tree>& v)
01306 {
01307 Tree l = nil;
01308 int n = v.size();
01309 while (n--) { l = cons(v[n],l); }
01310 return l;
01311 }