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
************************************************************************/
24
/*****************************************************************************
25
******************************************************************************
27
Y. Orlarey, (c) Grame 2002
28
------------------------------------------------------------------------------
29
This file contains several extensions to the tree library :
30
- lists : based on a operations like cons, hd , tl, ...
31
- environments : list of associations (key value)
32
- property list : used to annotate trees
41
nil = predefined empty list
42
cons (x,l) = create a nex list of head x and tail l
45
nth(l,i) = ith element of l (or nil)
46
replace(l,i,e) = a copy of l where the ith element is e
47
len(l) = number of elements of l
48
isNil(nil) = true (false otherwise)
49
isList(cons(x,l)) = true (false otherwise)
50
list(a,b,..) = cons(a, list(b,...))
52
lmap(f, cons(x,l)) = cons(f(x), lmap(f,l))
53
reverse([a,b,..,z]) = [z,..,b,a]
54
reverseall([a,b,..,z]) = [ra(z),..,ra(b),ra(a)] where ra is reverseall
58
(Sets are implemented as ordered lists of elements without duplication)
60
isElement(e,s) = true if e is an element of set s, false otherwise
61
addElement(e,s) = s U {e}
62
remElement(e,s) = s - {e}
64
list2set(l) = convert a list into a set
65
setUnion(s1,s2) = s1 U s2
66
setIntersection(s1,s2) = s1 intersection s2
67
setDifference(s1,s2) = s1 - s2
72
An 'environment' is a stack of pairs (key x value) used to keep track of lexical bindings
74
pushEnv (key, val, env) -> env' create a new environment
75
searchEnv (key,&v,env) -> bool search for key in env and set v accordingly
77
search(k1,&v, push(k2,x,env)) = true and v is set to x if k1==k2
78
= search(k1,&v,env) if k1 != k2
82
Every tree can be annotated with an 'attribut' field. This attribute field
83
can be used to manage a property list (pl). A property list is a list of pairs
84
key x value, with three basic operations :
86
setProperty (t, key, val) -> t add the association (key x val) to the pl of t
87
getProperty (t, key, &val) -> bool search the pp of t for the value associated to key
88
remProperty (t, key) -> t remove any association (key x ?) from the pl of t
92
Since reference counters are used for garbage collecting, one must be careful not to
93
create cycles in trees. The only possible source of cycles is by setting the attribut
94
of a tree t to a tree t' that contains t as a subtree.
98
2002-02-08 : First version
99
2002-02-20 : New description of the API, non recursive lmap and reverse
100
2002-03-29 : Added function remElement(e,set), corrected comment error
102
******************************************************************************
103
*****************************************************************************/
107
#include "compatibility.hh"
111
// predefined symbols CONS and NIL
112
Sym CONS = symbol("cons");
113
Sym NIL = symbol("nil");
115
// predefined nil tree
116
Tree nil = tree(NIL);
119
//------------------------------------------------------------------------------
120
// Printing of trees with special case for lists
121
//------------------------------------------------------------------------------
123
static bool printlist (Tree l, FILE* out)
130
fputc(sep, out); sep = ',';
143
} else if (isNil(l)) {
154
void print (Tree t, FILE* out)
156
int i; double f; Sym s; void* p;
158
if (printlist(t, out)) return;
161
if (isInt(n, &i)) fprintf (out, "%d", i);
162
else if (isDouble(n, &f)) fprintf (out, "%f", f);
163
else if (isSym(n, &s)) fprintf (out, "%s", name(s));
164
else if (isPointer(n, &p)) fprintf (out, "#%p", p);
169
for (int i=0; i<k; i++) {
170
fputc(sep, out); sep = ',';
171
print(t->branch(i), out);
178
//------------------------------------------------------------------------------
180
//------------------------------------------------------------------------------
182
Tree nth (Tree l, int i)
185
if (i == 0) return hd(l);
192
Tree replace(Tree l, int i, Tree e)
194
return (i==0) ? cons(e,tl(l)) : cons( hd(l), replace(tl(l),i-1,e) );
201
while (isList(l)) { l = tl(l); n++; }
206
//------------------------------------------------------------------------------
207
// Mapping and reversing
208
//------------------------------------------------------------------------------
210
Tree rconcat (Tree l, Tree q)
212
while (isList(l)) { q = cons(hd(l),q); l = tl(l); }
216
Tree concat (Tree l, Tree q)
218
return rconcat(reverse(l), q);
221
Tree lrange (Tree l, int i, int j)
225
while (c>i) r = cons( nth(l,--c), r);
229
//------------------------------------------------------------------------------
230
// Mapping and reversing
231
//------------------------------------------------------------------------------
233
static Tree rmap (tfun f, Tree l)
236
while (isList(l)) { r = cons(f(hd(l)),r); l = tl(l); }
240
Tree reverse (Tree l)
243
while (isList(l)) { r = cons(hd(l),r); l = tl(l); }
247
Tree lmap (tfun f, Tree l)
249
return reverse(rmap(f,l));
252
Tree reverseall (Tree l)
254
return isList(l) ? rmap(reverseall, l) : l;
258
//------------------------------------------------------------------------------
259
// Sets : implemented as ordered list
260
//------------------------------------------------------------------------------
262
bool isElement (Tree e, Tree l)
265
if (hd(l) == e) return true;
266
if (hd(l) > e) return false;
272
Tree addElement(Tree e, Tree l)
277
} else if (e == hd(l)) {
280
return cons(hd(l), addElement(e,tl(l)));
287
Tree remElement(Tree e, Tree l)
292
} else if (e == hd(l)) {
295
return cons(hd(l), remElement(e,tl(l)));
302
Tree singleton (Tree e)
307
Tree list2set (Tree l)
311
s = addElement(hd(l),s);
317
Tree setUnion (Tree A, Tree B)
319
if (isNil(A)) return B;
320
if (isNil(B)) return A;
322
if (hd(A) == hd(B)) return cons(hd(A), setUnion(tl(A),tl(B)));
323
if (hd(A) < hd(B)) return cons(hd(A), setUnion(tl(A),B));
324
/* hd(A) > hd(B) */ return cons(hd(B), setUnion(A,tl(B)));
327
Tree setIntersection (Tree A, Tree B)
329
if (isNil(A)) return A;
330
if (isNil(B)) return B;
331
if (hd(A) == hd(B)) return cons(hd(A), setIntersection(tl(A),tl(B)));
332
if (hd(A) < hd(B)) return setIntersection(tl(A),B);
333
/* (hd(A) > hd(B)*/ return setIntersection(A,tl(B));
336
Tree setDifference (Tree A, Tree B)
338
if (isNil(A)) return A;
339
if (isNil(B)) return A;
340
if (hd(A) == hd(B)) return setDifference(tl(A),tl(B));
341
if (hd(A) < hd(B)) return cons(hd(A), setDifference(tl(A),B));
342
/* (hd(A) > hd(B)*/ return setDifference(A,tl(B));
347
//------------------------------------------------------------------------------
349
//------------------------------------------------------------------------------
351
Tree pushEnv (Tree key, Tree val, Tree env)
353
return cons (cons(key,val), env);
356
bool searchEnv (Tree key, Tree& v, Tree env)
358
while (isList(env)) {
359
if (hd(hd(env)) == key) {
369
//------------------------------------------------------------------------------
371
//------------------------------------------------------------------------------
373
static bool findKey (Tree pl, Tree key, Tree& val)
375
if (isNil(pl)) return false;
376
if (left(hd(pl)) == key) { val= right(hd(pl)); return true; }
377
/* left(hd(pl)) != key */ return findKey (tl(pl), key, val);
380
static Tree updateKey (Tree pl, Tree key, Tree val)
382
if (isNil(pl)) return cons ( cons(key,val), nil );
383
if (left(hd(pl)) == key) return cons ( cons(key,val), tl(pl) );
384
/* left(hd(pl)) != key */ return cons ( hd(pl), updateKey( tl(pl), key, val ));
387
static Tree removeKey (Tree pl, Tree key)
389
if (isNil(pl)) return nil;
390
if (left(hd(pl)) == key) return tl(pl);
391
/* left(hd(pl)) != key */ return cons (hd(pl), removeKey(tl(pl), key));
396
void setProperty (Tree t, Tree key, Tree val)
398
CTree* pl = t->attribut();
399
if (pl) t->attribut(updateKey(pl, key, val));
400
else t->attribut(updateKey(nil, key, val));
403
void remProperty (Tree t, Tree key)
405
CTree* pl = t->attribut();
406
if (pl) t->attribut(removeKey(pl, key));
409
bool getProperty (Tree t, Tree key, Tree& val)
411
CTree* pl = t->attribut();
412
if (pl) return findKey(pl, key, val);
417
// nouvelle implementation
418
void setProperty (Tree t, Tree key, Tree val)
420
t->setProperty(key, val);
423
bool getProperty (Tree t, Tree key, Tree& val)
425
CTree* pl = t->getProperty(key);
434
void remProperty (Tree t, Tree key)
436
exit(1); // fonction not implemented
441
//------------------------------------------------------------------------------
442
// Bottom Up Tree Mapping
443
//------------------------------------------------------------------------------
445
Tree tmap (Tree key, tfun f, Tree t)
447
//printf("start tmap\n");
450
if (getProperty(t, key, p)) {
452
return (isNil(p)) ? t : p; // truc pour eviter les boucles
457
switch (t->arity()) {
463
r1 = tree(t->node(), tmap(key,f,t->branch(0)));
466
r1 = tree(t->node(), tmap(key,f,t->branch(0)), tmap(key,f,t->branch(1)));
469
r1 = tree(t->node(), tmap(key,f,t->branch(0)), tmap(key,f,t->branch(1)),
470
tmap(key,f,t->branch(2)));
473
r1 = tree(t->node(), tmap(key,f,t->branch(0)), tmap(key,f,t->branch(1)),
474
tmap(key,f,t->branch(2)), tmap(key,f,t->branch(3)));
479
setProperty(t, key, nil);
481
setProperty(t, key, r2);
491
//------------------------------------------------------------------------------
492
// substitute :remplace toutes les occurences de 'id' par 'val' dans 't'
493
//------------------------------------------------------------------------------
495
// genere une clef unique propre � cette substitution
496
static Tree substkey(Tree t, Tree id, Tree val)
499
snprintf(name, 255, "SUBST<%p,%p,%p> : ", (CTree*)t, (CTree*)id, (CTree*)val);
500
return tree(unique(name));
503
// realise la substitution proprement dite tout en mettant � jour la propriete
504
// pour ne pas avoir � la calculer deux fois
506
static Tree subst (Tree t, Tree propkey, Tree id, Tree val)
513
} else if (t->arity() == 0) {
515
} else if (getProperty(t, propkey, p)) {
516
return (isNil(p)) ? t : p;
519
switch (t->arity()) {
523
subst(t->branch(0), propkey, id, val));
528
subst(t->branch(0), propkey, id, val),
529
subst(t->branch(1), propkey, id, val));
534
subst(t->branch(0), propkey, id, val),
535
subst(t->branch(1), propkey, id, val),
536
subst(t->branch(2), propkey, id, val));
541
subst(t->branch(0), propkey, id, val),
542
subst(t->branch(1), propkey, id, val),
543
subst(t->branch(2), propkey, id, val),
544
subst(t->branch(3), propkey, id, val));
549
setProperty(t, propkey, nil);
551
setProperty(t, propkey, r);
558
// remplace toutes les occurences de 'id' par 'val' dans 't'
559
Tree substitute (Tree t, Tree id, Tree val)
561
return subst (t, substkey(t,id,val), id, val);
added
removed
.pc/atoi/compiler/tlib/list.cpp
