File Coverage

blib/lib/fp/lambda.pm

Criterion	Covered	Total	%
statement	118	118	100.0
branch			n/a
condition			n/a
subroutine	50	56	89.2
pod			n/a
total	168	174	96.5

package fp::lambda;

use strict;
use warnings;

our $VERSION = '0.01';

BEGIN {
    require fp;
    *import = \&fp::import;
}

## Church Booleans

# TRUE := λ x. λ y. x
*TRUE = sub {
    my $x = shift;
    sub { $x }
};

# FALSE :=  λ x. λ y. x
*FALSE = sub {
    my $x = shift;
    sub { shift }
};

# AND := λ p. λ q. p q FALSE
*AND = sub {
    my $p = shift;
    sub {
        my $q = shift;
        $p->($q)->(\&FALSE);
    }
};

# OR := λ p. λ q. p TRUE q
*OR = sub {
    my $p = shift;
    sub {
        my $q = shift;
        $p->(\&TRUE)->($q);
    }
};

# NOT := λ p. p FALSE TRUE
*NOT = sub {
    my $p = shift;
    $p->(\&FALSE)->(\&TRUE);
};

# cond := λ p. λ x. λ y. p x y
*cond = sub {
    my $p = shift;
    sub {
        my $x = shift;
        sub {
            my $y = shift;
            $p->($x)->($y);
        }
    }
};

## Church Numeral

# 0 := λ f. λ x. x
*zero = sub {
    my $f = shift;
    sub { shift }
};

# succ := λ n. λ f. λ x. f (n f x)
*succ = sub {
    my $n = shift;
    sub {
        my $f = shift;
        sub {
            my $x = shift;
            $f->( $n->($f)->($x) )
        }
    }
};

# pred := λ m. first (m (λ p. pair (second p) (plus one (second p))) (pair zero zero))
*pred = sub {
    my $m = shift;
    sub {
        first($m->(sub {
                my $p = shift;
                pair(second($p))->(plus(\&one)->(second($p)))
            })->(pair(\&zero)->(\&zero)))
    }->()
};

# plus := λ m. λ n. λ f. λ x. m f (n f x)
*plus = sub {
    my $m = shift;
    sub {
        my $n = shift;
        sub {
            my $f = shift;
            sub {
                my $x = shift;
                $m->( $f )->( $n->($f)->($x) )
            }
        }
    }
};

# subtract := λ m. λ n. n pred m
*subtract = sub {
    my $m = shift;
    sub {
        my $n = shift;
        $n->(\&pred)->($m);
    }
};

# multiply := λ m. λ n. m (plus n) zero
*multiply = sub {
    my $m = shift;
    sub {
        my $n = shift;
        $m->(plus($n))->(\&zero);
    }
};

# now make 1 .. 10

*one   = succ(\&zero);
*two   = succ(\&one);
*three = succ(\&two);
*four  = succ(\&three);
*five  = succ(\&four);
*six   = succ(\&five);
*seven = succ(\&six);
*eight = succ(\&seven);
*nine  = succ(\&eight);
*ten   = succ(\&nine);

## Predicates

# is_zero := λ n. n (λ x. FALSE) TRUE
*is_zero = sub {
    my $n = shift;
    $n->(sub { \&FALSE })->(\&TRUE);
};

# is_equal := λ m. λ n. and (is_zero (m pred n)) (is_zero (n pred m))
*is_equal = sub {
    my $m = shift;
    sub {
        my $n = shift;
        AND(
            is_zero($m->(\&pred)->($n))
        )->(
            is_zero($n->(\&pred)->($m))
        )
    }
};

## Data Structures

## Pairs

# pair := λ f. λ s. λ b. b f s
*pair = sub {
    my $f = shift;
    sub {
        my $s = shift;
        sub {
            my $b = shift;
            $b->($f)->($s);
        }
    }
};

# first := λ p p TRUE
*first = sub {
    my $p = shift;
    $p->(\&TRUE)
};

# second := λ p p FALSE
*second = sub {
    my $p = shift;
    $p->(\&FALSE)
};

# List functions

# NIL := pair TRUE TRUE
*NIL = pair(\&TRUE)->(\&TRUE);

# cons := λ h. λ t. pair FALSE (pair h t)
*cons = sub {
   my $h = shift;
   sub {
       my $t = shift;
       pair(\&FALSE)->(pair($h)->($t));
   }
};

# head := λ z. first (second z)
*head = sub {
    my $z = shift;
    first(second($z));
};

# tail := λ z. second (second z)
*tail = sub {
    my $z = shift;
    second(second($z));
};

# is_NIL := first
*is_NIL = \&first;

# is_not_NIL := λ x. NOT is_NIL
*is_not_NIL = sub {
    my $x = shift;
    NOT(is_NIL($x))
};

# size := λ l. cond (is_not_NIL l) (λ x. succ (size (tail l))) (λ l. zero)
*size = sub {
    my $l = shift;
    cond(is_not_NIL($l))->(
        # have to wrap this to get lazy evaluation
        sub { succ(size(tail($l))) }
    )->(
        sub { \&zero }
    )->();
};

# sum := λ l. cond (is_not_NIL l) (λ x. plus (head l) (sum (tail l))) (λ l. zero)
*sum = sub {
    my $l = shift;
    cond(is_not_NIL($l))->(
        sub { plus(head($l))->(sum(tail($l))) }
    )->(
        sub { \&zero }
    )->()
};

# append := λ l1. λ l2. cond (is_NIL l1) (l2) (cons (head l1) (append (tail l1) l2))
*append = sub {
    my $l1 = shift;
    sub {
        my $l2 = shift;
        cond(is_NIL($l1))->(
            sub { $l2 }
        )->(
            sub { cons(head($l1))->(append(tail($l1))->($l2)) }
        )->();
    }
};

# rev := λ l. cond (is_not_NIL) (NIL) (append rev(tail l) cons((head l) NIL))
*rev = sub {
    my $l = shift;
    cond(is_not_NIL($l))->(
        sub { append(rev(tail($l)))->(cons(head($l))->(\&NIL)) }
    )->(
        sub { \&NIL }
    )->()
};


# nth := λ n. λ l. cond (is_NIL l) (NIL) (cond (is_equal n zero) (head l) (nth (pred n)) (tail l)) )
*nth = sub {
  my $n = shift;
  sub {
      my $l = shift;
      cond(is_NIL($l))->(
          sub { \&NIL }
      )->(
          cond(is_equal($n)->(\&zero))->(
              sub { head($l) }
          )->(
              sub { nth(pred($n))->(tail($l)) }
          )
      )->()
  }
};

# apply := λ f. λ l. cond (is_NIL l) (NIL) (cons (f (head l)) (apply f (tail l)))
*apply = sub {
    my $f = shift;
    sub {
        my $l = shift;
        cond(is_NIL($l))->(
            sub { \&NIL }
        )->(
            sub { cons($f->(head($l)))->(apply($f)->(tail($l))) }
        )->()
    }
};

1;

__END__