+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__
+
+=encoding utf-8
+
+=head1 NAME
+
+Data::SExpression::Util - routines for processing linked lists
+
+=head1 SYNOPSIS
+
+ use Data::SExpression::Util qw/:all/;
+ my $list = cons 1, cons 2, cons 3, undef; # (1 2 3)
+ my $other_list = cons 4, cons 5, undef; # (4 5)
+
+ $list = append $list, $other_list; # $list is now (1 2 3 4 5)
+
+ say position 1, $list; # 0
+ say position 4, $list; # 3
+ say 'undef' unless defined position 0, $list; # undef
+
+ $list = rev $list; # (5 4 3 2 1)
+ $list = mapcar { $_ + 1 } $list; # (6 5 4 3 2)
+
+ say position 2, $list; # 4
+
+=head1 DESCRIPTION
+
+Data::SExpression::Util contains several routines for processing
+linked lists (represented L<Data::SExpression::Cons> objects). These
+are analogous to Lisp functions with the same names.
+
+Right now very few functions are implemented, more will come in the
+next version.
+
+The list of functions is:
+
+=over
+
+=item B<append>(I<$list>, I<$other_list>)
+
+Appends the list I<$other_list> at the end of the list I<$list>.
+
+=item B<mapcar> { I<block> } I<$list>
+
+Analogous to Perl's map function. Runs I<block> with each element of
+the list I<$list> as $_, and then returns a containing all of the
+result.
+
+=item B<rev>(I<$list>)
+
+Reverses a list
+
+=item B<position>(I<$elt>, I<$list>)
+
+Searches for I<$elt> in I<$list> and returns the first matching
+element (comparison is done via eq).
+
+=back
+
+=head1 AUTHOR
+
+Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2018 by Marius Gavrilescu
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.24.1 or,
+at your option, any later version of Perl 5 you may have available.
+
+
+=cut
projects / data-sexpression-util.git / commitdiff