やさしい Lisp の作り方 by Java and by C#を参考に書いてみる。

readerは文字列(strings)と今読んでいる位置(index)と現在読んでいる文字の値(char)の属性を用意してあって、一文字読み進めてインデックスを一つ進めるget_charと一文字読み進めるけどインデックス値は進めないという先読み機能のnext_charというメソッドで移動していく。

先読みメソッドを用意するよりはインデックス値を一つ巻き戻すメソッドを用意しておいて、必要に応じてインデックス値を減らすという実装のほうだとcharアトリビュートを用意しておく必要はないかなと思った。

よくわからなくなってきたのでもう一度きちんと見直すかも

package Moosp::Reader;

use Moose;
use Moosp::Nil;
use Moosp::T;
use Moosp::List;
use Moosp::Integer;
use Moosp::Symbol;
use Moosp::Env;

has env => ( is => 'rw', isa => 'Moosp::Env', default => sub { Moosp::Env->new });
has index => (is => 'rw', isa => 'Int', default => 0 );
has strings => (is => 'rw', isa => 'Str');
has char => (is => 'rw', isa => 'Str');

sub get_char {
  my $self = shift;
  my $index = $self->index;
  $self->char(substr($self->strings,$index,1));
  $self->index($index + 1);
  return $self->char;
}

sub next_char {
  my $self = shift;
  $self->char(substr($self->strings,$self->index,1));
  return $self->char;
}

sub getSexpPrepare {
  my $self = shift;
  $self->getSexpPrepareString(@_);
}

sub readFromString {
  my ($self, $input) = @_;
  $self->getSexpPrepareString($input);
  $self->getSexp;
}

sub getSexpPrepareString {
  my ($self, $input) = @_;
  $self->strings($input);
}

sub getSexp {
  my $self = shift;
  while (my $ch = $self->get_char()) {
    if    ($ch eq '(')  { return $self->makeList(); }
    elsif ($ch eq '\\') { return $self->makeQuote(); }
    elsif ($ch eq '-')  { return $self->makeMinusNumber(); }
    else  {
      if ($ch =~ /\s/)  { last; }
      if ($ch =~ /\d/)   { return $self->makeNumber($ch); }
      return $self->makeSymbol($ch);
    }
  }
  return Moosp::Nil->instance;
}

sub makeList {
  my $self = shift;

  my $top = Moosp::List->new();
  my $list = $top;
  my $ch;
  while(1) {
    $list->car($self->getSexp());
    $ch =  $self->char;
    last if ($ch eq ')');
    return Moosp::Nil->instance if ($ch eq '');
    if ($self->next_char eq '.') {
      $ch = $self->get_char();
      $ch = $self->get_char();
      $list->cdr($self->getSexp());
      return $top;
    }
    $list->cdr(Moosp::List->new());
    $list = $list->cdr();
  }
  $ch = $self->get_char();
  return $top;
}

sub makeNumber {
  my ($self, $str) = @_;
  while (my $ch = $self->get_char()) {
    last if $ch eq '(' || $ch eq ')';
    last if $ch =~ /\s/;
    unless ($ch =~ /\d/) {
      $self->index($self->index - 1);
      return $self->makeSymbolInternal($str);
    }
    $str .= $ch;
  }
  return Moosp::Integer->new({value => $str});
}

sub makeSymbol {
  my ($self, $ch) = @_;
  return $self->makeSymbolInternal($ch);
}

sub makeSymbolInternal {
  my ($self, $str) = @_;
  while (my $ch = $self->get_char()) {
    last if $ch eq '(' || $ch eq ')';
    last if $ch =~ /\s/;
    $str .= $ch;
  }
  $str = uc $str;
  return Moosp::T->instance if ($str eq 'T');
  return Moosp::Nil->instance if ($str eq "NIL");

  my $sym = $self->env->symbol->{$str};
  return $self->env->set_symbol(Moosp::Symbol->new(name => $str)) unless defined($sym);
  return $sym;
}

sub makeMinusNumber {
  my $self = shift;
  my $nch = $self->next_char();
  return $self->makeSymbolInternal("-") unless $nch =~ /\d/;
  return $self->makeNumber("-");
}

sub makeQuote {
  my $self = shift;
  my $top = Moosp::List->new();
  my $list = $top;
  $list->car($self->env->symbol->{"QUOTE"});
  $list->cdr(Moosp::List->new());
  $list = $list->cdr();
  $self->get_char();
  $list->car($self->getSexp());
  return $top;
}

1; # End of Moosp::Reader

Readerが出来るとそれっぽくなってきた感じがする。