package ACIS::MiLa::Reader;

use strict;
use vars qw( 
             $file $lineno
             $src
            @ISA @EXPORT
);

$src = {};

use Exporter;
@ISA = qw( Exporter );
@EXPORT = qw( filename lineno open_src_file get_next_token close_src );

sub filename () { $file   };
sub lineno   () { $lineno };


my $buffer;
my $position;
      
sub open_src_file ($) {
  my $file = shift;

  if ( open SRC, "<$file" ) {
    $src -> {type} = 'file';
    $src -> {file} = $file;
    $buffer = join '', <SRC>;
    $_ = $buffer;
    $position = 0;
    $lineno = 1;
    return 1;
  }
}

sub close_src () {
  if ( $src -> {type} eq 'file' ) {
    close SRC;
    $src = {};
  }
}


sub unescape_string {
  my $str = shift;
  $str =~ s/\\(.)/$1/g;
  return $str;
}


my $eof   ;
my $mode = '';

sub get_next_token() {

  my $tok;
  
  while ( 1 ) {

    $position = pos();

    if ( m/\G[\t\ ]*\z/gc ) {
      return ( 'eof', 1 );
    }

    if ( m/\G[\t\ ]*(?:\n\r?|\r\n)/gc ) {
      $lineno ++;
      $mode = 'nl';
      ### return to start
      next;
    }
    
    if ( m/\G[\t\ ]*#.*(\n\r?|\r\n?)/gc ) {
      $lineno ++;
      $mode = 'nl';
      ### restart
      next;
    }

    if ( $mode eq 'nl' ) {
      if ( m/\G([\t\ ]*)\S/gc ) {
        $mode = '';
        pos() --;
        return ( 'space', $1 );
        
      }
    } else {
      if ( m/\G[\t\ ]+/gc ) {
        $mode = '';
        next;
      }
    }
    
    if ( m/\G"/gc ) {
      
      my $tok  = '';
      my $nl_count = 0;
      my $mode = '';
      while ( m/\G(.)/gc ) {

        if ( $1 eq "\n" ) {
          $nl_count ++;
        }

        if ( $mode eq 'esc' ) {
          ###  XXX other escapes can be added, like \n, \r and so on.
          $tok .= $1;
          $mode = '';

        } else {
          if ( $1 eq "\\" ) {
            $mode = 'esc';

          } elsif ( $1 eq '"' ) {
            $mode = 'ok';
            last;

          } else {
            $tok .= $1;
          }
        }
      }
      
      if ( $mode ne 'ok' ) {
        die "Runaway string starting at line $lineno";
      }

      $lineno += $nl_count;
      
      return ( 'string', $tok );



      if ( m/\G"(\s|$)/gc ) {
        if ( length( $2 ) ) { pos()--; }
        $mode = '';
        return ( 'string', '' );
        
      } elsif ( m/\G([\s\S]*?[^\\])"(\s|$)/gc ) {
        $tok = $1;
        if ( length( $2 ) ) { pos()--; }
        $mode = '';

        my $nl_count = ( $tok =~ s/(\n\r?|\r\n?)/$1/g ) ;
        $lineno += $nl_count;

        ###  unescape the string
        $tok = unescape_string( $tok );

        return ( 'string', $tok );

      } elsif ( m/\G([\s\S]*?\\\\)"(\s|$)/gc ) {
        $tok = $1;
        if ( length( $2 ) ) { pos()--; }
        $mode = '';

        my $nl_count = ( $tok =~ s/(\n\r?|\r\n?)/$1/g ) ;
        $lineno += $nl_count;

        ###  unescape the string
        $tok = unescape_string( $tok );

        return ( 'string', $tok );

      } elsif ( m/\G([\s\S]*?[^\\])"\S/gc ) { 
        die "String is followed by a non-space char.  Starts at: line $lineno";

      } else {
        die "Runaway string starting at line $lineno";
      }
      
    } elsif ( m/\G(\S+)(\s|$)/gc ) {
      $tok = $1;
      if ( length( $2 ) ) { pos()--; }
      $mode = '';
      return ( 'word', $tok );

    } else {
      m/\G(.{1,15})/gc;
      die "can't parse: '$1...'";
    }
    
  }

}


1;
