Rosetta Dispatch Table (Interview Question)

[eyepopslikeamosquito]

Ha ha, nysus just reminded me of an old interview question I used to ask. Implement a simple dispatch table.

Let's start with a specification:

• The key of the dispatch table is a string \w+
• The name of the callback function is the key name with _callback appended
• Each callback function takes a single string parameter and returns a positive number

You must write the invoker function, which takes two arguments (the name and the string argument to be passed to the callback):

• If the name is invalid (e.g. "fred" below), invoker must return a negative number
• Otherwise, invoker must pass its second argument to the callback function and return what the callback function returns

To clarify, here is a sample implementation.

use strict;
use warnings;

# Callback functions ---------------------------------------

sub first_callback {
   my $z = shift;
   print "in first_callback, z=$z\n";
   return 1;
}

sub last_callback {
   my $z = shift;
   print "in last_callback, z=$z\n";
   return 2;
}

# Implementation of dispatch table -------------------------
# (You need to write this code)

my %op_table = ( first  => \&first_callback,
                 last   => \&last_callback,
               );

sub invoker
{
   my ($name, $z) = @_;
   exists($op_table{$name}) or return -1;
   $op_table{$name}->($z);
}

# Main program for testing ---------------------------------

for my $name ( "first", "last", "fred" ) {
   my $rc = invoker( $name, $name . '-arg' );
   print "$name: rc=$rc\n";
}

Running the above test program produces:

in first_callback, z=first-arg
first: rc=1
in last_callback, z=last-arg
last: rc=2
fred: rc=-1

Points to consider:

• Is a hash the recommended way to implement a dispatch table in Perl?
• How many other ways can you think of to implement it in Perl? (working demonstration code would be good)

For more fun, feel free to implement the above specification in another language of your choice.

[tybalt89]

Why create your own dispatch table when perl has one built in?

Or - violating specifications for fun? and profit?

#!/usr/bin/perl

# http://perlmonks.org/?node_id=1203952

use strict;
use warnings;

# Callback functions ---------------------------------------

sub first::callback {
   my $z = pop;
   print "in first_callback, z=$z\n";
   return 1;
}

sub last::callback {
   my $z = pop;
   print "in last_callback, z=$z\n";
   return 2;
}

sub UNIVERSAL::callback { -1 }

# Implementation of dispatch table -------------------------
# (You need to write this code)

#my %op_table = ( first  => \&first_callback,
#                 last   => \&last_callback,
#               );

sub invoker
{
   my ($name, $z) = @_;
   $name->callback($z);
}

# Main program for testing ---------------------------------

for my $name ( "first", "last", "fred" ) {
   my $rc = invoker( $name, $name . '-arg' );
   print "$name: rc=$rc\n";
}

Have I once again managed to fail an interview?

[eyepopslikeamosquito]

That's the sort of ingenuity and inventiveness I was hoping to provoke. Thanks.

Have I once again managed to fail an interview?

I think we both know I would be delighted to offer you a job without requiring an interview ... though I understand you are no longer looking. :)

[LanX]

some annotations:
• I would be cautious about name spaces like first:: and last:: , if you really need extra packages I'd use an extra parent one like callback::first etc
• I'd use ->can beforehand to check if the callback is really available, to avoid an unexpected die without good notice
• the STASH - your built in dispatch table - is a hash , just global (which leads to the first remark :)

[tybalt89]

Is there a case that ->can is needed that is not caught by UNIVERSAL::callback ?

[Limbic~Region]

eyepopslikeamosquito,
Over a decade ago, I wrote When should I use a dispatch table?. I no longer code and have all but left the Perl community to focus on other things. Just wondering if the performance overhead of dispatch tables still as much as they were back when I first investigated?

[Eily]

Did you get much variation in the working results? It seems kind of straightforward to me, but maybe it's because I'm too used to that idiom.

Is a hash the recommended way to implement a dispatch table in Perl?

There are at least two ways to do this with an array (either the key is an enum, or you iterate over the array for each call), but I wanted to try with closures (with an OO interface, to hide the complexity of creating the closure chain when adding the callbacks):

use strict;
use warnings;

# Callback functions ---------------------------------------

sub first_callback {
   my $z = shift;
   print "in first_callback, z=$z\n";
   return 1;
}

sub last_callback {
   my $z = shift;
   print "in last_callback, z=$z\n";
   return 2;
}

# Implementation of dispatch table -------------------------
# (You need to write this code)
package Invoker
{
  sub new
  {
    my ($class, $default) = @_;
    bless \(sub { shift; $default->(@_) }), $class; 
  }
  
  sub add
  {
    my ($self, $key, $callback) = @_;
    my $alt = $$self;
    $$self = sub { my $name = shift; $name eq $key ? $callback->(@_) :
+ $alt->($name => @_) };
    $self;
  }

  sub dispatch
  {
    my $self = shift;
    &{ $$self }(@_);
  }

}

sub default_callback 
{
  return -1;
}

my $invoker = Invoker->new(\&default_callback)
                     ->add(first  => \&first_callback)
                     ->add(last   => \&last_callback);

sub invoker {$invoker->dispatch(@_)};

# Main program for testing ---------------------------------

for my $name ( "first", "last", "fred" ) {
   my $rc = invoker( $name, $name . '-arg' );
   print "$name: rc=$rc\n";
}

This creates a chain of closures that each contain a key, the corresponding callback and a ref to the next closure in the chain. If the name matches the key, the callback is called, otherwise the parameters are passed to the next closure in the chain.

At first this was just supposed to be a silly implementation, though it did make me think about your first question: a hash is the best solution when using an exact match to a key as the dispatch condition, but the (iterative) array-based or closure-based implementations can accept any condition (though the only advantage of the closure-based solution over array-based is that it's more fun).

Edit: the init method has been renamed new, because I don't know why I didn't just do that in the first place. And made the explanation more complete

[Eily]

Bonus (got the idea by reading tybalt89's version)

sub Invoker::first    { shift; &first_callback }
sub Invoker::last     { shift; &last_callback }
sub Invoker::AUTOLOAD { -1 }

sub invoker 
{ 
  my $name = shift; 
  Invoker->$name(@_); 
}

It looks and kind of quacks like a symbolic ref on the method name, except it works under strict and warnings.

Edit: Actually if you ignore the first parameter of the callbacks, you can just use the symbols table as the containing hash and use the method above :)

use strict;
use warnings;

# Callback functions ---------------------------------------

sub first_callback {
   my (undef, $z) = @_;
   print "in first_callback, z=$z\n";
   return 1;
}

sub last_callback {
   my (undef, $z) = @_;
   print "in last_callback, z=$z\n";
   return 2;
}

sub default_callback { -1 }

# Dispatch -------------------------------------------------

%Dispatch:: = ( first => *first_callback,
                start => *first_callback,
                last  => *last_callback,
                AUTOLOAD => *default_callback);

sub invoker {
  my $name = shift;
  Dispatch->$name(@_);
}

# Main program for testing ---------------------------------

for my $name ( qw< first start last fred > ) {
   my $rc = invoker( $name, $name . '-arg' );
   print "$name: rc=$rc\n";
}

[eyepopslikeamosquito]

Thanks to everyone for their interesting and instructive responses.

For completeness, some candidates tried using symrefs, via something like this:

use strict;
use warnings;

sub Invoker::first_callback {
   my $z = shift;
   print "in first_callback, z=$z\n";
   return 1;
}

sub Invoker::last_callback {
   my $z = shift;
   print "in last_callback, z=$z\n";
   return 2;
}

sub invoker
{
   my ($name, $z) = @_;
   my $handler = 'Invoker::' . $name . "_callback";
   no strict 'refs';
   my $rc = eval { &$handler($z) };
   return defined($rc) ? $rc : -1;
}

# Main program for testing ---------------------------------

for my $name ( "first", "last", "fred" ) {
   my $rc = invoker( $name, $name . '-arg' );
   print "$name: rc=$rc\n";
}

or this:

use strict;
use warnings;

package Invoker;

sub first_callback {
   my $z = shift;
   print "in first_callback, z=$z\n";
   return 1;
}

sub last_callback {
   my $z = shift;
   print "in last_callback, z=$z\n";
   return 2;
}

sub invoker
{
   my ($name, $z) = @_;
   my $handler = $name . '_callback';
   no strict 'refs';
   exists(${__PACKAGE__.'::'}{$handler}) or return -1;
   &$handler($z);
}

package main;

# Main program for testing ---------------------------------

for my $name ( "first", "last", "fred" ) {
   my $rc = Invoker::invoker( $name, $name . '-arg' );
   print "$name: rc=$rc\n";
}

For cheap thrills, just now I tried implementing via Class::MOP. I'm a Class::MOP ignoramus, so please feel free to suggest better ways to do it.

use strict;
use warnings;
use Class::MOP;

# Callback functions ---------------------------------------

sub first_callback {
   my $z = $_[1];
   print "in first_callback, z=$z\n";
   return 1;
}

sub last_callback {
   my $z = $_[1];
   print "in last_callback, z=$z\n";
   return 2;
}

# Implementation of dispatch table -------------------------

my $invoker_pkg = Class::MOP::Package->create('Invoker');
$invoker_pkg->add_package_symbol('&first', \&first_callback);
$invoker_pkg->add_package_symbol('&last',  \&last_callback);

# use Data::Dumper;
# my $r = $invoker_pkg->namespace(); warn Dumper($r);

sub invoker
{
   my $name = shift;
   $invoker_pkg->has_package_symbol('&' . $name) or return -1;
   Invoker->$name(@_);
}

# Main program for testing ---------------------------------

for my $name ( "first", "last", "fred" ) {
   my $rc = invoker( $name, $name . '-arg' );
   print "$name: rc=$rc\n";
}

[duelafn]

I do like the hash for clean and obvious enumeration, but I hate the explicit hash and typing key names more than once, so I tend to hide both declaration and invocation in subs:

#!/usr/bin/perl -s
use strict;
use warnings;
use 5.014;

our $h;
sub callback; our %CALLBACKS;

# Callback functions ---------------------------------------

callback first => sub {
    my $z = shift;
    print "in first_callback, z=$z\n";
    return 1;
};

callback last => sub {
    my $z = shift;
    print "in last_callback, z=$z\n";
    return 2;
};

# Implementation of dispatch table -------------------------
# (You need to write this code)

sub callback {
    my ($name, $cb) = @_;
    $CALLBACKS{$name} = $cb;
}

sub invoker {
    my ($name, $z) = @_;
    return -1 unless exists($CALLBACKS{$name});
    $CALLBACKS{$name}->($z);
}

sub help {
    say "Available callbacks: @{[ sort keys %CALLBACKS ]}";
}

# Main program for testing ---------------------------------

exit help() if $h;

for my $name ( "first", "last", "fred" ) {
    my $rc = invoker( $name, $name . '-arg' );
    print "$name: rc=$rc\n";
}

Results:

$ perl /tmp/1203952.pl -h
Available callbacks: first last
$ perl /tmp/1203952.pl
in first_callback, z=first-arg
first: rc=1
in last_callback, z=last-arg
last: rc=2
fred: rc=-1