[system] / trunk / pg / lib / Value / List.pm Repository:
ViewVC logotype

View of /trunk/pg/lib/Value/List.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 5696 - (download) (as text) (annotate)
Sat Jun 14 12:14:21 2008 UTC (11 years, 8 months ago) by dpvc
File size: 3239 byte(s)
Added

	 no strict "refs"

to try to avoid new error checking in Perl 5.10.

    1 ###########################################################################
    2 #
    3 #  Implements the List object
    4 #
    5 package Value::List;
    6 my $pkg = 'Value::List';
    7 
    8 use strict; no strict "refs";
    9 our @ISA = qw(Value);
   10 
   11 #
   12 #  Make a List out of a list of entries or a
   13 #    reference to an array of entries, or the data from a Value object
   14 #
   15 sub new {
   16   my $self = shift; my $class = ref($self) || $self;
   17   my $context = (Value::isContext($_[0]) ? shift : $self->context);
   18   my $def = $context->lists->get("List");
   19   my $p = shift; my $isFormula = 0;
   20   my $isSingleton = (scalar(@_) == 0 && !(Value::isValue($p) && $p->classMatch('List')));
   21   $p = $p->data if (Value::isValue($p) && $p->classMatch('List') && scalar(@_) == 0);
   22   $p = [] unless defined $p;
   23   $p = [$p,@_] if ref($p) ne 'ARRAY' || scalar(@_) > 0;
   24   my $type;
   25   foreach my $x (@{$p}) {
   26     $x = Value::makeValue($x,context=>$context) unless ref($x);
   27     $isFormula = 1 if Value::isFormula($x);
   28     if (Value::isValue($x)) {
   29       if (!$type) {$type = $x->type}
   30         else {$type = 'unknown' unless $type eq $x->type}
   31     } else {$type = 'unknown'}
   32     if (!$isSingleton && $x->type eq 'List') {
   33       $x->{open}  = $def->{nestedOpen}  unless $x->{open};
   34       $x->{close} = $def->{nestedClose} unless $x->{close};
   35     }
   36   }
   37   return $p->[0] if ($isSingleton && $type eq 'List' && !$p->[0]{open});
   38   return $self->formula($p) if $isFormula;
   39   my $list = bless {data => $p, type => $type, context=>$context}, $class;
   40   $list->{correct_ans} = $p->[0]{correct_ans}
   41     if $isSingleton && defined scalar(@{$p}) && defined $p->[0]{correct_ans};
   42   if (scalar(@{$p}) == 0) {
   43     $list->{open}  = $def->{nestedOpen};
   44     $list->{close} = $def->{nestedClose};
   45   }
   46   return $list;
   47 }
   48 
   49 #
   50 #  Return the proper data
   51 #
   52 sub typeRef {
   53   my $self = shift;
   54   return Value::Type($self->class, $self->length, Value::Type($self->{type},1));
   55 }
   56 
   57 sub isOne {0}
   58 sub isZero {0}
   59 
   60 #
   61 #  Turn arbitrary data into a List
   62 #
   63 sub promote {
   64   my $self = shift; my $class = ref($self) || $self;
   65   my $context = (Value::isContext($_[0]) ? shift : $self->context);
   66   my $x = (scalar(@_) ? shift : $self);
   67   return $x->inContext($context) if ref($x) eq $class && scalar(@_) == 0;
   68   return $self->new($context,$x,@_)
   69     if (scalar(@_) > 0 || !Value::isValue($x) || Value::isComplex($x));
   70   return $self->make($context,$x->value);
   71 }
   72 
   73 ############################################
   74 #
   75 #  Operations on lists
   76 #
   77 
   78 #
   79 #  Add is concatenation
   80 #
   81 sub add {
   82   my ($self,$l,$r) = Value::checkOpOrder(@_);
   83   $l = Value::makeValue($l) unless Value::isValue($l);
   84   $r = Value::makeValue($r) unless Value::isValue($r);
   85   $l = $self->make($l) unless Value::classMatch($l,'List');
   86   $r = $self->make($r) unless Value::classMatch($r,'List');
   87   return $self->new($l->value,$r->value);
   88 }
   89 sub dot {my $self = shift; $self->add(@_)}
   90 
   91 #
   92 #  Lexicographic compare
   93 #
   94 sub compare {
   95   my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
   96   my @l = $l->value; my @r = $r->value;
   97   my $cmp = 0; my $n = scalar(@l); $n = scalar(@r) if scalar(@r) < $n;
   98   foreach my $i (0..$n-1) {
   99     $cmp = $l[$i] <=> $r[$i];
  100     return $cmp if $cmp;
  101   }
  102   return scalar(@l) <=> scalar(@r);
  103 }
  104 
  105 ###########################################################################
  106 
  107 1;
  108 

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9