File Coverage

blib/lib/Data/SExpression/Util.pm

Criterion	Covered	Total	%
statement	42	42	100.0
branch	10	10	100.0
condition			n/a
subroutine	13	13	100.0
pod	4	7	57.1
total	69	72	95.8

package Data::SExpression::Util;

use 5.014000;
use strict;
use warnings;
use parent qw/Exporter/;

our %EXPORT_TAGS = ( 'all' => [
	qw/cons
	   append
	   mapcar
	   rev
	   position
	  /]);

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our $VERSION = '0.000_001';

use Data::SExpression::Cons;

sub cons {
	my ($car, $cdr) = @_;
	Data::SExpression::Cons->new($car, $cdr);
}

sub append {
	my ($expr, $rest) = @_;
	if (defined $expr) {
		cons $expr->car, append($expr->cdr, $rest)
	} else {
		$rest
	}
}

sub mapcar (&@);

sub mapcar (&@) {
	my ($block, $expr) = @_;
	if (defined $expr) {
		my $result;
		do {
			local $_ = $expr->car;
			$result = $block->()
		};
		cons $result, mapcar { $block->($_) } $expr->cdr
	} else {
		undef
	}
}

sub revacc {
	my ($expr, $acc) = @_;
	if (defined $expr) {
		revacc ($expr->cdr, cons($expr->car, $acc))
	} else {
		$acc
	}
}

sub rev {
	my ($expr) = @_;
	revacc $expr, undef;
}

sub positionacc {
	my ($expr, $list, $acc) = @_;
	if (!defined $list) {
		undef
	} elsif ($list->car eq $expr) {
		$acc
	} else {
		positionacc($expr, $list->cdr, $acc + 1)
	}
}

sub position {
	my ($expr, $list) = @_;
	positionacc $expr, $list, 0
}

1;
__END__