projects / Faustine.git / blob
? search:
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
libsndfile-ocaml source files.
[Faustine.git] / interpretor / preprocessor / faust-0.9.47mr3 / compiler / evaluate / eval.cpp
1 /************************************************************************
2 ************************************************************************
3 FAUST compiler
4 Copyright (C) 2003-2004 GRAME, Centre National de Creation Musicale
5 ---------------------------------------------------------------------
6 This program is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2 of the License, or
9 (at your option) any later version.
10
11 This program is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with this program; if not, write to the Free Software
18 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
19 ************************************************************************
20 ************************************************************************/
21 #define TRACE
22
23 /**
24 * \file eval.cpp
25 * Implementation of the Block diagram evaluator.
26 *
27 * A strict lambda-calculus evaluator for block diagram expressions.
28 *
29 **/
30
31
32 #include "eval.hh"
33 #include <stdio.h>
34 #include "errormsg.hh"
35 #include "ppbox.hh"
36 #include "simplify.hh"
37 #include "propagate.hh"
38 #include "patternmatcher.hh"
39 #include "signals.hh"
40 #include "xtended.hh"
41 #include "loopDetector.hh"
42 #include "property.hh"
43 #include "names.hh"
44 #include "compatibility.hh"
45
46
47 #include <assert.h>
48 extern SourceReader gReader;
49 extern int gMaxNameSize;
50 extern bool gSimpleNames;
51 extern bool gSimplifyDiagrams;
52 // History
53 // 23/05/2005 : New environment management
54
55
56 //-------------- prototypes ---------------------------------------------------------
57 static Tree a2sb(Tree exp);
58 static Tree eval (Tree exp, Tree visited, Tree localValEnv);
59 static Tree realeval (Tree exp, Tree visited, Tree localValEnv);
60 static Tree revEvalList (Tree lexp, Tree visited, Tree localValEnv);
61 static Tree applyList (Tree fun, Tree larg);
62 static Tree iteratePar (Tree var, int num, Tree body, Tree visited, Tree localValEnv);
63 static Tree iterateSeq (Tree id, int num, Tree body, Tree visited, Tree localValEnv);
64 static Tree iterateSum (Tree id, int num, Tree body, Tree visited, Tree localValEnv);
65 static Tree iterateProd (Tree id, int num, Tree body, Tree visited, Tree localValEnv);
66 static Tree larg2par (Tree larg);
67 static int eval2int (Tree exp, Tree visited, Tree localValEnv);
68 static double eval2double (Tree exp, Tree visited, Tree localValEnv);
69 static const char * evalLabel (const char* l, Tree visited, Tree localValEnv);
70
71 static Tree evalIdDef(Tree id, Tree visited, Tree env);
72
73
74
75 static Tree evalCase(Tree rules, Tree env);
76 static Tree evalRuleList(Tree rules, Tree env);
77 static Tree evalRule(Tree rule, Tree env);
78 static Tree evalPatternList(Tree patterns, Tree env);
79 static Tree evalPattern(Tree pattern, Tree env);
80
81 static Tree patternSimplification (Tree pattern);
82 static bool isBoxNumeric (Tree in, Tree& out);
83
84 static Tree vec2list(const vector<Tree>& v);
85 static void list2vec(Tree l, vector<Tree>& v);
86 static Tree listn (int n, Tree e);
87
88 static Tree boxSimplification(Tree box);
89
90 // Public Interface
91 //----------------------
92
93
94 /**
95 * Eval "process" from a list of definitions.
96 *
97 * Strict evaluation of a block diagram expression by applying beta reduction.
98 * @param eqlist a list of faust defintions forming the the global environment
99 * @return the process block diagram in normal form
100 */
101 Tree evalprocess (Tree eqlist)
102 {
103 Tree b = a2sb(eval(boxIdent("process"), nil, pushMultiClosureDefs(eqlist, nil, nil)));
104
105 if (gSimplifyDiagrams) {
106 b = boxSimplification(b);
107 }
108
109 return b;
110 }
111
112
113 /* Eval a documentation expression. */
114
115 Tree evaldocexpr (Tree docexpr, Tree eqlist)
116 {
117 return a2sb(eval(docexpr, nil, pushMultiClosureDefs(eqlist, nil, nil)));
118 }
119
120
121
122 // Private Implementation
123 //------------------------
124
125 /**
126 * Transform unused (unapplied) closures into symbolic boxes
127 *
128 * @param exp the expression to transform
129 * @return an expression where abstractions have been replaced by symbolic boxes
130 */
131
132 property<Tree> gSymbolicBoxProperty;
133
134 static Tree real_a2sb(Tree exp);
135
136 static Tree a2sb(Tree exp)
137 {
138 Tree result;
139 Tree id;
140
141 if (gSymbolicBoxProperty.get(exp, result)) {
142 return result;
143 }
144
145 result = real_a2sb(exp);
146 if (result != exp && getDefNameProperty(exp, id)) {
147 setDefNameProperty(result, id); // propagate definition name property when needed
148 }
149 gSymbolicBoxProperty.set(exp, result);
150 return result;
151 }
152
153 static int gBoxSlotNumber = 0; ///< counter for unique slot number
154
155 static Tree real_a2sb(Tree exp)
156 {
157 Tree abstr, visited, unusedEnv, localValEnv, var, name, body;
158
159 if (isClosure(exp, abstr, unusedEnv, visited, localValEnv)) {
160
161 if (isBoxIdent(abstr)) {
162 // special case introduced with access and components
163 Tree result = a2sb(eval(abstr, visited, localValEnv));
164
165 // propagate definition name property when needed
166 if (getDefNameProperty(exp, name)) setDefNameProperty(result, name);
167 return result;
168
169 } else if (isBoxAbstr(abstr, var, body)) {
170 // Here we have remaining abstraction that we will try to
171 // transform in a symbolic box by applying it to a slot
172
173 Tree slot = boxSlot(++gBoxSlotNumber);
174 stringstream s; s << boxpp(var);
175 setDefNameProperty(slot, s.str() ); // ajout YO
176
177 // Apply the abstraction to the slot
178 Tree result = boxSymbolic(slot, a2sb(eval(body, visited, pushValueDef(var, slot, localValEnv))));
179
180 // propagate definition name property when needed
181 if (getDefNameProperty(exp, name)) setDefNameProperty(result, name);
182 return result;
183
184 } else if (isBoxEnvironment(abstr)) {
185 return abstr;
186
187 } else {
188 evalerror(yyfilename, -1, " a2sb : internal error : not an abstraction inside closure ", exp);
189 exit(1);
190 }
191
192 } else if (isBoxPatternMatcher(exp)) {
193 // Here we have remaining PM rules that we will try to
194 // transform in a symbolic box by applying it to a slot
195
196 Tree slot = boxSlot(++gBoxSlotNumber);
197 stringstream s; s << "PM" << gBoxSlotNumber;
198 setDefNameProperty(slot, s.str() );
199
200 // apply the PM rules to the slot and transfoms the result in a symbolic box
201 Tree result = boxSymbolic(slot, a2sb(applyList(exp, cons(slot,nil))));
202
203 // propagate definition name property when needed
204 if (getDefNameProperty(exp, name)) setDefNameProperty(result, name);
205 return result;
206
207 } else {
208 // it is a constructor : transform each branches
209 unsigned int ar = exp->arity();
210 tvec B(ar);
211 bool modified = false;
212 for (unsigned int i = 0; i < ar; i++) {
213 Tree b = exp->branch(i);
214 Tree m = a2sb(b);
215 B[i] = m;
216 if (b != m) modified=true;
217 }
218 Tree r = (modified) ? CTree::make(exp->node(), B) : exp;
219 return r;
220 }
221 }
222
223 static bool autoName(Tree exp , Tree& id)
224 {
225 stringstream s; s << boxpp(exp);
226 id = tree(s.str().c_str());
227 return true;
228 }
229
230 bool getArgName(Tree t, Tree& id)
231 {
232 //return getDefNameProperty(t, id) || autoName(t, id) ;
233 return autoName(t, id) ;
234 }
235
236
237
238 /**
239 * Eval a block diagram expression.
240 *
241 * Wrap the realeval function in order to propagate the name property
242 * @param exp the expression to evaluate
243 * @param visited list of visited definition to detect recursive definitions
244 * @param localValEnv the local environment
245 * @return a block diagram in normal form
246 */
247 static loopDetector LD(1024, 512);
248
249
250 static Node EVALPROPERTY(symbol("EvalProperty"));
251
252 /**
253 * set the value of box in the environment env
254 * @param box the block diagram we have evaluated
255 * @param env the evaluation environment
256 * @param value the evaluated block diagram
257 */
258 void setEvalProperty(Tree box, Tree env, Tree value)
259 {
260 setProperty(box, tree(EVALPROPERTY,env), value);
261 }
262
263
264 /**
265 * retrieve the value of box in the environment env
266 * @param box the expression we want to retrieve the value
267 * @param env the lexical environment
268 * @param value the returned value if any
269 * @return true if a value already exist
270 */
271 bool getEvalProperty(Tree box, Tree env, Tree& value)
272 {
273 return getProperty(box, tree(EVALPROPERTY,env), value);
274 }
275
276
277 static Tree eval (Tree exp, Tree visited, Tree localValEnv)
278 {
279 Tree id;
280 Tree result;
281
282 if (!getEvalProperty(exp, localValEnv, result)) {
283 LD.detect(cons(exp,localValEnv));
284 //cerr << "ENTER eval("<< *exp << ") with env " << *localValEnv << endl;
285 result = realeval(exp, visited, localValEnv);
286 setEvalProperty(exp, localValEnv, result);
287 //cerr << "EXIT eval(" << *exp << ") IS " << *result << " with env " << *localValEnv << endl;
288 if (getDefNameProperty(exp, id)) {
289 setDefNameProperty(result, id); // propagate definition name property
290 }
291 }
292 return result;
293 }
294
295 /**
296 * Eval a block diagram expression.
297 *
298 * Strict evaluation of a block diagram expression by applying beta reduction.
299 * @param exp the expression to evaluate
300 * @param visited list of visited definition to detect recursive definitions
301 * @param localValEnv the local environment
302 * @return a block diagram in normal form
303 */
304
305 static Tree realeval (Tree exp, Tree visited, Tree localValEnv)
306 {
307 //Tree def;
308 Tree fun;
309 Tree arg;
310 Tree var, num, body, ldef;
311 Tree label;
312 Tree cur, lo, hi, step;
313 Tree e1, e2, exp2, notused, visited2, lenv2;
314 Tree rules;
315 Tree id;
316
317 //cerr << "EVAL " << *exp << " (visited : " << *visited << ")" << endl;
318 //cerr << "REALEVAL of " << *exp << endl;
319
320 xtended* xt = (xtended*) getUserData(exp);
321
322
323 // constants
324 //-----------
325
326 if ( xt ||
327 isBoxInt(exp) || isBoxReal(exp) ||
328 isBoxWire(exp) || isBoxCut(exp) ||
329 isBoxPrim0(exp) || isBoxPrim1(exp) ||
330 isBoxPrim2(exp) || isBoxPrim3(exp) ||
331 isBoxPrim4(exp) || isBoxPrim5(exp) ||
332 isBoxFFun(exp) || isBoxFConst(exp) || isBoxFVar(exp) ) {
333 return exp;
334
335 // block-diagram constructors
336 //---------------------------
337
338 } else if ( isBoxSeq(exp, e1, e2) ) {
339 return boxSeq(eval(e1, visited, localValEnv), eval(e2, visited, localValEnv));
340
341 } else if ( isBoxPar(exp, e1, e2) ) {
342 return boxPar(eval(e1, visited, localValEnv), eval(e2, visited, localValEnv));
343
344 } else if ( isBoxRec(exp, e1, e2) ) {
345 return boxRec(eval(e1, visited, localValEnv), eval(e2, visited, localValEnv));
346
347 } else if ( isBoxSplit(exp, e1, e2) ) {
348 return boxSplit(eval(e1, visited, localValEnv), eval(e2, visited, localValEnv));
349
350 } else if ( isBoxMerge(exp, e1, e2) ) {
351 return boxMerge(eval(e1, visited, localValEnv), eval(e2, visited, localValEnv));
352
353 // Modules
354 //--------
355
356 } else if (isBoxAccess(exp, body, var)) {
357 Tree val = eval(body, visited, localValEnv);
358 if (isClosure(val, exp2, notused, visited2, lenv2)) {
359 // it is a closure, we have an environment to access
360 return eval(closure(var,notused,visited2,lenv2), visited, localValEnv);
361 } else {
362 evalerror(getDefFileProp(exp), getDefLineProp(exp), "No environment to access ", exp);
363 exit(1);
364 }
365
366 //////////////////////en chantier////////////////////////////
367
368 } else if (isBoxModifLocalDef(exp, body, ldef)) {
369 Tree val = eval(body, visited, localValEnv);
370 if (isClosure(val, exp2, notused, visited2, lenv2)) {
371 // we rebuild the closure using a copy of the original environment
372 // modified with some new definitions
373 Tree lenv3 = copyEnvReplaceDefs(lenv2, ldef, visited2, localValEnv);
374 return eval(closure(exp2,notused,visited2,lenv3), visited, localValEnv);
375 } else {
376
377 evalerror(getDefFileProp(exp), getDefLineProp(exp), "not a closure ", val);
378 evalerror(getDefFileProp(exp), getDefLineProp(exp), "No environment to access ", exp);
379 exit(1);
380 }
381
382 ///////////////////////////////////////////////////////////////////
383
384 } else if (isBoxComponent(exp, label)) {
385 string fname = tree2str(label);
386 Tree eqlst = gReader.expandlist(gReader.getlist(fname));
387 Tree res = closure(boxIdent("process"), nil, nil, pushMultiClosureDefs(eqlst, nil, nil));
388 setDefNameProperty(res, label);
389 //cerr << "component is " << boxpp(res) << endl;
390 return res;
391
392 } else if (isBoxLibrary(exp, label)) {
393 string fname = tree2str(label);
394 Tree eqlst = gReader.expandlist(gReader.getlist(fname));
395 Tree res = closure(boxEnvironment(), nil, nil, pushMultiClosureDefs(eqlst, nil, nil));
396 setDefNameProperty(res, label);
397 //cerr << "component is " << boxpp(res) << endl;
398 return res;
399
400
401 // user interface elements
402 //------------------------
403
404 } else if (isBoxButton(exp, label)) {
405 const char* l1 = tree2str(label);
406 const char* l2= evalLabel(l1, visited, localValEnv);
407 //cout << "button label : " << l1 << " become " << l2 << endl;
408 return ((l1 == l2) ? exp : boxButton(tree(l2)));
409
410 } else if (isBoxCheckbox(exp, label)) {
411 const char* l1 = tree2str(label);
412 const char* l2= evalLabel(l1, visited, localValEnv);
413 //cout << "check box label : " << l1 << " become " << l2 << endl;
414 return ((l1 == l2) ? exp : boxCheckbox(tree(l2)));
415
416 } else if (isBoxVSlider(exp, label, cur, lo, hi, step)) {
417 const char* l1 = tree2str(label);
418 const char* l2= evalLabel(l1, visited, localValEnv);
419 return ( boxVSlider(tree(l2),
420 tree(eval2double(cur, visited, localValEnv)),
421 tree(eval2double(lo, visited, localValEnv)),
422 tree(eval2double(hi, visited, localValEnv)),
423 tree(eval2double(step, visited, localValEnv))));
424
425 } else if (isBoxHSlider(exp, label, cur, lo, hi, step)) {
426 const char* l1 = tree2str(label);
427 const char* l2= evalLabel(l1, visited, localValEnv);
428 return ( boxHSlider(tree(l2),
429 tree(eval2double(cur, visited, localValEnv)),
430 tree(eval2double(lo, visited, localValEnv)),
431 tree(eval2double(hi, visited, localValEnv)),
432 tree(eval2double(step, visited, localValEnv))));
433
434 } else if (isBoxNumEntry(exp, label, cur, lo, hi, step)) {
435 const char* l1 = tree2str(label);
436 const char* l2= evalLabel(l1, visited, localValEnv);
437 return (boxNumEntry(tree(l2),
438 tree(eval2double(cur, visited, localValEnv)),
439 tree(eval2double(lo, visited, localValEnv)),
440 tree(eval2double(hi, visited, localValEnv)),
441 tree(eval2double(step, visited, localValEnv))));
442
443 } else if (isBoxVGroup(exp, label, arg)) {
444 const char* l1 = tree2str(label);
445 const char* l2= evalLabel(l1, visited, localValEnv);
446 return boxVGroup(tree(l2), eval(arg, visited, localValEnv) );
447
448 } else if (isBoxHGroup(exp, label, arg)) {
449 const char* l1 = tree2str(label);
450 const char* l2= evalLabel(l1, visited, localValEnv);
451 return boxHGroup(tree(l2), eval(arg, visited, localValEnv) );
452
453 } else if (isBoxTGroup(exp, label, arg)) {
454 const char* l1 = tree2str(label);
455 const char* l2= evalLabel(l1, visited, localValEnv);
456 return boxTGroup(tree(l2), eval(arg, visited, localValEnv) );
457
458 } else if (isBoxHBargraph(exp, label, lo, hi)) {
459 const char* l1 = tree2str(label);
460 const char* l2= evalLabel(l1, visited, localValEnv);
461 return boxHBargraph(tree(l2),
462 tree(eval2double(lo, visited, localValEnv)),
463 tree(eval2double(hi, visited, localValEnv)));
464
465 } else if (isBoxVBargraph(exp, label, lo, hi)) {
466 const char* l1 = tree2str(label);
467 const char* l2= evalLabel(l1, visited, localValEnv);
468 return boxVBargraph(tree(l2),
469 tree(eval2double(lo, visited, localValEnv)),
470 tree(eval2double(hi, visited, localValEnv)));
471
472 // lambda calculus
473 //----------------
474
475 } else if (isBoxIdent(exp)) {
476 return evalIdDef(exp, visited, localValEnv);
477
478 } else if (isBoxWithLocalDef(exp, body, ldef)) {
479 return eval(body, visited, pushMultiClosureDefs(ldef, visited, localValEnv));
480
481 } else if (isBoxAppl(exp, fun, arg)) {
482 return applyList( eval(fun, visited, localValEnv),
483 revEvalList(arg, visited, localValEnv) );
484
485 } else if (isBoxAbstr(exp)) {
486 // it is an abstraction : return a closure
487 return closure(exp, nil, visited, localValEnv);
488
489 } else if (isBoxEnvironment(exp)) {
490 // environment : return also a closure
491 return closure(exp, nil, visited, localValEnv);
492
493 } else if (isClosure(exp, exp2, notused, visited2, lenv2)) {
494
495 if (isBoxAbstr(exp2)) {
496 // a 'real' closure
497 return closure(exp2, nil, setUnion(visited,visited2), lenv2);
498 } else if (isBoxEnvironment(exp2)) {
499 // a 'real' closure
500 return closure(exp2, nil, setUnion(visited,visited2), lenv2);
501 } else {
502 // it was a suspended evaluation
503 return eval(exp2, setUnion(visited,visited2), lenv2);
504 }
505
506 // Algorithmic constructions
507 //--------------------------
508
509 } else if (isBoxIPar(exp, var, num, body)) {
510 int n = eval2int(num, visited, localValEnv);
511 return iteratePar(var, n, body, visited, localValEnv);
512
513 } else if (isBoxISeq(exp, var, num, body)) {
514 int n = eval2int(num, visited, localValEnv);
515 return iterateSeq(var, n, body, visited, localValEnv);
516
517 } else if (isBoxISum(exp, var, num, body)) {
518 int n = eval2int(num, visited, localValEnv);
519 return iterateSum(var, n, body, visited, localValEnv);
520
521 } else if (isBoxIProd(exp, var, num, body)) {
522 int n = eval2int(num, visited, localValEnv);
523 return iterateProd(var, n, body, visited, localValEnv);
524
525 } else if (isBoxSlot(exp)) {
526 return exp;
527
528 } else if (isBoxSymbolic(exp)) {
529
530 return exp;
531
532
533 // Pattern matching extension
534 //---------------------------
535
536 } else if (isBoxCase(exp, rules)) {
537 return evalCase(rules, localValEnv);
538
539 } else if (isBoxPatternVar(exp, id)) {
540 return exp;
541 //return evalIdDef(id, visited, localValEnv);
542
543 } else if (isBoxPatternMatcher(exp)) {
544 return exp;
545
546 } else {
547 cerr << "ERROR : EVAL don't intercept : " << *exp << endl;
548 assert(false);
549 }
550 }
551
552 /* Deconstruct a (BDA) op pattern (YO). */
553
554 static inline bool isBoxPatternOp(Tree box, Node& n, Tree& t1, Tree& t2)
555 {
556 if ( isBoxPar(box, t1, t2) ||
557 isBoxSeq(box, t1, t2) ||
558 isBoxSplit(box, t1, t2) ||
559 isBoxMerge(box, t1, t2) ||
560 isBoxRec(box, t1, t2) )
561 {
562 n = box->node();
563 return true;
564 } else {
565 return false;
566 }
567 }
568
569
570 Tree NUMERICPROPERTY = tree(symbol("NUMERICPROPERTY"));
571
572 void setNumericProperty(Tree t, Tree num)
573 {
574 setProperty(t, NUMERICPROPERTY, num);
575 }
576
577 bool getNumericProperty(Tree t, Tree& num)
578 {
579 return getProperty(t, NUMERICPROPERTY, num);
580 }
581
582 /**
583 * Simplify a block-diagram pattern by computing its numerical sub-expressions
584 * \param pattern an evaluated block-diagram
585 * \return a simplified pattern
586 *
587 */
588 /* uncomment for debugging output */
589 //#define DEBUG
590 Tree simplifyPattern (Tree value)
591 {
592 Tree num;
593 if (!getNumericProperty(value,num)) {
594 if (!isBoxNumeric(value,num)) {
595 num = value;
596 }
597 setNumericProperty(value,num);
598 }
599 return num;
600 }
601
602
603 static bool isBoxNumeric (Tree in, Tree& out)
604 {
605 int numInputs, numOutputs;
606 double x;
607 int i;
608 Tree v;
609
610 if (isBoxInt(in, &i) || isBoxReal(in, &x)) {
611 out = in;
612 return true;
613 } else {
614 v = a2sb(in);
615 if ( getBoxType(v, &numInputs, &numOutputs) && (numInputs == 0) && (numOutputs == 1) ) {
616 // potential numerical expression
617 Tree lsignals = boxPropagateSig(nil, v , makeSigInputList(numInputs) );
618 Tree res = simplify(hd(lsignals));
619 if (isSigReal(res, &x)) {
620 out = boxReal(x);
621 return true;
622 }
623 if (isSigInt(res, &i)) {
624 out = boxInt(i);
625 return true;
626 }
627 }
628 return false;
629 }
630 }
631
632 static Tree patternSimplification (Tree pattern)
633 {
634
635 Node n(0);
636 Tree v, t1, t2;
637
638 if (isBoxNumeric(pattern, v)) {
639 return v;
640 } else if (isBoxPatternOp(pattern, n, t1, t2)) {
641 return tree(n, patternSimplification(t1), patternSimplification(t2));
642 } else {
643 return pattern;
644 }
645 }
646
647
648
649 /**
650 * Eval a block diagram to a double.
651 *
652 * Eval a block diagram that represent a double constant. This function first eval
653 * a block diagram to its normal form, then check it represent a numerical value (a
654 * block diagram of type : 0->1) then do a symbolic propagation and try to convert the
655 * resulting signal to a double.
656 * @param exp the expression to evaluate
657 * @param globalDefEnv the global environment
658 * @param visited list of visited definition to detect recursive definitions
659 * @param localValEnv the local environment
660 * @return a block diagram in normal form
661 */
662 static double eval2double (Tree exp, Tree visited, Tree localValEnv)
663 {
664 Tree diagram = a2sb(eval(exp, visited, localValEnv)); // pour getBoxType
665 int numInputs, numOutputs;
666 getBoxType(diagram, &numInputs, &numOutputs);
667 if ( (numInputs > 0) || (numOutputs != 1) ) {
668 evalerror (yyfilename, yylineno, "not a constant expression of type : (0->1)", exp);
669 return 1;
670 } else {
671 Tree lsignals = boxPropagateSig(nil, diagram , makeSigInputList(numInputs) );
672 Tree val = simplify(hd(lsignals));
673 return tree2float(val);
674 }
675 }
676
677
678 /**
679 * Eval a block diagram to an int.
680 *
681 * Eval a block diagram that represent an integer constant. This function first eval
682 * a block diagram to its normal form, then check it represent a numerical value (a
683 * block diagram of type : 0->1) then do a symbolic propagation and try to convert the
684 * resulting signal to an int.
685 * @param exp the expression to evaluate
686 * @param globalDefEnv the global environment
687 * @param visited list of visited definition to detect recursive definitions
688 * @param localValEnv the local environment
689 * @return a block diagram in normal form
690 */
691 static int eval2int (Tree exp, Tree visited, Tree localValEnv)
692 {
693 Tree diagram = a2sb(eval(exp, visited, localValEnv)); // pour getBoxType()
694 int numInputs, numOutputs;
695 getBoxType(diagram, &numInputs, &numOutputs);
696 if ( (numInputs > 0) || (numOutputs != 1) ) {
697 evalerror (yyfilename, yylineno, "not a constant expression of type : (0->1)", exp);
698 return 1;
699 } else {
700 Tree lsignals = boxPropagateSig(nil, diagram , makeSigInputList(numInputs) );
701 Tree val = simplify(hd(lsignals));
702 return tree2int(val);
703 }
704 }
705
706 static bool isDigitChar(char c)
707 {
708 return (c >= '0') & (c <= '9');
709 }
710
711 static bool isIdentChar(char c)
712 {
713 return ((c >= 'a') & (c <= 'z')) || ((c >= 'A') & (c <= 'Z')) || ((c >= '0') & (c <= '9')) || (c == '_');
714 }
715
716 const char* Formats [] = {"%d", "%1d", "%2d", "%3d", "%4d"};
717
718 static char* writeIdentValue(char* dst, int format, const char* ident, Tree visited, Tree localValEnv)
719 {
720 int n = eval2int(boxIdent(ident), visited, localValEnv);
721 int i = min(4,max(format,0));
722
723 return dst + sprintf(dst, Formats[i], n);
724 }
725
726 static const char * evalLabel (const char* label, Tree visited, Tree localValEnv)
727 {
728 char res[2000];
729 char ident[64];
730
731 const char* src = &label[0];
732 char* dst = &res[0];
733 char* id = &ident[0];
734
735 bool parametric = false;
736 int state = 0; int format = 0;
737 char c;
738
739 while ((c=*src++)) {
740 if (state == 0) {
741 // outside ident mode
742 if (c == '%') {
743 // look ahead for next char
744 if (*src == '%') {
745 *dst++ = *src++; // copy escape char and skip one char
746 } else {
747 state = 1; // prepare ident mode
748 format = 0;
749 parametric = true;
750 id = &ident[0];
751 }
752 } else {
753 *dst++ = c; // copy char
754 }
755 } else if (state == 1) {
756 // read the format
757 if (isDigitChar(c)) {
758 format = format*10 + (c-'0');
759 } else {
760 state = 2;
761 --src; // unread !!!
762 }
763
764 } else {
765
766 // within ident mode
767 if (isIdentChar(c)) {
768 *id++ = c;
769 } else {
770 *id = 0;
771 dst = writeIdentValue(dst, format, ident, visited, localValEnv);
772 state = 0;
773 src -= 1;
774 }
775 }
776 }
777
778 if (state == 2) {
779 *id = 0;
780 dst = writeIdentValue(dst, format, ident, visited, localValEnv);
781 }
782 *dst = 0;
783 return (parametric) ? strdup(res) : label;
784 }
785
786
787
788 /**
789 * Iterate a parallel construction
790 *
791 * Iterate a parallel construction such that :
792 * par(i,10,E) --> E(i<-0),(E(i<-1),...,E(i<-9))
793 * @param id the formal parameter of the iteration
794 * @param num the number of iterartions
795 * @param body the body expression of the iteration
796 * @param globalDefEnv the global environment
797 * @param visited list of visited definition to detect recursive definitions
798 * @param localValEnv the local environment
799 * @return a block diagram in normal form
800 */
801 static Tree iteratePar (Tree id, int num, Tree body, Tree visited, Tree localValEnv)
802 {
803 assert (num>0);
804
805 Tree res = eval(body, visited, pushValueDef(id, tree(num-1), localValEnv));
806 for (int i = num-2; i >= 0; i--) {
807 res = boxPar(eval(body, visited, pushValueDef(id, tree(i), localValEnv)), res);
808 }
809
810 return res;
811 }
812
813
814
815 /**
816 * Iterate a sequential construction
817 *
818 * Iterate a sequential construction such that :
819 * seq(i,10,E) --> E(i<-0):(E(i<-1):...:E(i<-9))
820 * @param id the formal parameter of the iteration
821 * @param num the number of iterartions
822 * @param body the body expression of the iteration
823 * @param globalDefEnv the global environment
824 * @param visited list of visited definition to detect recursive definitions
825 * @return a block diagram in normal form
826 */
827 static Tree iterateSeq (Tree id, int num, Tree body, Tree visited, Tree localValEnv)
828 {
829 assert (num>0);
830
831 Tree res = eval(body, visited, pushValueDef(id, tree(num-1), localValEnv));
832 for (int i = num-2; i >= 0; i--) {
833 res = boxSeq(eval(body, visited, pushValueDef(id, tree(i), localValEnv)), res);
834 }
835
836 return res;
837 }
838
839
840
841 /**
842 * Iterate an addition construction
843 *
844 * Iterate an addition construction such that :
845 * par(i,10,E) --> E(i<-0)+E(i<-1)+...+E(i<-9)
846 * @param id the formal parameter of the iteration
847 * @param num the number of iterartions
848 * @param body the body expression of the iteration
849 * @param globalDefEnv the global environment
850 * @param visited list of visited definition to detect recursive definitions
851 * @param localValEnv the local environment
852 * @return a block diagram in normal form
853 */
854 static Tree iterateSum (Tree id, int num, Tree body, Tree visited, Tree localValEnv)
855 {
856 assert (num>0);
857
858 Tree res = eval(body, visited, pushValueDef(id, tree(0), localValEnv));
859
860 for (int i = 1; i < num; i++) {
861 res = boxSeq(boxPar(res, eval(body, visited, pushValueDef(id, tree(i), localValEnv))),boxPrim2(sigAdd)) ;
862 }
863
864 return res;
865 }
866
867
868
869 /**
870 * Iterate a product construction
871 *
872 * Iterate a product construction such that :
873 * par(i,10,E) --> E(i<-0)*E(i<-1)*...*E(i<-9)
874 * @param id the formal parameter of the iteration
875 * @param num the number of iterartions
876 * @param body the body expression of the iteration
877 * @param globalDefEnv the global environment
878 * @param visited list of visited definition to detect recursive definitions
879 * @param localValEnv the local environment
880 * @return a block diagram in normal form
881 */
882 static Tree iterateProd (Tree id, int num, Tree body, Tree visited, Tree localValEnv)
883 {
884 assert (num>0);
885
886 Tree res = eval(body, visited, pushValueDef(id, tree(0), localValEnv));
887
888 for (int i = 1; i < num; i++) {
889 res = boxSeq(boxPar(res, eval(body, visited, pushValueDef(id, tree(i), localValEnv))),boxPrim2(sigMul)) ;
890 }
891
892 return res;
893 }
894
895 /**
896 * Compute the sum of outputs of a list of boxes. The sum is
897 * valid if all the boxes have a valid boxType
898 *
899 * @param boxlist the list of boxes
900 * @param outputs sum of outputs of the boxes
901 * @return true if outputs is valid, false otherwise
902 */
903 #if 1
904 static bool boxlistOutputs(Tree boxlist, int* outputs)
905 {
906 int ins, outs;
907
908 *outputs = 0;
909 while (!isNil(boxlist))
910 {
911 Tree b = a2sb(hd(boxlist)); // for getBoxType, suppose list of evaluated boxes
912 if (getBoxType(b, &ins, &outs)) {
913 *outputs += outs;
914 } else {
915 // arbitrary output arity set to 1
916 // when can't be determined
917 *outputs += 1;
918 }
919 boxlist = tl(boxlist);
920 }
921 return isNil(boxlist);
922 }
923 #else
924 static bool boxlistOutputs(Tree boxlist, int* outputs)
925 {
926 int ins, outs;
927
928 *outputs = 0;
929 while (!isNil(boxlist) && getBoxType(hd(boxlist), &ins, &outs)) {
930 *outputs += outs;
931 boxlist = tl(boxlist);
932 }
933 return isNil(boxlist);
934 }
935 #endif
936
937 /**
938 * repeat n times a wire
939 */
940 static Tree nwires(int n)
941 {
942 Tree l = nil;
943 while (n--) { l = cons(boxWire(), l); }
944 return l;
945 }
946
947
948 /**
949 * Apply a function to a list of arguments.
950 * Apply a function F to a list of arguments (a,b,c,...).
951 * F can be either a closure over an abstraction, or a
952 * pattern matcher. If it is not the case then we have :
953 * F(a,b,c,...) ==> (a,b,c,...):F
954 *
955 * @param fun the function to apply
956 * @param larg the list of arguments
957 * @return the resulting expression in normal form
958 */
959 static Tree applyList (Tree fun, Tree larg)
960 {
961 Tree abstr;
962 Tree globalDefEnv;
963 Tree visited;
964 Tree localValEnv;
965 Tree envList;
966 Tree originalRules;
967 Tree revParamList;
968
969 Tree id;
970 Tree body;
971
972 Automaton* automat;
973 int state;
974
975 prim2 p2;
976
977 //cerr << "applyList (" << *fun << ", " << *larg << ")" << endl;
978
979 if (isNil(larg)) return fun;
980
981 if (isBoxError(fun) || isBoxError(larg)) {
982 return boxError();
983 }
984
985 if (isBoxPatternMatcher(fun, automat, state, envList, originalRules, revParamList)) {
986 Tree result;
987 int state2;
988 vector<Tree> envVect;
989
990 list2vec(envList, envVect);
991 //cerr << "applyList/apply_pattern_matcher(" << automat << "," << state << "," << *hd(larg) << ")" << endl;
992 state2 = apply_pattern_matcher(automat, state, hd(larg), result, envVect);
993 //cerr << "state2 = " << state2 << "; result = " << *result << endl;
994 if (state2 >= 0 && isNil(result)) {
995 // we need to continue the pattern matching
996 return applyList(
997 boxPatternMatcher(automat, state2, vec2list(envVect), originalRules, cons(hd(larg),revParamList)),
998 tl(larg) );
999 } else if (state2 < 0) {
1000 cerr << "ERROR : pattern matching failed, no rule of " << boxpp(boxCase(originalRules))
1001 << " matches argument list " << boxpp(reverse(cons(hd(larg), revParamList))) << endl;
1002 exit(1);
1003 } else {
1004 // Pattern Matching was succesful
1005 // the result is a closure that we need to evaluate.
1006 if (isClosure(result, body, globalDefEnv, visited, localValEnv)) {
1007 // why ??? return simplifyPattern(eval(body, nil, localValEnv));
1008 //return eval(body, nil, localValEnv);
1009 return applyList(eval(body, nil, localValEnv), tl(larg));
1010 } else {
1011 cerr << "wrong result from pattern matching (not a closure) : " << boxpp(result) << endl;
1012 return boxError();
1013 }
1014 }
1015 }
1016 if (!isClosure(fun, abstr, globalDefEnv, visited, localValEnv)) {
1017 // principle : f(a,b,c,...) ==> (a,b,c,...):f
1018 int ins, outs;
1019
1020 // check arity of function
1021 Tree efun = a2sb(fun);
1022 //cerr << "TRACEPOINT 1 : " << boxpp(efun) << endl;
1023 if (!getBoxType(efun, &ins, &outs)) { // on laisse comme ca pour le moment
1024 // we can't determine the input arity of the expression
1025 // hope for the best
1026 return boxSeq(larg2par(larg), fun);
1027 }
1028
1029 // check arity of arg list
1030 if (!boxlistOutputs(larg,&outs)) {
1031 // we don't know yet the output arity of larg. Therefore we can't
1032 // do any arity checking nor add _ to reach the required number of arguments
1033 // cerr << "warning : can't infere the type of : " << boxpp(larg) << endl;
1034 return boxSeq(larg2par(larg), fun);
1035 }
1036
1037 if (outs > ins) {
1038 cerr << "too much arguments : " << outs << ", instead of : " << ins << endl;
1039 cerr << "when applying : " << boxpp(fun) << endl
1040 << " to : " << boxpp(larg) << endl;
1041 assert(false);
1042 }
1043
1044 if ( (outs == 1)
1045 &&
1046 ( ( isBoxPrim2(fun, &p2) && (p2 != sigPrefix) )
1047 || ( getUserData(fun) && ((xtended*)getUserData(fun))->isSpecialInfix() ) ) ) {
1048 // special case : /(3) ==> _,3 : /
1049 Tree larg2 = concat(nwires(ins-outs), larg);
1050 return boxSeq(larg2par(larg2), fun);
1051
1052 } else {
1053
1054 Tree larg2 = concat(larg, nwires(ins-outs));
1055 return boxSeq(larg2par(larg2), fun);
1056 }
1057 }
1058
1059 if (isBoxEnvironment(abstr)) {
1060 evalerrorbox(yyfilename, -1, "an environment can't be used as a function", fun);
1061 exit(1);
1062 }
1063
1064 if (!isBoxAbstr(abstr, id, body)) {
1065 evalerror(yyfilename, -1, "(internal) not an abstraction inside closure", fun);
1066 exit(1);
1067 }
1068
1069 // try to synthetise a name from the function name and the argument name
1070 {
1071 Tree arg = eval(hd(larg), visited, localValEnv);
1072 Tree narg; if ( isBoxNumeric(arg,narg) ) { arg = narg; }
1073 Tree f = eval(body, visited, pushValueDef(id, arg, localValEnv));
1074
1075 Tree fname;
1076 if (getDefNameProperty(fun, fname)) {
1077 stringstream s; s << tree2str(fname); if (!gSimpleNames) s << "(" << boxpp(arg) << ")";
1078 setDefNameProperty(f, s.str());
1079 }
1080 return applyList(f, tl(larg));
1081 }
1082 }
1083
1084
1085
1086 /**
1087 * Eval a list of expression in reverse order
1088 *
1089 * Eval a list of expressions returning the list of results in reverse order.
1090 *
1091 * @param lexp list of expressions to evaluate
1092 * @param globalDefEnv the global environment
1093 * @param visited list of visited definition to detect recursive definitions
1094 * @param localValEnv the local environment
1095 * @return list of evaluated expressions in reverse order
1096 */
1097 static Tree revEvalList (Tree lexp, Tree visited, Tree localValEnv)
1098 {
1099 Tree result = nil;
1100 //Tree lexp_orig = lexp;
1101 //cerr << "ENTER revEvalList(" << *lexp_orig << ", env:" << *localValEnv << ")" << endl;
1102 while (!isNil(lexp)) {
1103 result = cons(eval(hd(lexp), visited, localValEnv), result);
1104 lexp = tl(lexp);
1105 }
1106
1107 //cerr << "EXIT revEvalList(" << *lexp_orig << ", env:" << *localValEnv << ") -> " << *result << endl;
1108 return result;
1109 }
1110
1111
1112
1113 /**
1114 * Transform a list of expressions in a parallel construction
1115 *
1116 * @param larg list of expressions
1117 * @return parallel construction
1118 */
1119 static Tree larg2par (Tree larg)
1120 {
1121 if (isNil(larg)) {
1122 evalerror(yyfilename, -1, "empty list of arguments", larg);
1123 exit(1);
1124 }
1125 if (isNil(tl(larg))) {
1126 return hd(larg);
1127 }
1128 return boxPar(hd(larg), larg2par(tl(larg)));
1129 }
1130
1131
1132
1133
1134 /**
1135 * Search the environment for the definition of a symbol
1136 * ID and evaluate it. Detects recursive definitions using
1137 * a set of visited IDxENV. Associates the symbol as a definition name
1138 * property of the definition.
1139 * @param id the symbol ID t-o search
1140 * @param visited set of visited symbols (used for recursive definition detection)
1141 * @param lenv the environment where to search
1142 * @return the evaluated definition of ID
1143 */
1144 static Tree evalIdDef(Tree id, Tree visited, Tree lenv)
1145 {
1146 Tree def, name;
1147
1148 // search the environment env for a definition of symbol id
1149 while (!isNil(lenv) && !getProperty(lenv, id, def)) {
1150 lenv = lenv->branch(0);
1151 }
1152
1153 // check that the definition exists
1154 if (isNil(lenv)) {
1155 cerr << "undefined symbol " << *id << endl;
1156 evalerror(getDefFileProp(id), getDefLineProp(id), "undefined symbol ", id);
1157 exit(1);
1158 }
1159
1160 //cerr << "Id definition is " << *def << endl;
1161 // check that it is not a recursive definition
1162 Tree p = cons(id,lenv);
1163 // set the definition name property
1164 if (!getDefNameProperty(def, name)) {
1165 // if the definition has no name use the identifier
1166 stringstream s; s << boxpp(id);
1167 //XXXXXX setDefNameProperty(def, s.str());
1168 }
1169
1170 // return the evaluated definition
1171 return eval(def, addElement(p,visited), nil);
1172 }
1173
1174
1175 /**
1176 * Creates a list of n elements.
1177 * @param n number of elements
1178 * @param e element to be repeated
1179 * @return [e e e ...] n times
1180 */
1181
1182 static Tree listn (int n, Tree e)
1183 {
1184 return (n<= 0) ? nil : cons(e, listn(n-1,e));
1185 }
1186
1187 /**
1188 * A property to store the pattern matcher corresponding to a set of rules
1189 * in a specific environement
1190 */
1191
1192 static Node PMPROPERTYNODE(symbol("PMPROPERTY"));
1193
1194 static void setPMProperty(Tree t, Tree env, Tree pm)
1195 {
1196 setProperty(t, tree(PMPROPERTYNODE, env), pm);
1197 }
1198
1199 static bool getPMProperty(Tree t, Tree env, Tree& pm)
1200 {
1201 return getProperty(t, tree(PMPROPERTYNODE, env), pm);
1202 }
1203
1204 /**
1205 * Eval a case expression containing a list of pattern matching rules.
1206 * Creates a boxPatternMatcher containing a pm autamaton a state
1207 * and a list of environments.
1208 * @param rules the list of rules
1209 * @param env the environment uused to evaluate the patterns and closure the rhs
1210 * @return a boxPatternMatcher ready to be applied
1211 */
1212
1213 static Tree evalCase(Tree rules, Tree env)
1214 {
1215 Tree pm;
1216 if (!getPMProperty(rules, env, pm)) {
1217 Automaton* a = make_pattern_matcher(evalRuleList(rules, env));
1218 pm = boxPatternMatcher(a, 0, listn(len(rules), pushEnvBarrier(env)), rules, nil);
1219 setPMProperty(rules, env, pm);
1220 }
1221 return pm;
1222 }
1223
1224
1225 /**
1226 * Evaluates each rule of the list
1227 */
1228 static Tree evalRuleList(Tree rules, Tree env)
1229 {
1230 //cerr << "evalRuleList "<< *rules << " in " << *env << endl;
1231 if (isNil(rules)) return nil;
1232 else return cons(evalRule(hd(rules), env), evalRuleList(tl(rules), env));
1233 }
1234
1235
1236 /**
1237 * Evaluates the list of patterns and closure the rhs
1238 */
1239 static Tree evalRule(Tree rule, Tree env)
1240 {
1241 //cerr << "evalRule "<< *rule << " in " << *env << endl;
1242 return cons(evalPatternList(left(rule), env), right(rule));
1243 }
1244
1245
1246 /**
1247 * Evaluates each pattern of the list
1248 */
1249 static Tree evalPatternList(Tree patterns, Tree env)
1250 {
1251 if (isNil(patterns)) {
1252 return nil;
1253 } else {
1254 return cons( evalPattern(hd(patterns), env),
1255 evalPatternList(tl(patterns), env) );
1256 }
1257 }
1258
1259
1260 /**
1261 * Evaluates a pattern and simplify it to numerical value
1262 * if possible
1263 */
1264 static Tree evalPattern(Tree pattern, Tree env)
1265 {
1266 Tree p = eval(pattern, nil, env);
1267 return patternSimplification(p);
1268 }
1269
1270
1271 static void list2vec(Tree l, vector<Tree>& v)
1272 {
1273 while (!isNil(l)) {
1274 v.push_back(hd(l));
1275 l = tl(l);
1276 }
1277 }
1278
1279
1280 static Tree vec2list(const vector<Tree>& v)
1281 {
1282 Tree l = nil;
1283 int n = v.size();
1284 while (n--) { l = cons(v[n],l); }
1285 return l;
1286 }
1287
1288
1289
1290
1291 /////////////////////////////////////////////////////////////////////////////////////////////////////////
1292 // further simplification : replace bloc-diagrams that denote constant number by this number
1293 /////////////////////////////////////////////////////////////////////////////////////////////////////////
1294
1295 static property<Tree> SimplifiedBoxProperty;
1296 static Tree numericBoxSimplification(Tree box);
1297 static Tree insideBoxSimplification (Tree box);
1298
1299 /**
1300 * boxSimplification(box) : simplify a block-diagram by replacing expressions
1301 * denoting a constant number by this number.
1302 */
1303 Tree boxSimplification (Tree box)
1304 {
1305 Tree simplified;
1306
1307 if (SimplifiedBoxProperty.get(box,simplified)) {
1308
1309 return simplified;
1310
1311 } else {
1312
1313 simplified = numericBoxSimplification(box);
1314
1315 // transferts name property if any
1316 Tree name; if (getDefNameProperty(box, name)) setDefNameProperty(simplified, name);
1317
1318 // attach simplified expression as a property of original box
1319 SimplifiedBoxProperty.set(box,simplified);
1320
1321 return simplified;
1322 }
1323 }
1324
1325 /**
1326 * Try to do a numeric simplification of a block-diagram
1327 */
1328 Tree numericBoxSimplification(Tree box)
1329 {
1330 int ins, outs;
1331 Tree result;
1332 int i;
1333 double x;
1334
1335 if ( ! getBoxType(box, &ins, &outs)) {
1336 cout << "ERROR in file " << __FILE__ << ':' << __LINE__ << ", Can't compute the box type of : " << *box << endl;
1337 exit(1);
1338 }
1339
1340 if (ins==0 && outs==1) {
1341 // this box can potentially denote a number
1342 if (isBoxInt(box, &i) || isBoxReal(box, &x)) {
1343 result = box;
1344 } else {
1345 // propagate signals to discover if it simplifies to a number
1346 int i;
1347 double x;
1348 Tree lsignals = boxPropagateSig(nil, box , makeSigInputList(0));
1349 Tree s = simplify(hd(lsignals));
1350
1351 if (isSigReal(s, &x)) {
1352 result = boxReal(x);
1353 } else if (isSigInt(s, &i)) {
1354 result = boxInt(i);
1355 } else {
1356 result = insideBoxSimplification(box);
1357 }
1358 }
1359 } else {
1360 // this box can't denote a number
1361 result = insideBoxSimplification(box);
1362 }
1363 return result;
1364 }
1365
1366 /**
1367 * Simplify inside a block-diagram : S[A*B] => S[A]*S[B]
1368 */
1369 Tree insideBoxSimplification (Tree box)
1370 {
1371 int i;
1372 double r;
1373 prim0 p0;
1374 prim1 p1;
1375 prim2 p2;
1376 prim3 p3;
1377 prim4 p4;
1378 prim5 p5;
1379
1380 Tree t1, t2, ff, label, cur, min, max, step, type, name, file, slot, body;
1381
1382
1383 xtended* xt = (xtended*)getUserData(box);
1384
1385 // Extended Primitives
1386
1387 if (xt) {
1388 return box;
1389 }
1390
1391 // Numbers and Constants
1392
1393 else if (isBoxInt(box, &i)) {
1394 return box;
1395 }
1396 else if (isBoxReal(box, &r)) {
1397 return box;
1398 }
1399
1400 else if (isBoxFConst(box, type, name, file)) {
1401 return box;
1402 }
1403
1404 else if (isBoxFVar(box, type, name, file)) {
1405 return box;
1406 }
1407
1408 // Wire and Cut
1409
1410 else if (isBoxCut(box)) {
1411 return box;
1412 }
1413
1414 else if (isBoxWire(box)) {
1415 return box;
1416 }
1417
1418 // Primitives
1419
1420 else if (isBoxPrim0(box, &p0)) {
1421 return box;
1422 }
1423
1424 else if (isBoxPrim1(box, &p1)) {
1425 return box;
1426 }
1427
1428 else if (isBoxPrim2(box, &p2)) {
1429 return box;
1430 }
1431
1432 else if (isBoxPrim3(box, &p3)) {
1433 return box;
1434 }
1435
1436 else if (isBoxPrim4(box, &p4)) {
1437 return box;
1438 }
1439
1440 else if (isBoxPrim5(box, &p5)) {
1441 return box;
1442 }
1443
1444 else if (isBoxFFun(box, ff)) {
1445 return box;
1446 }
1447
1448 // User Interface Widgets
1449
1450 else if (isBoxButton(box, label)) {
1451 return box;
1452 }
1453
1454 else if (isBoxCheckbox(box, label)) {
1455 return box;
1456 }
1457
1458 else if (isBoxVSlider(box, label, cur, min, max, step)) {
1459 return box;
1460 }
1461
1462 else if (isBoxHSlider(box, label, cur, min, max, step)) {
1463 return box;
1464 }
1465
1466 else if (isBoxNumEntry(box, label, cur, min, max, step)) {
1467 return box;
1468 }
1469
1470 else if (isBoxVBargraph(box, label, min, max)) {
1471 return box;
1472 }
1473
1474 else if (isBoxHBargraph(box, label, min, max)) {
1475 return box;
1476 }
1477
1478 // User Interface Groups
1479
1480 else if (isBoxVGroup(box, label, t1)) {
1481 return boxVGroup(label, boxSimplification(t1));
1482 }
1483
1484 else if (isBoxHGroup(box, label, t1)) {
1485 return boxHGroup(label, boxSimplification(t1));
1486 }
1487
1488 else if (isBoxTGroup(box, label, t1)) {
1489 return boxTGroup(label, boxSimplification(t1));
1490 }
1491
1492 // Slots and Symbolic Boxes
1493
1494 else if (isBoxSlot(box)) {
1495 return box;;
1496 }
1497
1498 else if (isBoxSymbolic(box, slot, body)){
1499
1500 Tree b = boxSimplification(body);
1501 return boxSymbolic(slot,b);
1502 }
1503
1504 // Block Diagram Composition Algebra
1505
1506 else if (isBoxSeq(box, t1, t2)) {
1507 Tree s1 = boxSimplification(t1);
1508 Tree s2 = boxSimplification(t2);
1509 return boxSeq(s1,s2);
1510 }
1511
1512 else if (isBoxPar(box, t1, t2)) {
1513 Tree s1 = boxSimplification(t1);
1514 Tree s2 = boxSimplification(t2);
1515 return boxPar(s1,s2);
1516 }
1517
1518 else if (isBoxSplit(box, t1, t2)) {
1519 Tree s1 = boxSimplification(t1);
1520 Tree s2 = boxSimplification(t2);
1521 return boxSplit(s1,s2);
1522 }
1523
1524 else if (isBoxMerge(box, t1, t2)) {
1525 Tree s1 = boxSimplification(t1);
1526 Tree s2 = boxSimplification(t2);
1527 return boxMerge(s1,s2);
1528 }
1529 else if (isBoxRec(box, t1, t2)) {
1530 Tree s1 = boxSimplification(t1);
1531 Tree s2 = boxSimplification(t2);
1532 return boxRec(s1,s2);
1533 }
1534
1535 cout << "ERROR in file " << __FILE__ << ':' << __LINE__ << ", unrecognised box expression : " << *box << endl;
1536 exit(1);
1537 return 0;
1538 }
An OCaml-based interpreter for Faust and its vector extension