libsndfile-ocaml source files.
[Faustine.git] / interpretor / preprocessor / faust-0.9.47mr3 / compiler / evaluate / environment.cpp
1 #include "environment.hh"
2 #include "errormsg.hh"
3 #include "boxes.hh"
4 #include "ppbox.hh"
5 #include "names.hh"
6
7
8 //-----------------------new environment management----------------------------
9 //
10 // The environement is made of layers. Each layer contains a set of definitions
11 // stored as properties of the layer. Each definition can refers to other
12 // definitions of the same layer or of subsequent layers. Recursive
13 // definitions are not allowed. Multiple defintions of the same symbol
14 // in a layer is allowed but generate a warning when the definition is
15 // different
16 //-----------------------------------------------------------------------------
17
18
19
20 /**
21 * Push a new (unique) empty layer (where multiple definitions can be stored)
22 * on top of an existing environment.
23 * @param lenv the old environment
24 * @return the new environment
25 */
26 static Tree pushNewLayer(Tree lenv)
27 {
28 return tree(unique("ENV_LAYER"), lenv);
29 }
30
31
32
33 /**
34 * Push a new environment barrier on top of an existing environment so
35 * that searchIdDef (used by the pattern matcher) will not look after
36 * the barrier. This barrier will not any influence on regular environment
37 * lookup.
38 * @param lenv the old environment
39 * @return the new environment
40 */
41 Sym BARRIER = symbol ("BARRIER");
42
43 Tree pushEnvBarrier(Tree lenv)
44 {
45 return tree(BARRIER, lenv);
46 }
47
48
49 /**
50 * Test if the environment is a barrier (or nil) so
51 * that searchIdDef will know where to stop when searching
52 * an environment.
53 * @param lenv the environment to test
54 * @return true is barrier reached
55 */
56 bool isEnvBarrier(Tree lenv)
57 {
58 return isNil(lenv) || (lenv->node() == Node(BARRIER));
59 }
60
61
62 /**
63 * Add a definition (as a property) to the current top level layer. Check
64 * and warn for multiple definitions.
65 * @param id the symbol id to be defined
66 * @param def the definition to be binded to the symbol id
67 * @param lenv the environment where to add this new definition
68 */
69 static void addLayerDef(Tree id, Tree def, Tree lenv)
70 {
71 // check for multiple definitions of a symbol in the same layer
72 Tree olddef;
73 if (getProperty(lenv, id, olddef)) {
74 if (def == olddef) {
75 evalwarning(getDefFileProp(id), getDefLineProp(id), "equivalent re-definitions of", id);
76 } else {
77 fprintf(stderr, "%s:%d: ERROR: redefinition of symbols are not allowed : ", getDefFileProp(id), getDefLineProp(id));
78 print(id,stderr);
79 fprintf(stderr, " is already defined in file \"%s\" line %d \n", getDefFileProp(id), getDefLineProp(id));
80 gErrorCount++;
81 }
82 }
83 setProperty(lenv, id, def);
84 }
85
86
87 /**
88 * Push a new layer and add a single definition.
89 * @param id the symbol id to be defined
90 * @param def the definition to be binded to the symbol id
91 * @param lenv the environment where to push the layer and add the definition
92 * @return the new environment
93 */
94 Tree pushValueDef(Tree id, Tree def, Tree lenv)
95 {
96 Tree lenv2 = pushNewLayer(lenv);
97 addLayerDef(id, def, lenv2);
98 return lenv2;
99 }
100
101
102 /**
103 * Push a new layer with multiple definitions creating the appropriate closures
104 * @param ldefs list of pairs (symbol id x definition) to be binded to the symbol id
105 * @param visited set of visited symbols (used for recursive definition detection)
106 * @param lenv the environment where to push the layer and add all the definitions
107 * @return the new environment
108 */
109 Tree pushMultiClosureDefs(Tree ldefs, Tree visited, Tree lenv)
110 {
111 Tree lenv2 = pushNewLayer(lenv);
112 while (!isNil(ldefs)) {
113 Tree def = hd(ldefs);
114 Tree id = hd(def);
115 Tree rhs= tl(def);
116 Tree cl = closure(tl(def),nil,visited,lenv2);
117 stringstream s; s << boxpp(id);
118 if (!isBoxCase(rhs)) setDefNameProperty(cl,s.str());
119 addLayerDef( id, cl, lenv2 );
120 ldefs = tl(ldefs);
121 }
122 return lenv2;
123 }
124
125
126 /**
127 * Search the environment (until first barrier) for
128 * the definition of a symbol ID and return it. Used by the
129 * pattern matcher.
130 * @param id the symbol ID to search
131 * @param def where to store the definition if any
132 * @param lenv the environment
133 * @return true if a definition was found
134 */
135 bool searchIdDef(Tree id, Tree& def, Tree lenv)
136 {
137 // search the environment until a definition is found
138 // or a barrier (or nil) is reached
139
140 while (!isEnvBarrier(lenv) && !getProperty(lenv, id, def)) {
141 lenv = lenv->branch(0);
142 }
143 return !isEnvBarrier(lenv);
144 }
145
146 /**
147 * Replace closure that point to oldEnv with closure on newEnv
148 */
149 static void updateClosures(vector<Tree>& clos, Tree oldEnv, Tree newEnv)
150 {
151 for (unsigned int i=0; i < clos.size(); i++) {
152 Tree exp, genv, visited, lenv;
153 if (isClosure(clos[i], exp, genv, visited, lenv)) {
154 if (lenv == oldEnv) {
155 clos[i] = closure(exp, genv, visited, newEnv);
156 }
157 }
158 }
159 }
160
161 /**
162 * Create a new environment by copying an existing one and replacing some definitions
163 * @param xenv existing environment we will copy
164 * @param ldefs list of pairs (symbol id x definition) that will replace old definitions
165 * @param visited set of visited symbols (used for recursive definition detection)
166 * @param lenv the current environment to evaluate the definitions
167 * @return the new environment
168 */
169 Tree copyEnvReplaceDefs(Tree anEnv, Tree ldefs, Tree visited, Tree curEnv)
170 {
171 vector<Tree> ids, clos;
172 Tree copyEnv;
173
174 anEnv->exportProperties(ids, clos); // get the definitions of the environment
175 copyEnv = pushNewLayer(anEnv->branch(0)); // create new environment with same stack
176 updateClosures(clos, anEnv, copyEnv); // update the closures replacing oldEnv with newEnv
177
178 for (unsigned int i=0; i < clos.size(); i++) { // transfers the updated definitions to the new environment
179 setProperty(copyEnv, ids[i], clos[i]);
180 }
181
182 while (!isNil(ldefs)) { // replace the old definitions with the new ones
183 Tree def = hd(ldefs);
184 Tree id = hd(def);
185 Tree rhs= tl(def);
186 Tree cl = closure(rhs,nil,visited,curEnv);
187 stringstream s; s << boxpp(id);
188 if (!isBoxCase(rhs)) setDefNameProperty(cl,s.str());
189 setProperty(copyEnv, id, cl);
190 ldefs = tl(ldefs);
191 }
192 return copyEnv;
193 }
194
195