package CParse::Parser::PerlXS;

use 5.6.0;
use strict;
use warnings;

no warnings "recursion";

use Carp;

use CParse::Attribute;
use CParse::AttributeList;
use CParse::Declaration;
use CParse::Declarator;
use CParse::Declarator::Array;
use CParse::Declarator::Direct;
use CParse::Declarator::Function;
use CParse::Enum;
use CParse::EnumRef;
use CParse::Enumerator;
use CParse::Extension;
use CParse::Function;
use CParse::FunctionSpecifier;
use CParse::Op;
use CParse::Op::Add;
use CParse::Op::ArraySubscript;
use CParse::Op::Assign;
use CParse::Op::BitAnd;
use CParse::Op::BitOr;
use CParse::Op::BitXor;
use CParse::Op::BoolAnd;
use CParse::Op::BoolOr;
use CParse::Op::Cast;
use CParse::Op::Call;
use CParse::Op::Conditional;
use CParse::Op::Equal;
use CParse::Op::Expression;
use CParse::Op::Member;
use CParse::Op::MemberIndirect;
use CParse::Op::Multiply;
use CParse::Op::Preinc;
use CParse::Op::Predec;
use CParse::Op::Postinc;
use CParse::Op::Postdec;
use CParse::Op::Postfix;
use CParse::Op::Relation;
use CParse::Op::Shift;
use CParse::Op::Alignof;
use CParse::Op::Sizeof;
use CParse::Op::SizeofExpr;
use CParse::Op::Unary;
use CParse::ParameterDeclaration;
use CParse::Pointer;
use CParse::StorageClass;
use CParse::Struct;
use CParse::StructDeclaration;
use CParse::StructDeclarator;
use CParse::StructRef;
use CParse::TypeName;
use CParse::TypeQualifier;
use CParse::TypeSpecifier;
use CParse::Union;
use CParse::UnionRef;

use CParse::Parser::Token::Keyword;
use CParse::Parser::Token::Identifier;
use CParse::Parser::Token::Integer;
use CParse::Parser::Token::Float;
use CParse::Parser::Token::Character;
use CParse::Parser::Token::String;
use CParse::Parser::Token::Punctuator;

our $VERSION = '0.1';

require XSLoader;
XSLoader::load('CParse::Parser::PerlXS', $VERSION);

# Preloaded methods go here.

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

    my $self = {
               };
    bless $self, $class;
    return $self;
  }

sub unit
  {
    my $self = shift;
    my $data = shift;
    my $linemap = shift;

    $self->{data} = $data;
    $self->{linemap} = $linemap;
    $self->{line} = 0;
    $self->{pos} = 0;
    $self->{errors} = 0;
    $self->{commit} = 0;
    $self->{skip_errors} = 0;
    $self->{token_queue} = [];
    $self->{trying_tokens} = [];

    my @external_decls;

    DECL: while (1)
      {
        if ($self->no_data_left)
          {
            last;
          }

        my $decl;

        foreach my $thing (qw/declaration function/)
          {
            $self->{skip_errors} = 0;
            $decl = $self->try_parse($thing);
            if ($decl)
              {
                my $data_line = $self->{trying_tokens}[0]->line;
                my $data_pos = $self->{trying_tokens}[0]->pos;

                my $file = $self->{linemap}{$data_line}{file} || "<unknown>";
                my $line = $self->{linemap}{$data_line}{line} || "<unknown>";

                $decl->set_location($file, $line, $data_pos);

                $self->{trying_tokens} = [];
                push @external_decls, $decl;
                next DECL;
              }

            last if $self->{errors};
          }

        die if scalar @{$self->{trying_tokens}};

        $self->syntax_error;
        last;
      }

    return undef if $self->{errors};
    return \@external_decls;
  }

sub error
  {
    my $self = shift;
    my $msg = shift;

    return if $self->{skip_errors};

    my $data_line = scalar @{$self->{token_queue}} ? $self->{token_queue}[0]->line : $self->{line};
    my $data_pos = scalar @{$self->{token_queue}} ? $self->{token_queue}[0]->pos : $self->{pos};

    my $file = $self->{linemap}{$data_line}{file} || "<unknown>";
    my $line = $self->{linemap}{$data_line}{line} || "<unknown>";
    print STDERR "$file:$line:$data_pos: $msg\n";

    foreach my $l ($data_line - 2 .. $data_line + 2)
      {
        next if $l < 0;
        last if $l >= scalar @{$self->{data}};

        print STDERR $self->{data}[$l] . "\n";
        print STDERR ' ' x $data_pos . "^-- Here\n" if $l == $data_line;
      }

    $self->{errors}++;
  }

sub syntax_error
  {
    my $self = shift;
    my $thing = shift;
    if (defined $thing)
      {
        $self->error("syntax error while trying to parse $thing");
      }
    else
      {
        $self->error("syntax error");
      }
  }

sub no_data_left
  {
    my $self = shift;
    return 0 if scalar @{$self->{token_queue}};
    my $token = $self->next_token;
    if ($token)
      {
        $self->retry_tokens($token);
        return 0;
      }
    else
      {
        return 1;
      }
  }

sub next_token
  {
    my $self = shift;

    if (scalar @{$self->{token_queue}})
      {
        return shift @{$self->{token_queue}};
      }

    while (1)
      {
        if ($self->{line} >= scalar @{$self->{data}})
          {
            # No lines left, this is EOF
            return undef;
          }

        my $line = substr $self->{data}[$self->{line}], $self->{pos};

        # Try to move to the next line
        if (length $line == 0)
          {
            $self->{line}++;
            $self->{pos} = 0;
            next;
          }

        # Try to consume whitespace
        if ($line =~ /^(\s+)/)
          {
            $self->{pos} += length $1;
            next;
          }

        # Try for a keyword
        if ($line =~ /^(auto|break|case|char|const|continue|default|do|double|
                        else|enum|extern|float|for|goto|if|inline|int|long|
                        register|restrict|return|short|signed|sizeof|static|
                        struct|switch|typedef|union|unsigned|void|volatile|
                        while|_Bool|_Complex|_Imaginary|
                        __const|__restrict|__volatile|__const__|__restrict__|
                        __volatile__|__attribute__|__attribute|__inline|
                        __inline__|__extension__|__alignof__|asm|__asm__)\b/x)
          {
            my $len = length $1;
            my $token = new CParse::Parser::Token::Keyword $1, $self->{line}, $self->{pos};
            $self->{pos} += $len;
            return $token;
          }

        # Try for an identifier
        if ($line =~ /^((?:[A-Za-z_]|\\u[[:xdigit:]]{4}|\\U[[:xdigit:]]{8})(?:\w|\\u[[:xdigit:]]{4}|\\U[[:xdigit:]]{8})*)/)
          {
            my $len = length $1;
            my $token = new CParse::Parser::Token::Identifier $1, $self->{line}, $self->{pos};
            $self->{pos} += $len;
            return $token;
          }

        # Try for a constant
        if ($line =~ /^((0[xX][[:xdigit:]]+|[1-9]\d*|0[0-7]*)([uU](?:l|L|ll|LL)?|[lL][uU]?|ll[uU]?|LL[uU]?)?)/)
          {
            my $len = length $1;
            my $token = new CParse::Parser::Token::Integer $2, $3, $self->{line}, $self->{pos};
            $self->{pos} += $len;
            return $token;
          }
        if ($line =~ /^(((?:\d+\.\d*|\.\d+|\d+)(?:[eE][+-]?\d+))([flFL])?)/)
          {
            my $len = length $1;
            my $token = new CParse::Parser::Token::Float $2, $3, $self->{line}, $self->{pos};
            $self->{pos} += $len;
            return $token;
          }
        if ($line =~ /^((0x(?:[[:xdigit:]]+\.[[:xdigit:]]*|\.[[:xdigit:]]+|[[:xdigit:]]+)[pP][+-]?\d+)([flFL])?)/)
          {
            my $len = length $1;
            my $token = new CParse::Parser::Token::Float $2, $3, $self->{line}, $self->{pos};
            $self->{pos} += $len;
            return $token;
          }
        if ($line =~ /^(L?'(?:[^'\\\n]|\\['"?abfnrtv\\]|\\[0-7]{1,3}|\\x[[:xdigit:]]+)*')/)
          {
            my $len = length $1;
            my $token = new CParse::Parser::Token::Character $1, $self->{line}, $self->{pos};
            $self->{pos} += $len;
            return $token;
          }

        # Try for a string literal
        if ($line =~ /^(L?"(?:[^"\\\n]|\\['"?abfnrtv\\]|\\[0-7]{1,3}|\\x[[:xdigit:]]+)*")/)
          {
            my $len = length $1;
            my $token = new CParse::Parser::Token::String $1, $self->{line}, $self->{pos};
            $self->{pos} += $len;
            return $token;
          }

        # Try for a punctuator
        if ($line =~ /^(==|!=|=|\*=|\/=|\%=|\+=|-=|>>=|<<=|&=|\^=|!=|\[|\]|
                        \(|\)|{|}|\.\.\.|\.|->|\+\+|--|&|\*|\+|-|~|\/|
                        \%|<<|>>|<=|>=|<|>|\^|&&|\|\||\||\?|:|;|
                        ,|\#|\#\#|!|<:|:>|<\%|\%>|\%:|\%\%:)/x)
          {
            my $len = length $1;
            my $token = new CParse::Parser::Token::Punctuator $1, $self->{line}, $self->{pos};
            $self->{pos} += $len;
            return $token;
          }

        $self->syntax_error;
        return undef;
      }
  }

sub retry_tokens
  {
    my $self = shift;
    unshift @{$self->{token_queue}}, @_;
  }

sub try_token
  {
    my $self = shift;

    my $token = $self->next_token;
    return undef unless $token;
    push @{$self->{trying_tokens}}, $token;
    return $token;
  }

1;
__END__
