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 ()
在庫あり。

MooseでChain of Responsibilityパターン

ProductName 増補改訂版Java言語で学ぶデザインパターン入門
結城 浩
ソフトバンククリエイティブ / ¥ 3,990 ()
通常24時間以内に発送

package Trouble;
use Moose;

has number => ( isa => 'Str', is => 'ro');

sub getNumber {
  my $self = shift;
  return $self->number;
}

sub toString {
  my $self = shift;
  return "[Trouble " . $self->number . "]";
}

package Support;
use Moose::Role;
use Perl6::Say;
requires 'resolve';

has name => (isa => 'Str', is => 'rw', required => 1);
has next => (isa => 'Support', is => 'rw');


sub setNext {
  my ($self, $next) = @_;
  $self->next($next);
  return $next;
}

sub support {
  my ($self, $trouble) = @_;
  if($self->resolve($trouble)) {
    $self->done($trouble);
  }
  elsif(defined($self->next)) {
    $self->next->support($trouble);
  } else {
    $self->fail($trouble);
  }
}

sub toString {
  my $self = shift;
  return "[" . $self->name . "]";
}

sub done {
  my( $self, $trouble ) = @_;
  say $trouble->toString() . " is resolved by " . $self->toString . ".";
}

sub fail {
  my( $self, $trouble ) = @_;
  say $trouble->toString() . " cannnot be resolved.";
}

package NoSupport;
use Moose;
with 'Support';

sub resolve { return 0; }

package LimitSupport;
use Moose;
with 'Support';
has limit => (isa => 'Int', is => 'rw', required => 1);

sub resolve {
  my ($self, $trouble) = @_;
  if($trouble->getNumber() < $self->limit) {
    return 1;
  }
  else {
    return 0;
  }
}

package SpecialSupport;
use Moose;
with 'Support';

has number => (isa => 'Int', is => 'rw', required => 1);

sub resolve {
  my ($self, $trouble) = @_;
  if($trouble->getNumber() == $self->number) {
    return 1;
  }
  else {
    return 0;
  }
}

package OddSupport;
use Moose;
with 'Support';

sub resolve {
  my ($self, $trouble) = @_;
  if($trouble->getNumber() % 2 == 1) {
    return 1;
  }
  else {
    return 0;
  }
}

package main;
use Perl6::Say;
my $alice   = NoSupport->new(name => "Alice");
my $bob     = LimitSupport->new(name => "Bob", limit => 100);
my $charlie = SpecialSupport->new(name => "Charlie", number => 429);
my $diana   = LimitSupport->new(name => "Diana", limit => 200);
my $elmo    = OddSupport->new(name => "Elmo");
my $fred    = LimitSupport->new(name => "Fred", limit => 300);

$alice->setNext($bob)->setNext($charlie)
  ->setNext($diana)->setNext($elmo)->setNext($fred);

for(my $i=0;$i<500;$i+=33){
  $alice->support(Trouble->new( number => $i));
}

実行

[Trouble 0] is resolved by [Bob].
[Trouble 33] is resolved by [Bob].
[Trouble 66] is resolved by [Bob].
[Trouble 99] is resolved by [Bob].
[Trouble 132] is resolved by [Diana].
[Trouble 165] is resolved by [Diana].
[Trouble 198] is resolved by [Diana].
[Trouble 231] is resolved by [Elmo].
[Trouble 264] is resolved by [Fred].
[Trouble 297] is resolved by [Elmo].
[Trouble 330] cannnot be resolved.
[Trouble 363] is resolved by [Elmo].
[Trouble 396] cannnot be resolved.
[Trouble 429] is resolved by [Charlie].
[Trouble 462] cannnot be resolved.
[Trouble 495] is resolved by [Elmo].

MooseでVisitorパターン

本に忠実な感じで、visitorクラスを。

ProductName 増補改訂版Java言語で学ぶデザインパターン入門
結城 浩
ソフトバンククリエイティブ / ¥ 3,990 ()
通常24時間以内に発送

package Visitor;
use Moose::Role;
requires 'visit';

package ListVisitor;
use Moose;
use Perl6::Say;
with 'Visitor';

sub visit {
  my ($self, $entry) = @_;
  my $currentdir = "";
  if(ref($entry) eq "File"){
    say $currentdir . "/" . $entry->toString();
  }
  elsif (ref($entry) eq "Directory"){
    say $currentdir . "/" . $entry->toString();
    my $savedir = $currentdir;
    $currentdir = $currentdir . "/" . $entry->getName();
    my $it = $entry->iterator();
    while($it->has_next){
      my $e = $it->next;
      $e->accept($self);
    }
    $currentdir = $savedir;
  }
}

package Element;
use Moose::Role;
requires 'accept';

package Entry;
use Moose::Role;
use Perl6::Say;
with 'Element';
requires 'getName';
requires 'getSize';


sub add {say "method add";}
sub iterator {say "method iterator";}

sub toString {
  my $self = shift;
  return $self->getName() . " (" . $self->getSize() . ")";
}

package File;
use Moose;
with 'Entry';

has name => (isa => 'Str', is => 'rw');
has size => (isa => 'Int', is => 'rw');

sub getName {
  my $self = shift;
  return $self->name;
}

sub getSize {
  my $self = shift;
  return $self->size;
}

sub accept {
  my ($self,$v) = @_;
  $v->visit($self);
}

package Directory;
use Moose;
use MooseX::Iterator;
with 'Entry';
has name => (isa => 'Str', is => 'rw');
has directory  => (isa => 'ArrayRef', is => 'rw', default => sub{[]});

sub getName {
  my $self = shift;
  return $self->name;
}

sub getSize {
  my $self = shift;
  my $size = 0;
  my $it = $self->iterator();
  while ( $it->has_next ) {
    my $e = $it->next;
    $size += $e->getSize();
  }
  return $size;
}

sub add {
  my ($self, $entry) = @_;
  push @{$self->directory}, $entry;
  return $self;
}

sub iterator {
  my $self = shift;
  return MooseX::Iterator::Array->new( collection => $self->directory );
}

sub accept {
  my ($self,$v) = @_;
  $v->visit($self);
}

package main;
use Perl6::Say;

say "Making root entries";
my $rootdir = Directory->new( name => "root" );
my $bindir = Directory->new( name => "bin" );
my $tmpdir = Directory->new( name => "tmp" );
my $usrdir = Directory->new( name => "usr" );
$rootdir->add($bindir);
$rootdir->add($tmpdir);
$rootdir->add($usrdir);

my $vi = File->new( name => "vi", size => 10000 );
my $latex = File->new( name => "latex", size => 20000 );
$bindir->add($vi);
$bindir->add($latex);
my $visit = ListVisitor->new();
$rootdir->accept($visit);

実行

Making root entries
/root (30000)
/bin (30000)
/vi (10000)
/latex (20000)
/tmp (0)
/usr (0)

javaのコードだとvisitメソッドをオーバーロードしてんだけどMooseでもできるのかどうかはわからなかった。

withとextendsの使い分けが微妙にわかってなさげ。このパターンだとsuperが必要ないからか?

directryクラスでのみ必要なメソッドは抽象クラスでエラーにしたい場合どうすべきかちょっとわからない。

Moose::Roleはextendsできない

デザパタ本のvisitorパターンはインターフェースを抽象クラスで実装していたので、Mooseでもできるかなと試してみた。

package Element;
use Moose::Role;
requires 'accept';

package Entry;
use Moose::Role;

extends 'Element';
requires 'getName';
requires 'getSize'; 

sub add {
  print "method add";
}

sub toStoring {
  my $self = shift;
  return $self->getName . " (" . $self->getSize . ")";
}

Moose::Roleはextendsできない。

Moose::Role does not currently support 'extends' at
/opt/local/lib/perl5/site_perl/5.10.0/Moose/Role.pm line 53
Moose::Role::extends('Element') called at moose_visitor.pl line 12

ドキュメントにも書いてあった。

Mooseでデザパタのやつを

Mooseでデザパタとデザパタ本を読みながらメモっていく。

ProductName 増補改訂版Java言語で学ぶデザインパターン入門
結城 浩
ソフトバンククリエイティブ / ¥ 3,990 ()
通常24時間以内に発送

  • Adapter
    • handlesで委譲させるべし
  • Template Method
    • Moose::Roleで抽象クラス
    • requiresでメソッドの実装を要求
  • Factory Method
    • コンストラクタの実装を要求するとこはtemplate method
  • Singleton
  • Bridge
    • 機能と実装を委譲で緩く結びつける
    • 実装側はMoose::Roleで抽象クラス
  • Composite
  • Visitor
    • あとで
    • デザパタ本のjavaの実装だとacceptメソッドにオーバーロード使っている
  • Chain of Responsibility
    • あとで

型による制約とMoose::Roleでインターフェースや抽象クラスが作れるのがよいのかな。