[slimpl] First Post! Catch/throw in Perl

[Larry Clapp]

Hi, all, and welcome to the slimpl / slim-vim list.

I thought I'd kick of the list with a little code.

This weekend I finally had most of the scaffolding in place to take a
hack at porting slime-eval, but I didn't finish, because slime-eval
uses catch/throw, which Perl doesn't have, at least not as such, so I
wrote one.  (I checked CPAN first, and the stuff I found there all
talk about "exceptions", which catch/throw aren't.)  Comments welcome.

# This catch/throw differs from Common Lisp's catch/throw in that you
# should use a string or number as the tag, since the tags are
# compared using Perl's eq, the equivalent of CL's string=.  Also it
# doesn't throw an error if there's not a valid catch for the throw,
# it just throws it and the program will die with an uncaught
# exception.  That'll probably change in the real implementation.
{
  my $secret = []; # create a secret value

  sub catch ($&) {
    my( $tag, $code ) = @_;
    my( $res, @res );
    my $wantarray = wantarray;
    eval {
      if ($wantarray) {
        @res = &$code();
      } else {
        $res = &$code();
      }
    };
    # detect exception / throw
    if ($@) {
      # detect a real throw ...
      if (ref( $@ ) eq 'ARRAY'
        && ref( $@->[ 0 ] ) eq 'ARRAY'
        && $@->[ 0 ] == $secret
        # ... to current tag
        && $@->[ 1 ] eq $tag)
      {
        my @thrown_values = @{ $@ };
        splice @thrown_values, 0, 2;
        if ($wantarray
          || @thrown_values > 1)
        {
          return @thrown_values;
        } else {
          return $thrown_values[ 0 ];
        }
      } else {
        # Not a throw, or not to current tag -- propagate it.
        die $@;
      }
    } else {
      # no exception -- return appropriate result
      return( $wantarray ? @res : $res );
    }
  }

  sub throw {
    # give the "this is a throw" password
    die [ $secret, @_ ];
  }
}

-- Larry