Perlでも普通のリスト操作を

30分プログラム、その372。Perlの話をするたびに、id:Gemmaさんが「Perlのリストはキモい、キモすぎる。ネストするだけでリファレンスを使うなんでありえない。」と言いつづけてる。
なので、Perlでもごく普通の単方向リストを作ってみた。これなら、あたりまえにネストできるぜ。

ネタのつもりで作ったんだけど、割りといいかもしれない。特にmapとかfold_rightみたいな再帰関数が、わりとすんなり実装できるのがうれしい。

使い方

# consしてリストを作る
my $xs = List->cons(1,
          List->cons(2,
            List->cons(3,List->nil)));

# 文字列にして表示
#   => (1, 2, 3)
print $xs->to_string,"\n";

# 別のリストの作り方
my $ys = List->new(1,2,3);
print $ys->to_string,"\n";

# mapを使って、全部1づつインクリメント
#   => (2, 3, 4)
my $zs = $ys->map(sub { $_[0] + 1 });

# fold_rightを使って、合計を求める
my $sum = $ys->fold_right(sub { $_[0] + $_[1] },0);

ソースコード

#! /usr/bin/perl
# -*- mode:perl; coding:utf-8 -*-
#
# list.pl -
#
# Copyright(C) 2008 by mzp
# Author: MIZUNO Hiroki / mzpppp at gmail dot com
# http://howdyworld.org
#
# Timestamp: 2008/09/22 23:34:40
#
# This program is free software; you can redistribute it and/or
# modify it under MIT Lincence.
#
use strict;
use warnings;


package List;
use Data::Dumper;
sub new{
    my ($class,$x,@xs) = @_;
    if(@xs == 0){
	List->cons($x,List->nil);
    }else{
	List->cons($x,List->new(@xs));
    }
}

sub cons{
    my ($class,$head,$tail) = @_;
    bless({head=>$head,tail=>$tail},$class);
}

my $nil = bless({head=>undef,tail=>undef});
sub nil{
    $nil;
}

# method
sub head{
    my ($self) = @_;
    $self->{'head'};
}

sub tail{
    my ($self) = @_;
    $self->{'tail'};
}

sub is_empty{
    my ($self) = @_;
    $self == $nil;
}

sub map{
    my ($self,$f) = @_;
    if($self->is_empty){
	$self;
    }else{
	List->cons($f->($self->head),
		   $self->tail->map($f));
    }
}

sub fold_right{
    my ($self,$f,$init) = @_;
    if($self->tail->is_empty){
	$f->($self->head,$init);
    }else{
	$f->($self->head,$self->tail->fold_right($f,$init));
    }
}

sub to_string{
    my ($self) = @_;
    if($self->is_empty){
	'nil'
    }else{
	my $s =$self->fold_right(
	    sub { 
		my ($a,$b) = @_;
		if($b eq ''){ $a }else{ $a .', ' . $b} 
	    } , '');
	"(${s})";
   }
}


package main;
use Data::Dumper;

my $xs = List->cons(1,
		    List->cons(2,
			       List->cons(3,List->nil)));
print $xs->to_string,"\n";

my $ys = List->new(1,2,3);
print $ys->to_string,"\n";

print $ys->map(sub { $_[0] + 1 })->to_string,"\n";

print $ys->fold_right(sub { $_[0] + $_[1] },0),"\n";

参考

• 過去の30分プログラム