package CType;

use 5.6.0;
use strict;
use warnings;

use Carp;

sub type
  {
    my $self = shift;
    return $self;
  }

sub set_location
  {
    my $self = shift;
    my $location = shift;
    $self->{file} = $location->{file};
    $self->{line} = $location->{line};
    $self->{pos} = $location->{pos};
  }

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

sub location
  {
    my $self = shift;

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

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

    return '' if $skip_cpp;
    return '' unless $self->{file};
    return "# $self->{line} \"$self->{file}\"\n";
  }

sub set_qualifiers
  {
    my $self = shift;
    my $qualifiers = shift;

    my %qualifiers = map {$_=>1} @$qualifiers;
    $self->{const} = $qualifiers{const} || 0;
    $self->{volatile} = $qualifiers{volatile} || 0;
    $self->{restrict} = $qualifiers{restrict} || 0;
  }

sub check_sizes
  {
    my $self = shift;
    my $other = shift;

    return 'abi' unless $other->width == $self->width;
    return 'abi' unless $other->signed == $self->signed;
    return 'ok';
  }

sub check_qualifiers
  {
    my $self = shift;
    my $other = shift;

    if ($self->{const} != $other->{const})
      {
        return 'both';
      }

    if ($self->{volatile} != $other->{volatile})
      {
        return 'abi';
      }

    if ($self->{restrict} != $other->{restrict})
      {
        return 'both';
      }

    return 'ok';
  }

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

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

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

sub dump_c_qualifiers
  {
    my $self = shift;
    my @qualifiers;
    push @qualifiers, 'const' if $self->const;
    push @qualifiers, 'volatile' if $self->volatile;
    push @qualifiers, 'restrict' if $self->restrict;

    my @attributes;

    # We emit alignment expressions iff the analysis logic decided
    # that this object had an interesting alignment.
    if ($self->{alignment})
      {
        my @alignments = $self->alignment_exprs;
        if (scalar @alignments)
          {
            push @attributes, map {'aligned(' . $_->dump_c . ')'} @alignments;
          }
      }

    if ($self->{packed})
      {
        push @attributes, 'packed';
      }

    if (scalar @attributes)
      {
        push @qualifiers, '__attribute__((' . join(', ', @attributes) . '))';
      }

    return join(' ', @qualifiers);
  }

sub describe_qualifiers
  {
    my $self = shift;
    my @qualifiers;
    push @qualifiers, 'const' if $self->const;
    push @qualifiers, 'volatile' if $self->volatile;
    push @qualifiers, 'restrict' if $self->restrict;
    push @qualifiers, ($self->alignment . "-bit aligned") if $self->{alignment};
    return join(' ', @qualifiers);
  }

sub width
  {
    my $self = shift;

    unless (defined $self->{width})
      {
        confess "Width of type is unknown (for $self)";
      }
    return $self->{width};
  }

sub alignment
  {
    my $self = shift;

    unless (defined $self->{alignment})
      {
        confess "Alignment of type is unknown (for $self)";
      }
    return $self->{alignment};
  }

sub signed
  {
    my $self = shift;

    unless (defined $self->{signed})
      {
        confess "Signedness of type is unknown (for $self)";
      }
    return $self->{signed};
  }

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

sub packed
  {
    my $self = shift;

    return $self->{packed};
  }

sub process_attributes
  {
    my $self = shift;
    my $attributes = shift;

    foreach my $attribute (@$attributes)
      {
        if ($attribute->name eq 'aligned')
          {
            if (scalar @{$attribute->args})
              {
                if ($self->can("add_alignment"))
                  {
                    $self->add_alignment($attribute->args->[0]->get_expr);
                  }
                else
                  {
                    my $arg = $attribute->args->[0]->get_expr->compute;
                    $self->{alignment} = $arg * 8;
                  }
              }
            else
              {
                confess "Automatic alignment is not supported";
              }
          }
      }
  }

sub capture_declarator
  {
    return 0;
  }

sub best_type_for_comparison
  {
    my $self = shift;
    return $self;
  }

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

    my ($self_type, $other_type);
    if ($self->isa('CType::Ref') and $other->isa('CType::Ref')
        and $self->kind eq $other->kind and $self->name eq $other->name)
      {
        # These are strictly matching references, so we'll not bother
        # looking through them
        $self_type = $self;
        $other_type = $other;
      }
    else
      {
        # Anything else, we look through just to be sure we know
        # what's going on
        $self_type = $self->best_type_for_comparison;
        $other_type = $other->best_type_for_comparison;
      }

    my @ret = $self_type->_check_interface($other_type);

    my $ret = {};

    my ($local_api, $local_abi);

    foreach (@ret)
      {
        if (ref $_)
          {
            foreach my $key (keys %$_)
              {
                $ret->{$key} = 1 if $_->{$key};
              }
          }
        elsif ($_ eq 'ok')
          {
          }
        elsif ($_ eq 'abi')
          {
            $ret->{abi_forward} = 1;
            $ret->{abi_backward} = 1;
            $local_abi = 1;
          }
        elsif ($_ eq 'api')
          {
            $ret->{api_forward} = 1;
            $ret->{api_backward} = 1;
            $local_api = 1;
          }
        elsif ($_ eq 'both')
          {
            $ret->{abi_forward} = 1;
            $ret->{abi_backward} = 1;
            $ret->{api_forward} = 1;
            $ret->{api_backward} = 1;
            $local_abi = 1;
            $local_api = 1;
          }
      }

    if ($local_abi and $local_api)
      {
        print "ABI and API mismatch between:\n";
        my $dump = $self_type->dump_c(1);
        $dump =~ s/\n?$/\n/;
        $dump =~ s/^/  /mg;
        print $dump;
        print "and:\n";
        my $other_dump = $other_type->dump_c(1);
        $other_dump =~ s/\n?$/\n/;
        $other_dump =~ s/^/  /mg;
        print $other_dump;
      }
    elsif ($local_abi)
      {
        print "ABI mismatch between:\n";
        my $dump = $self_type->dump_c(1);
        $dump =~ s/\n?$/\n/;
        $dump =~ s/^/  /mg;
        print $dump;
        print "and:\n";
        my $other_dump = $other_type->dump_c(1);
        $other_dump =~ s/\n?$/\n/;
        $other_dump =~ s/^/  /mg;
        print $other_dump;
      }
    elsif ($local_api)
      {
        print "API mismatch between:\n";
        my $dump = $self_type->dump_c(1);
        $dump =~ s/\n?$/\n/;
        $dump =~ s/^/  /mg;
        print $dump;
        print "and:\n";
        my $other_dump = $other_type->dump_c(1);
        $other_dump =~ s/\n?$/\n/;
        $other_dump =~ s/^/  /mg;
        print $other_dump;
      }

    return $ret;
  }

sub complete
  {
    1;
  }

1;