MooseでLispを実装してみる(Reader)

やさしい 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が出来るとそれっぽくなってきた感じがする。

Vox用のクライアント

Config::Pitエディタが立ち上がるように変更した。

サービスのURIを知るためにwgetしたらつながらなくてあせったが--auth-no-challengeオプションを入れて解決

#!/opt/local/bin/perl

use XML::Atom::Client;
use XML::Atom::Entry;
use constant NS_DC => 'http://purl.org/dc/elements/1.1/';
use File::Temp;
use File::Slurp;
use Path::Class;
use Config::Pit;

my $vox = "kzfm.vox.com";
my $title = "";
my $content = "";
my $category = "life";

my $config = pit_get($vox, require => {
        "username" => "your username on vox",
        "password" => "your password on vox",
        "postURI"  => "your potURI"
                       });


my $f = File::Temp->new();
close $f;
my $t = file($f->filename)->stat->mtime;
system $ENV{EDITOR}, $f->filename;
if ($t == file($f->filename)->stat->mtime) {
 print STDERR "No changes.";
} else {
 my @lines = read_file($f->filename);
 $title = shift @lines;
 $content = join "", @lines
}

die "content not found\n" unless $content;

my $api = XML::Atom::Client->new;
$api->username($config->{username});
$api->password($config->{password});

my $entry = XML::Atom::Entry->new;
$entry->title($title);
$entry->content($content);
my @tags = split /,/, $category;
my $dc = XML::Atom::Namespace->new( dc => NS_DC );
foreach my $tag (@tags) {
 $entry->add( $dc, 'subject', $tag);
}

my $EditURI = $api->createEntry($config->{postURI}, $entry);
print $api->errstr if $api->errstr;

perlでread-eval-print-loop

クォートされたS式を受け取って文字列を返すものをつくってみた。

use Term::ReadLine;
my $term = new Term::ReadLine 'Simple LISP REPL';
my $prompt = "CL-USER> ";
my $OUT = $term->OUT || \*STDOUT;

while ( defined ($_ = $term->readline($prompt)) ) {
  my $res = $_;
  warn $@ if $@;
  $res =~ s/^\'//;
  print $OUT $res, "\n" unless $@;
}

実行

$ perl s.pl
CL-USER> '(+ 1 2)
(+ 1 2)
CL-USER>

という手抜き。

だが、Readerを実装して処理させれば良いのであろう。

MooseでLispを実装してみる(List)

やさしい Lisp の作り方 by Java and by C#を参考に書いてみる。リストの構成にはシンボルが出てこない。

list

名前を付けるということがちょっと分かったような気がした。

シンボルは Lisp の最も重要なデータタイプの一つです。「記号」とか単に「名前」または「識別子」とも呼ばれていました。

シンボルは (1) 1 個以上の値を持つことができる、(2) シンボル名により唯一性が保障されます。(2) の唯一性とは同じ名前のシンボルは同じであることを表しています。もっと正確に言えば、同じ名前のシンボルは、ある等価関数によって必ず T を返す、つまり等価であることを保障します。

とりあえず、動くとこを見たかったので、色々端折ってる。

Atom

package Moosp::Atom;

use Moose;

__PACKAGE__->meta->make_immutable;

no Moose;


1; # End of Moosp::Atom

Number

package Moosp::Number;

use Moose;

extends 'Moosp::Atom';

sub str {}

no Moose;

1; # End of Moosp::Number

Integer

package Moosp::Integer;

use Moose;

extends 'Moosp::Number';
with 'Moosp::Sexp';

has 'value' => (is => 'rw',isa => 'Int');

sub add {
  my ($self, $i) = @_;
  my $new_value = $self->value + $i->value;
  __PACKAGE__->new({value => $new_value});
}

sub subt {
  my ($self, $i) = @_;
  my $new_value = $self->value - $i->value;
  __PACKAGE__->new({value => $new_value});
}

sub mul {
  my ($self, $i) = @_;
  my $new_value = $self->value * $i->value;
  __PACKAGE__->new({value => $new_value});
}

sub div {
  my ($self, $i) = @_;
  my $new_value = int($self->value / $i->value);
  __PACKAGE__->new({value => $new_value});
}

sub ge {
  my ($self, $i) = @_;
  if ($self->value >= $i->value){
    return Moosp::T->new();
  }
  else {
    return Moosp::Nil->new();
  }
}

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

__PACKAGE__->meta->make_immutable;
no Moose;

1; # End of Moosp::Integer

Cell

package Moosp::Cell;

use Moosp::Nil;
use Moose;

has 'car' => (
          is => 'rw',
          default => sub{ Moosp::Nil->instance }
);

has 'cdr' => (
          is => 'rw',
          default => sub { Moosp::Nil->instance }
);

__PACKAGE__->meta->make_immutable;

no Moose;

1;

List

package Moosp::List;

use Moose;
use Moosp::Nil;
extends 'Moosp::Cell';

sub BUILD {
  my ($self, $car, $cdr) = @_;
  $self->car(Moosp::Nil->instance);
  $self->cdr(Moosp::Nil->instance);
  return $self;
}

sub serialize {
  my $self = shift;
  my $str = "(";
  $str .= $self->car->serialize;
  if (ref($self->cdr) eq 'Moosp::Nil') {
    $str .= ")";
  }
  elsif (ref($self->cdr) eq 'Moosp::List') {
    $str .= " " . $self->cdr->serialize . ")";
  }
  else {
    $str .= " . " . $self->cdr->serialize . ")";
  }
  return $str;
}

1; # End of Moosp::List

test

my $int3 = Moosp::Integer->new(value => 3);
my $int5 = Moosp::Integer->new(value => 5);
my $list = Moosp::List->new();
$list->car($int3);
$list->cdr($int5); # (3 . 5)

my $list2 = Moosp::List->new();
$list2->car($int3);
$list2->cdr($list);  # (3 (3 . 5))

print $list2->cdr->car->value # cadr -> 3

MooseでLispを実装してみる(NilとT)

やさしい Lisp の作り方 by Java and by C#を参考に書いてみる。進行中のメモなのであちこち修正するかも。というか修正しまくりで全然進まないのでメモることにしたという。もう少しまとまったらLISPをみんなで勉強しよう!に投稿したい。

ちなみにMooseでlispなのでMoosp(ムースプ)だ。

まずNilとTはMooseX::SingletonでSingletonにした。

package Moosp::Nil;

use MooseX::Singleton;
with 'Moosp::Sexp';

sub str {"NIL"}

__PACKAGE__->meta->make_immutable;

no MooseX::Singleton;

1;

Tも一緒。

package Moosp::T;

use MooseX::Singleton;

extends 'Moosp::Atom';
with 'Moosp::Sexp';

sub str {"T"}

__PACKAGE__->meta->make_immutable;

no MooseX::Singleton;

1;

javaでlispだとSexpはインターフェースなのでMoose::Roleのクラスにしてみたけどこれでいいのかはわからない(まだ最後まで動かしてないので)。

package Moosp::Sexp;

use Moose::Role;

requires 'str';

sub print { 
  my $self = shift;
  print $self->str;
}

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

no Moose::Role;
1;

Moosp::Atom

package Moosp::Atom;

use Moose;

__PACKAGE__->meta->make_immutable;

no Moose;
1; 

モダンperl入門が手放せない

ProductName モダンPerl入門 (CodeZine BOOKS)
牧 大輔
翔泳社 / ¥ 2,940 ()
在庫あり。

Moose::Roleでwithするクラス

モダンperl入門のp.28で

+------+      +--------+
| Bird | <--- | Winged |
+------+      +--------+
    | 
    |
+--------+
| Pigeon |
+--------+

とあるので、BirdにwithでロールをつけてPigeonがBirdを継承すればよかろうと思ったが、それだと'Winged' requires the method 'fly' to be implemented by 'Bird'とBirdクラスでflyが実装されてないよっていうエラーになる。

package Animal;
use Moose;

package Winged;
use Moose::Role;
requires 'fly';

package Bird;
use Moose;
extends 'Animal';
# with 'Winged'; ここだとエラー

package Pigeon;
use Moose;
extends 'Bird';
with 'Winged'; # ここに記述
sub fly { print "Pigeons fly in the day\n" }

package main;

Pigeon->new->fly;

つまり、個別にwithしないといけないのかな。

+------+ 
| Bird | --------------------------------------------------+
+------+                                                   |
    |\__________________________                           |
    |                          |                           |
+------+      +--------+    +------+      +--------+    +------+      +--------+
| Bird | <--- | Winged |    | Owl  | <--- | Winged |    | Hawk | <--- | Winged |
+------+      +--------+    +------+      +--------+    +------+      +--------+

こんな感じ?。それとも鳥は翼を持つからflyメソッドをBirdクラスに直接書いてしまっても良いのだろうか?(ペンギンとかはここでは無しの方向で)

一応上の図には載せてないのだけどサンプルでは Animal->Mammal->Batという(鳥ではないけど飛ぶことのできる)コウモリクラスがあることを想定している。

ProductName モダンPerl入門 (CodeZine BOOKS)
牧 大輔
翔泳社 / ¥ 2,940 ()
在庫あり。

module-starterで新しいモジュールを追加できるようにする

この週末から、Mooseでlispを実装してみるということをはじめた。もともとやさしい Lisp の作り方 by Java and by C#を見ながらeclipseでいじってたんだけど、コードが省略されてたり、ライブラリのコードがなかったりしたので、それだったら元のページを参考にしながらMooseで書いてみようかなと(ユニットテストとかもperlのほうが慣れてるし)。

module-starterはそのままではモジュールの追加ができなくて、どんどん新しいモジュールを足していく場合には不便なのでModule-Starterのカスタマイズを参考にモジュールの追加が出来るようにした。快適になった。

ProductName モダンPerl入門 (CodeZine BOOKS)
牧 大輔
翔泳社 / ¥ 2,940 ()
在庫あり。

MooseというのはMOPの上に乗っかっているのでLispの方向に向かっているのかなぁと思っていたのだけど、実際に書いてみると型の制約とかRoleとかはJavaっぽいなぁとも思った。

CLOSもガリガリ書いてみないとダメだなぁ。

parrotでGCD

schemeでレジスタ計算機を書いたら、次はparrotというレジスタ仮想機械、(そしてPerl6へみたいな。)

さて、ダウンロードしてきたソースコードについてたexamples/pir/euclid.pirというのがユークリッドの互除法のサンプルなのでこれを使う。

pirというのはParrot Assembly Language(pasm)よりも抽象度の高い言語らしい。

.sub 'example' :main
        $I1 = 96
        $I2 = 64
        print  "Algorithm E (Euclid's algorithm)\n"
e1:     $I4 = mod $I1, $I2
e2:     unless $I4 goto done
e3:     $I1 = $I2
        $I2 = $I4
        branch e1
done:   print "The greatest common denominator of 96 and 64 is "
        print  $I2
        print  ".\n"
.end

pasmに変換

parrot --output=euclid.pasm euclid.pir 

これで、アセンブリコードが吐き出されたので見てみる。

example:
    set I0, 96
    set I1, 64
    print "Algorithm E (Euclid's algorithm)\n"
e1:
    mod I2, I0, I1
e2:
    unless I2, done
e3:
    set I0, I1
    set I1, I2
    branch e1
done:
    print "The greatest common denominator of 96 and 64 is "
    print I1
    print ".\n"
    end 

ふむふむ。

perlスクリプト実行中に外部エディタを利用してデータ入力をおこなう

Config::Pitでデータを追加する時に外部エディタが立ち上がって便利なので、ソースを読んでみた。

File::Tempでテンポラリファイルを用意しておいて、system関数で、環境変数Editorに指定されているプログラムで、テンポラリファイルを開く。そのときのタイムスタンプと修正時刻を比較して、更新があったときファイルの内容を読み出す(Config::PitだとYAML::Syckで出し入れ)。

簡単のためにFile::Slurpで。

use File::Temp;
use File::Slurp;
use Path::Class;

my $text;
my $f = File::Temp->new();
close $f;
my $t = file($f->filename)->stat->mtime;
system $ENV{EDITOR}, $f->filename;
if ($t == file($f->filename)->stat->mtime) {
  print STDERR "No changes.";
} else {
  $text = read_file($f->filename); #外部エディタで入力したデータを読み込む
}

print $text;

File::Tempだと、テンポラリファイルの面倒をきちんと見てくれるので安心なので、よく使うんだけど、editorを組み合わせることが出来るんだったら、gamessとかのインプット用のテンプレートを用意しておいて、実行時にeditorでチョロチョロっと追加してそのままrunできるようなものがつくれてよいかもしれない。