Examples' Makefiles are completed and tested.
[Faustine.git] / interpretor / preprocessor / faust-0.9.47mr3 / compiler / tlib / recursive-tree.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
22
23
24 #include <assert.h>
25 #include <stdio.h>
26 #include <stdlib.h>
27 #include <limits.h>
28 #include "tlib.hh"
29
30 // Declaration of implementation
31 static Tree calcDeBruijn2Sym (Tree t);
32 static Tree substitute(Tree t, int n, Tree id);
33 static Tree calcsubstitute(Tree t, int level, Tree id);
34 static Tree liftn(Tree t, int threshold);
35 static Tree calcliftn(Tree t, int threshold);
36
37 // recursive trees
38
39 Sym DEBRUIJN = symbol ("DEBRUIJN");
40 Sym DEBRUIJNREF = symbol ("DEBRUIJNREF");
41 Sym SUBSTITUTE = symbol ("SUBSTITUTE");
42
43 Sym SYMREC = symbol ("SYMREC");
44 Sym SYMRECREF = symbol ("SYMRECREF");
45 Sym SYMLIFTN = symbol ("LIFTN");
46
47 //Tree NOVAR = tree("NOVAR");
48
49 //-----------------------------------------------------------------------------------------
50 // rec, isRec : declare recursive trees
51 //-----------------------------------------------------------------------------------------
52
53 // de Bruijn declaration of a recursive tree
54 Tree rec(Tree body)
55 {
56 return tree(DEBRUIJN, body);
57 }
58
59 bool isRec(Tree t, Tree& body)
60 {
61 return isTree(t, DEBRUIJN, body);
62 }
63
64 Tree ref(int level)
65 {
66 assert(level > 0);
67 return tree(DEBRUIJNREF, tree(level)); // reference to enclosing recursive tree starting from 1
68 }
69
70 bool isRef(Tree t, int& level)
71 {
72 Tree u;
73
74 if (isTree(t, DEBRUIJNREF, u)) {
75 return isInt(u->node(), &level);
76 } else {
77 return false;
78 }
79 }
80
81
82 //-----------------------------------------------------------------------------------------
83 // Recursive tree in symbolic notation (using a recursive definition property)
84 //-----------------------------------------------------------------------------------------
85 Tree RECDEF = tree(symbol("RECDEF"));
86
87 // declaration of a recursive tree using a symbolic variable
88 Tree rec(Tree var, Tree body)
89 {
90 Tree t = tree(SYMREC, var);
91 t->setProperty(RECDEF, body);
92 return t;
93 }
94
95 bool isRec(Tree t, Tree& var, Tree& body)
96 {
97 if (isTree(t, SYMREC, var)) {
98 body = t->getProperty(RECDEF);
99 return true;
100 } else {
101 return false;
102 }
103 }
104
105
106 Tree ref(Tree id)
107 {
108 return tree(SYMREC, id); // reference to a symbolic id
109 }
110
111 bool isRef(Tree t, Tree& v)
112 {
113 return isTree(t, SYMREC, v);
114 }
115
116 //-----------------------------------------------------------------------------------------
117 // L'aperture d'un arbre est la plus profonde reference de Bruijn qu'il contienne.
118 // Les references symboliques compte pour zero ce qui veut dire qu'un arbre d'aperture
119 // 0 ne compte aucun reference de bruijn libres.
120
121 int CTree::calcTreeAperture( const Node& n, const tvec& br )
122 {
123 int x;
124 if (n == DEBRUIJNREF) {
125
126 if (isInt(br[0]->node(), &x)) {
127 return x;
128 } else {
129 return 0;
130 }
131
132 } else if (n == DEBRUIJN) {
133
134 return br[0]->fAperture - 1;
135
136 } else {
137 // return max aperture of branches
138 int rc = 0;
139 tvec::const_iterator b = br.begin();
140 tvec::const_iterator z = br.end();
141 while (b != z) {
142 if ((*b)->aperture() > rc) rc = (*b)->aperture();
143 ++b;
144 }
145 return rc;
146 }
147 }
148
149 Tree lift(Tree t) { return liftn(t, 1); }
150
151 void printSignal(Tree sig, FILE* out, int prec=0);
152
153 // lift (t) : increase free references by 1
154
155 #if 0
156 static Tree _liftn(Tree t, int threshold);
157
158 static Tree liftn(Tree t, int threshold)
159 {
160 fprintf(stderr, "call of liftn("); printSignal(t, stderr); fprintf(stderr, ", %d)\n", threshold);
161 Tree r = _liftn(t, threshold);
162 fprintf(stderr, "return of liftn("); printSignal(t, stderr); fprintf(stderr, ", %d) -> ", threshold);
163 printSignal(r, stderr); fprintf(stderr, "\n");
164 return r;
165 }
166 #endif
167
168
169 static Tree liftn(Tree t, int threshold)
170 {
171 Tree L = tree( Node(SYMLIFTN), tree(Node(threshold)) );
172 Tree t2 = t->getProperty(L);
173
174 if (!t2) {
175 t2 = calcliftn(t, threshold);
176 t->setProperty(L, t2);
177 }
178 return t2;
179
180 }
181
182 static Tree calcliftn(Tree t, int threshold)
183 {
184 int n;
185 Tree u;
186
187 if (isClosed(t)) {
188
189 return t;
190
191 } else if (isRef(t,n)) {
192
193 if (n < threshold) {
194 // it is a bounded reference
195 return t;
196 } else {
197 // it is a free reference
198 return ref(n+1);
199 }
200
201 } else if (isRec(t,u)) {
202
203 return rec(liftn(u, threshold+1));
204
205 } else {
206 int n = t->arity();
207 //Tree br[4];
208 tvec br(n);
209 for (int i = 0; i < n; i++) {
210 br[i] = liftn(t->branch(i), threshold);
211 }
212 //return CTree::make(t->node(), n, br);
213 return CTree::make(t->node(), br);
214 }
215
216 }
217
218 //-----------------------------------------------------------
219 // Transform a tree from deBruijn to symbolic representation
220 //-----------------------------------------------------------
221 Tree DEBRUIJN2SYM = tree(symbol("deBruijn2Sym"));
222
223 Tree deBruijn2Sym (Tree t)
224 {
225 assert(isClosed(t));
226 Tree t2 = t->getProperty(DEBRUIJN2SYM);
227
228 if (!t2) {
229 t2 = calcDeBruijn2Sym(t);
230 t->setProperty(DEBRUIJN2SYM, t2);
231 }
232 return t2;
233 }
234
235 static Tree calcDeBruijn2Sym (Tree t)
236 {
237 Tree body, var;
238 int i;
239
240 if (isRec(t,body)) {
241
242 var = tree(unique("W"));
243 return rec(var, deBruijn2Sym(substitute(body,1,ref(var))));
244
245 } else if (isRef(t,var)) {
246
247 return t;
248
249 } else if (isRef(t,i)) {
250
251 fprintf(stderr, "ERREUR, une reference de Bruijn touvee ! : ");
252 printSignal(t, stderr);
253 fprintf(stderr, ")\n");
254 exit(1);
255 return t;
256
257 } else {
258
259 //Tree br[4];
260 int a = t->arity();
261 tvec br(a);
262
263 for (int i = 0; i < a; i++) {
264 br[i] = deBruijn2Sym(t->branch(i));
265 }
266 //return CTree::make(t->node(), a, br);
267 return CTree::make(t->node(), br);
268 }
269 }
270
271 static Tree substitute(Tree t, int level, Tree id)
272 {
273 Tree S = tree( Node(SUBSTITUTE), tree(Node(level)), id );
274 Tree t2 = t->getProperty(S);
275
276 if (!t2) {
277 t2 = calcsubstitute(t, level, id);
278 t->setProperty(S, t2);
279 }
280 return t2;
281
282 }
283
284 static Tree calcsubstitute(Tree t, int level, Tree id)
285 {
286 int l;
287 Tree body;
288
289 if (t->aperture()<level) {
290 // fprintf(stderr, "aperture %d < level %d !!\n", t->aperture(), level);
291 return t;
292 }
293 if (isRef(t,l)) return (l == level) ? id : t;
294 if (isRec(t,body)) return rec(substitute(body, level+1, id));
295
296 int ar = t->arity();
297 //Tree br[4];
298 tvec br(ar);
299 for (int i = 0; i < ar; i++) {
300 br[i] = substitute(t->branch(i), level, id);
301 }
302 //return CTree::make(t->node(), ar, br);
303 return CTree::make(t->node(), br);
304 }
305
306
307 //--------------------------------------------------------------------------
308 // UpdateAperture (t) : recursively mark open and closed terms.
309 // closed term : fAperture == 0, open term fAperture == -1
310
311 struct Env {
312 Tree fTree; Env* fNext;
313 Env(Tree t, Env* nxt) : fTree(t), fNext(nxt) {}
314 };
315
316 static void markOpen(Tree t);
317 static int recomputeAperture(Tree t, Env* p);
318 static int orderof (Tree t, Env* p);
319
320 void updateAperture(Tree t)
321 {
322 markOpen(t);
323 recomputeAperture(t, NULL);
324 }
325
326 //----------------------implementation--------------------------------
327
328 static void markOpen(Tree t)
329 {
330 if (t->aperture() == INT_MAX) return;
331 t->setAperture(INT_MAX);
332 int ar = t->arity();
333 for (int i = 0; i < ar; i++) {
334 markOpen(t->branch(i));
335 }
336 }
337
338 static int recomputeAperture(Tree t, Env* env)
339 {
340 Tree var, body;
341
342 if (t->aperture() == 0) return 0;
343
344 if (isRef(t, var)) {
345
346 return orderof(var, env);
347
348 } else if (isRec(t, var, body)) {
349
350 Env e(var,env);
351 int a = recomputeAperture(body, &e) - 1;
352 if (a<=0) { /*print(t, stderr);*/ t->setAperture(0); }
353 return a;
354
355 } else {
356 // return max aperture of branches
357 int ma = 0;
358 int ar = t->arity();
359 for (int i = 0; i<ar; i++) {
360 int a = recomputeAperture(t->branch(i), env);
361 if (ma < a) ma = a;
362 }
363 if (ma <= 0) { /*print(t, stderr);*/ t->setAperture(0); }
364 return ma;
365 }
366 }
367
368
369 static int orderof (Tree t, Env* p)
370 {
371 if (p == NULL) return 0;
372 if (t == p->fTree) return 1;
373
374 int pos = 1;
375 while (p != NULL) {
376 if (t == p->fTree) return pos;
377 p = p->fNext;
378 pos++;
379 }
380 return 0;
381 }