[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 4928 - (download) (as text) (annotate)
Tue Apr 17 00:36:16 2007 UTC (12 years, 8 months ago) by dpvc
File size: 5521 byte(s)
Modified the way the Parser-based versions of the traditional answer
checkers get copies of their contexts.  They now use a new method
getCopy to obtain the copy either from the problem's context table or
the default table (rather than only from the default).  That way the
instructor can use parserCustomization.pl to customize the contexts
used by the answer checkers.

    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->{parser} = {%{$Parser::class}};
   22   push(@{$context->{data}{values}},'parser');
   23   $context->{_initialized} = 0;
   24   push(@{$context->{data}{objects}},(
   25     'functions','variables','constants','operators','strings','parens',
   26   ));
   27   push(@{$context->{data}{values}},'reduction');
   28   my %data = (
   29     functions => {},
   30     variables => {},
   31     constants => {},
   32     operators => {},
   33     strings   => {},
   34     parens    => {},
   35     lists     => {},
   36     flags     => {},
   37     reduction => {},
   38     @_
   39   );
   40   $context->{_functions} = new Parser::Context::Functions($context,%{$data{functions}});
   41   $context->{_variables} = new Parser::Context::Variables($context,%{$data{variables}});
   42   $context->{_constants} = new Parser::Context::Constants($context,%{$data{constants}});
   43   $context->{_operators} = new Parser::Context::Operators($context,%{$data{operators}});
   44   $context->{_strings}   = new Parser::Context::Strings($context,%{$data{strings}});
   45   $context->{_parens}    = new Parser::Context::Parens($context,%{$data{parens}});
   46   $context->{_reduction} = new Parser::Context::Reduction($context,%{$data{reduction}});
   47   $context->lists->set(%{$data{lists}});
   48   $context->flags->set(%{$data{flags}});
   49   $context->{_initialized} = 1;
   50   $context->update;
   51   return $context;
   52 }
   53 
   54 #
   55 #  Update the token pattern
   56 #
   57 sub update {
   58   my $self = shift; return unless $self->{_initialized};
   59   $self->{pattern}{token} =
   60    '(?:('.join(')|(',
   61          $self->strings->{pattern},
   62          $self->functions->{pattern},
   63          $self->constants->{pattern},
   64          $self->{pattern}{number},
   65          $self->operators->{pattern},
   66          $self->parens->{open},
   67          $self->parens->{close},
   68          $self->variables->{pattern},
   69   ).'))';
   70 }
   71 
   72 #
   73 #  Access to the data lists
   74 #
   75 sub operators {(shift)->{_operators}}
   76 sub functions {(shift)->{_functions}}
   77 sub constants {(shift)->{_constants}}
   78 sub variables {(shift)->{_variables}}
   79 sub strings   {(shift)->{_strings}}
   80 sub parens    {(shift)->{_parens}}
   81 sub reduction {(shift)->{_reduction}}
   82 
   83 sub reduce     {(shift)->{_reduction}->reduce(@_)}
   84 sub noreduce   {(shift)->{_reduction}->noreduce(@_)}
   85 sub reductions {(shift)->{_reduction}}
   86 
   87 #
   88 #  Store pointer to user's context table
   89 #
   90 my $userContext;
   91 
   92 #
   93 #  Set/Get the current Context object
   94 #
   95 sub current {
   96   my $self = shift; my $contextTable = shift; my $context = shift;
   97   if ($contextTable) {$userContext = $contextTable} else {$contextTable = $userContext}
   98   if (defined($context)) {
   99     if (!ref($context)) {
  100       my $name = $context;
  101       $context = Parser::Context->get($contextTable,$context);
  102       Value::Error("Unknown context '%s'",$name) unless defined($context);
  103     }
  104     $contextTable->{current} = $context;
  105     $Value::context = \$contextTable->{current};
  106   } elsif (!defined($contextTable->{current})) {
  107     $contextTable->{current} = $Parser::Context::Default::numericContext->copy;
  108     $Value::context = \$contextTable->{current};
  109   }
  110   return $contextTable->{current};
  111 }
  112 
  113 #
  114 #  Get a named context
  115 #   (either from the main list or a copy from the default list)
  116 #
  117 sub get {
  118   my $self = shift; my $contextTable = shift; my $name = shift;
  119   $contextTable = $userContext unless $contextTable;
  120   my $context = $contextTable->{$name};
  121   return $context if $context;
  122   $context = $Parser::Context::Default::context{$name};
  123   return unless $context;
  124   return $context->copy;
  125 }
  126 
  127 #
  128 #  Get a copy of named context
  129 #
  130 sub getCopy {
  131   my $self = shift; my $contextTable = shift; my $name = shift;
  132   $contextTable = $userContext unless $contextTable;
  133   my $context = $contextTable->{$name};
  134   $context = $Parser::Context::Default::context{$name} unless $context;
  135   return unless $context;
  136   return $context->copy;
  137 }
  138 
  139 #
  140 #  Update the precedences of multiplication so that they
  141 #  are the standard or non-standard ones, depending on the
  142 #  argument.  It should be 'Standard' or 'Non-Standard'.
  143 #
  144 sub usePrecedence {
  145   my $self = shift;
  146   for (shift) {
  147 
  148     /^Standard/i  and do {
  149       $self->operators->set(
  150         ' *' => {precedence => 3},
  151         '* ' => {precedence => 3},
  152         ' /' => {precedence => 3},
  153         '/ ' => {precedence => 3},
  154          fn  => {precedence => 7.5},
  155          ' ' => {precedence => 3},
  156       );
  157       last;
  158     };
  159 
  160     /^Non-Standard/i and do {
  161       $self->operators->set(
  162         ' *' => {precedence => 2.8},
  163         '* ' => {precedence => 2.8},
  164         ' /' => {precedence => 2.8},
  165         '/ ' => {precedence => 2.8},
  166          fn  => {precedence => 2.9},
  167          ' ' => {precedence => 3.1},
  168       );
  169       last;
  170     };
  171 
  172     Value::Error("Precedence type should be one of 'Standard' or 'Non-Standard'");
  173   }
  174 }
  175 
  176 #########################################################################
  177 #
  178 #  Load the subclasses.
  179 #
  180 
  181 use Parser::Context::Constants;
  182 use Parser::Context::Functions;
  183 use Parser::Context::Operators;
  184 use Parser::Context::Parens;
  185 use Parser::Context::Strings;
  186 use Parser::Context::Variables;
  187 use Parser::Context::Reduction;
  188 
  189 #########################################################################
  190 
  191 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9