interpretor/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