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

    1 #########################################################################
    2 #
    3 #  Implements the list of known functions
    4 #
    5 package Parser::Context::Functions;
    6 use strict;
    7 use vars qw (@ISA);
    8 @ISA = qw(Value::Context::Data);
    9 
   10 sub init {
   11   my $self = shift;
   12   $self->{dataName} = 'functions';
   13   $self->{name} = 'function';
   14   $self->{Name} = 'Function';
   15   $self->{namePattern} = '[a-zA-Z][a-zA-Z0-9]*';
   16 }
   17 
   18 #
   19 #  Remove a function from the list by assigning it
   20 #    the undefined function.  This means it will still
   21 #    be recognized by the parser, but will generate an
   22 #    error message whenever it is used.  The old class
   23 #    is saved so that it can be redefined again.
   24 #
   25 sub undefine {
   26   my $self = shift;
   27   my @data = ();
   28   foreach my $x (@_) {
   29     push(@data,$x => {
   30       oldClass => $self->get($x)->{class},
   31       class => 'Parser::Function::undefined',
   32     });
   33   }
   34   $self->set(@data);
   35 }
   36 
   37 sub redefine {
   38   my $self = shift; my $X = shift;
   39   return $self->SUPER::redefine($X,@_) if scalar(@_) > 0;
   40   $X = [$X] unless ref($X) eq 'ARRAY';
   41   my @data = ();
   42   foreach my $x (@{$X}) {
   43     my $oldClass = $self->get($x)->{oldClass};
   44     push(@data,$x => {class => $oldClass, oldClass => undef})
   45       if $oldClass;
   46   }
   47   $self->set(@data);
   48 }
   49 
   50 #########################################################################
   51 #
   52 #  Handle enabling and disabling functions
   53 #
   54 
   55 my %Category = (
   56    SimpleTrig  => [qw(sin cos tan sec csc cot)],
   57    InverseTrig => [qw(asin acos atan asec acsc acot
   58           arcsin arccos arctan arcsec arccsc arccot atan2)],
   59 
   60    SimpleHyperbolic  => [qw(sinh cosh tanh sech csch coth)],
   61    InverseHyperbolic => [qw(asinh acosh atanh asech acsch acoth
   62                             arcsinh arccosh arctanh arcsech arccsch arccoth)],
   63 
   64    Numeric     => [qw(log log10 exp sqrt abs int sgn ln logten)],
   65 
   66    Vector      => [qw(norm unit)],
   67 
   68    Complex     => [qw(arg mod Re Im conj)],
   69 
   70    Hyperbolic  => [qw(_alias_ SimpleHyperbolic InverseHyperbolic)],
   71    Trig        => [qw(_alias_ SimpleTrig InverseTrig Hyperbolic)],
   72    All         => [qw(_alias_ Trig Numeric Vector Complex)],
   73 );
   74 
   75 sub disable {Disable(@_)}
   76 sub Disable {
   77   my $context = Parser::Context->current;
   78   if (ref($_[0]) ne "") {$context = (shift)->{context}}
   79   my @names = @_; my ($list,$name);
   80   while ($name = shift(@names)) {
   81     $list = $Category{$name};
   82     $list = [$name] if !$list && $context->{functions}{$name};
   83     unless (defined($list)) {warn "Undefined function or category '$name'"; next}
   84     if ($list->[0] eq '_alias_')
   85       {unshift @names, @{$list}[1..scalar(@{$list})-1]; next}
   86     $context->functions->undefine(@{$list});
   87   }
   88 }
   89 
   90 sub enable {Enable(@_)}
   91 sub Enable {
   92   my $context = Parser::Context->current;
   93   my $functions = $Parser::Context::Default::fullContext->{functions};
   94   if (ref($_[0]) ne "") {$context = (shift)->{context}}
   95   my @names = @_; my ($list,$name);
   96   while ($name = shift(@names)) {
   97     $list = $Category{$name};
   98     $list = [$name] if !$list && $context->{functions}{$name};
   99     unless (defined($list)) {warn "Undefined function or category '$name'"; next}
  100     if ($list->[0] eq '_alias_')
  101       {unshift @names, @{$list}[1..scalar(@{$list})-1]; next}
  102     my @fn; foreach my $f (@{$list})
  103       {push @fn, $f => {class => $functions->{$f}{class}}}
  104     $context->functions->set(@fn);
  105   }
  106 }
  107 
  108 #########################################################################
  109 
  110 1;