1 #include "environment.hh"
8 //-----------------------new environment management----------------------------
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
16 //-----------------------------------------------------------------------------
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
26 static Tree
pushNewLayer(Tree lenv
)
28 return tree(unique("ENV_LAYER"), lenv
);
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
38 * @param lenv the old environment
39 * @return the new environment
41 Sym BARRIER
= symbol ("BARRIER");
43 Tree
pushEnvBarrier(Tree lenv
)
45 return tree(BARRIER
, lenv
);
50 * Test if the environment is a barrier (or nil) so
51 * that searchIdDef will know where to stop when searching
53 * @param lenv the environment to test
54 * @return true is barrier reached
56 bool isEnvBarrier(Tree lenv
)
58 return isNil(lenv
) || (lenv
->node() == Node(BARRIER
));
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
69 static void addLayerDef(Tree id
, Tree def
, Tree lenv
)
71 // check for multiple definitions of a symbol in the same layer
73 if (getProperty(lenv
, id
, olddef
)) {
75 evalwarning(getDefFileProp(id
), getDefLineProp(id
), "equivalent re-definitions of", id
);
77 fprintf(stderr
, "%s:%d: ERROR: redefinition of symbols are not allowed : ", getDefFileProp(id
), getDefLineProp(id
));
79 fprintf(stderr
, " is already defined in file \"%s\" line %d \n", getDefFileProp(id
), getDefLineProp(id
));
83 setProperty(lenv
, id
, def
);
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
94 Tree
pushValueDef(Tree id
, Tree def
, Tree lenv
)
96 Tree lenv2
= pushNewLayer(lenv
);
97 addLayerDef(id
, def
, lenv2
);
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
109 Tree
pushMultiClosureDefs(Tree ldefs
, Tree visited
, Tree lenv
)
111 Tree lenv2
= pushNewLayer(lenv
);
112 while (!isNil(ldefs
)) {
113 Tree def
= hd(ldefs
);
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
);
127 * Search the environment (until first barrier) for
128 * the definition of a symbol ID and return it. Used by the
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
135 bool searchIdDef(Tree id
, Tree
& def
, Tree lenv
)
137 // search the environment until a definition is found
138 // or a barrier (or nil) is reached
140 while (!isEnvBarrier(lenv
) && !getProperty(lenv
, id
, def
)) {
141 lenv
= lenv
->branch(0);
143 return !isEnvBarrier(lenv
);
147 * Replace closure that point to oldEnv with closure on newEnv
149 static void updateClosures(vector
<Tree
>& clos
, Tree oldEnv
, Tree newEnv
)
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
);
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
169 Tree
copyEnvReplaceDefs(Tree anEnv
, Tree ldefs
, Tree visited
, Tree curEnv
)
171 vector
<Tree
> ids
, clos
;
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
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
]);
182 while (!isNil(ldefs
)) { // replace the old definitions with the new ones
183 Tree def
= hd(ldefs
);
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
);