Add rate_type in interpreter/types.ml.
[Faustine.git] / interpretor / preprocessor / faust-0.9.47mr3 / compiler / generator / uitree.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 "uitree.hh"
25
26
27
28 static Tree makeSubFolderChain(Tree path, Tree elem);
29 static Tree putFolder(Tree folder, Tree item);
30 static Tree getFolder (Tree folder, Tree ilabel);
31
32
33 static void error(const char * s, Tree t)
34 {
35 fprintf(stderr, "ERROR : %s (%p)\n", s, t);
36 }
37
38 #define ERROR(s,t) error(s,t); exit(1)
39
40
41 //------------------------------------------------------------------------------
42 // Property list
43 //------------------------------------------------------------------------------
44
45 #if 0
46 // version normale, qui marche, mais qui ne range pas en ordre alphabetique
47 static bool findKey (Tree pl, Tree key, Tree& val)
48 {
49 if (isNil(pl)) return false;
50 if (left(hd(pl)) == key) { val= right(hd(pl)); return true; }
51 /* left(hd(pl)) != key */ return findKey (tl(pl), key, val);
52 }
53
54 static Tree updateKey (Tree pl, Tree key, Tree val)
55 {
56 if (isNil(pl)) return cons ( cons(key,val), nil );
57 if (left(hd(pl)) == key) return cons ( cons(key,val), tl(pl) );
58 /* left(hd(pl)) != key */ return cons ( hd(pl), updateKey( tl(pl), key, val ));
59 }
60
61 static Tree removeKey (Tree pl, Tree key)
62 {
63 if (isNil(pl)) return nil;
64 if (left(hd(pl)) == key) return tl(pl);
65 /* left(hd(pl)) != key */ return cons (hd(pl), removeKey(tl(pl), key));
66 }
67
68 #else
69
70 // verion experimentale qui range en ordre alphabetique
71
72 static bool isBefore(Tree k1, Tree k2)
73 {
74 // before comparing replace (type . label) by label
75 if (isList(k1)) { k1 = tl(k1); }
76 if (isList(k2)) { k2 = tl(k2); }
77
78 //fprintf(stderr, "isBefore("); print(k1, stderr); fprintf(stderr,", "); print(k2, stderr); fprintf(stderr,")\n");
79 Sym s1, s2;
80 if (!isSym(k1->node(), &s1)) {
81 ERROR("the node of the tree is not a symbol", k1);
82 }
83 if (!isSym(k2->node(), &s2)) {
84 ERROR("the node of the tree is not a symbol", k2);
85 }
86
87 //fprintf (stderr, "strcmp(\"%s\", \"%s\") = %d\n", name(s1), name(s2), strcmp(name(s1), name(s2)));
88 return strcmp(name(s1), name(s2)) < 0;
89 }
90
91
92 static bool findKey (Tree pl, Tree key, Tree& val)
93 {
94 if (isNil(pl)) return false;
95 if (left(hd(pl)) == key) { val = right(hd(pl)); return true; }
96 if (isBefore(left(hd(pl)),key)) return findKey (tl(pl), key, val);
97 return false;
98 }
99
100 static Tree updateKey (Tree pl, Tree key, Tree val)
101 {
102 if (isNil(pl)) return cons ( cons(key,val), nil );
103 if (left(hd(pl)) == key) return cons ( cons(key,val), tl(pl) );
104 if (isBefore(left(hd(pl)),key)) return cons ( hd(pl), updateKey( tl(pl), key, val ));
105 return cons(cons(key,val), pl);
106 }
107
108 /**
109 * Like updateKey but allow multiple items with same key
110 */
111 static Tree addKey (Tree pl, Tree key, Tree val)
112 {
113 if (isNil(pl)) return cons ( cons(key,val), nil );
114 if (isBefore(key, left(hd(pl)))) return cons(cons(key,val), pl);
115 return cons ( hd(pl), addKey( tl(pl), key, val ));
116 }
117
118
119 #if 0
120 static Tree removeKey (Tree pl, Tree key)
121 {
122 if (isNil(pl)) return nil;
123 if (left(hd(pl)) == key) return tl(pl);
124 if (isBefore(left(hd(pl)),key)) return cons (hd(pl), removeKey(tl(pl), key));
125 return pl;
126 }
127 #endif
128 #endif
129
130 //------------------------------------------------------------------------------
131 // gestion de la construction de l'arbre d'interface utilisateur
132 //------------------------------------------------------------------------------
133
134 Sym UIFOLDER = symbol ("uiFolder");
135 Tree uiFolder(Tree label, Tree elements) { return tree(UIFOLDER, label, elements); }
136 bool isUiFolder(Tree t) { return isTree(t, UIFOLDER); }
137 bool isUiFolder(Tree t, Tree& label, Tree& elements) { return isTree(t, UIFOLDER, label, elements); }
138
139 Sym UIWIDGET = symbol ("uiWidget");
140 Tree uiWidget(Tree label, Tree varname, Tree sig) { return tree(UIWIDGET, label, varname, sig); }
141 bool isUiWidget(Tree t, Tree& label, Tree& varname, Tree& sig) { return isTree(t, UIWIDGET, label, varname, sig); }
142
143
144
145 // place un item dans un folder. Remplace eventuellement l'élément de même nom.
146 Tree putFolder(Tree folder, Tree item)
147 {
148 Tree label, content;
149
150 if ( ! isUiFolder(folder, label, content)) { fprintf(stderr, "ERROR in addFolder : not a folder\n"); }
151 return uiFolder(label, updateKey(content, uiLabel(item), item));
152 }
153
154 // place un item dans un folder. Sans Remplacement
155 Tree addToFolder(Tree folder, Tree item)
156 {
157 Tree label, content;
158
159 if ( ! isUiFolder(folder, label, content)) { fprintf(stderr, "ERROR in addFolder : not a folder\n"); }
160 return uiFolder(label, addKey(content, uiLabel(item), item));
161 }
162
163 // get an item from a folder (or return NIL)
164 Tree getFolder (Tree folder, Tree ilabel)
165 {
166 Tree flabel, content, item;
167 if (!isUiFolder(folder, flabel, content)) { fprintf(stderr, "ERROR in getFolder : not a folder\n"); }
168 if (findKey(content, ilabel, item)) {
169 return item;
170 } else {
171 return nil;
172 }
173 }
174
175 // crée une chaine de dossiers correspondant à path et contenant in fine elem
176 Tree makeSubFolderChain(Tree path, Tree elem)
177 {
178 if (isNil(path)) {
179 return elem;
180 } else {
181 return putFolder(uiFolder(hd(path)), makeSubFolderChain(tl(path),elem));
182 }
183 }
184
185
186 Tree putSubFolder(Tree folder, Tree path, Tree item)
187 {
188 if (isNil(path)) {
189 //return putFolder(folder, item);
190 return addToFolder(folder, item);
191 } else {
192 Tree subfolder = getFolder(folder, hd(path));
193 if (isUiFolder(subfolder)) {
194 return putFolder(folder, putSubFolder(subfolder, tl(path), item));
195 } else {
196 return putFolder(folder, makeSubFolderChain(path, item));
197 }
198 }
199 }
200
201
202 /*
203 Fonctionnement des dossiers.
204 Dossier à 1 niveau : Un dossier contient une liste de choses reperées par un nom :
205 Dossier[(l1,d1)...(ln,dn)]
206 ou (lx,dx) est une chose dx repérée par un nom lx. On suppose les lx tous différents
207
208 On peut ajouter une chose à un dossier : Ajouter(Dossier, Chose) -> Dossier
209
210 Si le dossier contient deja qq chose de meme nom, cette chose est remplacée par la nouvelle.
211
212 AJOUTER (Dossier[(l1,d1)...(ln,dn)], (lx,dx)) -> Dossier[(l1,d1)...(lx,dx)...(ln,dn)]
213
214 AJOUTER (Dossier[(l1,d1)...(lx,dx)...(ln,dn)], (lx,dx')) -> Dossier[(l1,d1)...(lx,dx')...(ln,dn)]
215 */