prop-src/patenv.cc

   1 //////////////////////////////////////////////////////////////////////////////
   2 //  Implementation of the pattern variable environment
   3 //////////////////////////////////////////////////////////////////////////////
   4 #include <strstream>
   5 #include <AD/contain/stack.h>
   6 #include "patenv.h"
   7 #include "type.h"
   8 #include "ast.h"
   9 #include "options.h"
  10
  11 /////////////////////////////////////////////////////////////////////////////
  12 //  A binding between a pattern variable and a binding expression.
  13 /////////////////////////////////////////////////////////////////////////////
  14 struct BINDING {
  15    Id       var;      // Name of the pattern variable
  16    Ty       ty;       // type of pattern variable
  17    Exp      exp;      // The expression
  18    Polarity polarity; // polarity of the pattern variable
  19    BINDING() {}
  20    BINDING(Id v, Exp e, Ty t, Polarity p)
  21      : var(v), exp(e), ty(t), polarity(p) {}
  22 };
  23
  24 /////////////////////////////////////////////////////////////////////////////
  25 // An environment of pattern variables is implemented as a pair of
  26 // stacks, one caching the current set of bindings and one registering
  27 // the lexical scope boundaries.
  28 /////////////////////////////////////////////////////////////////////////////
  29 class PatternVarEnv_Impl {
  30
  31    PatternVarEnv_Impl(const PatternVarEnv_Impl&);  // no copy constructor
  32    void operator = (const PatternVarEnv_Impl&);    // no assignment
  33
  34 public:
  35
  36    Stack<BINDING> env;              // bindings stack
  37    Stack<int>     levels;           // scope levels stack
  38    Stack<Bool>    linear;           // is current scope linear?
  39    Stack<Bool>    separate_guards;  // separate the guards
  40    Stack<Bool>    tree_grammar;     // tree grammar mode
  41    Stack<Exp>     guards;           // guard expressions
  42
  43    //////////////////////////////////////////////////////////////////////////
  44    // Constructor
  45    //////////////////////////////////////////////////////////////////////////
  46    PatternVarEnv_Impl (int max_size, int max_levels)
  47       : env(max_size), levels(max_levels), linear(max_levels),
  48         separate_guards(max_levels), tree_grammar(max_levels),
  49         guards(max_levels) {}
  50 };
  51
  52 ///////////////////////////////////////////////////////////////////////////
  53 //  Pattern variable environment routines.
  54 ///////////////////////////////////////////////////////////////////////////
  55
  56 ///////////////////////////////////////////////////////////////////////////
  57 //  Constructor
  58 ///////////////////////////////////////////////////////////////////////////
  59 PatternVarEnv::PatternVarEnv (int max_size, int max_levels)
  60    : impl(new PatternVarEnv_Impl(max_size, max_levels)) {}
  61
  62 ///////////////////////////////////////////////////////////////////////////
  63 //  Destructor
  64 ///////////////////////////////////////////////////////////////////////////
  65 PatternVarEnv::~PatternVarEnv () { delete impl; }
  66
  67 ///////////////////////////////////////////////////////////////////////////
  68 //  Method to add a new binding to the current scope.
  69 //  If the current scope allows only linear patterns, we'll search the
  70 //  scope to make sure that the new pattern variable is not a duplicate.
  71 //  Otherwise, the check is omitted.
  72 ///////////////////////////////////////////////////////////////////////////
  73 Exp PatternVarEnv::add (Id v, Exp e, Ty ty, Polarity polarity)
  74 {  register const BINDING * top   = &impl->env.top();
  75    register const BINDING * limit = &impl->env[impl->levels.top()];
  76    for ( ;top >= limit; top--) {
  77       if (top->var == v) {
  78          if (polarity == ISneither)
  79          {  error("%Lmultiple mixed polarity pattern variable '%s'\n",v);
  80          } else if (impl->linear.top())
  81          {  error("%Lduplicated pattern variable '%s'.  Use option -non_linear.\n", v);
  82          } else
  83          {  Used::equality = true;
  84             if (! unify(ty, top->ty))
  85             {  error("%Lexpecting type %T but found %T in pattern variable '%s'\n",
  86                      top->ty, ty, v);
  87             }
  88             if (tree_grammar()) break;
  89             return top->exp;
  90          }
  91       }
  92    }
  93    impl->env.push(BINDING(v,e,ty,polarity));
  94    return NOexp;
  95 }
  96
  97 ///////////////////////////////////////////////////////////////////////////
  98 //  Method to lookup a binding from all the scopes.
  99 //  This is implemented as a naive linear search.  Sorry!
 100 ///////////////////////////////////////////////////////////////////////////
 101 Exp PatternVarEnv::lookup(Id v, Bool * from_current)
 102 {  register const BINDING * top   = &impl->env.top();
 103    register const BINDING * limit = &impl->env[0];
 104    for ( ;top >= limit; top--)
 105       if (top->var == v) {
 106          if (from_current) {  // check whether it is from the current scope
 107             if (impl->levels.size() == 0)
 108                *from_current = true;
 109             else
 110                *from_current = top >= &impl->env[impl->levels.top()];
 111          }
 112          return top->exp;
 113       }
 114    return NOexp;
 115 }
 116
 117 ///////////////////////////////////////////////////////////////////////////
 118 //  Tell whether we need to generate separate guard expressions
 119 ///////////////////////////////////////////////////////////////////////////
 120 Bool PatternVarEnv::separate_guard() { return impl->separate_guards.top(); }
 121 Bool PatternVarEnv::tree_grammar()   { return impl->tree_grammar.top(); }
 122 Exp  PatternVarEnv::guard()          { return impl->guards.top(); }
 123 Exp  PatternVarEnv::guard(Exp e)
 124 {  Exp e2 = guard();
 125    if (e == NOexp) return e2;
 126    if (e2 == NOexp) return e;
 127    return BINOPexp("&&",e2,e);
 128 }
 129 void PatternVarEnv::add_guard(Exp e)
 130 {  if (e != NOexp)
 131    {  Exp& g = impl->guards.top();
 132       if (g != NOexp) g = BINOPexp("&&",g,e);
 133       else g = e;
 134       if (options.debug) msg("%Lnew guard expression: %e\n", g);
 135    }
 136 }
 137
 138 ///////////////////////////////////////////////////////////////////////////
 139 //  Method to insert a new scope
 140 ///////////////////////////////////////////////////////////////////////////
 141 void PatternVarEnv::new_scope(Bool is_linear, Bool guard_sep, Bool treegram)
 142 {  if (impl->levels.is_full()) {
 143       error("%Lpattern scope stack overflows\n");
 144    } else {
 145       impl->levels.push(impl->env.size());
 146       impl->linear.push(is_linear);
 147       impl->separate_guards.push(guard_sep);
 148       impl->tree_grammar.push(treegram);
 149       impl->guards.push(NOexp);
 150    }
 151 }
 152
 153 ///////////////////////////////////////////////////////////////////////////
 154 //  Method to leave a scope.
 155 ///////////////////////////////////////////////////////////////////////////
 156 void PatternVarEnv::old_scope()
 157 {  if (impl->levels.is_empty()) {
 158       error("%Lpattern scope stack underflows\n");
 159    } else {
 160       impl->env.set_size(impl->levels.pop());
 161       impl->linear.pop();
 162       impl->separate_guards.pop();
 163       impl->tree_grammar.pop();
 164       impl->guards.pop();
 165    }
 166 }