#!/usr/bin/perl -w
use strict;
use B::Utils qw(opgrep walkallops_filtered);

my $foo = ' delicious';
my $stringy = "abcde";

my %metoo = (
  key => 3,
  foo => $foo,
  string => $stringy,
);

my $lvalue = \(vec($foo,  0, 32) = 0x5065726C);
ltype($lvalue);

$lvalue = \(keys %metoo = 8);
ltype($lvalue);

$lvalue = \(pos $stringy = 3);
ltype($lvalue);

$lvalue = \(pos $stringy = 5);
ltype($lvalue);

$lvalue = \substr($stringy, 2);
ltype($lvalue);

$lvalue = \substr($stringy, 1, 2);
ltype($lvalue);

sub lvalue {
  my $ref = shift;
  my $lref = B::svref_2object($ref);
  return undef if $lref !~ /PVLV/;
  my $value = $$ref;
  my $type = $lref->TYPE;
  my $targ = $lref->TARG;
  my $string = $lref->TARG->PV;
  my $offset = $lref->TARGOFF;
  my $length = $lref->TARGLEN;
  my $func;
  if ($type eq 'k') {
    my $hashname = getname($targ);
    my $val = $targ->MAX;
    ++$val;
    $func = "keys $hashname = $val;";
  }
  if ($type eq 'v') {
    my $expr = getname($targ);
    $func = "vec($expr,$offset,$length) = $value;";
  }
  if ($type eq 'x') {
    my $expr = getname($targ);
    $func = "substr($expr,".$offset.','.$length.');';
  }
  if ($type eq '.') {
    my $scalar = getname($targ);
    $func = "pos $scalar = ".$value.';';
  }
  return $func;
}

sub ltype {
  my $lvalue = shift;
  print '$$lvalue = ',$$lvalue,"\n";
  print lvalue($lvalue),$/;
  print $/;
}


sub getname {
  my $targ = shift;
  my $class = B::class($targ);
  my $name;

  walkallops_filtered(
    sub {
      my $op = shift;
      
      if ($class eq 'HV') {
        opgrep( {  name => "padhv",
                   next => {
                     name => "keys",
                   },
                 }, $op) or return;
      } elsif ($class eq 'PVMG') {
        opgrep( {  name => "padsv",
                   next => {
                     name => [ "pos", "substr" ],
                   },
                 }, $op) or return;
       } elsif ($class eq 'PV') {
         opgrep( {  name => "padsv",
                    next => {
                      name => "const",
                      next => {
                        next => {
                          name => "vec",
                        },
                      },
                    },
                  }, $op) or return;
       }
    },
    sub {
      my $op = shift; 
      my $padname = ((B::main_cv->PADLIST->ARRAY)[0]->ARRAY)[$op->targ];
      my $tempname = $padname->PV if $padname;
      return () unless $tempname;
      if ($class =~ /PV/) {
        my $temppv = $targ->PV;
        $name = $tempname if ($temppv eq eval($tempname));
      } elsif ($class eq 'HV') {
        my %temphash = $targ->ARRAY;
        $name = $tempname if (%temphash eq eval($tempname));
      }
    }
  );
  return $name;
}