1 /************************************************************************
2  ************************************************************************
3     FAUST compiler
4     Copyright (C) 2003-2018 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 
22 /*****************************************************************************
23 ******************************************************************************
24 
25                                 The Box Language
26 
27 ******************************************************************************
28 *****************************************************************************/
29 
30 /**\file boxes.cpp
31  * \author Yann Orlarey
32  * \version 1.0
33  * \date 2003
34  * \brief Implementation of block diagram expressions.
35  *  Boxes are created using five main connection operations : sequential (:),
36  *  parallel (,), split (<:), merge (:>), and recursive (~).
37  */
38 
39 #include "boxes.hh"
40 #include <stdio.h>
41 #include <string.h>
42 #include "exception.hh"
43 #include "global.hh"
44 #include "ppbox.hh"
45 #include "prim2.hh"
46 #include "xtended.hh"
47 
48 /*****************************************************************************
49                                     Identifiers
50 *****************************************************************************/
51 
boxIdent(const char * name)52 Tree boxIdent(const char* name)
53 {
54     return tree(gGlobal->BOXIDENT, tree(symbol(name)));
55 }
isBoxIdent(Tree t)56 bool isBoxIdent(Tree t)
57 {
58     return t->node() == Node(gGlobal->BOXIDENT);
59 }
isBoxIdent(Tree t0,const char ** str)60 bool isBoxIdent(Tree t0, const char** str)
61 {
62     Tree t1;
63     Sym  s;
64     if (isTree(t0, gGlobal->BOXIDENT, t1) && isSym(t1->node(), &s)) {
65         *str = name(s);
66         return true;
67     } else {
68         return false;
69     }
70 }
71 
72 /*****************************************************************************
73                                     Numbers
74 *****************************************************************************/
75 
boxInt(int n)76 EXPORT Tree boxInt(int n)
77 {
78     return tree(n);
79 }
boxReal(double n)80 EXPORT Tree boxReal(double n)
81 {
82     return tree(n);
83 }
84 
isBoxInt(Tree t)85 bool isBoxInt(Tree t)
86 {
87     return isInt(t->node());
88 }
isBoxReal(Tree t)89 bool isBoxReal(Tree t)
90 {
91     return isDouble(t->node());
92 }
93 
isBoxInt(Tree t,int * i)94 bool isBoxInt(Tree t, int* i)
95 {
96     return isInt(t->node(), i);
97 }
isBoxReal(Tree t,double * r)98 bool isBoxReal(Tree t, double* r)
99 {
100     return isDouble(t->node(), r);
101 }
102 
103 /*****************************************************************************
104                              Waveform
105 *****************************************************************************/
106 
boxWaveform(const tvec & br)107 EXPORT Tree boxWaveform(const tvec& br)
108 {
109     return tree(gGlobal->BOXWAVEFORM, br);
110 }
111 
isBoxWaveform(Tree s)112 bool isBoxWaveform(Tree s)
113 {
114     return isTree(s, gGlobal->BOXWAVEFORM);
115 }
116 
117 /*****************************************************************************
118                              Route
119 *****************************************************************************/
120 
boxRoute(Tree n,Tree m,Tree r)121 EXPORT Tree boxRoute(Tree n, Tree m, Tree r)
122 {
123     return tree(gGlobal->BOXROUTE, n, m, r);
124 }
125 
isBoxRoute(Tree s,Tree & n,Tree & m,Tree & r)126 bool isBoxRoute(Tree s, Tree& n, Tree& m, Tree& r)
127 {
128     return isTree(s, gGlobal->BOXROUTE, n, m, r);
129 }
130 
131 /*****************************************************************************
132                                 Wire and Cut
133 *****************************************************************************/
134 
boxCut()135 EXPORT Tree boxCut()
136 {
137     return tree(gGlobal->BOXCUT);
138 }
isBoxCut(Tree t)139 bool isBoxCut(Tree t)
140 {
141     return isTree(t, gGlobal->BOXCUT);
142 }
143 
boxWire()144 EXPORT Tree boxWire()
145 {
146     return tree(gGlobal->BOXWIRE);
147 }
isBoxWire(Tree t)148 bool isBoxWire(Tree t)
149 {
150     return isTree(t, gGlobal->BOXWIRE);
151 }
152 
153 /*****************************************************************************
154                         Symbolic Boxes with symbolic slots
155 *****************************************************************************/
156 
boxSlot(int id)157 Tree boxSlot(int id)
158 {
159     return tree(gGlobal->BOXSLOT, tree(id));
160 }
isBoxSlot(Tree t)161 bool isBoxSlot(Tree t)
162 {
163     Tree w;
164     return isTree(t, gGlobal->BOXSLOT, w);
165 }
isBoxSlot(Tree t,int * id)166 bool isBoxSlot(Tree t, int* id)
167 {
168     Tree w;
169     return isTree(t, gGlobal->BOXSLOT, w) && isInt(w->node(), id);
170 }
171 
boxSymbolic(Tree slot,Tree body)172 Tree boxSymbolic(Tree slot, Tree body)
173 {
174     return tree(gGlobal->BOXSYMBOLIC, slot, body);
175 }
isBoxSymbolic(Tree t)176 bool isBoxSymbolic(Tree t)
177 {
178     Tree slot, body;
179     return isTree(t, gGlobal->BOXSYMBOLIC, slot, body);
180 }
isBoxSymbolic(Tree t,Tree & slot,Tree & body)181 bool isBoxSymbolic(Tree t, Tree& slot, Tree& body)
182 {
183     return isTree(t, gGlobal->BOXSYMBOLIC, slot, body);
184 }
185 
186 /*****************************************************************************
187                               Composition of Boxes
188 *****************************************************************************/
189 
boxSeq(Tree x,Tree y)190 EXPORT Tree boxSeq(Tree x, Tree y)
191 {
192     return tree(gGlobal->BOXSEQ, x, y);
193 }
isBoxSeq(Tree t,Tree & x,Tree & y)194 bool isBoxSeq(Tree t, Tree& x, Tree& y)
195 {
196     return isTree(t, gGlobal->BOXSEQ, x, y);
197 }
198 
boxPar(Tree x,Tree y)199 EXPORT Tree boxPar(Tree x, Tree y)
200 {
201     return tree(gGlobal->BOXPAR, x, y);
202 }
isBoxPar(Tree t,Tree & x,Tree & y)203 bool isBoxPar(Tree t, Tree& x, Tree& y)
204 {
205     return isTree(t, gGlobal->BOXPAR, x, y);
206 }
207 
boxRec(Tree x,Tree y)208 EXPORT Tree boxRec(Tree x, Tree y)
209 {
210     return tree(gGlobal->BOXREC, x, y);
211 }
isBoxRec(Tree t,Tree & x,Tree & y)212 bool isBoxRec(Tree t, Tree& x, Tree& y)
213 {
214     return isTree(t, gGlobal->BOXREC, x, y);
215 }
216 
boxSplit(Tree x,Tree y)217 EXPORT Tree boxSplit(Tree x, Tree y)
218 {
219     return tree(gGlobal->BOXSPLIT, x, y);
220 }
isBoxSplit(Tree t,Tree & x,Tree & y)221 bool isBoxSplit(Tree t, Tree& x, Tree& y)
222 {
223     return isTree(t, gGlobal->BOXSPLIT, x, y);
224 }
225 
boxMerge(Tree x,Tree y)226 EXPORT Tree boxMerge(Tree x, Tree y)
227 {
228     return tree(gGlobal->BOXMERGE, x, y);
229 }
isBoxMerge(Tree t,Tree & x,Tree & y)230 bool isBoxMerge(Tree t, Tree& x, Tree& y)
231 {
232     return isTree(t, gGlobal->BOXMERGE, x, y);
233 }
234 
235 /*****************************************************************************
236                         Algorithmic Composition of Boxes
237 *****************************************************************************/
238 
boxIPar(Tree x,Tree y,Tree z)239 Tree boxIPar(Tree x, Tree y, Tree z)
240 {
241     return tree(gGlobal->BOXIPAR, x, y, z);
242 }
boxISeq(Tree x,Tree y,Tree z)243 Tree boxISeq(Tree x, Tree y, Tree z)
244 {
245     return tree(gGlobal->BOXISEQ, x, y, z);
246 }
boxISum(Tree x,Tree y,Tree z)247 Tree boxISum(Tree x, Tree y, Tree z)
248 {
249     return tree(gGlobal->BOXISUM, x, y, z);
250 }
boxIProd(Tree x,Tree y,Tree z)251 Tree boxIProd(Tree x, Tree y, Tree z)
252 {
253     return tree(gGlobal->BOXIPROD, x, y, z);
254 }
255 
isBoxIPar(Tree t,Tree & x,Tree & y,Tree & z)256 bool isBoxIPar(Tree t, Tree& x, Tree& y, Tree& z)
257 {
258     return isTree(t, gGlobal->BOXIPAR, x, y, z);
259 }
isBoxISeq(Tree t,Tree & x,Tree & y,Tree & z)260 bool isBoxISeq(Tree t, Tree& x, Tree& y, Tree& z)
261 {
262     return isTree(t, gGlobal->BOXISEQ, x, y, z);
263 }
isBoxISum(Tree t,Tree & x,Tree & y,Tree & z)264 bool isBoxISum(Tree t, Tree& x, Tree& y, Tree& z)
265 {
266     return isTree(t, gGlobal->BOXISUM, x, y, z);
267 }
isBoxIProd(Tree t,Tree & x,Tree & y,Tree & z)268 bool isBoxIProd(Tree t, Tree& x, Tree& y, Tree& z)
269 {
270     return isTree(t, gGlobal->BOXIPROD, x, y, z);
271 }
272 
273 /*****************************************************************************
274                         Static information on Boxes
275 *****************************************************************************/
276 
boxInputs(Tree x)277 Tree boxInputs(Tree x)
278 {
279     return tree(gGlobal->BOXINPUTS, x);
280 }
boxOutputs(Tree x)281 Tree boxOutputs(Tree x)
282 {
283     return tree(gGlobal->BOXOUTPUTS, x);
284 }
285 
isBoxInputs(Tree t,Tree & x)286 bool isBoxInputs(Tree t, Tree& x)
287 {
288     return isTree(t, gGlobal->BOXINPUTS, x);
289 }
isBoxOutputs(Tree t,Tree & x)290 bool isBoxOutputs(Tree t, Tree& x)
291 {
292     return isTree(t, gGlobal->BOXOUTPUTS, x);
293 }
294 
295 /*****************************************************************************
296                               Lambda-Calculus of Boxes
297 *****************************************************************************/
298 
boxAbstr(Tree x,Tree y)299 Tree boxAbstr(Tree x, Tree y)
300 {
301     return tree(gGlobal->BOXABSTR, x, y);
302 }
boxAppl(Tree x,Tree y)303 Tree boxAppl(Tree x, Tree y)
304 {
305     return tree(gGlobal->BOXAPPL, x, y);
306 }
307 
isBoxAbstr(Tree t)308 bool isBoxAbstr(Tree t)
309 {
310     return t->node() == Node(gGlobal->BOXABSTR);
311 }
isBoxAppl(Tree t)312 bool isBoxAppl(Tree t)
313 {
314     return t->node() == Node(gGlobal->BOXAPPL);
315 }
316 
isBoxAbstr(Tree t,Tree & x,Tree & y)317 bool isBoxAbstr(Tree t, Tree& x, Tree& y)
318 {
319     return isTree(t, gGlobal->BOXABSTR, x, y);
320 }
isBoxAppl(Tree t,Tree & x,Tree & y)321 bool isBoxAppl(Tree t, Tree& x, Tree& y)
322 {
323     return isTree(t, gGlobal->BOXAPPL, x, y);
324 }
325 
buildBoxAbstr(Tree largs,Tree body)326 Tree buildBoxAbstr(Tree largs, Tree body)
327 {
328     if (isNil(largs)) {
329         return body;
330     } else {
331         return buildBoxAbstr(tl(largs), boxAbstr(hd(largs), body));
332     }
333 }
334 
335 #if 0
336 Tree buildBoxAppl(Tree fun, Tree revarglist)
337 {
338 	if (isNil(revarglist)) {
339 		return fun;
340 	} else {
341 		return  boxAppl(buildBoxAppl(fun, tl(revarglist)), hd(revarglist));
342 	}
343 }
344 #else
345 
buildBoxAppl(Tree fun,Tree revarglist)346 Tree buildBoxAppl(Tree fun, Tree revarglist)
347 {
348     if (isNil(revarglist)) {
349         // TO CHECK !!!!!!
350         throw faustexception("ERROR : buildBoxAppl called with null revarglist\n");
351     }
352     return boxAppl(fun, revarglist);
353 }
354 #endif
355 
closure(Tree abstr,Tree genv,Tree vis,Tree lenv)356 Tree closure(Tree abstr, Tree genv, Tree vis, Tree lenv)
357 {
358     return tree(gGlobal->CLOSURE, abstr, genv, vis, lenv);
359 }
360 
isClosure(Tree t,Tree & abstr,Tree & genv,Tree & vis,Tree & lenv)361 bool isClosure(Tree t, Tree& abstr, Tree& genv, Tree& vis, Tree& lenv)
362 {
363     return isTree(t, gGlobal->CLOSURE, abstr, genv, vis, lenv);
364 }
365 
boxError()366 Tree boxError()
367 {
368     return tree(gGlobal->BOXERROR);
369 }
370 
isBoxError(Tree t)371 bool isBoxError(Tree t)
372 {
373     return isTree(t, gGlobal->BOXERROR);
374 }
375 
boxAccess(Tree exp,Tree id)376 Tree boxAccess(Tree exp, Tree id)
377 {
378     return tree(gGlobal->BOXACCESS, exp, id);
379 }
isBoxAccess(Tree t,Tree & exp,Tree & id)380 bool isBoxAccess(Tree t, Tree& exp, Tree& id)
381 {
382     return isTree(t, gGlobal->BOXACCESS, exp, id);
383 }
384 
385 /*****************************************************************************
386                         Boxes with local definitions
387 *****************************************************************************/
388 
boxWithLocalDef(Tree body,Tree ldef)389 Tree boxWithLocalDef(Tree body, Tree ldef)
390 {
391     return tree(gGlobal->BOXWITHLOCALDEF, body, ldef);
392 }
isBoxWithLocalDef(Tree t,Tree & body,Tree & ldef)393 bool isBoxWithLocalDef(Tree t, Tree& body, Tree& ldef)
394 {
395     return isTree(t, gGlobal->BOXWITHLOCALDEF, body, ldef);
396 }
397 
398 /*****************************************************************************
399  Boxes with recursive definitions
400  *****************************************************************************/
401 
402 // def2names transforms a liste of definition (name.expression) into a list of name
def2names(Tree ldef)403 static Tree def2names(Tree ldef)
404 {
405     if (isNil(ldef)) {
406         return gGlobal->nil;
407     } else {
408         Tree def = hd(ldef);
409         return cons(hd(def), def2names(tl(ldef)));
410     }
411 }
412 
413 // def2exp transforms a list of definition (name.expression) into a list of expressions
def2exp(Tree ldef)414 static Tree def2exp(Tree ldef)
415 {
416     if (isNil(ldef)) {
417         return gGlobal->nil;
418     } else {
419         Tree def = hd(ldef);
420         return cons(tl(def), def2exp(tl(ldef)));
421     }
422 }
423 
424 // makeBus(3) => "_,_,_"
makeBus(int n)425 static Tree makeBus(int n)
426 {
427     return (n <= 1) ? boxWire() : boxPar(boxWire(), makeBus(n - 1));
428 }
429 
430 // makeParList((a,b,d)) => "a,b,c"
makeParList(Tree lexp)431 static Tree makeParList(Tree lexp)
432 {
433     Tree l2 = tl(lexp);
434     if (isNil(l2)) {
435         return hd(lexp);
436     } else {
437         return boxPar(hd(lexp), makeParList(l2));
438     }
439 }
440 
441 // makeBoxAbstr(largs,body) => \(lnames).(body)
makeBoxAbstr(Tree largs,Tree body)442 static Tree makeBoxAbstr(Tree largs, Tree body)
443 {
444     if (isNil(largs)) {
445         return body;
446     } else {
447         return boxAbstr(hd(largs), makeBoxAbstr(tl(largs), body));
448     }
449 }
450 
451 // makeSelector(5,2) => "!,!,_,!,!"
makeSelector(int n,int i)452 static Tree makeSelector(int n, int i)
453 {
454     Tree op = (i == 0) ? boxWire() : boxCut();
455     return (n == 1) ? op : boxPar(op, makeSelector(n - 1, i - 1));
456 }
457 
458 // defines each symbol si of lnames as => "si = RECURSIVEBODY : select(n,i);"
makeRecProjectionsList(int n,int i,Tree lnames,Tree ldef)459 static Tree makeRecProjectionsList(int n, int i, Tree lnames, Tree ldef)
460 {
461     if (i == n) {
462         return ldef;
463     } else {
464         Tree sel = boxSeq(gGlobal->LETRECBODY, makeSelector(n, i));
465         return cons(cons(hd(lnames), sel), makeRecProjectionsList(n, i + 1, tl(lnames), ldef));
466     }
467 }
468 
469 // buildRecursiveBodyDef(n,lnames,lexp) => "RECURSIVEBODY = \(lnames).(lexp) ~ bus(n);"
buildRecursiveBodyDef(int n,Tree lnames,Tree lexp)470 static Tree buildRecursiveBodyDef(int n, Tree lnames, Tree lexp)
471 {
472     return cons(gGlobal->LETRECBODY, boxRec(makeBoxAbstr(lnames, makeParList(lexp)), makeBus(n)));
473 }
474 
475 //----------------------------------------------------------------------------
476 // Transform a letrec expression into a with expression
477 //----------------------------------------------------------------------------
boxWithRecDef(Tree body,Tree ldef)478 Tree boxWithRecDef(Tree body, Tree ldef)
479 {
480     // cout << "list of recursive definitions : " << *ldef << endl;
481     Tree lnames = def2names(ldef);
482     Tree lexp   = def2exp(ldef);
483     int  n      = len(ldef);
484 
485     Tree rdef = buildRecursiveBodyDef(n, lnames, lexp);
486     Tree lrp  = makeRecProjectionsList(n, 0, lnames, gGlobal->nil);
487     Tree w    = boxWithLocalDef(body, cons(rdef, lrp));
488     // cerr << "boxWithRecDef(" << boxpp(body) << ',' << *ldef << ") -> " << boxpp(w) << endl;
489     return w;
490 }
491 
492 /*****************************************************************************
493                         Boxes modif local definitions
494 *****************************************************************************/
495 
boxModifLocalDef(Tree body,Tree ldef)496 Tree boxModifLocalDef(Tree body, Tree ldef)
497 {
498     return tree(gGlobal->BOXMODIFLOCALDEF, body, ldef);
499 }
isBoxModifLocalDef(Tree t,Tree & body,Tree & ldef)500 bool isBoxModifLocalDef(Tree t, Tree& body, Tree& ldef)
501 {
502     return isTree(t, gGlobal->BOXMODIFLOCALDEF, body, ldef);
503 }
504 
505 /*****************************************************************************
506                              Modules
507 *****************************************************************************/
508 
boxEnvironment()509 Tree boxEnvironment()
510 {
511     return tree(gGlobal->BOXENVIRONMENT);
512 }
isBoxEnvironment(Tree s)513 bool isBoxEnvironment(Tree s)
514 {
515     return isTree(s, gGlobal->BOXENVIRONMENT);
516 }
517 
boxComponent(Tree filename)518 Tree boxComponent(Tree filename)
519 {
520     return tree(gGlobal->BOXCOMPONENT, filename);
521 }
isBoxComponent(Tree s,Tree & filename)522 bool isBoxComponent(Tree s, Tree& filename)
523 {
524     return isTree(s, gGlobal->BOXCOMPONENT, filename);
525 }
526 
boxLibrary(Tree filename)527 Tree boxLibrary(Tree filename)
528 {
529     return tree(gGlobal->BOXLIBRARY, filename);
530 }
isBoxLibrary(Tree s,Tree & filename)531 bool isBoxLibrary(Tree s, Tree& filename)
532 {
533     return isTree(s, gGlobal->BOXLIBRARY, filename);
534 }
535 
importFile(Tree filename)536 Tree importFile(Tree filename)
537 {
538     return tree(gGlobal->IMPORTFILE, filename);
539 }
isImportFile(Tree s,Tree & filename)540 bool isImportFile(Tree s, Tree& filename)
541 {
542     return isTree(s, gGlobal->IMPORTFILE, filename);
543 }
544 
545 /*****************************************************************************
546                             External Primitive Boxes (n -> 1)
547 *****************************************************************************/
548 
boxPrim0(prim0 foo)549 Tree boxPrim0(prim0 foo)
550 {
551     return tree(gGlobal->BOXPRIM0, tree((void*)foo));
552 }
isBoxPrim0(Tree s)553 bool isBoxPrim0(Tree s)
554 {
555     Tree t;
556     return isTree(s, gGlobal->BOXPRIM0, t);
557 }
isBoxPrim0(Tree s,prim0 * p)558 bool isBoxPrim0(Tree s, prim0* p)
559 {
560     Tree t;
561     return isTree(s, gGlobal->BOXPRIM0, t) && isPointer(t->node(), (void**)p);
562 }
563 
boxPrim1(prim1 foo)564 Tree boxPrim1(prim1 foo)
565 {
566     return tree(gGlobal->BOXPRIM1, tree((void*)foo));
567 }
isBoxPrim1(Tree s)568 bool isBoxPrim1(Tree s)
569 {
570     Tree t;
571     return isTree(s, gGlobal->BOXPRIM1, t);
572 }
isBoxPrim1(Tree s,prim1 * p)573 bool isBoxPrim1(Tree s, prim1* p)
574 {
575     Tree t;
576     return isTree(s, gGlobal->BOXPRIM1, t) && isPointer(t->node(), (void**)p);
577 }
578 
boxPrim2(prim2 foo)579 Tree boxPrim2(prim2 foo)
580 {
581     return tree(gGlobal->BOXPRIM2, tree((void*)foo));
582 }
isBoxPrim2(Tree s)583 bool isBoxPrim2(Tree s)
584 {
585     Tree t;
586     return isTree(s, gGlobal->BOXPRIM2, t);
587 }
isBoxPrim2(Tree s,prim2 * p)588 bool isBoxPrim2(Tree s, prim2* p)
589 {
590     Tree t;
591     return isTree(s, gGlobal->BOXPRIM2, t) && isPointer(t->node(), (void**)p);
592 }
593 
boxPrim3(prim3 foo)594 Tree boxPrim3(prim3 foo)
595 {
596     return tree(gGlobal->BOXPRIM3, tree((void*)foo));
597 }
isBoxPrim3(Tree s)598 bool isBoxPrim3(Tree s)
599 {
600     Tree t;
601     return isTree(s, gGlobal->BOXPRIM3, t);
602 }
isBoxPrim3(Tree s,prim3 * p)603 bool isBoxPrim3(Tree s, prim3* p)
604 {
605     Tree t;
606     return isTree(s, gGlobal->BOXPRIM3, t) && isPointer(t->node(), (void**)p);
607 }
608 
boxPrim4(prim4 foo)609 Tree boxPrim4(prim4 foo)
610 {
611     return tree(gGlobal->BOXPRIM4, tree((void*)foo));
612 }
isBoxPrim4(Tree s)613 bool isBoxPrim4(Tree s)
614 {
615     Tree t;
616     return isTree(s, gGlobal->BOXPRIM4, t);
617 }
isBoxPrim4(Tree s,prim4 * p)618 bool isBoxPrim4(Tree s, prim4* p)
619 {
620     Tree t;
621     return isTree(s, gGlobal->BOXPRIM4, t) && isPointer(t->node(), (void**)p);
622 }
623 
boxPrim5(prim5 foo)624 Tree boxPrim5(prim5 foo)
625 {
626     return tree(gGlobal->BOXPRIM5, tree((void*)foo));
627 }
isBoxPrim5(Tree s)628 bool isBoxPrim5(Tree s)
629 {
630     Tree t;
631     return isTree(s, gGlobal->BOXPRIM5, t);
632 }
isBoxPrim5(Tree s,prim5 * p)633 bool isBoxPrim5(Tree s, prim5* p)
634 {
635     Tree t;
636     return isTree(s, gGlobal->BOXPRIM5, t) && isPointer(t->node(), (void**)p);
637 }
638 
639 /*****************************************************************************
640                              Foreign Functions
641 *****************************************************************************/
642 
boxFFun(Tree ff)643 EXPORT Tree boxFFun(Tree ff)
644 {
645     return tree(gGlobal->BOXFFUN, ff);
646 }
isBoxFFun(Tree s)647 bool isBoxFFun(Tree s)
648 {
649     Tree ff;
650     return isTree(s, gGlobal->BOXFFUN, ff);
651 }
isBoxFFun(Tree s,Tree & ff)652 bool isBoxFFun(Tree s, Tree& ff)
653 {
654     return isTree(s, gGlobal->BOXFFUN, ff);
655 }
656 
boxFConst(Tree type,Tree name,Tree file)657 EXPORT Tree boxFConst(Tree type, Tree name, Tree file)
658 {
659     return tree(gGlobal->BOXFCONST, type, name, file);
660 }
isBoxFConst(Tree s)661 bool isBoxFConst(Tree s)
662 {
663     Tree t, n, f;
664     return isTree(s, gGlobal->BOXFCONST, t, n, f);
665 }
isBoxFConst(Tree s,Tree & type,Tree & name,Tree & file)666 bool isBoxFConst(Tree s, Tree& type, Tree& name, Tree& file)
667 {
668     return isTree(s, gGlobal->BOXFCONST, type, name, file);
669 }
670 
boxFVar(Tree type,Tree name,Tree file)671 EXPORT Tree boxFVar(Tree type, Tree name, Tree file)
672 {
673     return tree(gGlobal->BOXFVAR, type, name, file);
674 }
isBoxFVar(Tree s)675 bool isBoxFVar(Tree s)
676 {
677     Tree t, n, f;
678     return isTree(s, gGlobal->BOXFVAR, t, n, f);
679 }
isBoxFVar(Tree s,Tree & type,Tree & name,Tree & file)680 bool isBoxFVar(Tree s, Tree& type, Tree& name, Tree& file)
681 {
682     return isTree(s, gGlobal->BOXFVAR, type, name, file);
683 }
684 
685 /*****************************************************************************
686                              User Interface Elements
687 *****************************************************************************/
688 
boxButton(Tree lbl)689 EXPORT Tree boxButton(Tree lbl)
690 {
691     return tree(gGlobal->BOXBUTTON, lbl);
692 }
isBoxButton(Tree s)693 bool isBoxButton(Tree s)
694 {
695     Tree lbl;
696     return isTree(s, gGlobal->BOXBUTTON, lbl);
697 }
isBoxButton(Tree s,Tree & lbl)698 bool isBoxButton(Tree s, Tree& lbl)
699 {
700     return isTree(s, gGlobal->BOXBUTTON, lbl);
701 }
702 
boxCheckbox(Tree lbl)703 EXPORT Tree boxCheckbox(Tree lbl)
704 {
705     return tree(gGlobal->BOXCHECKBOX, lbl);
706 }
isBoxCheckbox(Tree s)707 bool isBoxCheckbox(Tree s)
708 {
709     Tree lbl;
710     return isTree(s, gGlobal->BOXCHECKBOX, lbl);
711 }
isBoxCheckbox(Tree s,Tree & lbl)712 bool isBoxCheckbox(Tree s, Tree& lbl)
713 {
714     return isTree(s, gGlobal->BOXCHECKBOX, lbl);
715 }
716 
boxHSlider(Tree lbl,Tree cur,Tree min,Tree max,Tree step)717 EXPORT Tree boxHSlider(Tree lbl, Tree cur, Tree min, Tree max, Tree step)
718 {
719     return tree(gGlobal->BOXHSLIDER, lbl, list4(cur, min, max, step));
720 }
isBoxHSlider(Tree s)721 bool isBoxHSlider(Tree s)
722 {
723     Tree lbl, params;
724     return isTree(s, gGlobal->BOXHSLIDER, lbl, params);
725 }
726 
isBoxHSlider(Tree s,Tree & lbl,Tree & cur,Tree & min,Tree & max,Tree & step)727 bool isBoxHSlider(Tree s, Tree& lbl, Tree& cur, Tree& min, Tree& max, Tree& step)
728 {
729     Tree params;
730     if (isTree(s, gGlobal->BOXHSLIDER, lbl, params)) {
731         cur  = nth(params, 0);
732         min  = nth(params, 1);
733         max  = nth(params, 2);
734         step = nth(params, 3);
735         return true;
736     } else {
737         return false;
738     }
739 }
740 
boxVSlider(Tree lbl,Tree cur,Tree min,Tree max,Tree step)741 EXPORT Tree boxVSlider(Tree lbl, Tree cur, Tree min, Tree max, Tree step)
742 {
743     return tree(gGlobal->BOXVSLIDER, lbl, list4(cur, min, max, step));
744 }
isBoxVSlider(Tree s)745 bool isBoxVSlider(Tree s)
746 {
747     Tree lbl, params;
748     return isTree(s, gGlobal->BOXVSLIDER, lbl, params);
749 }
750 
isBoxVSlider(Tree s,Tree & lbl,Tree & cur,Tree & min,Tree & max,Tree & step)751 bool isBoxVSlider(Tree s, Tree& lbl, Tree& cur, Tree& min, Tree& max, Tree& step)
752 {
753     Tree params;
754     if (isTree(s, gGlobal->BOXVSLIDER, lbl, params)) {
755         cur  = nth(params, 0);
756         min  = nth(params, 1);
757         max  = nth(params, 2);
758         step = nth(params, 3);
759         return true;
760     } else {
761         return false;
762     }
763 }
764 
boxNumEntry(Tree lbl,Tree cur,Tree min,Tree max,Tree step)765 EXPORT Tree boxNumEntry(Tree lbl, Tree cur, Tree min, Tree max, Tree step)
766 {
767     return tree(gGlobal->BOXNUMENTRY, lbl, list4(cur, min, max, step));
768 }
isBoxNumEntry(Tree s)769 bool isBoxNumEntry(Tree s)
770 {
771     Tree lbl, params;
772     return isTree(s, gGlobal->BOXNUMENTRY, lbl, params);
773 }
774 
isBoxNumEntry(Tree s,Tree & lbl,Tree & cur,Tree & min,Tree & max,Tree & step)775 bool isBoxNumEntry(Tree s, Tree& lbl, Tree& cur, Tree& min, Tree& max, Tree& step)
776 {
777     Tree params;
778     if (isTree(s, gGlobal->BOXNUMENTRY, lbl, params)) {
779         cur  = nth(params, 0);
780         min  = nth(params, 1);
781         max  = nth(params, 2);
782         step = nth(params, 3);
783         return true;
784     } else {
785         return false;
786     }
787 }
788 
boxHGroup(Tree lbl,Tree x)789 Tree boxHGroup(Tree lbl, Tree x)
790 {
791     return tree(gGlobal->BOXHGROUP, lbl, x);
792 }
isBoxHGroup(Tree s)793 bool isBoxHGroup(Tree s)
794 {
795     Tree lbl, x;
796     return isTree(s, gGlobal->BOXHGROUP, lbl, x);
797 }
isBoxHGroup(Tree s,Tree & lbl,Tree & x)798 bool isBoxHGroup(Tree s, Tree& lbl, Tree& x)
799 {
800     return isTree(s, gGlobal->BOXHGROUP, lbl, x);
801 }
802 
boxVGroup(Tree lbl,Tree x)803 Tree boxVGroup(Tree lbl, Tree x)
804 {
805     return tree(gGlobal->BOXVGROUP, lbl, x);
806 }
isBoxVGroup(Tree s)807 bool isBoxVGroup(Tree s)
808 {
809     Tree lbl, x;
810     return isTree(s, gGlobal->BOXVGROUP, lbl, x);
811 }
isBoxVGroup(Tree s,Tree & lbl,Tree & x)812 bool isBoxVGroup(Tree s, Tree& lbl, Tree& x)
813 {
814     return isTree(s, gGlobal->BOXVGROUP, lbl, x);
815 }
816 
boxTGroup(Tree lbl,Tree x)817 Tree boxTGroup(Tree lbl, Tree x)
818 {
819     return tree(gGlobal->BOXTGROUP, lbl, x);
820 }
isBoxTGroup(Tree s)821 bool isBoxTGroup(Tree s)
822 {
823     Tree lbl, x;
824     return isTree(s, gGlobal->BOXTGROUP, lbl, x);
825 }
isBoxTGroup(Tree s,Tree & lbl,Tree & x)826 bool isBoxTGroup(Tree s, Tree& lbl, Tree& x)
827 {
828     return isTree(s, gGlobal->BOXTGROUP, lbl, x);
829 }
830 
boxHBargraph(Tree lbl,Tree min,Tree max)831 EXPORT Tree boxHBargraph(Tree lbl, Tree min, Tree max)
832 {
833     return tree(gGlobal->BOXHBARGRAPH, lbl, min, max);
834 }
isBoxHBargraph(Tree s)835 bool isBoxHBargraph(Tree s)
836 {
837     Tree lbl, min, max;
838     return isTree(s, gGlobal->BOXHBARGRAPH, lbl, min, max);
839 }
isBoxHBargraph(Tree s,Tree & lbl,Tree & min,Tree & max)840 bool isBoxHBargraph(Tree s, Tree& lbl, Tree& min, Tree& max)
841 {
842     return isTree(s, gGlobal->BOXHBARGRAPH, lbl, min, max);
843 }
844 
boxVBargraph(Tree lbl,Tree min,Tree max)845 EXPORT Tree boxVBargraph(Tree lbl, Tree min, Tree max)
846 {
847     return tree(gGlobal->BOXVBARGRAPH, lbl, min, max);
848 }
isBoxVBargraph(Tree s)849 bool isBoxVBargraph(Tree s)
850 {
851     Tree lbl, min, max;
852     return isTree(s, gGlobal->BOXVBARGRAPH, lbl, min, max);
853 }
isBoxVBargraph(Tree s,Tree & lbl,Tree & min,Tree & max)854 bool isBoxVBargraph(Tree s, Tree& lbl, Tree& min, Tree& max)
855 {
856     return isTree(s, gGlobal->BOXVBARGRAPH, lbl, min, max);
857 }
858 
boxSoundfile(Tree lbl,Tree chan)859 EXPORT Tree boxSoundfile(Tree lbl, Tree chan)
860 {
861     return tree(gGlobal->BOXSOUNDFILE, lbl, chan);
862 }
863 
isBoxSoundfile(Tree s)864 bool isBoxSoundfile(Tree s)
865 {
866     Tree label;
867     Tree chan;
868     return isTree(s, gGlobal->BOXSOUNDFILE, label, chan);
869 }
870 
isBoxSoundfile(Tree s,Tree & label,Tree & chan)871 bool isBoxSoundfile(Tree s, Tree& label, Tree& chan)
872 {
873     return isTree(s, gGlobal->BOXSOUNDFILE, label, chan);
874 }
875 
876 /*****************************************************************************
877                              metadata (pattern matching)
878 *****************************************************************************/
boxMetadata(Tree exp,Tree mdlist)879 Tree boxMetadata(Tree exp, Tree mdlist)
880 {
881     return tree(gGlobal->BOXMETADATA, exp, mdlist);
882 }
883 
isBoxMetadata(Tree s,Tree & exp,Tree & mdlist)884 bool isBoxMetadata(Tree s, Tree& exp, Tree& mdlist)
885 {
886     return isTree(s, gGlobal->BOXMETADATA, exp, mdlist);
887 }
888 
889 /*****************************************************************************
890                              pattern matching case
891 *****************************************************************************/
892 
893 /**
894  * Prepare a "pattern" by replacing variables x by special
895  * pattern variables ?x.
896  *
897  * P[x]     -> ?x
898  * P[x(e)]  -> x(P[e])
899  * P[e(f)]  -> P[e](P[f])
900  * P[e:f]   -> P[e]:P[f]
901  * etc.
902  */
preparePattern(Tree box)903 static Tree preparePattern(Tree box)
904 {
905     //    cerr << "preparePattern(" << boxpp(box) << ")" << endl;
906 
907     int    id;
908     double r;
909     prim0  p0;
910     prim1  p1;
911     prim2  p2;
912     prim3  p3;
913     prim4  p4;
914     prim5  p5;
915 
916     Tree t1, t2, t3, ff, label, cur, min, max, step, type, name, file, arg, body, fun, args, ldef, slot, ident, rules;
917 
918     xtended* xt = (xtended*)getUserData(box);
919 
920     // Primitive elements
921     if (xt)
922         return box;
923     else if (isBoxIdent(box))
924         return boxPatternVar(box);
925     else if (isBoxAppl(box, fun, args)) {
926         if (isBoxIdent(fun))
927             return boxAppl(fun, lmap(preparePattern, args));
928         else
929             return boxAppl(preparePattern(fun), lmap(preparePattern, args));
930     } else if (isBoxAbstr(box, arg, body))
931         return box;
932     else if (isBoxInt(box))
933         return box;
934     else if (isBoxReal(box, &r))
935         return box;
936     else if (isBoxWaveform(box))
937         return box;
938     else if (isBoxCut(box))
939         return box;
940     else if (isBoxWire(box))
941         return box;
942     else if (isBoxPrim0(box, &p0))
943         return box;
944     else if (isBoxPrim1(box, &p1))
945         return box;
946     else if (isBoxPrim2(box, &p2))
947         return box;
948     else if (isBoxPrim3(box, &p3))
949         return box;
950     else if (isBoxPrim4(box, &p4))
951         return box;
952     else if (isBoxPrim5(box, &p5))
953         return box;
954 
955     else if (isBoxWithLocalDef(box, body, ldef))
956         return boxWithLocalDef(preparePattern(body), ldef);
957 
958     // Foreign elements
959     else if (isBoxFFun(box, ff))
960         return box;
961     else if (isBoxFConst(box, type, name, file))
962         return box;
963     else if (isBoxFVar(box, type, name, file))
964         return box;
965 
966     // Block diagram binary operator
967     else if (isBoxSeq(box, t1, t2))
968         return boxSeq(preparePattern(t1), preparePattern(t2));
969     else if (isBoxSplit(box, t1, t2))
970         return boxSplit(preparePattern(t1), preparePattern(t2));
971     else if (isBoxMerge(box, t1, t2))
972         return boxMerge(preparePattern(t1), preparePattern(t2));
973     else if (isBoxPar(box, t1, t2))
974         return boxPar(preparePattern(t1), preparePattern(t2));
975     else if (isBoxRec(box, t1, t2))
976         return boxRec(preparePattern(t1), preparePattern(t2));
977 
978     // Iterative block diagram construction
979     else if (isBoxIPar(box, t1, t2, t3))
980         return boxIPar(t1, t2, preparePattern(t3));
981     else if (isBoxISeq(box, t1, t2, t3))
982         return boxISeq(t1, t2, preparePattern(t3));
983     else if (isBoxISum(box, t1, t2, t3))
984         return boxISum(t1, t2, preparePattern(t3));
985     else if (isBoxIProd(box, t1, t2, t3))
986         return boxIProd(t1, t2, preparePattern(t3));
987 
988     // Static information
989     else if (isBoxInputs(box, t1))
990         return boxInputs(preparePattern(t1));
991     else if (isBoxOutputs(box, t1))
992         return boxOutputs(preparePattern(t1));
993 
994     // User interface
995     else if (isBoxButton(box, label))
996         return box;
997     else if (isBoxCheckbox(box, label))
998         return box;
999 
1000     else if (isBoxVSlider(box, label, cur, min, max, step))
1001         return box;
1002     else if (isBoxHSlider(box, label, cur, min, max, step))
1003         return box;
1004 
1005     else if (isBoxVGroup(box, label, t1))
1006         return boxVGroup(label, preparePattern(t1));
1007     else if (isBoxHGroup(box, label, t1))
1008         return boxHGroup(label, preparePattern(t1));
1009     else if (isBoxTGroup(box, label, t1))
1010         return boxTGroup(label, preparePattern(t1));
1011 
1012     else if (isBoxHBargraph(box, label, min, max))
1013         return box;
1014     else if (isBoxVBargraph(box, label, min, max))
1015         return box;
1016     else if (isBoxNumEntry(box, label, cur, min, max, step))
1017         return box;
1018 
1019     else if (isNil(box))
1020         return box;
1021     else if (isList(box))
1022         return lmap(preparePattern, box);
1023     else if (isBoxEnvironment(box))
1024         return box;
1025     /* not expected
1026     else if (isClosure(box, abstr, genv, vis, lenv)) {
1027         fout << "closure[" << boxpp(abstr)
1028             << ", genv = " << envpp(genv)
1029             << ", lenv = " << envpp(lenv)
1030             << "]";
1031     }
1032     */
1033     else if (isBoxComponent(box, label))
1034         return box;
1035     else if (isBoxAccess(box, t1, t2))
1036         return box;
1037 
1038     /* not expected
1039     else if (isImportFile(box, label)) {
1040         fout << "import("
1041             << tree2str(label) << ')';
1042     }
1043     */
1044 
1045     else if (isBoxSlot(box, &id))
1046         return box;
1047     else if (isBoxSymbolic(box, slot, body))
1048         return box;
1049 
1050     // Pattern Matching Extensions
1051     else if (isBoxCase(box, rules))
1052         return box;
1053     else if (isBoxPatternVar(box, ident))
1054         return box;
1055 
1056     // None of the previous tests succeded, then it is not a valid box
1057     else {
1058         stringstream error;
1059         error << "ERROR in preparePattern() : " << *box << " is not a valid box" << endl;
1060         throw faustexception(error.str());
1061     }
1062 
1063     return box;
1064 }
1065 
prepareRule(Tree rule)1066 static Tree prepareRule(Tree rule)
1067 {
1068     return cons(lmap(preparePattern, hd(rule)), tl(rule));
1069 }
1070 
prepareRules(Tree rules)1071 static Tree prepareRules(Tree rules)
1072 {
1073     return lmap(prepareRule, rules);
1074 }
1075 
boxCaseInternal(Tree rules)1076 Tree boxCaseInternal(Tree rules)
1077 {
1078     return tree(gGlobal->BOXCASE, rules);
1079 }
boxCase(Tree rules)1080 Tree boxCase(Tree rules)
1081 {
1082     return boxCaseInternal(prepareRules(rules));
1083 }
1084 
isBoxCase(Tree s)1085 bool isBoxCase(Tree s)
1086 {
1087     Tree rules;
1088     return isTree(s, gGlobal->BOXCASE, rules);
1089 }
isBoxCase(Tree s,Tree & rules)1090 bool isBoxCase(Tree s, Tree& rules)
1091 {
1092     return isTree(s, gGlobal->BOXCASE, rules);
1093 }
1094 
boxPatternVar(Tree id)1095 Tree boxPatternVar(Tree id)
1096 {
1097     return tree(gGlobal->BOXPATVAR, id);
1098 }
isBoxPatternVar(Tree s,Tree & id)1099 bool isBoxPatternVar(Tree s, Tree& id)
1100 {
1101     return isTree(s, gGlobal->BOXPATVAR, id);
1102 }
1103 
boxPatternMatcher(Automaton * a,int state,Tree env,Tree origRules,Tree revParamList)1104 Tree boxPatternMatcher(Automaton* a, int state, Tree env, Tree origRules, Tree revParamList)
1105 {
1106     return tree(gGlobal->BOXPATMATCHER, tree((void*)a), tree(state), env, origRules, revParamList);
1107 }
1108 
isBoxPatternMatcher(Tree s)1109 bool isBoxPatternMatcher(Tree s)
1110 {
1111     Tree ta, ts, env, orig, rpl;
1112     return isTree(s, gGlobal->BOXPATMATCHER, ta, ts, env, orig, rpl);
1113 }
1114 
isBoxPatternMatcher(Tree s,Automaton * & a,int & state,Tree & env,Tree & origRules,Tree & revParamList)1115 bool isBoxPatternMatcher(Tree s, Automaton*& a, int& state, Tree& env, Tree& origRules, Tree& revParamList)
1116 {
1117     Tree ta, ts;
1118     if (isTree(s, gGlobal->BOXPATMATCHER, ta, ts, env, origRules, revParamList)) {
1119         a     = (Automaton*)tree2ptr(ta);
1120         state = tree2int(ts);
1121         return true;
1122     } else {
1123         return false;
1124     }
1125 }
1126