Use Scope::Upper's return ablility. Small bit of XS to detect wether …

…or not we returned

.gitignore

@@ -0,0 +1,9 @@
+/TryCatch.*
+!TryCatch.xs
+Makefile.old
+Makefile
+.*.sw?
+pm_to_blib
+blib/
+inc/
+META.yml

Makefile.PL

@@ -0,0 +1,19 @@
+use strict;
+use warnings;
+
+require 5.008001;
+
+use inc::Module::Install 0.77;
+
+name 'TryCatch';
+all_from 'lib/TryCatch.pm';
+
+requires 'Parse::Method::Signatures';
+requires 'B::Hooks::EndOfScope' => 0.05;
+requires 'Devel::Declare';
+requires 'Moose';
+requires 'Scope::Upper' => 0.04;
+
+WriteAll;
+
+

TryCatch.xs

@@ -0,0 +1,71 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#define MY_CXT_KEY "TryCatch::XS::_guts" XS_VERSION
+
+typedef struct {
+  int prev_op_is_return;
+  runops_proc_t old_runops;
+} my_cxt_t;
+
+START_MY_CXT
+
+static int
+my_runops(pTHX)
+{
+  OPCODE prev_opcode = OP_NULL;
+#ifdef PERL_IMPLICIT_CONTEXT
+  dMY_CXT;
+#else
+  dMY_CXT_INTERP(pTHX);
+#endif
+
+  while ((PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX))) {
+    PERL_ASYNC_CHECK();
+    prev_opcode = PL_op->op_type;
+  }
+  MY_CXT.prev_op_is_return = prev_opcode==OP_RETURN;
+  TAINT_NOT;
+  return 0;
+}
+
+
+MODULE = TryCatch PACKAGE = TryCatch::XS
+
+
+BOOT:
+{
+  MY_CXT_INIT;
+  MY_CXT.prev_op_is_return = 0;
+}
+
+void
+_monitor_return(code, array_ctx)
+SV* code;
+SV* array_ctx; // Desired wantarray context;
+  PROTOTYPE: DISABLE
+  PREINIT:
+    dMY_CXT;
+  PPCODE:
+    int ret, ctx;
+
+    MY_CXT.old_runops = PL_runops;
+    MY_CXT.prev_op_is_return = 0;
+    PL_runops = &my_runops;
+
+    ctx =  SvTRUE(array_ctx) ? G_ARRAY :
+           array_ctx != &PL_sv_undef ? G_SCALAR: G_VOID;
+
+    ret = call_sv(code, ctx);
+
+    SPAGAIN;
+    PL_runops = MY_CXT.old_runops;
+    XPUSHs(MY_CXT.prev_op_is_return ? &PL_sv_yes : &PL_sv_no);
+    XSRETURN(1+ret);
+
+void
+CLONE(...)
+    CODE:
+    MY_CXT_CLONE;
+

lib/TryCatch.pm

@@ -2,6 +2,15 @@ package TryCatch;
 
 use strict;
 use warnings;
+
+use base 'DynaLoader';
+
+our $VERSION = '1.000000';
+
+sub dl_load_flags { 0x01 }
+
+__PACKAGE__->bootstrap($VERSION);
+
 use Sub::Exporter -setup => {
   exports => [qw/try/],
   groups => { default => [qw/try/] },
@@ -29,12 +38,16 @@ our $SPECIAL_VALUE = \"no return";
 
 use Devel::Declare ();
 use B::Hooks::EndOfScope;
-use B::Hooks::Parser;
 use Devel::Declare::Context::Simple;
-use SlimSignature;
+#use Parse::Method::Signautres;
 use Moose::Util::TypeConstraints;
+use Scope::Upper qw/unwind want_at/;
 
-sub try {}
+sub try ($) {
+  my @ret = TryCatch::XS::_monitor_return($_[0], want_at(1));
+  #print("_monitor_return returned @ret @{[scalar @ret]}\n");
+  unwind @ret, 1 if pop @ret;
+}
 
 # This might be what catch should be
 sub catch{
@@ -55,7 +68,7 @@ sub catch{
   return $err if $cond->($err);
 }
 
-# Replace try with an actual eval call;
+# Replace try {} with an try sub {};
 sub _parse_try {
   my $pack = shift;
 
@@ -65,8 +78,9 @@ sub _parse_try {
     $ctx->inc_offset($len);
     $ctx->skipspace;
     my $ret = $ctx->inject_if_block(
-      q# BEGIN { TryCatch::try_postlude() } { BEGIN {TryCatch::try_inner_postlude() } #,
-      '; my $__t_c_ret = eval');
+      q# BEGIN { TryCatch::try_postlude() } #,
+      'sub '
+    );
   }
 
 }
@@ -114,7 +128,7 @@ sub try_postlude_block {
 
   } elsif ($toke eq 'finally') {
   } else {
-    my $str = '; return $__t_c_ret if !ref($__t_c_ret) || $__t_c_ret != $TryCatch::SPECIAL_VALUE;'; 
+    my $str = ';';# return $__t_c_ret if !ref($__t_c_ret) || $__t_c_ret != $TryCatch::SPECIAL_VALUE;'; 
     substr( $linestr, $offset, 0 ) = $str;
 
     $ctx->set_linestr($linestr);
@@ -155,7 +169,7 @@ sub process_catch {
   print("process_catch: $first '$sub'\n");
 
   if (substr($linestr, $ctx->offset, 1) eq '(') {
-    my ($param, $left) = SlimSignature->param(
+    my ($param, $left) = ( # TODO: Parse::Method::Signatures->param
       input => $linestr,
       offset => $ctx->offset+1 );
 
@@ -206,4 +220,19 @@ sub process_catch {
     substr($linestr, $ctx->offset) . "'\n");
   $ctx->inject_if_block( 'BEGIN { TryCatch::catch_postlude() }');
 }
+
 1;
+
+__END__
+
+=head1 NAME
+
+TryCatch - first class try catch semantics for Perl, with no source filters.
+
+=head1 AUTHOR
+
+Ash Berlin <ash@cpan.org>
+
+=head1 LICENSE
+
+Licensed under the same terms as Perl itself.

t/simple.t

@@ -5,17 +5,25 @@ use Test::More tests => 3;
 BEGIN { use_ok "TryCatch" }
 
 sub simple_return {
-  #try {
-  #  1+1;
-  #}
   try {
     return "simple_return";
   }
 
   print("foo\n");
   return "bar";
 }
+sub simple_no_return {
+  try {
+    "simple_return"; # Not a return op
+  }
+
+  return "bar";
+}
+
+is(simple_return(), "simple_return");
+is(simple_no_return(), "bar");
 
+__END__
 
 sub simple_catch {
   try {
@@ -44,5 +52,4 @@ sub catch_2 {
   return "Shouldn't get here either";
 }
 
-is(simple_return(), "simple_return");
 is(simple_catch(), "str_error: Foo\n");