From 45be15da3b109c2ef900c87c4a6c59f9419339fa Mon Sep 17 00:00:00 2001 From: Marius Gavrilescu Date: Mon, 30 Apr 2018 23:25:14 +0300 Subject: [PATCH] Initial commit --- Changes | 4 + MANIFEST | 6 ++ Makefile.PL | 24 ++++++ README | 31 +++++++ lib/Data/SExpression/Util.pm | 155 +++++++++++++++++++++++++++++++++++ t/Data-SExpression-Util.t | 22 +++++ 6 files changed, 242 insertions(+) create mode 100644 Changes create mode 100644 MANIFEST create mode 100644 Makefile.PL create mode 100644 README create mode 100644 lib/Data/SExpression/Util.pm create mode 100644 t/Data-SExpression-Util.t diff --git a/Changes b/Changes new file mode 100644 index 0000000..ccbc0d8 --- /dev/null +++ b/Changes @@ -0,0 +1,4 @@ +Revision history for Perl extension Data::SExpression::Util. + +0.000_001 2018-04-30T21:25+01:00 + - Initial release, only a few functions available diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..6ef75f4 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,6 @@ +Changes +Makefile.PL +MANIFEST +README +t/Data-SExpression-Util.t +lib/Data/SExpression/Util.pm diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..44244ec --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,24 @@ +use 5.014000; +use ExtUtils::MakeMaker; + +WriteMakefile( + NAME => 'Data::SExpression::Util', + VERSION_FROM => 'lib/Data/SExpression/Util.pm', + ABSTRACT_FROM => 'lib/Data/SExpression/Util.pm', + AUTHOR => 'Marius Gavrilescu ', + MIN_PERL_VERSION => '5.14.0', + LICENSE => 'perl', + SIGN => 1, + PREREQ_PM => { + qw/Data::SExpression 0.41/, + }, + TEST_REQUIRES => { + qw/Data::Dump::Sexp 0/, + }, + META_ADD => { + dynamic_config => 0, + resources => { + repository => 'https://git.ieval.ro/?p=data-sexpression-util.git', + }, + } +); diff --git a/README b/README new file mode 100644 index 0000000..4c79b7f --- /dev/null +++ b/README @@ -0,0 +1,31 @@ +Data-SExpression-Util version 0.000_001 +======================================= + +Data::SExpression::Util contains several routines for processing +linked lists (represented Data::SExpression::Cons objects). These are +analogous to Lisp functions with the same names. + +INSTALLATION + +To install this module type the following: + + perl Makefile.PL + make + make test + make install + +DEPENDENCIES + +This module requires these other modules and libraries: + +* Data::SExpression + +COPYRIGHT AND LICENCE + +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. + + diff --git a/lib/Data/SExpression/Util.pm b/lib/Data/SExpression/Util.pm new file mode 100644 index 0000000..5ba8da3 --- /dev/null +++ b/lib/Data/SExpression/Util.pm @@ -0,0 +1,155 @@ +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 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(I<$list>, I<$other_list>) + +Appends the list I<$other_list> at the end of the list I<$list>. + +=item B { I } I<$list> + +Analogous to Perl's map function. Runs I with each element of +the list I<$list> as $_, and then returns a containing all of the +result. + +=item B(I<$list>) + +Reverses a list + +=item B(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, Emarius@ieval.roE + +=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 diff --git a/t/Data-SExpression-Util.t b/t/Data-SExpression-Util.t new file mode 100644 index 0000000..e1a4f5a --- /dev/null +++ b/t/Data-SExpression-Util.t @@ -0,0 +1,22 @@ +#!/usr/bin/perl +use strict; +use warnings; + +use Test::More tests => 6; +use Data::Dump::Sexp qw/dump_sexp/; +BEGIN { use_ok('Data::SExpression::Util', ':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) + +is position(1, $list), 0; +is position(4, $list), 3; +ok !defined(position 0, $list); + +$list = rev $list; +is dump_sexp($list), '(5 4 3 2 1)'; + +$list = mapcar { $_ + 1 } $list; # (6 5 4 3 2) +is dump_sexp($list), '(6 5 4 3 2)'; -- 2.39.2