[system] / trunk / pg / lib / Parser / Context.pm Repository:
ViewVC logotype

View of /trunk/pg/lib/Parser/Context.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2647 - (download) (as text) (annotate)
Thu Aug 19 12:18:56 2004 UTC (15 years, 3 months ago) by dpvc
File size: 4769 byte(s)
Context() now accepts a reference to an actual Context object rather
than a name of a predefined context, and will switch to that.

    1 #
    2 # add/remove/get reduction flags
    3 # make patterns into real patterns, not strings
    4 #
    5 
    6 #########################################################################
    7 
    8 package Parser::Context;
    9 my $pkg = "Parser::Context";
   10 use strict;
   11 use vars qw(@ISA);
   12 @ISA = qw(Value::Context);
   13 
   14 #
   15 #  Create a new Context object and initialize its data lists
   16 #
   17 sub new {
   18   my $self = shift; my $class = ref($self) || $self;
   19   my $context = $Value::defaultContext->copy();
   20   bless $context, $class;
   21   $context->{_initialized} = 0;
   22   foreach my $list ('functions','variables','constants','operators','strings','parens') {
   23     push(@{$context->{data}{hashes}},$list);
   24     $context->{$list} = {};
   25   }
   26   my %data = (
   27     functions => {},
   28     variables => {},
   29     constants => {},
   30     operators => {},
   31     strings   => {},
   32     parens    => {},
   33     lists     => {},
   34     flags     => {},
   35     @_
   36   );
   37   $context->{_functions} = new Parser::Context::Functions($context,%{$data{functions}});
   38   $context->{_variables} = new Parser::Context::Variables($context,%{$data{variables}});
   39   $context->{_constants} = new Parser::Context::Constants($context,%{$data{constants}});
   40   $context->{_operators} = new Parser::Context::Operators($context,%{$data{operators}});
   41   $context->{_strings}   = new Parser::Context::Strings($context,%{$data{strings}});
   42   $context->{_parens}    = new Parser::Context::Parens($context,%{$data{parens}});
   43   $context->lists->set(%{$data{lists}}) if defined($data{lists});
   44   $context->flags->set(%{$data{flags}}) if defined($data{flags});
   45   $context->{_initialized} = 1;
   46   $context->update;
   47   return $context;
   48 }
   49 
   50 #
   51 #  Update the token pattern
   52 #
   53 sub update {
   54   my $self = shift; return unless $self->{_initialized};
   55   $self->{pattern}{token} =
   56    '(?:('.join(')|(',
   57          $self->strings->{pattern},
   58          $self->functions->{pattern},
   59          $self->constants->{pattern},
   60          $self->{pattern}{number},
   61          $self->operators->{pattern},
   62          $self->parens->{open},
   63          $self->parens->{close},
   64          $self->variables->{pattern},
   65   ).'))';
   66 }
   67 
   68 #
   69 #  Access to the data lists
   70 #
   71 sub operators {(shift)->{_operators}}
   72 sub functions {(shift)->{_functions}}
   73 sub constants {(shift)->{_constants}}
   74 sub variables {(shift)->{_variables}}
   75 sub strings   {(shift)->{_strings}}
   76 sub parens    {(shift)->{_parens}}
   77 
   78 
   79 #
   80 #  Store pointer to user's context table
   81 #
   82 my $userContext;
   83 
   84 #
   85 #  Set/Get the current Context object
   86 #
   87 sub current {
   88   my $self = shift; my $contextTable = shift; my $context = shift;
   89   if ($contextTable) {$userContext = $contextTable} else {$contextTable = $userContext}
   90   if (defined($context)) {
   91     if (!ref($context)) {
   92       my $name = $context;
   93       $context = Parser::Context->get($contextTable,$context);
   94       Value::Error("Unknown context '$name'") unless defined($context);
   95     }
   96     $contextTable->{current} = $context;
   97     $Value::context = \$contextTable->{current};
   98   } elsif (!defined($contextTable->{current})) {
   99     $contextTable->{current} = $Parser::Context::Default::fullContext->copy;
  100     $Value::context = \$contextTable->{current};
  101   }
  102   return $contextTable->{current};
  103 }
  104 
  105 #
  106 #  Get a named context
  107 #   (either from the main list or a copy from the default list)
  108 #
  109 sub get {
  110   my $self = shift; my $contextTable = shift; my $name = shift;
  111   my $context = $contextTable->{$name};
  112   return $context if $context;
  113   $context = $Parser::Context::Default::context{$name};
  114   return unless $context;
  115   return $context->copy;
  116 }
  117 
  118 #
  119 #  Update the precedences of multiplication so that they
  120 #  are the standard or non-standard ones, depending on the
  121 #  argument.  It should be 'Standard' or 'Non-Standard'.
  122 #
  123 sub usePrecedence {
  124   my $self = shift;
  125   for (shift) {
  126 
  127     /^Standard/i  and do {
  128       $self->operators->set(
  129         ' *' => {precedence => 3},
  130         '* ' => {precedence => 3},
  131         ' /' => {precedence => 3},
  132         '/ ' => {precedence => 3},
  133          fn  => {precedence => 3},
  134          ' ' => {precedence => 3},
  135       );
  136       last;
  137     };
  138 
  139     /^Non-Standard/i and do {
  140       $self->operators->set(
  141         ' *' => {precedence => 2.8},
  142         '* ' => {precedence => 2.8},
  143         ' /' => {precedence => 2.8},
  144         '/ ' => {precedence => 2.8},
  145          fn  => {precedence => 2.9},
  146          ' ' => {precedence => 3.1},
  147       );
  148       last;
  149     };
  150 
  151     Value::Error("Precedence type should be one of 'Standard' or 'Non-standard'");
  152   }
  153 }
  154 
  155 #########################################################################
  156 #
  157 #  Load the subclasses.
  158 #
  159 
  160 use Parser::Context::Constants;
  161 use Parser::Context::Functions;
  162 use Parser::Context::Operators;
  163 use Parser::Context::Parens;
  164 use Parser::Context::Strings;
  165 use Parser::Context::Variables;
  166 
  167 #########################################################################
  168 
  169 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9