Sub::Multi - Data::Bind-based multi-sub dispatch

Sub-Multi documentation Contained in the Sub-Multi distribution.

Index

Code Index:

NAME

Top

Sub::Multi - Data::Bind-based multi-sub dispatch

SYNOPSIS

Top

 my $multi_sub = Sub::Multi->new($sub1, $sub2, $sub3);

Now dispatch to the right subroutine, based on @args.

 $multi_sub->(@args);

DESCRIPTION

Top

Perl6 allows multiple subs and methods with the same name, differing only in their signature.

    multi sub bar (Dog $foo) {?}
    multi sub bar (Cat $foo) {?}

Dispatching will happen based on the runtime signature of the subroutine or method call.

new

 my $multi_sub = Sub::Multi->new($sub1, $sub2, $sub3);
 $multi_sub->(@args);

Build and return a code reference that will dispatch based on the Perl6 multi dispatch semantics.

TODO: Verify this statement: Before the method is actually dispatched, a call to Data::Bind->sub_signature should be made to register the subroutine signature.

add_multi

  my $multi_sub  =  Sub::Multi->add_multi($sub_name, \&sub );
  $multi_sub->(@args);

Associates $sub_name with \&sub, and returns code reference that will dispatch appropriately. add_multi can be called multiple times with the same $sub_name to build a multi-dispatch method.

TODO: Verify this statement: Before the method is actually dispatched, a call to Data::Bind->sub_signature should be made to register the subroutine signature.

SEE ALSO

Top

Data::Bind

TODO: Add a good reference to Perl6 multiple dispatch here.

AUTHORS

Top

Chia-liang Kao <clkao@clkao.org>

COPYRIGHT

Top

Copyright 2006 by Chia-liang Kao and others.

This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

See http://www.perl.com/perl/misc/Artistic.html

Sub-Multi documentation Contained in the Sub-Multi distribution. 
package Sub::Multi;
our $VERSION = '0.003';
use 5.008;
use base 'Class::Multimethods::Pure';
use Data::Bind 0.27;



sub new {
    my ($class, @subs) = @_;
    return bless sub { $class->dispatch(\@subs, @_) }, 'Sub::Multi::Method';
}


sub add_multi {
    my ($class, $name, $sub) = @_;
    my $pkg = ((caller)[0]);
    no strict 'refs';
    my $subs = ${$pkg."::SUB_MULTI_REGISTRY"} ||= [];
    push @$subs, $sub;
    no warnings 'redefine';
    *{$pkg."::$name"} = $class->new(@$subs);
}

sub dispatch {
    my $class = shift;
    my $subs = shift;
    my @compat;
    for my $variant (@$subs) {
	my $cv = Data::Bind::_get_cv($variant);
	push @compat, $variant if *$cv->{sig}->is_compatible( [ @{$_[0]} ], { %{$_[1]} } );
    }
    die 'I hate vapour ware' unless @compat;
    while (@compat != 1) {
	die 'I hate ambiguous software';
    }
    goto $compat[0];
}

1;