Using a functional programming style on Perl 5

Christian Jaeger

LeafPair.com

Note: a few changes have been applied since the presentation. You can see them in the commit history at https://github.com/pflanze/london.pm-talk.

Why functional programming in Perl?

I ...

used Perl as primary language 1998-2005
am using Scheme since 2005 if possible
am still using Perl a lot
am offering consulting in Perl

Overview

Functional Programming?
Can Perl do it?
Combinators
Linked lists, lazy evaluation
Haskell style lazy sequences

Functional programming?

A functional program

uses only pure functions and constants
- a function is pure when:
  - it doesn't have any other effect than returning a result value
  - its result value depends only on its arguments
- functions may take functions as arguments, and/or return functions
can only have other effects by way of instructing a non-functional program to do them
can use method calls if all method implementations are pure

Functional programming: why?

dependencies and flow of data are directly visible from expressions

no contortions necessary to test

TEST { null ->cons(1)->cons(2)->array }
  [2,1];

the ultimate detangling → reliable composability

Perl can do it, Right?

higher-order functions
```
my @b= map { $_*$_ } @a;
```

closures (functions created by other functions)

sub new_counter {
    my ($n)=@_;
    sub {
        $n++ 
    }
}

iteration using recursion

sub odd  { my ($n)=@_; $n == 0 ? 0 : even ($n - 1) }
sub even { my ($n)=@_; $n == 0 ? 1 : odd ($n - 1) }

Perl can do it, Right?

higher-order functions

my @b= map { $_*$_ } @a;
# hm, map is not taking a function as argument

closures (functions created by other functions)

sub new_counter {
    my ($n)=@_;
    sub {
        $n++ # Ok, that's not actually pure
    }
}

iteration using recursion

sub odd  { my ($n)=@_; $n == 0 ? 0 : even ($n - 1) }
sub even { my ($n)=@_; $n == 0 ? 1 : odd ($n - 1) }
# oh, Out of memory!

Perl can do it better

higher-order functions


sub array_map {
    my ($f, $a)=@_;
    [ map { &$f($_) } @$a ]
}

sub square {
    my ($x)= @_;
    $x * $x
}

my $b= array_map *square, $a;

Perl can do it better II

higher-order functions

use Method::Signatures;

func array_map ($f, $a) {
    [ map { &$f($_) } @$a ]
}

func square ($x) {
    $x * $x
}

my $b= array_map *square, $a;

Perl can do it better III

iteration by recursion

sub odd  { my ($n)=@_; $n == 0 ? 0 : even ($n - 1) }
sub even { my ($n)=@_; $n == 0 ? 1 : odd ($n - 1) }
odd 137001 # Out of memory!

to:

use Method::Signatures;
use Sub::Call::Tail;

func odd ($n) { $n == 0 ? 0 : tail even ($n - 1) }
func even ($n) { $n == 0 ? 1 : tail odd ($n - 1) }
odd 137001 # -> 1

# alternatively:
func odd ($n) { $n == 0 ? 0 : do { @_=($n - 1); goto \&even } }
...

Perl can do it better III

iteration by recursion

sub odd  { my ($n)=@_; $n == 0 ? 0 : even ($n - 1) }
sub even { my ($n)=@_; $n == 0 ? 1 : odd ($n - 1) }
odd 137001 # Out of memory!

to:

use Method::Signatures;
use Sub::Call::Tail;
use strict; use warnings; use warnings FATAL => 'uninitialized';

func odd ($n) { $n == 0 ? 0 : tail even ($n - 1) }
func even ($n) { $n == 0 ? 1 : tail odd ($n - 1) }
odd 137001 # -> 1

Perl can do it better III

iteration by recursion

sub odd  { my ($n)=@_; $n == 0 ? 0 : even ($n - 1) }
sub even { my ($n)=@_; $n == 0 ? 1 : odd ($n - 1) }
odd 137001 # Out of memory!

to:

use Method::Signatures;
use Sub::Call::Tail;
use strict; use warnings; use warnings FATAL => 'uninitialized';
# no stringification;

func odd ($n) { $n == 0 ? 0 : tail even ($n - 1) }
func even ($n) { $n == 0 ? 1 : tail odd ($n - 1) }
odd 137001 # -> 1

Perl can do it already?, cont

local (nested) functions

func outer ($n) {
    my $inner= func ($n, $tot) {
        $n > 0 ? &$inner($n-1, $tot*$n) : $tot 
    };
    &$inner($n, 1);
}

Perl can do it already?, cont

local (nested) functions

func outer ($n) {
    my $inner= func ($n, $tot) {
        $n > 0 ? &$inner($n-1, $tot*$n) : $tot # Global symbol "$inner"
    };
    &$inner($n, 1);
}

Perl can do it already?, cont

local (nested) functions

func outer ($n) {
    my $inner= func ($n, $tot) {
        $n > 0 ? &$inner($n-1, $tot*$n) : $tot # Global symbol "$inner"
    };
    &$inner($n, 1);
}

change to:

func outer ($n) {
    my $inner; $inner= func ($n, $tot) {
        $n > 0 ? &$inner($n-1, $tot*$n) : $tot
    }; 
    &$inner($n, 1);
}

Perl can do it already?, cont

local (nested) functions

func outer ($n) {
    my $inner= func ($n, $tot) {
        $n > 0 ? &$inner($n-1, $tot*$n) : $tot # Global symbol "$inner"
    };
    &$inner($n, 1);
}

change to:

func outer ($n) {
    my $inner; $inner= func ($n, $tot) { # leaks memory!
        $n > 0 ? &$inner($n-1, $tot*$n) : $tot
    }; 
    &$inner($n, 1);
}

Perl can do it with some help

func outer ($n) {
    my $inner; $inner= func ($n, $tot) { # leaks memory!
        $n > 0 ? &$inner($n-1, $tot*$n) : $tot
    }; 
    &$inner($n, 1);
}

for (1..1e6) { outer 10 };

Perl can do it with some help

use Scalar::Util 'weaken';

sub Weakened ($) {
    my ($ref)= @_;
    weaken $_[0];
    $ref
}

func outer ($n) {
    my $inner; $inner= func ($n, $tot) {
        $n > 0 ? &$inner($n-1, $tot*$n) : $tot
    }; 
    Weakened($inner)->($n, 1);
}

for (1..1e6) { outer 10 };

... or with a trick

Fixpoint combinator

# in FP::fix
func fix ($f) {
    sub {
	tail &$f (fix($f), @_)
    }
}

func outer ($n) {
    my $inner= fix func ($inner, $n, $tot) {
        $n > 0 ? &$inner($n-1, $tot*$n) : $tot
    }; 
    &$inner($n, 1);
}

Combinators

“A combinator is a higher-order function that uses only function application and earlier defined combinators to define a result from its arguments.” (en.wikipedia.org/wiki/Combinator)

example: function composition

func compose ($f,$g) { sub { &$f (&$g (@_)) } } func inc ($x) { $x + 1 } func square ($x) { $x * $x }
squareinc= compose square, *inc;	# equivalent to func squareinc ($x) { square (inc $x) }

Linked lists and lazy evaluation

Functional list generation:

repl> $l= [ 2, undef ]
$VAR1 = [ 2, undef ];
repl> $m= [ 1, $l ]
$VAR1 = [ 1, [ 2, undef ] ];
repl> $l
$VAR1 = [ 2, undef ];

repl> (cons 1, cons 2, null) -> array
$VAR1 = [ 1, 2 ];

Haskell:

Prelude> 1 : 2 : []
[1,2]

Lazy evaluation

evaluating expressions only when necessary

repl> $x = lazy { warn "evaluating!"; 2*3 }
$VAR1 = bless( ... , 'FP::Lazy::Promise' );
repl> force $x
evaluating! at (eval 104) line 1.
$VAR1 = 6;
repl> force $x
$VAR1 = 6;

repl> $x = lazy { 1 / 0 }
$VAR1 = bless( ... , 'FP::Lazy::Promise' );
repl> force $x
Illegal division by zero at (eval 112) line 1.

Haskell style

*Main> let ones = 1 : ones
*Main> take 5 ones
[1,1,1,1,1]

*Main> let alternating = True:False:alternating
*Main> take 5 alternating
[True,False,True,False,True]

Using functional-perl:

repl> func ones () { my $ones; $ones= lazy { cons 1, $ones };
                              Weakened $ones }
repl> ones->take(5)->array
$VAR1 = [ 1,1,1,1,1 ];

Haskell style: lazy sequences

Infinite stream calculated on demand:

Prelude> let fibs = 1:1:zipWith (+) fibs (tail fibs)
Prelude> take 10 fibs
[1,1,2,3,5,8,13,21,34,55]

Using functional-perl:

func fibs () {
    my $fibs; $fibs=
      cons 1, cons 1, lazy { stream_zip_with *add, $fibs, rest $fibs };
    $fibs
}
main> fibs->stream_take(10)->array
$VAR1 = [ 1,1,2,3,5,8,13,21,34,55 ];

Thanks for listening!

Questions?

Get the code from https://github.com/pflanze/functional-perl

and discuss it on functional-perl.org

May 28 2015, London Perl Mongers Technical Meeting