#!/usr/bin/perl
#

package S2::NodeVarRef;

use strict;
use S2::Node;
use S2::NodeExpr;
use S2::Type;
use vars qw($VERSION @ISA $LOCAL $OBJECT $PROPERTY);

$LOCAL = 1;
$OBJECT = 2;
$PROPERTY = 3;
$VERSION = '1.0';
@ISA = qw(S2::Node);

sub new {
    my ($class) = @_;
    my $n = new S2::Node;
    bless $n, $class;
}

sub canStart {
    my ($class, $toker) = @_;
    return $toker->peek() == $S2::TokenPunct::DOLLAR;
}

sub parse {
    my ($class, $toker) = @_;

    my $n = new S2::NodeVarRef();
    $n->{'levels'} = [];
    $n->{'type'} = $LOCAL;

    # voo-doo so tokenizer won't continue parsing a string
    # if we're in a string and trying to parse interesting things
    # involved in a VarRef:
    
    $n->setStart($n->requireToken($toker, $S2::TokenPunct::DOLLAR, 0));

    $toker->pushInString(0);  # pretend we're not, even if we are.
	
    if ($toker->peekChar() eq "{") {
        $n->requireToken($toker, $S2::TokenPunct::LBRACE, 0);
        $n->{'braced'} = 1;
    } else {
        $n->{'braced'} = 0;
    }

    if ($toker->peekChar() eq ".") {
        $n->requireToken($toker, $S2::TokenPunct::DOT, 0);
        $n->{'type'} = $OBJECT;
    } elsif ($toker->peekChar() eq "*") {
        $n->requireToken($toker, $S2::TokenPunct::MULT, 0);
        $n->{'type'} = $PROPERTY;
    } 

    my $requireDot = 0;
	
    # only peeking at characters, not tokens, otherwise
    # we could force tokens could be created in the wrong 
    # context.  
    while ($toker->peekChar() =~ /[a-zA-Z\_\.]/)
    {
        if ($requireDot) {
            $n->requireToken($toker, $S2::TokenPunct::DOT, 0);
        } else {
            $requireDot = 1;
        }
        
        my $ident = $n->getIdent($toker, 1, 0);

        my $vl = {
            'var' => $ident->getIdent(),
            'derefs' => [],
        };

        # more preventing of token peeking:
        while ($toker->peekChar() eq '[' ||
               $toker->peekChar() eq '{') 
        {
            my $dr = {}; # Deref, 'type', 'expr'
            my $t = $n->eatToken($toker, 0);
		
            if ($t == $S2::TokenPunct::LBRACK) {
                $dr->{'type'} = '[';
                $n->addNode($dr->{'expr'} = S2::NodeExpr->parse($toker));
                $n->requireToken($toker, $S2::TokenPunct::RBRACK, 0);
            } elsif ($t == $S2::TokenPunct::LBRACE) {
                $dr->{'type'} = '{';
                $n->addNode($dr->{'expr'} = S2::NodeExpr->parse($toker));
                $n->requireToken($toker, $S2::TokenPunct::RBRACE, 0);
            } else {
                die;
            }
            
            push @{$vl->{'derefs'}}, $dr;
        }
        
        push @{$n->{'levels'}}, $vl;
    } # end while

    # did we parse just $ ?
    S2::error($n, "Malformed variable reference") unless
        @{$n->{'levels'}};    

    if ($n->{'braced'}) {
        # false argument necessary to prevent peeking at token
        # stream while it's in the interpolated variable parsing state,
        # else the string text following the variable would be
        # treated as if it were outside the string.
        $n->requireToken($toker, $S2::TokenPunct::RBRACE, 0);
    }

    $toker->popInString();  # back to being in a string if we were
    
    # now we must skip white space that requireToken above would've
    # done had we not told it not to, but not if the main tokenizer
    # is in a quoted string
    if ($toker->{'inString'} == 0) {
        $n->skipWhite($toker);
    }
    return $n;
}

# if told by NodeTerm.java, add another varlevel to point to
# this object's $.as_string
sub useAsString {
    my $this = shift;
    push @{$this->{'levels'}}, {
        'var' => 'as_string',
        'derefs' => [],
    };
}

sub isHashElement {
    my $this = 0;

    return 0 unless @{$this->{'levels'}};
    my $l = $this->{'levels'}->[-1];
    return 0 unless @$l;
    my $d = $l->[-1];
    return $d->{'type'} eq "{";
}

sub getType {
    my ($this, $ck, $wanted) = @_;

    if (defined $wanted) {
        my $t = getType($this, $ck);
        return $t unless
            $wanted->equals($S2::Type::STRING);
        my $type = $t->toString();
        if ($ck->classHasAsString($type)) {
            $this->{'useAsString'} = 1;
            return $S2::Type::STRING;
        }
    }

    # must have at least reference something.
    return undef unless @{$this->{'levels'}};

    my @levs = @{$this->{'levels'}};
    my $lev = shift @levs;  # VarLevel
    my $vart = undef;  # Type

    # properties
    if ($this->{'type'} == $PROPERTY) {
        $vart = $ck->propertyType($lev->{'var'});
        S2::error($this, "Unknown property") unless $vart;
        $vart = $vart->clone();
    }

    # local variables.
    if ($this->{'type'} == $LOCAL) {
        $vart = $ck->localType($lev->{'var'});
        S2::error($this, "Unknown local variable \$$lev->{'var'}") unless $vart;
    }

    # properties & locals
    if ($this->{'type'} == $PROPERTY ||
        $this->{'type'} == $LOCAL) 
    {
        $vart = $vart->clone();
        
        # dereference [] and {} stuff
        $this->doDerefs($ck, $lev->{'derefs'}, $vart);
        
        # if no more levels, return now.  otherwise deferencing
        # happens below.
        return $vart unless @levs;
        $lev = shift @levs;
    }
     
    # initialize the name of the current object
    if ($this->{'type'} == $OBJECT) {
        my $curclass = $ck->getCurrentFunctionClass();
        S2::error($this, "Can't reference member variable in non-class function") unless $curclass;
        $vart = new S2::Type($curclass);
    }
        
    while ($lev) {
        my $nc = $ck->getClass($vart->toString());
        S2::error($this, "Can't use members of an undefined class") unless $nc;
        $vart = $nc->getMemberType($lev->{'var'});
        S2::error($this, "Can't find member '$lev->{'var'}' in " . $nc->getName()) unless $vart;
        $vart = $vart->clone();
        
        # dereference [] and {} stuff 
        $this->doDerefs($ck, $lev->{'derefs'}, $vart);
        $lev = shift @levs;
    }
    return $vart;
}

# private
sub doDerefs {
    my ($this, $ck, $derefs, $vart) = @_;
    foreach my $d (@{$derefs}) {
        my $et = $d->{'expr'}->getType($ck);
        if ($d->{'type'} eq "{") {
            S2::error($this, "Can't dereference a non-hash as a hash")
                unless $vart->isHashOf();
            S2::error($this, "Must dereference a hash with a string or int")
                unless ($et->equals($S2::Type::STRING) ||
                        $et->equals($S2::Type::INT));
            $vart->removeMod();  # not a hash anymore
        } elsif ($d->{'type'} eq "[") {
            S2::error($this, "Can't dereference a non-array as an array ")
                unless $vart->isArrayOf();
            S2::error($this, "Must dereference an array with an int")
                unless $et->equals($S2::Type::INT);
            $vart->removeMod();  # not an array anymore
        }
    }
}

# is this variable $super ?
sub isSuper {
    my ($this) = @_;
    return 0 if $this->{'type'} != $LOCAL;
    return 0 if @{$this->{'levels'}} > 1;
    my $v = $this->{'levels'}->[0];
    return ($v->{'var'} eq "super" &&
            @{$v->{'derefs'}} == 0);
}

sub asS2 {
    my ($this, $o) = @_;
    die "Unported";
}

sub asPerl {
    my ($this, $bp, $o) = @_;
    my $first = 1;

    if ($this->{'type'} == $LOCAL) {
        $o->write("\$");
    } elsif ($this->{'type'} == $OBJECT) {
        $o->write("\$this");
    } elsif ($this->{'type'} == $PROPERTY) {
        $o->write("\$_ctx->[PROPS]");
        $first = 0;
    }

    foreach my $lev (@{$this->{'levels'}}) {
        if (! $first || $this->{'type'} == $OBJECT) {
            $o->write("->{'$lev->{'var'}'}");
        } else {
            my $v = $lev->{'var'};
            if ($first && $this->{'type'} == $LOCAL &&
                $v eq "super") {
                $v = "this";
            }
            $o->write($v);
            $first = 0;
        }

        foreach my $d (@{$lev->{'derefs'}}) {
            $o->write("->$d->{'type'}"); # [ or {
            $d->{'expr'}->asPerl($bp, $o);
            $o->write($d->{'type'} eq "[" ? "]" : "}");
        }
    } # end levels

    if ($this->{'useAsString'}) {
        $o->write("->{'as_string'}");
    }
}

sub isProperty {
    my $this = shift;
    return $this->{'type'} == $PROPERTY;
}

sub propName {
    my $this = shift;
    return "" unless $this->{'type'} == $PROPERTY;
    return $this->{'levels'}->[0]->{'var'};
}