package CDecl;

use 5.6.0;
use strict;
use warnings;

no warnings 'recursion';

sub new
  {
    my $this = shift;
    my $class = ref($this) || $this;

    my $storage_class = shift;
    my $identifier = shift;
    my $type = shift;
    my $location = shift;

    my $self = {class => $storage_class,
                identifier => $identifier,
                type => $type,
                file => $location->{file},
                line => $location->{line},
                pos => $location->{pos},
               };
    bless $self, $class;
    return $self;
  }

sub identifier
  {
    my $self = shift;
    return $self->{identifier};
  }

sub file
  {
    my $self = shift;
    return $self->{file};
  }

sub location
  {
    my $self = shift;

    return '' unless $self->{file};
    return "$self->{file}:$self->{line}";
  }

sub describe_name
  {
    my $self = shift;

    my $name = "";
    if ($self->{class})
      {
        $name = $self->{class} . " ";
      }

    $name .= $self->{identifier} || "<unnamed>";
  }

sub dump_c
  {
    my $self = shift;
    my $skip_cpp = shift;

    my $cpp_line = '';

    if ($self->{class} ne 'param' and $self->{file} and not $skip_cpp)
      {
        $cpp_line = "# $self->{line} \"$self->{file}\"\n";
      }
    # We've now dumped cpp, so we don't do it again in this decl
    $skip_cpp = 1;

    my $class_prefix;
    if ($self->{class} eq 'member' or $self->{class} eq 'param')
      {
        $class_prefix = '';
      }
    else
      {
        $class_prefix = $self->{class} . ' ';
      }

    my $decl_suffix;
    if ($self->{class} eq 'param')
      {
        $decl_suffix = '';
      }
    else
      {
        $decl_suffix = ";\n";
      }

    if ($self->{type}->capture_declarator)
      {
        my $str = $self->{type}->dump_c($skip_cpp, $self->{identifier});
        $str =~ s/\n*$//;
        return $cpp_line . $class_prefix . $str . $decl_suffix;
      }

    my $declarator = $self->{identifier} ? " $self->{identifier}" : "";

    my $str = $self->{type}->dump_c($skip_cpp);
    $str =~ s/\n*$//;
    return $cpp_line . $class_prefix . $str . $declarator . $decl_suffix;
  }

sub layout
  {
    my $self = shift;
    my $accept_incomplete = shift;
    my $namespace = shift;

    $accept_incomplete = 1 if $self->{class} eq 'extern';

    return if $accept_incomplete and not $self->type($accept_incomplete);

    eval {$self->type($accept_incomplete)->layout($accept_incomplete, $namespace)};
    if ($@)
      {
        print STDERR "While laying out " . $self->dump_c(1) . ":\n";
        die;
      }
  }

sub type
  {
    my $self = shift;
    my $accept_incomplete = shift;
    return $self->{type}->type($accept_incomplete);
  }

sub alignment
  {
    my $self = shift;
    return $self->type->alignment;
  }

sub alignment_exprs
  {
    my $self = shift;
    return $self->type->alignment_exprs;
  }

sub width
  {
    my $self = shift;
    return $self->type->width(@_);
  }

sub signed
  {
    my $self = shift;
    return $self->type->signed(@_);
  }

sub set_packed
  {
    my $self = shift;
    $self->{packed} = shift;
  }

sub packed
  {
    my $self = shift;
    return $self->{packed} if defined $self->{packed};
    return $self->type->packed(@_);
  }

sub set_offset
  {
    my $self = shift;
    $self->{offset} = shift;
  }

sub offset
  {
    my $self = shift;
    return $self->{offset};
  }

sub describe
  {
    my $self = shift;

    my $str = "";

    if (defined $self->{offset} and $self->{identifier})
      {
        $str .= " " if length $str;
        $str .= "$self->{offset} $self->{identifier}:";
      }
    elsif (defined $self->{offset})
      {
        $str .= " " if length $str;
        $str .= "$self->{offset}:";
      }
    elsif ($self->{identifier})
      {
        $str .= " " if length $str;
        $str .= "$self->{identifier}:";
      }

    if ($self->{class} eq 'param' or $self->{class} eq 'member')
      {
      }
    else
      {
        $str .= " " if length $str;
        $str .= $self->{class};
      }

    if ($self->{type})
      {
        $str .= " " if length $str;
        $str .= $self->{type}->describe;
      }

    return $str;
  }

sub check_interface
  {
    my $self = shift;
    my $other = shift;
    my $ignore_identifiers = shift;

    unless ($self->{type} and $other->{type})
      {
        die "Unable to check types due to missing prototype; please don't use K&R C";
      }

    my @ret = $self->{type}->check_interface($other->{type});

    my $ret = {};

    foreach (@ret)
      {
        foreach my $key (keys %$_)
          {
            $ret->{$key} = 1 if $_->{$key};
          }
      }

    if ($self->{class} ne $other->{class})
      {
        print "API and ABI mismatch: storage class '$self->{class}' versus '$other->{class}'\n";
        $ret->{api_forward} = 1;
        $ret->{api_backward} = 1;
        $ret->{abi_forward} = 1;
        $ret->{abi_backward} = 1;
      }

    if (not $ignore_identifiers)
      {
        if (defined $self->{identifier} and defined $other->{identifier})
          {
            if ($self->{identifier} ne $other->{identifier})
              {
                print "API mismatch: identifier '$self->{identifier}' versus '$other->{identifier}'\n";
                $ret->{api_forward} = 1;
                $ret->{api_backward} = 1;
              }
          }
        elsif (defined $self->{identifier} or defined $other->{identifier})
          {
            die;
          }
      }

    if (defined $self->{offset} and defined $other->{offset})
      {
        if ($self->{offset} != $other->{offset})
          {
            print "ABI mismatch: offset of $self->{offset} versus $other->{offset}\n";
            $ret->{abi_forward} = 1;
            $ret->{abi_backward} = 1;
          }
      }
    elsif (defined $self->{offset} or defined $other->{offset})
      {
        die "Internal error: offset for one decl but not the other";
      }

    if (grep {$ret->{$_}} keys %$ret)
      {
        my $location = $self->location;
        if ($location)
          {
            print " in declaration at $location:\n";
          }
        else
          {
            print " in declaration:\n";
          }
        my $dump = $self->dump_c(1);
        $dump =~ s/\n?$/\n/;
        print $dump;
        my $other_location = $other->location;
        if ($other_location)
          {
            print " versus declaration at $location:\n";
          }
        else
          {
            print " versus declaration:\n";
          }
        my $other_dump = $other->dump_c(1);
        $other_dump =~ s/\n?$/\n/;
        print $other_dump;
      }

    return $ret;
  }

sub get_refs
  {
    my $self = shift;
    return $self->{type}->get_refs;
  }

sub complete
  {
    my $self = shift;
    return $self->{type}->complete;
  }

1;
