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

    1 #########################################################################
    2 #
    3 #  Implements the list of known variables and their types
    4 #
    5 package Parser::Context::Variables;
    6 use strict;
    7 our @ISA = qw(Value::Context::Data);
    8 
    9 #
   10 #  The named types for variables
   11 #    (you can use arbitary types by supplying an
   12 #     instance of the type rather than a name)
   13 #
   14 our %type = (
   15   'Real'    => $Value::Type{number},
   16   'Complex' => $Value::Type{complex},
   17   'Point2D' => Value::Type('Point',2,$Value::Type{number}),
   18   'Point3D' => Value::Type('Point',3,$Value::Type{number}),
   19   'Vector2D' => Value::Type('Vector',2,$Value::Type{number}),
   20   'Vector3D' => Value::Type('Vector',3,$Value::Type{number}),
   21   'Parameter' => $Value::Type{number},
   22 );
   23 
   24 sub init {
   25   my $self = shift;
   26   $self->{dataName} = 'variables';
   27   $self->{name} = 'variable';
   28   $self->{Name} = 'Variable';
   29   $self->{namePattern} = qr/[a-zA-Z][a-zA-Z0-9]*/;
   30   $self->{tokenType} = 'var';
   31   $self->{precedence} = 5;
   32   $self->{patterns}{$self->{namePattern}} = [$self->{precedence},$self->{tokenType}];
   33 }
   34 
   35 #sub addToken {}    # no tokens needed
   36 #sub removeToken {}
   37 
   38 #
   39 #  If the type is one of the names ones, use it's known type
   40 #  Otherwise if it is a Value object use its type,
   41 #  Otherwise, if it is a signed number, use the Real type
   42 #  Otherwise report an error
   43 #
   44 sub create {
   45   my $self = shift; my $value = shift; my @extra;
   46   return $value if ref($value) eq 'HASH';
   47   ($value,@extra) = @{$value} if ref($value) eq 'ARRAY';
   48   if (defined($type{$value})) {
   49     push(@extra,(parameter => 1)) if $value eq 'Parameter';
   50     $value = $type{$value};
   51   } elsif (Value::isValue($value)) {
   52     $value = $value->typeRef;
   53   } elsif ($value =~ m/$self->{context}{pattern}{signedNumber}/) {
   54     $value = $type{'Real'};
   55   } else {
   56     Value::Error("Unrecognized variable type '%s'",$value);
   57   }
   58   return {type => $value, @extra};
   59 }
   60 sub uncreate {shift; (shift)->{type}};
   61 
   62 #
   63 #  Return a variable's type
   64 #
   65 sub type {
   66   my $self = shift; my $x = shift;
   67   return $self->{context}{variables}{$x}{type};
   68 }
   69 
   70 #
   71 #  Return a parameter's value
   72 #
   73 sub value {
   74   my $self = shift; my $x = shift;
   75   return $self->{context}{variables}{$x}{value};
   76 }
   77 
   78 #
   79 #  Get the names of all variables
   80 #
   81 sub variables {
   82   my $self = shift; my @names;
   83   foreach my $x ($self->SUPER::names)
   84     {push(@names,$x) unless $self->{context}{variables}{$x}{parameter}}
   85   return @names;
   86 }
   87 
   88 #
   89 #  Get the names of all parameters
   90 #
   91 sub parameters {
   92   my $self = shift; my @names;
   93   foreach my $x ($self->SUPER::names)
   94     {push(@names,$x) if $self->{context}{variables}{$x}{parameter}}
   95   return @names;
   96 }
   97 
   98 #########################################################################
   99 
  100 1;