ae688b1eebd85baf7d11c51c67a1bfda6bf9eb99
1 /************************************************************************
2 ************************************************************************
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.
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.
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 ************************************************************************/
25 * Implementation of the Block diagram evaluator.
27 * A strict lambda-calculus evaluator for block diagram expressions.
34 #include "errormsg.hh"
36 #include "simplify.hh"
37 #include "propagate.hh"
38 #include "patternmatcher.hh"
41 #include "loopDetector.hh"
42 #include "property.hh"
44 #include "compatibility.hh"
48 extern SourceReader gReader
;
49 extern int gMaxNameSize
;
50 extern bool gSimpleNames
;
51 extern bool gSimplifyDiagrams
;
53 // 23/05/2005 : New environment management
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
);
71 static Tree
evalIdDef(Tree id
, Tree visited
, Tree env
);
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
);
81 static Tree
patternSimplification (Tree pattern
);
82 static bool isBoxNumeric (Tree in
, Tree
& out
);
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
);
88 static Tree
boxSimplification(Tree box
);
91 //----------------------
95 * Eval "process" from a list of definitions.
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
101 Tree
evalprocess (Tree eqlist
)
103 Tree b
= a2sb(eval(boxIdent("process"), nil
, pushMultiClosureDefs(eqlist
, nil
, nil
)));
105 if (gSimplifyDiagrams
) {
106 b
= boxSimplification(b
);
113 /* Eval a documentation expression. */
115 Tree
evaldocexpr (Tree docexpr
, Tree eqlist
)
117 return a2sb(eval(docexpr
, nil
, pushMultiClosureDefs(eqlist
, nil
, nil
)));
122 // Private Implementation
123 //------------------------
126 * Transform unused (unapplied) closures into symbolic boxes
128 * @param exp the expression to transform
129 * @return an expression where abstractions have been replaced by symbolic boxes
132 property
<Tree
> gSymbolicBoxProperty
;
134 static Tree
real_a2sb(Tree exp
);
136 static Tree
a2sb(Tree exp
)
141 if (gSymbolicBoxProperty
.get(exp
, result
)) {
145 result
= real_a2sb(exp
);
146 if (result
!= exp
&& getDefNameProperty(exp
, id
)) {
147 setDefNameProperty(result
, id
); // propagate definition name property when needed
149 gSymbolicBoxProperty
.set(exp
, result
);
153 static int gBoxSlotNumber
= 0; ///< counter for unique slot number
155 static Tree
real_a2sb(Tree exp
)
157 Tree abstr
, visited
, unusedEnv
, localValEnv
, var
, name
, body
;
159 if (isClosure(exp
, abstr
, unusedEnv
, visited
, localValEnv
)) {
161 if (isBoxIdent(abstr
)) {
162 // special case introduced with access and components
163 Tree result
= a2sb(eval(abstr
, visited
, localValEnv
));
165 // propagate definition name property when needed
166 if (getDefNameProperty(exp
, name
)) setDefNameProperty(result
, name
);
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
173 Tree slot
= boxSlot(++gBoxSlotNumber
);
174 stringstream s
; s
<< boxpp(var
);
175 setDefNameProperty(slot
, s
.str() ); // ajout YO
177 // Apply the abstraction to the slot
178 Tree result
= boxSymbolic(slot
, a2sb(eval(body
, visited
, pushValueDef(var
, slot
, localValEnv
))));
180 // propagate definition name property when needed
181 if (getDefNameProperty(exp
, name
)) setDefNameProperty(result
, name
);
184 } else if (isBoxEnvironment(abstr
)) {
188 evalerror(yyfilename
, -1, " a2sb : internal error : not an abstraction inside closure ", exp
);
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
196 Tree slot
= boxSlot(++gBoxSlotNumber
);
197 stringstream s
; s
<< "PM" << gBoxSlotNumber
;
198 setDefNameProperty(slot
, s
.str() );
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
))));
203 // propagate definition name property when needed
204 if (getDefNameProperty(exp
, name
)) setDefNameProperty(result
, name
);
208 // it is a constructor : transform each branches
209 unsigned int ar
= exp
->arity();
211 bool modified
= false;
212 for (unsigned int i
= 0; i
< ar
; i
++) {
213 Tree b
= exp
->branch(i
);
216 if (b
!= m
) modified
=true;
218 Tree r
= (modified
) ? CTree::make(exp
->node(), B
) : exp
;
223 static bool autoName(Tree exp
, Tree
& id
)
225 stringstream s
; s
<< boxpp(exp
);
226 id
= tree(s
.str().c_str());
230 bool getArgName(Tree t
, Tree
& id
)
232 //return getDefNameProperty(t, id) || autoName(t, id) ;
233 return autoName(t
, id
) ;
239 * Eval a block diagram expression.
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
247 static loopDetector
LD(1024, 512);
250 static Node
EVALPROPERTY(symbol("EvalProperty"));
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
258 void setEvalProperty(Tree box
, Tree env
, Tree value
)
260 setProperty(box
, tree(EVALPROPERTY
,env
), value
);
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
271 bool getEvalProperty(Tree box
, Tree env
, Tree
& value
)
273 return getProperty(box
, tree(EVALPROPERTY
,env
), value
);
277 static Tree
eval (Tree exp
, Tree visited
, Tree localValEnv
)
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
296 * Eval a block diagram expression.
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
305 static Tree
realeval (Tree exp
, Tree visited
, Tree localValEnv
)
310 Tree var
, num
, body
, ldef
;
312 Tree cur
, lo
, hi
, step
;
313 Tree e1
, e2
, exp2
, notused
, visited2
, lenv2
;
317 //cerr << "EVAL " << *exp << " (visited : " << *visited << ")" << endl;
318 //cerr << "REALEVAL of " << *exp << endl;
320 xtended
* xt
= (xtended
*) getUserData(exp
);
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
) ) {
335 // block-diagram constructors
336 //---------------------------
338 } else if ( isBoxSeq(exp
, e1
, e2
) ) {
339 return boxSeq(eval(e1
, visited
, localValEnv
), eval(e2
, visited
, localValEnv
));
341 } else if ( isBoxPar(exp
, e1
, e2
) ) {
342 return boxPar(eval(e1
, visited
, localValEnv
), eval(e2
, visited
, localValEnv
));
344 } else if ( isBoxRec(exp
, e1
, e2
) ) {
345 return boxRec(eval(e1
, visited
, localValEnv
), eval(e2
, visited
, localValEnv
));
347 } else if ( isBoxSplit(exp
, e1
, e2
) ) {
348 return boxSplit(eval(e1
, visited
, localValEnv
), eval(e2
, visited
, localValEnv
));
350 } else if ( isBoxMerge(exp
, e1
, e2
) ) {
351 return boxMerge(eval(e1
, visited
, localValEnv
), eval(e2
, visited
, localValEnv
));
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
);
362 evalerror(getDefFileProp(exp
), getDefLineProp(exp
), "No environment to access ", exp
);
366 //////////////////////en chantier////////////////////////////
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
);
377 evalerror(getDefFileProp(exp
), getDefLineProp(exp
), "not a closure ", val
);
378 evalerror(getDefFileProp(exp
), getDefLineProp(exp
), "No environment to access ", exp
);
382 ///////////////////////////////////////////////////////////////////
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;
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;
401 // user interface elements
402 //------------------------
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
)));
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
)));
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
))));
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
))));
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
))));
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
) );
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
) );
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
) );
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
)));
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
)));
475 } else if (isBoxIdent(exp
)) {
476 return evalIdDef(exp
, visited
, localValEnv
);
478 } else if (isBoxWithLocalDef(exp
, body
, ldef
)) {
479 return eval(body
, visited
, pushMultiClosureDefs(ldef
, visited
, localValEnv
));
481 } else if (isBoxAppl(exp
, fun
, arg
)) {
482 return applyList( eval(fun
, visited
, localValEnv
),
483 revEvalList(arg
, visited
, localValEnv
) );
485 } else if (isBoxAbstr(exp
)) {
486 // it is an abstraction : return a closure
487 return closure(exp
, nil
, visited
, localValEnv
);
489 } else if (isBoxEnvironment(exp
)) {
490 // environment : return also a closure
491 return closure(exp
, nil
, visited
, localValEnv
);
493 } else if (isClosure(exp
, exp2
, notused
, visited2
, lenv2
)) {
495 if (isBoxAbstr(exp2
)) {
497 return closure(exp2
, nil
, setUnion(visited
,visited2
), lenv2
);
498 } else if (isBoxEnvironment(exp2
)) {
500 return closure(exp2
, nil
, setUnion(visited
,visited2
), lenv2
);
502 // it was a suspended evaluation
503 return eval(exp2
, setUnion(visited
,visited2
), lenv2
);
506 // Algorithmic constructions
507 //--------------------------
509 } else if (isBoxIPar(exp
, var
, num
, body
)) {
510 int n
= eval2int(num
, visited
, localValEnv
);
511 return iteratePar(var
, n
, body
, visited
, localValEnv
);
513 } else if (isBoxISeq(exp
, var
, num
, body
)) {
514 int n
= eval2int(num
, visited
, localValEnv
);
515 return iterateSeq(var
, n
, body
, visited
, localValEnv
);
517 } else if (isBoxISum(exp
, var
, num
, body
)) {
518 int n
= eval2int(num
, visited
, localValEnv
);
519 return iterateSum(var
, n
, body
, visited
, localValEnv
);
521 } else if (isBoxIProd(exp
, var
, num
, body
)) {
522 int n
= eval2int(num
, visited
, localValEnv
);
523 return iterateProd(var
, n
, body
, visited
, localValEnv
);
525 } else if (isBoxSlot(exp
)) {
528 } else if (isBoxSymbolic(exp
)) {
533 // Pattern matching extension
534 //---------------------------
536 } else if (isBoxCase(exp
, rules
)) {
537 return evalCase(rules
, localValEnv
);
539 } else if (isBoxPatternVar(exp
, id
)) {
541 //return evalIdDef(id, visited, localValEnv);
543 } else if (isBoxPatternMatcher(exp
)) {
547 cerr
<< "ERROR : EVAL don't intercept : " << *exp
<< endl
;
552 /* Deconstruct a (BDA) op pattern (YO). */
554 static inline bool isBoxPatternOp(Tree box
, Node
& n
, Tree
& t1
, Tree
& t2
)
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
) )
570 Tree NUMERICPROPERTY
= tree(symbol("NUMERICPROPERTY"));
572 void setNumericProperty(Tree t
, Tree num
)
574 setProperty(t
, NUMERICPROPERTY
, num
);
577 bool getNumericProperty(Tree t
, Tree
& num
)
579 return getProperty(t
, NUMERICPROPERTY
, num
);
583 * Simplify a block-diagram pattern by computing its numerical sub-expressions
584 * \param pattern an evaluated block-diagram
585 * \return a simplified pattern
588 /* uncomment for debugging output */
590 Tree
simplifyPattern (Tree value
)
593 if (!getNumericProperty(value
,num
)) {
594 if (!isBoxNumeric(value
,num
)) {
597 setNumericProperty(value
,num
);
603 static bool isBoxNumeric (Tree in
, Tree
& out
)
605 int numInputs
, numOutputs
;
610 if (isBoxInt(in
, &i
) || isBoxReal(in
, &x
)) {
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
)) {
623 if (isSigInt(res
, &i
)) {
632 static Tree
patternSimplification (Tree pattern
)
638 if (isBoxNumeric(pattern
, v
)) {
640 } else if (isBoxPatternOp(pattern
, n
, t1
, t2
)) {
641 return tree(n
, patternSimplification(t1
), patternSimplification(t2
));
650 * Eval a block diagram to a double.
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
662 static double eval2double (Tree exp
, Tree visited
, Tree localValEnv
)
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
);
671 Tree lsignals
= boxPropagateSig(nil
, diagram
, makeSigInputList(numInputs
) );
672 Tree val
= simplify(hd(lsignals
));
673 return tree2float(val
);
679 * Eval a block diagram to an int.
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
691 static int eval2int (Tree exp
, Tree visited
, Tree localValEnv
)
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
);
700 Tree lsignals
= boxPropagateSig(nil
, diagram
, makeSigInputList(numInputs
) );
701 Tree val
= simplify(hd(lsignals
));
702 return tree2int(val
);
706 static bool isDigitChar(char c
)
708 return (c
>= '0') & (c
<= '9');
711 static bool isIdentChar(char c
)
713 return ((c
>= 'a') & (c
<= 'z')) || ((c
>= 'A') & (c
<= 'Z')) || ((c
>= '0') & (c
<= '9')) || (c
== '_');
716 const char* Formats
[] = {"%d", "%1d", "%2d", "%3d", "%4d"};
718 static char* writeIdentValue(char* dst
, int format
, const char* ident
, Tree visited
, Tree localValEnv
)
720 int n
= eval2int(boxIdent(ident
), visited
, localValEnv
);
721 int i
= min(4,max(format
,0));
723 return dst
+ sprintf(dst
, Formats
[i
], n
);
726 static const char * evalLabel (const char* label
, Tree visited
, Tree localValEnv
)
731 const char* src
= &label
[0];
733 char* id
= &ident
[0];
735 bool parametric
= false;
736 int state
= 0; int format
= 0;
741 // outside ident mode
743 // look ahead for next char
745 *dst
++ = *src
++; // copy escape char and skip one char
747 state
= 1; // prepare ident mode
753 *dst
++ = c
; // copy char
755 } else if (state
== 1) {
757 if (isDigitChar(c
)) {
758 format
= format
*10 + (c
-'0');
767 if (isIdentChar(c
)) {
771 dst
= writeIdentValue(dst
, format
, ident
, visited
, localValEnv
);
780 dst
= writeIdentValue(dst
, format
, ident
, visited
, localValEnv
);
783 return (parametric
) ? strdup(res
) : label
;
789 * Iterate a parallel construction
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
801 static Tree
iteratePar (Tree id
, int num
, Tree body
, Tree visited
, Tree localValEnv
)
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
);
816 * Iterate a sequential construction
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
827 static Tree
iterateSeq (Tree id
, int num
, Tree body
, Tree visited
, Tree localValEnv
)
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
);
842 * Iterate an addition construction
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
854 static Tree
iterateSum (Tree id
, int num
, Tree body
, Tree visited
, Tree localValEnv
)
858 Tree res
= eval(body
, visited
, pushValueDef(id
, tree(0), localValEnv
));
860 for (int i
= 1; i
< num
; i
++) {
861 res
= boxSeq(boxPar(res
, eval(body
, visited
, pushValueDef(id
, tree(i
), localValEnv
))),boxPrim2(sigAdd
)) ;
870 * Iterate a product construction
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
882 static Tree
iterateProd (Tree id
, int num
, Tree body
, Tree visited
, Tree localValEnv
)
886 Tree res
= eval(body
, visited
, pushValueDef(id
, tree(0), localValEnv
));
888 for (int i
= 1; i
< num
; i
++) {
889 res
= boxSeq(boxPar(res
, eval(body
, visited
, pushValueDef(id
, tree(i
), localValEnv
))),boxPrim2(sigMul
)) ;
896 * Compute the sum of outputs of a list of boxes. The sum is
897 * valid if all the boxes have a valid boxType
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
904 static bool boxlistOutputs(Tree boxlist
, int* outputs
)
909 while (!isNil(boxlist
))
911 Tree b
= a2sb(hd(boxlist
)); // for getBoxType, suppose list of evaluated boxes
912 if (getBoxType(b
, &ins
, &outs
)) {
915 // arbitrary output arity set to 1
916 // when can't be determined
919 boxlist
= tl(boxlist
);
921 return isNil(boxlist
);
924 static bool boxlistOutputs(Tree boxlist
, int* outputs
)
929 while (!isNil(boxlist
) && getBoxType(hd(boxlist
), &ins
, &outs
)) {
931 boxlist
= tl(boxlist
);
933 return isNil(boxlist
);
938 * repeat n times a wire
940 static Tree
nwires(int n
)
943 while (n
--) { l
= cons(boxWire(), l
); }
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
955 * @param fun the function to apply
956 * @param larg the list of arguments
957 * @return the resulting expression in normal form
959 static Tree
applyList (Tree fun
, Tree larg
)
977 //cerr << "applyList (" << *fun << ", " << *larg << ")" << endl;
979 if (isNil(larg
)) return fun
;
981 if (isBoxError(fun
) || isBoxError(larg
)) {
985 if (isBoxPatternMatcher(fun
, automat
, state
, envList
, originalRules
, revParamList
)) {
988 vector
<Tree
> envVect
;
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
997 boxPatternMatcher(automat
, state2
, vec2list(envVect
), originalRules
, cons(hd(larg
),revParamList
)),
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
;
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
));
1011 cerr
<< "wrong result from pattern matching (not a closure) : " << boxpp(result
) << endl
;
1016 if (!isClosure(fun
, abstr
, globalDefEnv
, visited
, localValEnv
)) {
1017 // principle : f(a,b,c,...) ==> (a,b,c,...):f
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
);
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
);
1038 cerr
<< "too much arguments : " << outs
<< ", instead of : " << ins
<< endl
;
1039 cerr
<< "when applying : " << boxpp(fun
) << endl
1040 << " to : " << boxpp(larg
) << endl
;
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
);
1054 Tree larg2
= concat(larg
, nwires(ins
-outs
));
1055 return boxSeq(larg2par(larg2
), fun
);
1059 if (isBoxEnvironment(abstr
)) {
1060 evalerrorbox(yyfilename
, -1, "an environment can't be used as a function", fun
);
1064 if (!isBoxAbstr(abstr
, id
, body
)) {
1065 evalerror(yyfilename
, -1, "(internal) not an abstraction inside closure", fun
);
1069 // try to synthetise a name from the function name and the argument name
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
));
1076 if (getDefNameProperty(fun
, fname
)) {
1077 stringstream s
; s
<< tree2str(fname
); if (!gSimpleNames
) s
<< "(" << boxpp(arg
) << ")";
1078 setDefNameProperty(f
, s
.str());
1080 return applyList(f
, tl(larg
));
1087 * Eval a list of expression in reverse order
1089 * Eval a list of expressions returning the list of results in reverse order.
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
1097 static Tree
revEvalList (Tree lexp
, Tree visited
, Tree localValEnv
)
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
);
1107 //cerr << "EXIT revEvalList(" << *lexp_orig << ", env:" << *localValEnv << ") -> " << *result << endl;
1114 * Transform a list of expressions in a parallel construction
1116 * @param larg list of expressions
1117 * @return parallel construction
1119 static Tree
larg2par (Tree larg
)
1122 evalerror(yyfilename
, -1, "empty list of arguments", larg
);
1125 if (isNil(tl(larg
))) {
1128 return boxPar(hd(larg
), larg2par(tl(larg
)));
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
1144 static Tree
evalIdDef(Tree id
, Tree visited
, Tree lenv
)
1148 // search the environment env for a definition of symbol id
1149 while (!isNil(lenv
) && !getProperty(lenv
, id
, def
)) {
1150 lenv
= lenv
->branch(0);
1153 // check that the definition exists
1155 cerr
<< "undefined symbol " << *id
<< endl
;
1156 evalerror(getDefFileProp(id
), getDefLineProp(id
), "undefined symbol ", id
);
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());
1170 // return the evaluated definition
1171 return eval(def
, addElement(p
,visited
), nil
);
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
1182 static Tree
listn (int n
, Tree e
)
1184 return (n
<= 0) ? nil
: cons(e
, listn(n
-1,e
));
1188 * A property to store the pattern matcher corresponding to a set of rules
1189 * in a specific environement
1192 static Node
PMPROPERTYNODE(symbol("PMPROPERTY"));
1194 static void setPMProperty(Tree t
, Tree env
, Tree pm
)
1196 setProperty(t
, tree(PMPROPERTYNODE
, env
), pm
);
1199 static bool getPMProperty(Tree t
, Tree env
, Tree
& pm
)
1201 return getProperty(t
, tree(PMPROPERTYNODE
, env
), pm
);
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
1213 static Tree
evalCase(Tree rules
, Tree env
)
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
);
1226 * Evaluates each rule of the list
1228 static Tree
evalRuleList(Tree rules
, Tree env
)
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
));
1237 * Evaluates the list of patterns and closure the rhs
1239 static Tree
evalRule(Tree rule
, Tree env
)
1241 //cerr << "evalRule "<< *rule << " in " << *env << endl;
1242 return cons(evalPatternList(left(rule
), env
), right(rule
));
1247 * Evaluates each pattern of the list
1249 static Tree
evalPatternList(Tree patterns
, Tree env
)
1251 if (isNil(patterns
)) {
1254 return cons( evalPattern(hd(patterns
), env
),
1255 evalPatternList(tl(patterns
), env
) );
1261 * Evaluates a pattern and simplify it to numerical value
1264 static Tree
evalPattern(Tree pattern
, Tree env
)
1266 Tree p
= eval(pattern
, nil
, env
);
1267 return patternSimplification(p
);
1271 static void list2vec(Tree l
, vector
<Tree
>& v
)
1280 static Tree
vec2list(const vector
<Tree
>& v
)
1284 while (n
--) { l
= cons(v
[n
],l
); }
1291 /////////////////////////////////////////////////////////////////////////////////////////////////////////
1292 // further simplification : replace bloc-diagrams that denote constant number by this number
1293 /////////////////////////////////////////////////////////////////////////////////////////////////////////
1295 static property
<Tree
> SimplifiedBoxProperty
;
1296 static Tree
numericBoxSimplification(Tree box
);
1297 static Tree
insideBoxSimplification (Tree box
);
1300 * boxSimplification(box) : simplify a block-diagram by replacing expressions
1301 * denoting a constant number by this number.
1303 Tree
boxSimplification (Tree box
)
1307 if (SimplifiedBoxProperty
.get(box
,simplified
)) {
1313 simplified
= numericBoxSimplification(box
);
1315 // transferts name property if any
1316 Tree name
; if (getDefNameProperty(box
, name
)) setDefNameProperty(simplified
, name
);
1318 // attach simplified expression as a property of original box
1319 SimplifiedBoxProperty
.set(box
,simplified
);
1326 * Try to do a numeric simplification of a block-diagram
1328 Tree
numericBoxSimplification(Tree box
)
1335 if ( ! getBoxType(box
, &ins
, &outs
)) {
1336 cout
<< "ERROR in file " << __FILE__
<< ':' << __LINE__
<< ", Can't compute the box type of : " << *box
<< endl
;
1340 if (ins
==0 && outs
==1) {
1341 // this box can potentially denote a number
1342 if (isBoxInt(box
, &i
) || isBoxReal(box
, &x
)) {
1345 // propagate signals to discover if it simplifies to a number
1348 Tree lsignals
= boxPropagateSig(nil
, box
, makeSigInputList(0));
1349 Tree s
= simplify(hd(lsignals
));
1351 if (isSigReal(s
, &x
)) {
1352 result
= boxReal(x
);
1353 } else if (isSigInt(s
, &i
)) {
1356 result
= insideBoxSimplification(box
);
1360 // this box can't denote a number
1361 result
= insideBoxSimplification(box
);
1367 * Simplify inside a block-diagram : S[A*B] => S[A]*S[B]
1369 Tree
insideBoxSimplification (Tree box
)
1380 Tree t1
, t2
, ff
, label
, cur
, min
, max
, step
, type
, name
, file
, slot
, body
;
1383 xtended
* xt
= (xtended
*)getUserData(box
);
1385 // Extended Primitives
1391 // Numbers and Constants
1393 else if (isBoxInt(box
, &i
)) {
1396 else if (isBoxReal(box
, &r
)) {
1400 else if (isBoxFConst(box
, type
, name
, file
)) {
1404 else if (isBoxFVar(box
, type
, name
, file
)) {
1410 else if (isBoxCut(box
)) {
1414 else if (isBoxWire(box
)) {
1420 else if (isBoxPrim0(box
, &p0
)) {
1424 else if (isBoxPrim1(box
, &p1
)) {
1428 else if (isBoxPrim2(box
, &p2
)) {
1432 else if (isBoxPrim3(box
, &p3
)) {
1436 else if (isBoxPrim4(box
, &p4
)) {
1440 else if (isBoxPrim5(box
, &p5
)) {
1444 else if (isBoxFFun(box
, ff
)) {
1448 // User Interface Widgets
1450 else if (isBoxButton(box
, label
)) {
1454 else if (isBoxCheckbox(box
, label
)) {
1458 else if (isBoxVSlider(box
, label
, cur
, min
, max
, step
)) {
1462 else if (isBoxHSlider(box
, label
, cur
, min
, max
, step
)) {
1466 else if (isBoxNumEntry(box
, label
, cur
, min
, max
, step
)) {
1470 else if (isBoxVBargraph(box
, label
, min
, max
)) {
1474 else if (isBoxHBargraph(box
, label
, min
, max
)) {
1478 // User Interface Groups
1480 else if (isBoxVGroup(box
, label
, t1
)) {
1481 return boxVGroup(label
, boxSimplification(t1
));
1484 else if (isBoxHGroup(box
, label
, t1
)) {
1485 return boxHGroup(label
, boxSimplification(t1
));
1488 else if (isBoxTGroup(box
, label
, t1
)) {
1489 return boxTGroup(label
, boxSimplification(t1
));
1492 // Slots and Symbolic Boxes
1494 else if (isBoxSlot(box
)) {
1498 else if (isBoxSymbolic(box
, slot
, body
)){
1500 Tree b
= boxSimplification(body
);
1501 return boxSymbolic(slot
,b
);
1504 // Block Diagram Composition Algebra
1506 else if (isBoxSeq(box
, t1
, t2
)) {
1507 Tree s1
= boxSimplification(t1
);
1508 Tree s2
= boxSimplification(t2
);
1509 return boxSeq(s1
,s2
);
1512 else if (isBoxPar(box
, t1
, t2
)) {
1513 Tree s1
= boxSimplification(t1
);
1514 Tree s2
= boxSimplification(t2
);
1515 return boxPar(s1
,s2
);
1518 else if (isBoxSplit(box
, t1
, t2
)) {
1519 Tree s1
= boxSimplification(t1
);
1520 Tree s2
= boxSimplification(t2
);
1521 return boxSplit(s1
,s2
);
1524 else if (isBoxMerge(box
, t1
, t2
)) {
1525 Tree s1
= boxSimplification(t1
);
1526 Tree s2
= boxSimplification(t2
);
1527 return boxMerge(s1
,s2
);
1529 else if (isBoxRec(box
, t1
, t2
)) {
1530 Tree s1
= boxSimplification(t1
);
1531 Tree s2
= boxSimplification(t2
);
1532 return boxRec(s1
,s2
);
1535 cout
<< "ERROR in file " << __FILE__
<< ':' << __LINE__
<< ", unrecognised box expression : " << *box
<< endl
;