File Coverage

blib/lib/fp.pm

Criterion	Covered	Total	%
statement	64	64	100.0
branch	44	50	88.0
condition			n/a
subroutine	50	50	100.0
pod	44	44	100.0
total	202	208	97.1

package fp;

use strict;
use warnings;

our $VERSION = '0.03';

## import routine
## --------------------------------------------------
# NOTE:
# every effort has been made with import
# subroutine to not use the assignment
# statement, but since you can't export
# without it, it had to be done. I don't
# consider this as part of the library
# but rather part of the infastructure of
# this module.
sub import {
    no strict 'refs';
    my $package = shift;
    # we have to use the build in map
    # here instead of fp::apply, in
    # order to get an accurate value
    # from caller. If we use fp::apply,
    # it's recursion will cause issues
    # with that.
    map {
        *{(caller())[0] . "::$_"} = \&{"${package}::$_"}
        } (fp::filter(sub {
                    defined &{"${package}::$_[0]"}
                  }, (fp::is_not_equal_to(fp::len(fp::tail(@_)), 0) ?
                            fp::tail(@_)
                            :
                            fp::filter(
                                sub { fp::is_not_equal_to("import", fp::head(@_)) },
                                fp::list(keys %{"${package}::"})
                                )))) }

## functional constants
## --------------------------------------------------
# boolean constants
sub true  () { 1 }
sub false () { 0 }

# empty list constant
sub nil () { () }

## list operations
## --------------------------------------------------
# creation
sub list (@);
sub list (@) { @_ }

# emptiness predicates
sub is_empty     (@) { @_ ? 0 : 1 }
sub is_not_empty (@) { @_ ? 1 : 0 }

# selection
sub head  (@) { $_[0] }
sub tail  (@) { @_[ 1 .. $#_ ] }

# selection macros
sub first  (@) { is_not_empty(@_) ? head @_ : nil }
sub second (@) { first  tail @_ }
sub third  (@) { second tail @_ }
sub fourth (@) { third  tail @_ }
sub fifth  (@) { fourth tail @_ }
sub sixth  (@) { fifth  tail @_ }

sub reduce (@) { tail @_ }

# random access
sub nth (@); # pre-declare sub so it can be used in recursion
sub nth (@) {
	(is_empty(tail @_)) ?
		nil
		:
		((head @_) == 0) ?
			second @_
			:
			nth(((head @_) - 1), (reduce tail @_)) }

# length
sub len (@); # pre-declare sub so it can be used in recursion
sub len (@) { @_ ?  1 + len(reduce @_) : 0 }

# end access
sub end (@) { nth((len(@_) - 1), @_)  }

# add element to the head of the list
sub prepend (@) { @_ }

# add element to the end of the list
sub append (@) { ((tail @_), (head @_)) }

# combine two lists
sub combine (@) { @_ }

# reverse a list
sub rev (@); # pre-declare sub so it can be used in recursion
sub rev (@) {
	(is_empty @_) ?
		nil
		:
		(rev(reduce @_), (first @_)) }

# list membership predicate
sub member (@); # pre-declare sub so it can be used in recursion
sub member (@) {
	(is_empty(tail @_)) ?
		false
		:
		(is_equal_to((first @_),(second @_))) ?
			true
			:
			member((first @_), (reduce tail @_)) }

# make a list into a set (list with unique elements)
sub unique (@); # pre-declare sub so it can be used in recursion
sub unique (@) {
	(is_empty(@_)) ?
		nil
		:
		(member((first @_), (tail @_))) ?
			(nil, unique(reduce @_))
			:
			((first @_), unique(reduce @_)) }

# unique prepend - returns unique list or original list
sub unique_prepend (@) {
	(member((first @_), (tail @_))) ?
		tail @_
		:
		prepend(@_) }

# unique append - returns unique list or original list
sub unique_append (@) {
	(member((first @_), (tail @_))) ?
		tail @_
		:
		append(@_) }

# unique combine function - takes the whole argument list
sub unique_combine (@) { unique(@_) }

## set (unique list) operations
## --------------------------------------------------

# adjoin a set with mutliple new elements
sub adjoin (@) { unique(@_) }

# union of two sets is a list of all thier unique elements
sub union (@) { unique(@_) }

# intersection of two sets is a list of all elements found in both
sub intersection (@); # pre-declare sub so it can be used in recursion
sub intersection (@) {
	(is_empty(@_)) ?
		nil
		:
		(member((first @_), (tail @_))) ?
			((first @_), intersection(reduce @_))
			:
			(nil, intersection(reduce @_)) }

# differnce of two sets is a list of elements from the first lists
# that are not contained in the second list
## NOTE - this cannot be implemented because of perl's auto-list-flatening

# xor of two sets is a list of elements not found in both
## NOTE - this cannot be implemented because of perl's auto-list-flatening
## --------------------------------------------------

## function constructor
## --------------------------------------------------
sub function (&);
sub function (&) { (head @_) }

## --------------------------------------------------
# map a function to a list
sub apply (@);  # pre-declare sub so it can be used in recursion
sub apply (@) {
	(is_empty(tail @_)) ?
		nil
		:
		(&{first(@_)}(second @_), apply((first @_), (reduce tail @_))) }

# filter a list based on a function
sub filter (@);  # pre-declare sub so it can be used in recursion
sub filter (@) {
	(is_empty(tail @_)) ?
		nil
		:
		(&{first(@_)}(second @_)) ?
			((second @_), filter((first @_), (reduce tail @_)))
			:
			(nil, filter((first @_), (reduce tail @_))) }

## list reduction functions
## --------------------------------------------------
# sum a list of integers
sub sum (@); # pre-declare sub so it can be used in recursion
sub sum (@) {
	(is_empty @_) ?
		0
		:
		first(@_) + sum(reduce @_) }

# concatenate a list of strings
sub concat (@); # pre-declare sub so it can be used in recursion
sub concat (@) {
	(is_empty @_) ?
		""
		:
		first(@_) . concat(reduce @_) }

# multiply a list of integers
sub product (@); # pre-declare sub so it can be used in recursion
sub product (@) {
	(is_empty @_) ?
		1
		:
		first(@_) * product(reduce @_) }

## list expansion functions
## --------------------------------------------------
# split up a string
sub explode ($) { (first(@_) =~ /(.)/g) }

# split up a multi-digit numeral
sub slice_by ($) { (first(@_) =~ /\d/g) }

# get a range of elements
sub range ($$) { (first(@_) .. second(@_)) }

## misc. predicates
## --------------------------------------------------
# even and odd mutually recursive predicates
sub is_even ($) {
	(first(@_) <= 0) ?
		true
		:
		is_odd(first(@_) - 1) }

sub is_odd ($) {
	(first(@_) <= 0) ?
		false
		:
		is_even(first(@_) - 1) }

sub is_not_equal_to ($$) {
    (not is_equal_to(@_)) }

sub is_equal_to ($$) {
	(is_digit(head @_)) ?
        (head(@_) == tail(@_))
        :
        (head(@_) eq tail(@_)) }

sub is_digit ($) {
	(first(@_) =~ /\d/) }

sub is_whitespace ($) {
	(first(@_) =~ /\s/) }

sub is_alpha ($) {
	(first(@_) =~ /[a-zA-Z]/) }

1;

__END__