package CType::Fundamental;

use 5.6.0;
use strict;
use warnings;

use Exporter;
use CType;
use CExpr::Alignof;

our @ISA = qw/Exporter CType/;
our @EXPORT_OK = qw/register_type_attrs compare_ord/;

# These are all the fundamental types

my %types;
my %type_info = (Void => {name => 'void',
                          nature => 'void',
                          ord => 0,
                         },
                 VoidPtr => {name => 'void *',
                             nature => 'int',
                             ord => 'undef',
                            },
                 Char => {name => 'char',
                          nature => 'int',
                          ord => 1,
                         },
                 SignedChar => {name => 'signed char',
                                nature => 'int',
                                ord => 2,
                               },
                 UnsignedChar => {name => 'unsigned char',
                                  nature => 'int',
                                  ord => 2,
                                 },
                 Short => {name => 'short int',
                           nature => 'int',
                           ord => 3,
                          },
                 UnsignedShort => {name => 'unsigned short int',
                                   nature => 'int',
                                   ord => 3,
                                  },
                 Int => {name => 'int',
                         nature => 'int',
                         ord => 4,
                        },
                 UnsignedInt => {name => 'unsigned int',
                                 nature => 'int',
                                 ord => 4,
                                },
                 Long => {name => 'long int',
                          nature => 'int',
                          ord => 5,
                         },
                 UnsignedLong => {name => 'unsigned long int',
                                  nature => 'int',
                                  ord => 5,
                                 },
                 LongLong => {name => 'long long int',
                              nature => 'int',
                              ord => 6,
                             },
                 UnsignedLongLong => {name => 'unsigned long long int',
                                      nature => 'int',
                                      ord => 6,
                                     },
                 Float => {name => 'float',
                           nature => 'float',
                           ord => 1,
                          },
                 Double => {name => 'double',
                            nature => 'float',
                            ord => 2,
                           },
                 LongDouble => {name => 'long double',
                                nature => 'float',
                                ord => 3,
                               },
                 Bool => {name => '_Bool',
                          nature => 'int',
                          ord => 'undef',
                         },
                 FloatComplex => {name => 'float complex',
                                  nature => 'complex',
                                  ord => 1,
                                 },
                 DoubleComplex => {name => 'double complex',
                                   nature => 'complex',
                                   ord => 2,
                                  },
                 LongDoubleComplex => {name => 'long double complex',
                                       nature => 'complex',
                                       ord => 3,
                                      },
                 FloatImaginary => {name => 'float imaginary',
                                    nature => 'imaginary',
                                    ord => 1,
                                   },
                 DoubleImaginary => {name => 'double imaginary',
                                     nature => 'imaginary',
                                     ord => 2,
                                    },
                 LongDoubleImaginary => {name => 'long double imaginary',
                                         nature => 'imaginary',
                                         ord => 3,
                                        },
                 Enum => {name => '<error>',
                          nature => 'int',
                          ord => 'undef',
                         },
                );

foreach my $class (keys %type_info)
  {
    eval <<"END";
package CType::Fundamental::$class;
our \@ISA = qw/CType::Fundamental/;
sub nature {return '$type_info{$class}{nature}';}
sub name {return '$type_info{$class}{name}';}
sub ord {return $type_info{$class}{ord};}
END
    die if $@;
  }

sub _add_type
  {
    my $specifiers = shift;
    my $class = shift;
    my $nature = shift;

    my $type_key = join(' ', sort @$specifiers);
    die "Duplicate type key $type_key" if exists $types{$type_key};
    $types{$type_key} = 'CType::Fundamental::' . $class;
  }

# These are all the valid type names, and their relationship to the
# fundamental types. Some types have multiple names, some do not.

# These are all the valid type specifier combinations and their
# meaning, taken from the list in ISO C99 6.7.2.2
_add_type([qw/void/], 'Void');
_add_type([qw/void */], 'VoidPtr');
_add_type([qw/char/], 'Char');
_add_type([qw/signed char/], 'SignedChar');
_add_type([qw/unsigned char/], 'UnsignedChar');
_add_type([qw/short/], 'Short');
_add_type([qw/signed short/], 'Short');
_add_type([qw/short int/], 'Short');
_add_type([qw/signed short int/], 'Short');
_add_type([qw/unsigned short/], 'UnsignedShort');
_add_type([qw/unsigned short int/], 'UnsignedShort');
_add_type([qw/int/], 'Int');
_add_type([qw/signed/], 'Int');
_add_type([qw/signed int/], 'Int');
_add_type([qw/unsigned/], 'UnsignedInt');
_add_type([qw/unsigned int/], 'UnsignedInt');
_add_type([qw/long/], 'Long');
_add_type([qw/signed long/], 'Long');
_add_type([qw/long int/], 'Long');
_add_type([qw/signed long int/], 'Long');
_add_type([qw/unsigned long/], 'UnsignedLong');
_add_type([qw/unsigned long int/], 'UnsignedLong');
_add_type([qw/long long/], 'LongLong');
_add_type([qw/signed long long/], 'LongLong');
_add_type([qw/long long int/], 'LongLong');
_add_type([qw/signed long long int/], 'LongLong');
_add_type([qw/unsigned long long/], 'UnsignedLongLong');
_add_type([qw/unsigned long long int/], 'UnsignedLongLong');
_add_type([qw/float/], 'Float');
_add_type([qw/double/], 'Double');
_add_type([qw/long double/], 'LongDouble');
_add_type([qw/_Bool/], 'Bool');
_add_type([qw/float _Complex/], 'FloatComplex');
_add_type([qw/double _Complex/], 'DoubleComplex');
_add_type([qw/long double _Complex/], 'LongDoubleComplex');
_add_type([qw/float _Imaginary/], 'FloatImaginary');
_add_type([qw/double _Imaginary/], 'DoubleImaginary');
_add_type([qw/long double _Imaginary/], 'LongDoubleImaginary');
_add_type([qw/enum null_enum/], 'Enum');

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

    my $type_key = join(' ', sort @$specifiers);
    unless (exists $types{$type_key})
      {
        die "unknown type " . join(' ', @$specifiers);
      }

    my $type_class = $types{$type_key};

    my $self = {attributes => $attributes,
               };
    bless $self, $type_class;

    $self->process_attributes($attributes);

    return $self
  }

sub new_class
  {
    my $type_class = shift;
    my $attributes = [];

    my $self = {attributes => $attributes,
               };
    bless $self, $type_class;

    $self->process_attributes($attributes);

    return $self
  }

sub CType::Fundamental::Void::describe
  {
    my $self = shift;

    return "void";
  }

sub describe
  {
    my $self = shift;

    my $qualifiers = $self->describe_qualifiers;
    $qualifiers .= ' ' if $qualifiers;

    my $signed = $self->signed ? 'signed' : 'unsigned';
    my $width = $self->width . "-bit";
    my $nature = $self->nature;

    return "$qualifiers$signed $width $nature";
  }

sub dump_c
  {
    my $self = shift;
    my $skip_cpp = shift;
    my $qualifiers = $self->dump_c_qualifiers;

    my $str = '';
    $str .= $self->name;
    $str .= ' ' . $qualifiers if $qualifiers;
    return $str;
  }

# This function contemplates the fundamental size relationships
# between types as laid down in the C spec. This is different from the
# *actual* sizes of the types. 'int' and 'long int' may be the same
# size on this platform, but 'long int' always has a higher
# ordinality, because the C spec says that long int must always be *at
# least* as big as int.
#
# So, what we're talking about here is the *possible* ordering on some
# platforms. Some types compare equal - signed char and unsigned char
# are always the same thing, for example. Some types do not have a
# meaningful comparison - there is no fixed relation between int and
# void *; on some platforms one is larger, and on some the other is.
#
# This function returns 0 if the types are ordinally equal, 1 if $a is
# larger, -1 if $b is larger, and undef if it can't tell. This is an
# expanded starship operator.
#
# This information is used in alignment analysis, to determine which
# the dominant types are. If a structure has long int alignment, then
# we don't need to note that it's also aligned for short int, because
# that's ordinally smaller. But if it has both int and void *
# alignment, we need both because they're ordinally undefined.

sub compare_ord
  {
    my $a = shift;
    my $b = shift;

    $a = $a->type if $a->isa('CExpr::Alignof');
    $b = $b->type if $b->isa('CExpr::Alignof');

    # Anything that's the same type is equal
    return 0 if ref $a eq ref $b;

    # All pointers are equal
    return 0 if $a->isa('CType::Fundamental::VoidPtr') and $b->isa('CType::Fundamental::VoidPtr');

    # Anything that's not a fundamental type is undef
    return undef unless $a->isa('CType::Fundamental');
    return undef unless $b->isa('CType::Fundamental');

    # Two types of differing nature are undef
    return undef if $a->nature ne $b->nature;

    # Certain types have no ordinal relations, like void *; we use an
    # undef ordinal value to indicate this
    return undef if not defined $a->ord;
    return undef if not defined $b->ord;

    return $a->ord <=> $b->ord;
  }

sub compare
  {
    my $self = shift;
    my $other = shift;
  }

our %min_values;
our %max_values;
our %alignment_exprs;

sub register_type_attrs
  {
    my $type = shift;
    my $width = shift;
    my $alignment = shift;
    my $signed = shift;
    my $min_value = shift;
    my $max_value = shift;

    my @specifiers = split / /, $type;
    my $type_key = join(' ', sort @specifiers);
    unless (exists $types{$type_key})
      {
        die "unknown type $type";
      }

    my $type_class = $types{$type_key};

    $min_values{$type_class} = $min_value;
    $max_values{$type_class} = $max_value;

    eval <<"END";
package ${type_class};

use CExpr::Alignof;

sub width {my \$self = shift; return (ref \$self ? \$self->{width} : undef) || $width;}
sub alignment {my \$self = shift; return (ref \$self ? \$self->{alignment} : undef) || $alignment;}
sub alignment_exprs {my \$self = shift; return (ref \$self ? \$self->{alignment_exprs} : undef) || \$CType::Fundamental::alignment_exprs{'$type_class'};}
sub signed {my \$self = shift; return (ref \$self ? \$self->{signed} : undef) || $signed;}
sub min_value {my \$self = shift; return (ref \$self ? \$self->{min_value} : undef) || \$CType::Fundamental::min_values{'$type_class'};}
sub max_value {my \$self = shift; return (ref \$self ? \$self->{max_value} : undef) || \$CType::Fundamental::max_values{'$type_class'};}
END
    die if $@;

    my $type_obj = new_class($type_class);
    $alignment_exprs{$type_class} = new CExpr::Alignof $type_obj;
  }

register_type_attrs('void', 0, 0, 0, 0, 0);

sub can_represent
  {
    my $self = shift;
    my $value = shift;

    return 0 if $value < $self->min_value;
    return 0 if $value > $self->max_value;

    return 1;
  }

sub pick_smallest_type
  {
    my $min_value = shift;
    my $max_value = shift;
    my $best = undef;
    foreach my $type_class (map {'CType::Fundamental::' . $_} keys %type_info)
      {
        next unless $type_class->can('min_value');
        next unless $type_class->can('max_value');
        next if $type_class->min_value == $type_class->max_value;
        next if $type_class->min_value > $min_value;
        next if $type_class->max_value < $max_value;
        next if defined $best and $best->width < $type_class->width;
        next if defined $best and $best->width == $type_class->width and $best->signed < $type_class->signed;
        $best = $type_class;
      }
    return $best;
  }

sub layout
  {
  }

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

    return 'both' unless $other->isa('CType::Fundamental');

    my @ret;

    push @ret, $self->check_sizes($other);
    push @ret, $self->check_qualifiers($other);

    if ($self->nature ne $other->nature)
      {
        push @ret, 'both';
      }

    return @ret;
  }

sub get_refs
  {
    return ();
  }

1;
